Попытка разыменовать нулевой указатель. Как исправить?

PROGRAM GRAF;
uses crt;
type mat=array[1..10,1..10] of integer; {matrica cmezhnosti}
ukaz=^usel;
usel=record
key:integer;
left,right,back:ukaz;
end;
var
top,t,p,q,ps:ukaz; {dly dereva}
matr : mat;
gr,gp:array [1..100] of integer;
f:text;
l,r,w:boolean;
fail,s:string;
word,m1,m2:array [1..20] of string;
ch:char;
i,j,a,b,m,n,k,strok,stolb,z,kolway: integer;
 
procedure Chtenie; {chtenie iz faila}
begin
assign(f,'GRAF.txt');
reset(f);
while not Eof(f) do
begin
readln(f,s);
m:=1;
if s='' then exit;
while (s[m]<>'-') and (s[m]<>' ') do begin
m1[i]:=m1[i]+s[m];
m:=m+1;
end;
if s[m]='-' then begin i:=i+1; m:=m+1; end;
while (s[m]<>'.') and (s[m]<>' ') do begin
m2[j]:=m2[j]+s[m];
m:=m+1;
end;
if s[m]='.' then begin m:=1; j:=j+1; end;
end;
close(f);
end;
 
function proverka(j:integer):boolean;
begin
if (j<>b) and (j<>268) then begin
proverka:=true; r:=true;
for i:=1 to z do
if j=gp[i] then m:=m+1;
if m>=10 then begin proverka:=false; r:=false; end;
if r=true then begin gp[z]:=j; z:=z+1; end;
end; end;
 
procedure sozd_graf(p:ukaz);
begin
if p=nil then
begin
t:=t^.back;
if t^.back<>nil then sozd_graf(t^.right);
if t^.back=nil then l:=false;
end;
if ((p<>top) and ((p^.key=a) or (p^.key=b))) or (proverka(p^.key)=false) then
if p^.right<>nil then sozd_graf(p^.right) else
begin
t:=p;
sozd_graf(p^.back^.right);
end;
if l=true then begin
k:=0; j:=p^.key; ps:=p;
for i:=1 to n do
if matr[j,i]=1 then
begin
new(q);
q^.key:=i;
q^.left:=nil;
q^.right:=nil;
q^.back:=ps;
if k=1 then begin p^.right:=q; p:=q; end
else begin p^.left:=q; p:=q; k:=1; end;
end;
if k=1 then sozd_graf(p^.back^.left)
else begin t:=p^.back; sozd_graf(t^.right); end;
end; end;
 
procedure put(t:ukaz);
begin
i:=1;
while t<>nil do
begin
gr[i]:=t^.key;
i:=i+1;
t:=t^.back;
end;
for j:=i-1 downto 1 do write(word[gr[j]],' ');
end;
 
procedure obxod(p:ukaz);
begin
if p<>nil then begin
if p^.key=b then begin kolway:=kolway+1; write('Íàéäåí ïóòü: ');
put(p);
writeln;
end;
obxod(p^.right);
obxod(p^.left);
end;
end;
 
procedure poisk;
begin
top:=nil;
new(t);
t^.key:=a;
top:=t;
top^.back:=nil;
top^.left:=nil;
top^.right:=nil;
t:=nil;
l:=true; z:=1; m:=0; gp[1]:=0;
sozd_graf(top);
obxod(top^.left);
end;
 
begin
clrscr;
i:=1;j:=1;
chtenie;
{Vudelenie otdelnuh gorodov v massiv}
word[1]:=m1[1];
n:=1;
for m:=2 to i-1 do begin
l:=true;
for k:=1 to n do
if word[k]=m1[m] then l:=false;
if l=true then begin n:=n+1; word[n]:=m1[m]; end;
end;
for m:=1 to j do begin
l:=true;
for k:=1 to n do
if word[k]=m2[m] then l:=false;
if l=true then begin n:=n+1; word[n]:=m2[m]; end;
end;
 
w:=true;
While w do
begin
Writeln;
Write('Vvedite punkt otpravleniy: ');
Readln(a);
Write('Vvedite punkt pributiy: ');
Readln(b);
Writeln;
z:=1; kolway:=0;
poisk;
if kolway=0 then writeln('Net putei');
Write('Povtorit` poisk [y/n] ? ');
Readln(ch);
if ch='n' then w:=false {dly vuhoda iz cikla}
end;
end.