Сортировка способом пирамиды

uses crt;
type mas = array [1..10000] of word;
var qq: mas;
p,k:longint;
zz,i,n,m:word;
zzz:integer;
procedure mmas (var a:mas; var m:word);
var c:text;
 begin
  m:=0;
  assign(c, paramstr(1));
  reset(c);
  while (not eof(c)) and (m<10000) do
   begin
    inc(m);
    readln(c, a[m]);
   end;
  close(c);
 end;
procedure piramida(var a:mas; var n,i:word; var k,p:longint);
var x,m:word;
    begin
         if (n div 2)>=i then
            if (i*2+1)>n then
               begin
                    if a[i]>a[i*2] then
                    begin
                    m:=a[i];
                    a[i]:=a[2*i];
                    a[2*i]:=m;
                    end;
               end
            else
                begin
                     if a[2*i]<a[2*i+1] then
                     m:=2*i
                     else
                     m:=2*i+i;
                     if a[m]<a[i] then
                     begin
                     x:=a[m];
                     a[m]:=a[i];
                     a[i]:=x;
                     piramida(a,m,n,k,p);
                end;
            end;
end;
 
procedure  build(var a:mas; var n:word; var p,k:longint);
var i:word;
begin
p:=0;
k:=0;
for i:=(n div 2) downto 1 do
piramida(a,i,n,k,p);
end;
 
procedure sort(var a:mas; n:word; var p,k:longint);
var b:mas;
var i:word;
    begin
         build(a, n, p, k);
         for i:=1 to n do
         begin
         n:=n-i+1;
         b[i]:=a[1];
         a[1]:=a[n-i+1];
         piramida(a,i,n,k,p);
         end;
a:=b;
end;
 
procedure vmas (var a:mas; var n:word ; var p, k: longint);
var c: text;
var i:word;
 begin
  assign(c, paramstr(2));
  rewrite(c);
  writeln(c, 'Kilkist porivnyan = ', p);
  writeln(c, 'Kilkist perestanovok = ',k);
  for i:=1 to n do writeln(c, a[i]);
  close(c);
 end;
begin
mmas(qq, m);
piramida(qq,i,n,p,k);
build(qq,n,p,k);
sort(qq,m,p,k);
vmas(qq, m, p, k);
writeln('Kilkist porivnyan = ', p);
writeln('kilkist perestanovok = ', k);
readln;
end.