Переполнение

[stas45rus]

Всем здравствуйте. Подскажите пжл. почему программа выдаёт переполнение кучи. Вот код:

PROGRAM TY;
Uses Crt;
TYPE
  Knot=^PKnot;
  PKnot=Record
         Counter:Longint;
         Symbol:Byte;
         Right,Left:Knot;
         Next,Prev:Knot;
        End;
VAR
  P,X,Root:Knot;
  f:File;
  r:Text;
  ch:Char;
  st:String;

Function InsertList2(Var P,X:Knot; s:Longint; i:Byte):Knot;
Begin
  If P=Nil Then
   begin
     New(P);
     P^.Counter:=s;
     P^.Symbol:=i;
     P^.Next:=Nil;
     P^.Prev:=Nil;
     X:=P;
   end
  Else
   begin
     New(X^.Next);
     X^.Next^.Prev:=X;
     X:=X^.Next;
     X^.Counter:=s;
     X^.Symbol:=i;
     X^.Next:=Nil;
   end;
  InsertList2:=P;
End;

Function SortingList2(P:Knot):Knot;
Var
  s:Longint;
  i:Byte;
  X,N:Knot;
Begin
  X:=P;
  While X<>Nil Do
   begin
     N:=X^.Next;
     While N<>Nil Do
      begin
        If N^.Counter<X^.Counter Then
         begin
           s:=N^.Counter;
           i:=N^.Symbol;
           N^.Counter:=X^.Counter;
           N^.Symbol:=X^.Symbol;
           X^.Counter:=s;
           X^.Symbol:=i;
         end;
        N:=N^.Next;
      end;
     X:=X^.Next;
   end;
  SortingList2:=X;
End;

Procedure AdditionList2(Var P:Knot);
Var
  X:Knot;
  s:Longint;
  i:Byte;
Begin
  X:=P;
  i:=0;
  While (X<>Nil) and (X^.Next<>Nil) Do
   begin
     s:=X^.Counter+X^.Next^.Counter;
     InsertList2(P,X,s,i);
     SortingList2(P);
     X:=X^.Next^.Next;
   end;
End;  

Procedure Print(P:Knot);
Begin
  While P<>Nil Do
   begin
     Writeln(r,P^.Counter,' ',P^.Symbol);
     P:=P^.Next;
   end;
  Writeln(r); 
  While X<>Nil Do
   begin
     Writeln(r,X^.Counter,' ',X^.Symbol);
     X:=X^.Prev;
   end;  
End;

Procedure Compression;
Var
  i,Buf:Byte;
  s:Longint;
Begin
  For i:=0 To 255 Do
   begin
     s:=0;
     While not(eof(f)) Do
      begin
        BlockRead(f,Buf,1);
        If i=Buf Then Inc(s);
      end;
     If eof(f) Then Seek(f,0);
     If s<>0 Then InsertList2(P,X,s,i);
   end;
  SortingList2(P);
  AdditionList2(P);
  Print(P);
End;

BEGIN
 ClrScr;
 Writeln('Для архивации файла нажмите ''a''.');
 Writeln('Для распвковки файла нажмите ''r''.');
 Writeln('Для отмены нажмите любую клавишу.');
 ch:=ReadKey;
 Case ch Of
   #97:begin
         Writeln('Введите полный путь и имя файла:');
         Readln(st);
         Assign(f,st);
         Reset(f,1);
         If FileSize(f)=0 Then Writeln('Файл пуст!!!')
          Else
           begin
             Assign(r,'D:\Kopiya.TXT');
             Rewrite(r);

             Compression;

             Close(r);
           end;
         Close(f);
       end;
  Else Halt;
 end; 
 Readln;
END.

[ViktorR]

Каков размер подставляемого файла?
Упаковка делается блоками?
После каждого упакованного блока память надо освобождать от списка.
Т.е. new() - есть, а dispose() - не видно.

Как то так ...