Files
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

1 line
2.4 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

$title ('MP/M 1.1 Erase File')
erase:
do;
$include (copyrt.lit)
/*
Revised:
19 Jan 80 by Thomas Rolander
*/
declare start label;
declare jmp$to$start structure (
jmp$instr byte,
jmp$location address ) data (
0C3H,
.start-3);
mon1:
procedure (func,info) external;
declare func byte;
declare info address;
end mon1;
mon2:
procedure (func,info) byte external;
declare func byte;
declare info address;
end mon2;
declare fcb (1) byte external;
declare fcb16 (1) byte external;
declare tbuff (1) byte external;
/**************************************
* *
* B D O S Externals *
* *
**************************************/
read$console:
procedure byte;
return mon2 (1,0);
end read$console;
print$console$buffer:
procedure (buffer$address);
declare buffer$address address;
call mon1 (9,buffer$address);
end print$console$buffer;
search$first:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (17,fcb$address);
end search$first;
search$next:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (18,fcb$address);
end search$next;
delete$file:
procedure (fcb$address);
declare fcb$address address;
call mon1 (19,fcb$address);
end delete$file;
get$user$code:
procedure byte;
return mon2 (32,0ffh);
end get$user$code;
terminate:
procedure;
call mon1 (143,0);
end terminate;
/*
Main Program
*/
declare (i,response,user,dcnt) byte;
declare last$dseg$byte byte
initial (0);
start:
do;
user = get$user$code;
i = 0;
do while fcb(i:=i+1) = '?';
;
end;
if i > 11 then
do;
call print$console$buffer (.(
'Confirm delete all user files (Y/N)?','$'));
response = read$console;
if not ((response = 'y') or
(response = 'Y'))
then call terminate;
end;
dcnt = search$first (.fcb);
do while dcnt <> 0ffh;
if tbuff(ror(dcnt,3) and 0110$0000b) = user then
do;
call delete$file (.fcb);
call terminate;
end;
dcnt = search$next (.fcb);
end;
call print$console$buffer (.(
'No file','$'));
call terminate;
end;
end erase;