I used the heapsort,but wa.HELP!

program ural1126(input,output);
var
  n,m,i,j,k:longint;
  id,num:array[1..35000] of longint;
  f,g:array[1..15000] of longint;
procedure swap(a,b:longint);
var
  x:longint;
begin
    x:=f[a];f[a]:=f[b];f[b]:=x;
    x:=id[g[a]];id[g[a]]:=id[g[b]];id[g[b]]:=x;
    x:=g[a];g[a]:=g[b];g[b]:=x;
end;

procedure sift(v,m:longint);
var
  maxi,l,r:longint;
begin
  l:=v*2;r:=l+1;maxi:=v;
  if (l<=m) and (f[l]>f[maxi]) then maxi:=l;
  if (r<=m) and (f[r]>f[maxi]) then maxi:=r;
  if maxi<>v then
  begin
    swap(v,maxi);

    sift(v,m);
  end;
end;


procedure heapsort;
begin
  for i:=m div 2 downto 1 do sift(i,m);
end;


begin

  readln(m);
  read(k);
  while k<>-1 do
  begin
    inc(n);
    num[n]:=k;read(k);
  end;
  for i:=1 to m do
  begin
    f[i]:=num[i];
    id[i]:=i;g[i]:=i;
  end;
  heapsort;
  writeln(f[1]);

  for i:=1 to n-m do
  begin
    k:=id[i];id[i]:=-1;
    f[k]:=num[i+m];id[i+m]:=k;g[k]:=i+m;
    sift(k,m);
    while (k>1) and (f[k]>f[k div 2])do
    begin
      swap(k,k div 2);
      k:=k div 2;
    end;
    writeln(f[1]);
  end;
end.