при транспонировании стека первый элемент остается на месте!

[Александра_69]

unit Unit2;

Type

  Tkey2=integer;
  TInf2 =  record 
    inf2:integer;   
    key2:Tkey2;
  end;
  tsel2=^sel2;
  sel2=record
    inf2:tinf2;
    a2:tsel2;
  end;
TLists=class(TObject)
     sp1,sp : TSel;
     sp12,sp2:tsel2;
   constructor create;
   Procedure Adds (Inf:Tinf);
   Procedure Reads (Var Inf:Tinf);
   Procedure Prints(LBox:TListBox);
   Procedure SortBublInf;
   Procedure SortBublAdr;
   procedure add(inf2:tinf2);
   procedure read(var inf2:tinf2);
   procedure readafter(n:word;var inf2:tinf2);
   procedure print(lb:tlistbox);
   function poiskchet:word;
   procedure trans;
end;

Implementation
constructor TLists.create;
begin inherited create; sp1:=nil; end;

Procedure tlists.add(inf2:tinf2);
begin new(sp2); sp2.inf2:=inf2;
sp2.a2:=sp12; sp12:=sp2; end;

Procedure tlists.read;
begin inf2:=sp12.inf2;sp2:=sp12;
sp12:=sp12.a2; dispose(sp2); end;

Procedure tlists.readafter;
var spi:tsel2; i:word;
begin spi:=sp12;
for i:=1 to n-1 do spi:=spi.a2;
sp2:=spi.a2; inf2:=sp2.inf2;
spi.a2:=sp2.a2; dispose(sp2); end;

Procedure TLists.Adds;
begin New(sp); sp^.Inf:=Inf;
sp^.A:=sp1;	sp1:=sp; end;

Procedure TLists.Reads; 
Begin If sp1<>nil then
Begin Inf:=sp1^.Inf; sp:=sp1;
sp1:=sp1^.A; Dispose(sp); end
end;


procedure Tlists.trans;
 Procedure RevAfter(spi:Tsel);
 begin sp:=spi^.A^.A;	spi^.A^.A:=sp^.A;
 sp^.A:=spi^.A;	spi^.A:=sp;  end;
Var spt:Tsel;
Begin 	 spt:=Nil;
Repeat
  sp:=sp1;
  While sp^.A^.A<>spt do  begin
  RevAfter(sp); end;
  spt:=sp^.A;
Until sp1^.A^.A=spt;
end;

end.

как исправить ситуацию?