Описать процедуру, которая вставляет в непустой список L пару новых элементов Е1 и Е2 перед его последним элементом

Program Spisok;
uses
  crt; 
type
  Tinf=integer; {тип данных, который будет храниться в элементе списка}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;   {указатель на следующий элемент списка}
  end;
 
{Процедура добавления нового элемента в односвязный список}
procedure AddElem(var spis1:List;znach1:TInf);
var
  tmp:List;
begin
  begin
    tmp:=spis1;
    while tmp^.next<>nil do
      tmp:=tmp^.next; {ставим tmp на последний элемент списка}
    GetMem(tmp^.next,sizeof(TList)); {создаём следующий элемент}
    tmp:=tmp^.next;   {переносим tmp на новый элемент}
  end;
  tmp^.next:=nil; {зануляем указатель}
  tmp^.data:=znach1; {заносим значение}
end;

procedure AddElem(var spis1:List;znach1:TInf);
var
  p, t : List;
begin
  new(t);
  t^.data := znach1;
 
  p := spis1;
  if (p = nil) or (p^.next = nil) then // spis1 или пустой, или состоит только из одного элемента
  begin
    // тогда надо сделать НОВЫЙ элемент первым (указать next-ом на spis1, и изменить значение spis1)
    t^.next := spis1;
    spis1 := t;
  end
  else // в списке было больше одного элемента
  begin
    // значит, идем по списку, пока не встретим ПРЕДпоследний элемент
    while p^.next^.next <> nil do p := p^.next;
    // новый элемент будет указывать на последний
    t^.next := p^.next;
    // а ПРЕДпоследний - на новый...
    p^.next := t;
  end;
end;

Program Spisok;
uses
  crt;
type
  Tinf=integer;
  List=^TList;
  TList=record
    data:TInf;
    next:List;
  end;
 
procedure AddElem(var spis1:List;znach1:TInf);
var
  p, t : List;
begin
  new(t);
  t^.data := znach1;
 
  p := spis1;
  if (p = nil) or (p^.next = nil) then
  begin
    t^.next := spis1;
    spis1 := t;
  end
  else
  begin
    while p^.next^.next <> nil do p := p^.next;
    t^.next := p^.next;
    p^.next := t;
  end;
end;
 
var
  L, q : list;
begin
  l := nil;
  addelem(l, 1);
  addelem(l, 2);
  addelem(l, 3);
  addelem(l, 4);
  addelem(l, 5);
  addelem(l, 6);
 
  q := l;
  while q <> nil do
  begin
    write(q^.data:4);
    q := q^.next;
  end;
  writeln;
  readln;
end.

Uses crt;
type tinf=integer;
     uk=^rec;
     rec=record
      x:integer;
      adr:uk;
     end;
Var first, p1, p2, p3, l, q:uk;
    f:text;
 
procedure SOZD_SPIS ;
begin
assign(f,'dinspis.txt');
reset(f);
first:=nil;
while not seekeof(f) do begin
new(p1); read(f,p1^.x);
if first=nil then first:=p1
else p2^.adr:=p1;
p2:=p1;
end;
p2^.adr:=nil;
close(f);
end;
 
Procedure VIVOD(t:string) ;
begin
writeln(t);
p1:=first;
while p1<>nil do begin
write (p1^.x, ' ');
p1:=p1^.adr;
end;
writeln;
end;
 
procedure AddElem(var spis1:uk;znach1:tinf);
var
  p,t:uk;
begin
  new(t);
  t^.x := znach1;
  p:=spis1;
  if (p = nil) or (p^.adr = nil) then
  begin
    t^.adr:=spis1;
    spis1:=t;
  end
  else
  begin
    while p^.adr^.adr <> nil do p:=p^.adr;
    t^.adr := p^.adr;
    p^.adr := t;
  end;
end;
 
Begin
SOZD_SPIS;
VIVOD('исходн');
  l:=nil;
  addelem(l, 1);
  q:=l;
  while q<>nil do
  begin
    write(q^.x:4);
    q:=q^.adr;
  end;
  writeln;
  readln;
VIVOD('после вставки');
readkey;
End.

Begin
SOZD_SPIS;
VIVOD('исходн');
  l:=nil;
  addelem(l, 1);
  l^.adr := first; // <--- 
  
  q:=l;
  VIVOD('после вставки');
  while q<>nil do
  begin
    write(q^.x:4);
    q:=q^.adr;
  end;
  writeln;
  readln;
End.

Begin
  SOZD_SPIS;
  VIVOD('исходн');
  l:=nil;
  addelem(l, 1);
 
  q := first;
  while (q^.adr <> nil) and (q^.adr^.adr <> nil) do q := q^.adr; // пробегаем до предпоследнего
  l^.adr := q^.adr; // переназначаем указатели
  q^.adr := l;
 
  q:=first; // и выводим новый список...
  while q<>nil do
  begin
    write(q^.x:4);
    q:=q^.adr;
  end;
  writeln;
  readln;
End.

procedure DOBAVLENIE(var first:uk);
var
  D:uk;
begin
  p2:=nil;
  new(D);
  writeln('Введите новый элемент');
  readln(D^.x);
  p1:=p2;
  if (p1=nil) or (p1^.adr=nil) then //список или пустой или только из одного элемента
      begin
        D^.adr:=p2; //тогда новый элемент сделаем первым
        p2:=D;
      end
  else //если же в списке больше одного элемента 
      begin
        while p1^.adr^.adr<>nil do p1:=p1^.adr; //тогда идем по списку,пока не встретим предпоследний элемент
        D^.adr:=p1^.adr; //новый элемент будет указывать на последний
        p1^.adr:=D; //а предпоследний элемент будет указывать на новый
      end;
  p3:=first;
  while (p3^.adr<>nil) and (p3^.adr^.adr<>nil) do p3:=p3^.adr; // пробегаем до предпоследнего
  p2^.adr:=p3^.adr; // переназначаем указатели
  p3^.adr:=p2;
end;

  p3:=first;
  while (p3^.adr<>nil) and (p3^.adr^.adr<>nil) do p3:=p3^.adr; // пробегаем до предпоследнего
  p2^.adr:=p3^.adr; // переназначаем указатели
  p3^.adr:=p2;

begin
        while p1^.adr^.adr<>nil do p1:=p1^.adr; //тогда идем по списку,пока не встретим предпоследний элемент
        D^.adr:=p1^.adr; //новый элемент будет указывать на последний
        p1^.adr:=D; //а предпоследний элемент будет указывать на новый
      end;

procedure DOBAVLENIE(var first:uk);
var
  p, D:uk; // никогда (если не хочешь глюков) не работай через глобальные переменные
begin
  new(D);
  writeln('Введите новый элемент');
  readln(D^.x);
 
  p := first;
  if p = nil then // проверяем на пустой список
  begin
    D^.adr := nil;
    first := D;
  end
  else
    if p^.adr = nil then // есть только один элемент - уже можно добавить "перед ним", но надо изменять first
    begin
      D^.adr := first;
      first := d;
    end
    else // остальные случаи: элемент корректно добавится на предпоследнюю позицию
    begin
        while p^.adr^.adr<>nil do p:=p^.adr;
        D^.adr:=p^.adr;
        p^.adr:=D;
    end;
end;