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

1 line
2.5 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 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;