Ошибка в сортировке линейного списка, помогите пожалуйста найти

[Loginanton]

Вот код моей программы:

program test;
type
    aaa = ^bbb;
    bbb = record
        st : string;
        next : aaa;
        prev : aaa;
        sort : aaa;
        end; { end of record }
var
    a , root , head , tmp : aaa;
    f : text;
    n , i , j : byte;
procedure p1;
begin
          assign(f, 'F1.txt');
          reset(f);
    new(a);
    root := a;
    a^.prev := nil;
    n := 0;
    while not eof(f) do begin
        readln(f, a^.st);
        n := n + 1;
        new(a^.next);
                    a^.sort := a^.next;
        a^.next^.prev := a;
        a := a^.next;
        end;
    head := a^.prev;
    a := nil;
    a := root;
          close(f);
    writeln('Количество строк в файле: ', n);
          for i := (n - 1) downto 1 do begin
           for j := 1 to i do begin
                     if length(a^.st) > length(a^.sort^.st) then begin
                               a^.sort^.sort^.prev := a;
                                        tmp := a^.sort^.sort; { ! }
                                        a^.sort^.sort := a;
                                        a^.sort^.prev := a^.prev;
                                        a^.prev^.sort := a^.sort;
                                        a^.prev := a^.sort;
                                        a^.sort := tmp;
                               end; { end if }
                              a := a^.sort;
                              end; { end for }
                    a := root;
                    end; { end for }
          while a^.sort <> nil do begin
           writeln(a^.st);
                    a := a^.sort;
                    end; { end while }
end; { end of p1 }
begin
p1;
readln;
end. { end of program }

Ошибка точно в месте где два элемента списка меняются местами, просто менять местами значения a^.st нельзя - задание не позволяет. Помогите найти ошибку пожалуйста, заранее благодарен.

[capta1n]

Мой вариант сортировки - может поможет :

program exe;
type
 s = string[12];
 PComp = ^Comp;
 Comp =     record
             data : s;
             next : PComp
            end;
var
 Pbeg, Pend, THIS : PComp;
 line : s;
 count : word;
 f1 : text;
begin
  assign (f1, 'f1.txt');
  reset (f1);

  while not EOF(f1) do
  begin
    readln (f1, line);
    if Pbeg=nil then
    begin
      new (Pbeg);
      Pbeg^.data:=line;
      Pbeg^.next:=nil;
      Pend:=Pbeg
    end
    else
    begin
      new (Pend^.next);
      Pend:=Pend^.next;
      Pend^.data:=line;
      Pend^.next:=nil
    end
  end;
  repeat
    Pend:=Pbeg;
    count:=0;
    repeat
      if (Pend=Pbeg) and (Pend^.data > Pend^.next^.data) then
      begin
        Pbeg:=Pend^.next;
        Pend^.next:=Pbeg^.next;
        Pbeg^.next:=Pend;
        count:=count+1
      end;
      if Pend^.next^.data > Pend^.next^.next^.data then
      begin
        THIS:=Pend^.next^.next;
        Pend^.next^.next:=THIS^.next;
        THIS^.next:=Pend^.next;
        Pend^.next:=THIS;
        count:=count+1;
      end;
      Pend:=Pend^.next
    until Pend^.next^.next=nil;
  until count=0;
  Pend:=Pbeg;
  while Pend<>nil do
  begin
    writeln (Pend^.data);
    Pend:=Pend^.next
  end;

readln

end.

В общем сортровка для 4 и более элементов - нет времени переделывать ее - ну там потому что однонаправленный список, поэтому проверки жесткие ну в общем держи - не забудь про отзыв

[Викдон]

как то сложно написано в первой проге: a^.next^.prev := a; можно использовать второй указатель:

new(a^.next);
root:=a;
a:=a^.next;
a^.prev:=root