Отсортировать файл. Нужно сделать сегодня. РГР

[nicklifs]

Нужно отсортировать файл с помощью двухпутевого(2 файла) сбалансированного естественного слияния. Это значит, что при сортировке используется 4 вспомогательных файла. Исходный файл - F0. Файлы f1,f2 и файлы d1,d2 используются при сортировке. Нужно работать только с файлом(никаких массивов и т.д.). Идея: сначала исходный файл разбивается на файлы f1 f2 по сериям, в f1 попадают 1,3,5... серии исходного файла, в f2 - 2,4,6...
Потом происходит работа только с файлами f1,f2 и d1,d2... пока не образуется в файле d1(или при обратном шаге f1) отсортированная последовательнось.

из f1,f2 происходит слияние серий(первые серии файлов f1,f2 сливаются в первую серию файла d1) и так далее

потом наоборот из d1,d2 происходит слияние в f1,f2

[nicklifs]

uses crt;
var f0,f1,f2,d1,d2: file of integer;
i,n,prov,x: integer;

procedure firstras(var prov:integer);
var k, x,last:integer;
begin
reset(f0);
rewrite(f1);
rewrite(f2);
k:=1; //записать в 1 файл


read(f0,last);
write(f1,last);
while not eof(f0) do begin
read(f0,x);
if ((x>last)and(k=1)) then begin
write(f1,x);
last:=x;
end;
if ((x>last)and(k=2)) then begin
write(f2,x);
last:=x;
end;
if (x<last) then begin
if k=1 then begin write(f2,x); k:=2 end
else begin write(f1,x); k:=1 end;
end;
end;

reset(f2);
if eof(f2) then prov:=1 //файл отсортирован
else prov:=2;
close(f1);
close(f2);
end; // изначальное распределение

procedure sort(var f1,f2,d1,d2:file of integer; var prov:integer );
var a,alast,b,blast,k,m,last,x: integer;
fl:boolean;
begin
rewrite(d1);
rewrite(d2);
reset(f1);
reset(f2);

fl:=true;
k:=1; //записываем в 1 файл (k=1)
m:=1; //читаем из файла 1

read(f1,a);
read(f2,b);
if a<b then begin
write(d1,a);
alast:=a;
blast:=a;
m:=1;
end
else begin
write(d2,b);
blast:=b;
alast:=b;
m:=2;
end;
if m=1 then begin read(f1,a); if a<alast then fl:=false end;
if m=2 then begin read(f2,b); if b<blast then fl:=false end;
while (not eof(f1))and(not eof(f2)) do begin


if fl=true then begin

if a<b then begin
write(d1,a);
alast:=a;
m:=1;
end
else begin
write(d2,b);
blast:=b;
m:=2;
end;

end
else begin
if (m=1) then begin
if k=1 then write(d1,b)
else write(d2,b);
blast:=b;
read(f2,b);
while b>blast do begin
if k=1 then begin write(d1,b);blast:=b; read(f2,b); end
else begin write(d2,b); blast:=b; read(f2,b); end;
end;

end
else begin
if k=1 then write(d1,a)
else write(d2,a);
alast:=a;
read(f1,a);
while a>alast do begin
if k=1 then begin write(d1,a);alast:=a; read(f1,a); end
else begin write(d2,b); blast:=b; read(f1,a); end;
end;

end;


fl:=true;
end;

end;

reset(d2);
if eof(d2) then prov:=1 //файл отсортирован!
else prov:=2;
close(f1);
close(f2);
close(d1);
close(d2);
end;

Begin
assign(f0,'f0.dat');
assign(f1,'f1.dat');
assign(f2,'f2.dat');
assign(d1,'d1.dat');
assign(d2,'d2.dat');
write('Введите кол-во элементов исходного файла: ');
readln(n);
rewrite(f0);
for i:=1 to n do write(f0,random(201)-100);
writeln('Исходный файл: ');
reset(f0);
while not eof(f0) do begin
read(f0,x);
write(x,' ');
end;
writeln;

firstras(prov);
while(prov<>1) do begin
sort(f1,f2,d1,d2,prov);
if prov<>1 then sort(d1,d2,f1,f2,prov);
end;

reset(d1);
reset(f1);
rewrite(f0);
if not eof(d1) then begin
read(d1,x);
write(f0,x);
end;
if not eof(f1)then begin
read(f1,x);
write(f0,x);
end;
close(f1);
close(d1);

write('Результат: ');
reset(f0);
while not eof(f0) do begin
read(f0,x);
write(x,' ');
end;
writeln;
close(f0);
End.

[nicklifs]

проблемы с процедурой sort

[nicklifs]

процедура firstraz тоже немного работает неправильно

[nicklifs]

работает 100%
procedure firstras(var prov:integer);
var k, i, x,last:integer;
begin
reset(f0);
rewrite(f1);
rewrite(f2);
k:=1; //çàïèñûâàòü â k-ôàéë(â ïåðâûé èçíà÷àëüíî) â f1
i:=1;

read(f0,last);
write(f1,last);
while not eof(f0) do begin
read(f0,x);

if ((x>last)and(k=1)) then begin
write(f1,x);
last:=x;
end;
if ((x>last)and(k=2)) then begin
write(f2,x);
last:=x;
end;
if (x<last) then begin
if k=1 then begin write(f2,x);last:=x; k:=2 end
else begin write(f1,x);last:=x; k:=1 end;
end;
end;

reset(f2);
if eof(f2) then prov:=1 //ôàéë îòñîðòèðîâàí!
else prov:=2;
close(f1);
close(f2);
end; // èçíà÷àëüíîå ðàñïðåäåëåíèå

[nicklifs]

процедура SORT ЗАЦИКЛИВАЕТСЯ... ПОМОГИТЕ