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

1 line
8.7 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 ('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;