Files
Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM I/MPM I SOURCE/07/era.plm
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

1 line
2.4 KiB
Plaintext
Raw 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;