var
(* variant record user to circumvent type conflicts *)
abs_mem_adr : record case Boolean of
true : (i : integer);
false : (p : byteptr);
end;
i,j,return_code : integer;
function dirfrst :integer; external; (* search for first directory entry *)
function dirnext :integer; external; (* search for next entry *)
procedure request_all;
(* filename and filetype are assigned all ?'s, select currently logged drive *)
begin
abs_mem_adr.i:=def_fcb;
abs_mem_adr.p^:=chr(0); (* binary zeros for fcb drive code *)
for i:=1 to 11 do
begin
abs_mem_adr.i:=abs_mem_adr.i + 1;
abs_mem_adr.p^:='?'
end
end;
procedure write_entry(disp: integer);
(* display filename and filetype from dma + (32 X relative displacement *)
begin
abs_mem_adr.i:=def_dma + (disp * 32);
for i:=1 to 8 do
begin
abs_mem_adr.i:=abs_mem_adr.i + 1;
write(abs_mem_adr.p^)
end;
write(' ');
for i:=1 to 3 do
begin
abs_mem_adr.i:=abs_mem_adr.i + 1;
write(abs_mem_adr.p^)
end
end;
(* M A I N P R O G R A M *)
begin
� writeln('DIRCTORY LISTING:');
request_all;
return_code:=dirfrst;
if return_code=255 then writeln('**Disk is empty**')
else
begin
j:=1;
while return_code <> 255 do
begin
write_entry(return_code);
write(' ');
j:=j+1;
if j > 4 then
begin
writeln; (* four entries displayed per line *)
j:=1
end; (* end if *)
return_code:=dirnext
end; (* end while *)
end; (* end else *)
end.
