Динамические данные(очередь,стэк)

uses crt;
var f:file of integer;
    n,a,b,i,j,x:integer;
begin
clrscr;
randomize;
assign(f,'fileF');
rewrite(f);
write('Сколько чисел записать в файл n=');
readln(n);
for i:=1 to n do
 begin
  a:=random(1001)-500;
  write(f,a);
 end;
writeln('Содержание исходного файла:');
reset(f);
while not eof(f) do
 begin
  read(f,a);
  write(a,' ');
 end;
writeln;
close(f);
reset(f);
for i:=0 to filesize(f)-2 do
for j:=i+1 to filesize(f)-1 do
  begin
    seek(f,i);
    read(f,a);
    seek(f,j);
    read(f,b);
    if a>b then
      begin
       x:=a;
       a:=b;
       b:=x;
       seek(f,i);
       write(f,a);
       seek(f,j);
       write(f,x);
      end;
   end;
close(f);
writeln('Содержание отсортированного файла:');
reset(f);
while not eof(f) do
 begin
  read(f,a);
  write(a,' ');
 end;
close(f);
readln
end.

PASuses
    crt;
type
   tlist=^list;
   list=record
               inf:integer;
               adr:tlist;
         end;
var
   f:file of integer;
   stak1,stak2:tlist;
   i,c,x:integer;
procedure dobstack(var stk:tlist; x:integer );
var
   tmp:tlist;
begin
     new(tmp);
     tmp^.inf:=x;
     tmp^.adr:=stk;
     stk:=tmp;
end;
procedure dobav;
begin
     stak1:=nil;
     stak2:=nil;
     reset(f);
     repeat
           read(f,x);
           dobstack(stak1,x)
     until eof(f);
    close(f);
end;
begin
     clrscr;
     assign(f,'d:\f.tol');
     dobav;
     writeln('poloshitelnie elemnti: ');
     repeat
     if stak1^.inf > 0 then
        begin
 
            write(stak1^.inf,' ')
        end
     else
            dobstack(stak2,stak1^.inf);
     stak1:=stak1^.adr;
     until stak1=nil;
     writeln;
     writeln('nepoloshitelnie elemnti: ');
     repeat
           write(stak2^.inf,' ');
           stak2:=stak2^.adr
     until stak2=nil;
readkey;

uses
    crt;
type
    fail=file of integer;
    tlist=^list;
    list=record
               inf:integer;
               adr:tlist;
         end;
var
   f1,f2:fail;
   ocher,ocher2,och:tlist;
   t,c,k,z:integer;
procedure sozdocher(var f,f1:fail);
begin
    reset(f);
    reset(f1);
    t:=0;
    new(och);
    read(f,och^.inf);
    ocher2:=och;
    while not eof(f) do
        begin
          t:=t+1;
          if t <> k-1 then
             begin
                  new(ocher);
                  read(f,ocher^.inf);
                  ocher2^.adr:=ocher;
                  ocher2:=ocher;
             end
          else
              while not eof(f1) do
                    begin
                         new(ocher);
                         read(f1,ocher^.inf);
                         ocher2^.adr:=ocher;
                         ocher2:=ocher;
                    end;
      end;
close(f);
close(f1);
end;
procedure vivod;
begin
     while och<>ocher2^.adr do
           begin
                write(och^.inf,' ');
                och:=och^.adr
           end;
end;
begin
clrscr;
assign(f1,'d:\f.tol');
assign(f2,'d:\f1.tol');
writeln('wvedite k ');
readln(k);
new(ocher);
ocher:=ocher2;
sozdocher(f1,f2);
vivod;
readkey;
end.