Выполнить упорядочение динамической структуры данных (линейного списка) по полю year

type
  TAuto = record
    year: Integer;
    model: String[31];
  end;
  
  PNode = ^TNode;
  TNode = record
    next: PNode;
    data: TAuto;
  end;
 
  TLessFunc = function (const a, b: TNode): Boolean;
 
procedure Sort(var lst: PNode; less: TLessFunc);
  procedure swap(var a, b: PNode);
  var t: PNode; 
  begin
    t:=a; a:=b; b:=t;
    t:=a^.next; a^.next:=b^.next; b^.next:=t;
  end;
var
  p: ^PNode;
  done: Boolean;
begin
  repeat
    done:=True; p:=@lst;
    while (p^<>nil) and (p^^.next<>nil) do begin
      if less(p^^.next^, p^^) then begin
        swap(p^,p^^.next);
        done:=False;
      end;
      p:=@p^^.next;
    end;
  until done;
end;
 
function  NewNode(aData: TAuto; aNext: PNode): PNode;
var p: PNode;
begin
  New(p); NewNode:=p;
  p^.data:=aData;
  p^.next:=aNext;
end;
 
{$F+}
function  lessYear(const a, b: TNode): Boolean;
begin
  lessYear:=a.data.year<b.data.year;
end;
 
var
  lst, p: PNode;
  a: TAuto;
begin
  lst:=nil;
  WriteLn('Введите сведения об автомобилях, окончание ввода - 0:');
  with a do
    repeat
      Write('Год и модель: '); ReadLn(year, model);
      if year=0 then Break;
      while (Length(model)>0) and (model[1]=' ') do Delete(model,1,1);
      lst:=NewNode(a,lst);
    until False;
  WriteLn('Содержимое списка:');
  p:=lst;
  while p<>nil do with p^,p^.data do begin
    WriteLn(year:6,' - ',model);
    p:=next;
  end;
  Sort(lst, lessYear);
  WriteLn('Содержимое сортированного списка:');
  p:=lst;
  while p<>nil do with p^,p^.data do begin
    WriteLn(year:6,' - ',model);
    p:=next;
    Dispose(lst); lst:=p;
  end;
end.

Program Spisok;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=record
    year:integer;
    model:string[128];
  end;
  {тип данных, который будет храниться в элементе списка}
 
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;   {указатель на следующий элемент списка}
  end;
 
{Процедура добавления нового элемента в односвязный список}
procedure AddElem(var spis1:List;znach1:tinf);
var
  tmp:List;
begin
  if spis1=nil then {Проверяем не пуст ли список, если пуст, то }
  begin
    GetMem(spis1,sizeof(TList));  {создаём его первый элемент}
    tmp:=spis1;
  end
  else {в случае если список не пуст}
  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.year:=znach1.year; {заносим значение}
  tmp^.data.model:=znach1.model; {заносим значение}
end;
 
{процедура печати списка
полностью расписана при работе со стеком}
procedure Print(spis1:List);
begin
  if spis1=nil then
  begin
    writeln('Список пуст.');
    exit;
  end;
  while spis1<>nil do
  begin
    Write(spis1^.data.model, ', ',spis1^.data.year);
    spis1:=spis1^.next;
    writeln;
  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;
 
{процедура поиска в списке
 полностью расписана при работе со стеком}
Function SearchElemZnach(spis1:List;znach1:integer):List;
begin
  if spis1<>nil then
    while (Spis1<>nil) and (znach1<>spis1^.data.year) do
      spis1:=spis1^.next;
  SearchElemZnach:=spis1;
end;
 
 
{Процедура сортировки "пузырьком" с изменением только данных
 полностью расписана при работе со стеком}
procedure SortBublInf(nach:list);
var
  tmp,rab:List;
  tmps:Tinf;
begin
  GetMem(tmp,SizeOf(Tlist));
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.data.year>rab^.data.year then
      begin
        tmps:=tmp^.data;
        tmp^.data:=rab^.data;
        rab^.data:=tmps
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end
end;
 
{Процедура сортировки "пузырьком" с изменением только адресов
 полностью расписана при работе со стеком}
procedure SortBublLink(nach:List);
var
  tmp,pered,pered1,pocle,rab:List;
begin
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.data.year<rab^.data.year then
      begin
        pered:=nach;
        pered1:=nach;
        if rab<>nach then
          while pered^.next<>rab do pered:=pered^.next;
        while pered1^.next<>tmp do pered1:=pered1^.next;
        pocle:=tmp^.next;
        if rab^.next=tmp then
        begin
          tmp^.next:=rab;
          rab^.next:=pocle
        end
        else
        begin
          tmp^.next:=rab^.next;
          rab^.next:=pocle;
        end;
        if pered1<>rab then
          pered1^.next:=rab;
        if rab<>nach then
          pered^.next:=tmp
        else
          nach:=tmp;
        pered1:=tmp;
        tmp:=rab;
        rab:=pered1;
      end;
      tmp:=tmp^.next;
    end;
    rab:=rab^.next;
  end;
end;
 
var
  Spis,tmpl:List;
  znach:Tinf;
  i,n:integer;
begin
  Spis:=nil;
  write('Введите количество добавляемых элементов: ');  readln(n);
  for i:=1 to n do
    begin
      write('Введите год выпуска: ');  readln(znach.year);
      write('Введите модель: ');  readln(znach.model);
      AddElem(Spis,znach);
    end;
  Print(Spis);
  if Spis=nil then
    begin
      Write('Список пуст.');
    end
  else
    begin
      SortBublLink(Spis);
      Write('Список отсортирован.');
    end;
  writeln;
  Print(Spis);
  readkey;
 
  FreeStek(Spis);
end.