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

1 line
2.5 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 Rename File')
ren:
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;
declare dcnt byte;
dcnt = mon2 (17,fcb$address);
if dcnt <> 0ffh then
do;
if tbuff(ror(dcnt,3) and 110$0000b)
<> low (mon2 (32,0ffh)) then
dcnt = 0ffh;
end;
return dcnt;
end search$first;
delete$file:
procedure (fcb$address);
declare fcb$address address;
call mon1 (19,fcb$address);
end delete$file;
rename$file:
procedure (fcb$address);
declare fcb$address address;
call mon1 (23,fcb$address);
end rename$file;
terminate:
procedure;
call mon1 (143,0);
end terminate;
declare locfcb (33) byte;
/*
Main Program
*/
declare response byte;
declare last$dseg$byte byte
initial (0);
start:
do;
call move (16,.fcb16,.locfcb);
if search$first (.fcb) <> 0ffh then
do;
call print$console$buffer
(.('File already exists, delete (Y/N)?','$'));
response = read$console;
if (response = 'y') or
(response = 'Y') then
do;
call delete$file (.fcb);
end;
else
do;
call terminate;
end;
end;
if search$first (.locfcb) = 0ffh then
do;
call print$console$buffer
(.('No such file to rename.','$'));
end;
else
do;
call move (16,.fcb,.locfcb+16);
call rename$file (.locfcb);
end;
call terminate;
end;
end ren;