I always get wrong answer! Could you help me?

Here is my program:
type pp=^point;
     point=record
             a2:integer;
             n2:pp;
           end;
var n,s,a,b,e:integer; p:pp;
    c,d:array[1..1000] of pp; f:array[1..1000] of boolean;
procedure z(a1:integer);
begin
  p:=d[a1];
  while c[a1]^.n2<>nil do begin
    p^.n2:=c[a1]^.n2; p:=p^.n2;
    c[a1]^.n2:=c[a1]^.n2^.n2;
    a1:=p^.a2;
  end;
  p^.n2:=nil;
end;
procedure y(a1:integer);
var b1:integer;
begin
  f[a1]:=false;
  b1:=a1;
  while d[a1]^.n2<>nil do begin
    writeln(b1,' ',d[a1]^.n2^.a2);
    b1:=d[a1]^.n2^.a2;
    if f[b1] then y(b1);
    d[a1]^.n2:=d[a1]^.n2^.n2;
  end;
end;
begin
  assign(input,''); reset(input);
  assign(output,''); rewrite(output);
  readln(n,s);
  for a:=1 to n do begin
    new(c[a]); c[a]^.n2:=nil;
    new(d[a]); d[a]^.n2:=nil;
  end;
  for a:=1 to n do begin
    for b:=1 to n do begin
      read(e);
      if (a<>b)and(e=0) then begin
        new(p); p^.a2:=b; p^.n2:=c[a]^.n2; c[a]^.n2:=p;
      end;
    end;
    readln;
  end;
  z(s);
  for a:=1 to n do
    if c[a]^.n2<>nil then z(a);
  fillchar(f,sizeof(f),true);
  y(s);
  close(input); close(output);
end.

Thank you!