Создать двухсвязной список

Program Spisok_dn;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=integer; {тип данных, который будет храниться в элементе списка}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next,    {указатель на следующий элемент списка}
    prev:List;   {указатель на предыдущий элемент списка}
  end;
 
{Процедура добавления нового элемента в двунаправленный список}
procedure AddElem(var nach,ends:List;znach1:TInf);
var
  tmp:List;
begin
  if nach=nil then {не пуст ли список, если пуст, то}
  begin
    Getmem(nach,SizeOf(TList)); {создаём элемент, указатель nach уже будет иметь адрес}
    nach^.next:=nil; {никогда не забываем "занулять" указатели}
    nach^.prev:=nil; {аналогично}
    ends:=nach; {изменяем указатель конца списка}
  end
  else {если список не пуст}
  begin
    GetMem(ends^.next,SizeOf(Tlist)); {создаём новый элемент}
    ends^.next^.prev:=ends; {связь нового элемента с последним элементом списка}
    ends:=ends^.next;{конец списка изменился и мы указатель "переставляем"}
    ends^.next:=nil; {не забываем "занулять" указатели}
  end;
  ends^.data:=znach1; {заносим данные}
end;
 
{процедура печати списка
полностью расписана при работе со стеком}
procedure Print(spis1:List);
begin
  if spis1=nil then
  begin
    writeln('‘ЇЁб®Є Їгбв.');
    exit;
  end;
  while spis1<>nil do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next
  end;
end;
 
Procedure FreeStek(spis1:List);
var
  tmp:List;
begin
  while spis1<>nil do
  begin
    tmp:=spis1;
    spis1:=spis1^.next;
    FreeMem(tmp,SizeOf(Tlist));
  end;
end;
 
{процедура удаления элемента в двунаправленном списке}
Procedure DelElem(var spis1,spis2:List;tmp:List);
var
  tmpi:List;
begin
  if (spis1=nil) or (tmp=nil) then
    exit;
  if tmp=spis1 then {если удаляемый элемент первый в списке, то}
  begin
    spis1:=tmp^.next; {указатель на первый элемент переставляем на следующий элемент списка}
    if spis1<>nil then {если список оказался не из одного элемента, то}
      spis1^.prev:=nil {"зануляем" указатель}
    else {в случае, если элемент был один, то}
      spis2:=nil; {"зануляем" указатель конца списка, а указатель начала уже "занулён"}
    FreeMem(tmp,SizeOf(TList));
  end
  else
    if tmp=spis2 then {если удаляемый элемент оказался последним элементом списка}
    begin
      spis2:=spis2^.prev; {указатель конца списка переставляем на предыдущий элемент}
      if spis2<>nil then {если предыдущий элемент существует,то}
        spis2^.next:=nil {"зануляем" указатель}
      else {в случае, если элемент был один в списке, то}
        spis1:=nil; {"зануляем" указатель на начало списка}
      FreeMem(tmp,SizeOf(TList));
    end
    else {если же удаляется список не из начали и не из конца, то}
    begin
      tmpi:=spis1;
      while tmpi^.next<>tmp do {ставим указатель tmpi на элемент перед удаляемым}
        tmpi:=tmpi^.next;
      tmpi^.next:=tmp^.next; {меняем связи}
      if tmp^.next<>nil then
        tmp^.next^.prev:=tmpi; {у элемента до удаляемого и после него}
      FreeMem(tmp,sizeof(TList));
    end;
end;
 
procedure Search_max_min(SpisNach:List;var adr1,adr2:List);
var
  tmp:List;
begin
  adr1:=spisNach;
  adr2:=adr1;
  tmp:=adr1;
  while tmp<>nil do
  begin
    if tmp^.data>adr1^.data then
      adr1:=tmp;
    if tmp^.data<adr2^.data then
      adr2:=tmp;
    tmp:=tmp^.next;
  end;
  tmp:=adr1;
  while (tmp<>adr2) and (tmp<>nil) do
    tmp:=tmp^.next;
  if tmp=nil then
  begin
    tmp:=adr2;
    adr2:=adr1;
    adr1:=tmp;
  end;
  adr1:=adr1^.next;
  adr2:=adr2^.prev;
  if adr2^.next=adr1 then
  begin
    adr1:=nil; adr2:=nil;
  end;
end;
 
var
  ad,ad1,tmp,
  SpisNach, {указатель на начало списка и}
  SpisEnd,   {указатель на конец списка. Эти два указателя }
  tmpl:List; {неотъемлимая часть в двунаправленном списке}
  n:integer;
  tmpinf:TInf;
begin
  SpisNach:=nil;
  SpisEnd:=nil;
  repeat
    clrscr;
    Writeln('Vvedute kolu4ectvo elementov v spiske');
    Write('N= ');
    readln(n);
  until n>0;
  randomize;
  while n>0 do
  begin
    TmpInf:=random(1000);
    AddEleM(SpisNach,SpisEnd,TmpInf);
    dec(n);
  end;
  clrscr;
  Writeln('Spisok do u3menenui');
  Print(SpisNach);
  writeln;
  Search_max_min(SpisNach,ad,ad1);
  if (ad<>nil) and (ad1<>nil) then
  begin
    writeln;
    tmp:=SpisNach;
    if tmp<>ad then
    begin
      while tmp^.next<>ad do
        tmp:=tmp^.next;
      tmp^.next:=ad1^.next;
    end
    else
      SpisNach:=ad1^.next;
    ad1^.next:=nil;
    FreeStek(ad)
  end;
  Writeln('Spisok posle u3menenui');
  Print(SpisNach);
  readln;
  FreeStek(SpisNach);
 
end.