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

1 line
8.7 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 ('Copy Console #1 to Console #2')
copy1to2:
do;
$include (copyrt.lit)
$nolist
/*
Common Literals
*/
declare true literally '0FFFFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare restarts literally
'0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H,0C7C7H,
0C7C7H,0C7C7H,0C7C7H';
$list
$include (fcb.lit)
$include (proces.lit)
$include (queue.lit)
/*
Template for all BDOS and XDOS calls
*/
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;
mon2a:
procedure (func,info) address external;
declare func byte;
declare info address;
end mon2a;
declare fcb (1) byte external;
declare fcb16 (1) byte external;
declare tbuff (1) byte external;
/**************************************
* *
* B D O S Externals *
* *
**************************************/
system$reset:
procedure;
call mon1 (0,0);
end system$reset;
read$console:
procedure byte;
return mon2 (1,0);
end read$console;
write$console:
procedure (char);
declare char byte;
call mon1 (2,char);
end write$console;
write$list:
procedure (char);
declare char byte;
call mon1 (5,char);
end write$list;
direct$console$in:
procedure byte;
return mon2 (6,0ffh);
end direct$console$in;
direct$console$out:
procedure (char);
declare char byte;
call mon1 (6,char);
end direct$console$out;
print$console$buffer:
procedure (buffer$address);
declare buffer$address address;
call mon1 (9,buffer$address);
end print$console$buffer;
read$console$buffer:
procedure (buffer$address);
declare buffer$address address;
call mon1 (10,buffer$address);
end read$console$buffer;
check$console$status:
procedure byte;
return mon2 (11,0);
end check$console$status;
reset$disk$system:
procedure;
call mon1 (13,0);
end reset$disk$system;
open$file:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (15,fcb$address);
end open$file;
close$file:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (16,fcb$address);
end close$file;
delete$file:
procedure (fcb$address);
declare fcb$address address;
call mon1 (19,fcb$address);
end delete$file;
read$record:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (20,fcb$address);
end read$record;
write$record:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (21,fcb$address);
end write$record;
create$file:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (22,fcb$address);
end create$file;
rename$file:
procedure (fcb$address);
declare fcb$address address;
call mon1 (23,fcb$address);
end rename$file;
set$DMA$address:
procedure (DMA$address);
declare DMA$address address;
call mon1 (26,DMA$address);
end set$DMA$address;
set$user$code:
procedure (user);
declare user byte;
call mon1 (32,user);
end set$user$code;
get$user$code:
procedure byte;
return mon2 (32,0);
end get$user$code;
read$random:
procedure (fcbadr);
declare fcbadr address;
call mon1 (33,fcbadr);
end read$random;
write$random:
procedure (fcbadr);
declare fcbadr address;
call mon1 (34,fcbadr);
end write$random;
set$random$record:
procedure (fcbadr);
declare fcbadr address;
call mon1 (36,fcbadr);
end set$random$record;
/**************************************
* *
* X D O S Externals *
* *
**************************************/
flag$wait:
procedure (flag) byte;
declare flag byte;
return mon2 (132,flag);
end flag$wait;
flag$set:
procedure (flag) byte;
declare flag byte;
return mon2 (133,flag);
end flag$set;
make$queue:
procedure (qcb$address);
declare qcb$address address;
call mon1 (134,qcb$address);
end make$queue;
open$queue:
procedure (qcb$address) byte;
declare qcb$address address;
return mon2 (135,qcb$address);
end open$queue;
delete$queue:
procedure (qcb$address) byte;
declare qcb$address address;
return mon2 (136,qcb$address);
end delete$queue;
read$queue:
procedure (qcb$address);
declare qcb$address address;
call mon1 (137,qcb$address);
end read$queue;
cond$read$queue:
procedure (qcb$address) byte;
declare qcb$address address;
return mon2 (138,qcb$address);
end cond$read$queue;
write$queue:
procedure (qcb$address);
declare qcb$address address;
call mon1 (139,qcb$address);
end write$queue;
cond$write$queue:
procedure (qcb$address) byte;
declare qcb$address address;
return mon2 (140,qcb$address);
end cond$write$queue;
delay:
procedure (ticks);
declare ticks address;
call mon1 (141,ticks);
end delay;
dispatch:
procedure;
call mon1 (142,0);
end dispatch;
terminate:
procedure;
call mon1 (143,0);
end terminate;
create:
procedure (process$descriptor$adr);
declare process$descriptor$adr address;
call mon1 (144,process$descriptor$adr);
end create;
set$priority:
procedure (priority);
declare priority byte;
call mon1 (145,priority);
end set$priority;
attach:
procedure (console);
declare console byte;
call mon1 (146,console);
end attach;
detach:
procedure (console);
declare console byte;
call mon1 (147,console);
end detach;
set$console:
procedure (console);
declare console byte;
call mon1 (148,console);
end set$console;
assign$console:
procedure (pname$adr);
declare pname$adr address;
call mon1 (149,pname$adr);
end assign$console;
send$cli$command:
procedure (command$line);
declare command$line address;
call mon1 (150,command$line);
end send$cli$command;
call$res$sys$process:
procedure (pname$adr) address;
declare pname$adr address;
return mon2a (151,pname$adr);
end call$res$sys$process;
parse$filename:
procedure (pcb$address) address;
declare pcb$address address;
return mon2a (152,pcb$address);
end parse$filename;
get$console$number:
procedure byte;
return mon2 (153,0);
end get$console$number;
system$data$adr:
procedure address;
return mon2a (154,0);
end system$data$adr;
get$tod:
procedure (buffer$adr);
declare buffer$adr address;
call mon1 (155,buffer$adr);
end get$tod;
/**************************************
* *
* Misc. BDOS & XDOS procs *
* *
**************************************/
crlf:
procedure;
call write$console (0dh);
call write$console (0ah);
end crlf;
declare buffer (8192) byte;
declare disk$wr$pd process$descriptor
initial (0,0,199,.disk$wr$stk+46,
'DiskWr ',1,0ffh,0,0,.buffer,0);
declare disk$wr$stk (24) address
initial (restarts,.disk$wr);
declare disk$wr$cque structure (cqueue,buf(16) byte)
initial (0,'DiskWrQ ',1,16);
declare char$in byte;
declare Out$uqcb userqcbhead
initial (.disk$wr$cque,.char$in);
declare char$out byte;
declare In$uqcb userqcbhead
initial (.disk$wr$cque,.char$out);
declare ret byte;
/*
Disk Write Process
*/
Disk$Wr:
procedure;
do forever;
char$in = direct$console$in;
call write$queue (.Out$uqcb);
if char$in = 1ah then
do;
call mon1 (143,0ffffh);
end;
end;
end Disk$wr;
/*
Main Program
*/
start:
do;
call make$queue (.Disk$Wr$CQue);
call create (.Disk$Wr$Pd);
do forever;
call read$queue (.In$uqcb);
if char$out = 1ah then
do;
ret = delete$queue (.Disk$Wr$CQue);
call terminate;
end;
call write$console (char$out);
end;
end;
end copy1to2;