mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 08:54:17 +00:00
270 lines
6.6 KiB
Plaintext
270 lines
6.6 KiB
Plaintext
$title('MP/M II V2.0 Spool Process - Banked Portion')
|
||
spool:
|
||
do;
|
||
|
||
$include (copyrt.lit)
|
||
/*
|
||
Revised:
|
||
14 Sept 81 by Thomas Rolander
|
||
*/
|
||
|
||
$include (proces.lit)
|
||
$include (queue.lit)
|
||
$include (fcb.lit)
|
||
|
||
/*
|
||
BDOS & XDOS Literals
|
||
*/
|
||
|
||
declare
|
||
lo literally '005',
|
||
open$file literally '015',
|
||
delete$file literally '019',
|
||
read$file literally '020',
|
||
set$dma literally '026',
|
||
free$drives literally '039',
|
||
make$queue literally '134',
|
||
open$queue literally '135',
|
||
read$queue literally '137',
|
||
cond$read$queue literally '138',
|
||
write$queue literally '139',
|
||
cond$write$queue literally '140',
|
||
delay literally '141',
|
||
dispatch literally '142',
|
||
set$priority literally '145',
|
||
parse$fname literally '152',
|
||
attach$list literally '158',
|
||
detach$list literally '159';
|
||
|
||
/*
|
||
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';
|
||
|
||
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 control$z literally '1AH';
|
||
|
||
/*
|
||
Spool Process Data Segment
|
||
*/
|
||
declare os address public
|
||
/* The OS address will be filled in here by the
|
||
MPM Loader, this address is used by Mon1 & Mon2 */
|
||
data (0);
|
||
|
||
declare spool$stack$pointer address
|
||
data (.spool$stk+38);
|
||
|
||
declare nrs$name (8) byte data (
|
||
'Spool ');
|
||
|
||
declare spool$pd$adr address;
|
||
declare spool$pd based spool$pd$adr process$descriptor;
|
||
|
||
declare spool$stk (20) address
|
||
initial (restarts,.spool);
|
||
|
||
declare spool$lqcb$adr address;
|
||
declare spool$lqcb based spool$lqcb$adr
|
||
structure (lqueue,
|
||
buf (192) byte);
|
||
|
||
declare spool$uqcb userqcbhead
|
||
initial (0,.field);
|
||
|
||
declare stpspl$cqcb$adr address;
|
||
declare stpspl$cqcb based stpspl$cqcb$adr circularqueue;
|
||
|
||
declare stpspl$uqcb address;
|
||
|
||
declare field (62) byte;
|
||
declare disk$select byte at (.field(0));
|
||
declare console byte at (.field(1));
|
||
declare null byte initial (0);
|
||
|
||
declare pcb structure (
|
||
field$adr address,
|
||
fcb$adr address)
|
||
initial (0,.fcb);
|
||
|
||
declare fcb fcb$descriptor;
|
||
|
||
declare ret byte;
|
||
|
||
declare (char,column,itab,jtab,eod,i) byte;
|
||
|
||
declare nxt$chr$adr address;
|
||
declare delim based nxt$chr$adr byte;
|
||
|
||
declare actbuf address;
|
||
declare nmbufs address initial (8);
|
||
|
||
list$buf:
|
||
procedure (buf$adr) byte;
|
||
declare buf$adr address;
|
||
declare buffer based buf$adr (1) byte;
|
||
declare i byte;
|
||
|
||
do i = 0 to 127;
|
||
if (char := buffer(i)) = control$z
|
||
then return true;
|
||
itab = (char = 09H) and (7 - (column and 7));
|
||
if char = 09H
|
||
then char = ' ';
|
||
do jtab = 0 to itab;
|
||
if char >= ' '
|
||
then column = column + 1;
|
||
if char = 0AH then
|
||
do;
|
||
column = 0;
|
||
if mon2 (cond$read$queue,.stpspl$uqcb) = 0 then
|
||
do;
|
||
nxt$chr$adr = 0;
|
||
call mon1 (lo,char);
|
||
return true;
|
||
end;
|
||
end;
|
||
call mon1 (lo,char);
|
||
end;
|
||
end;
|
||
return false;
|
||
end list$buf;
|
||
|
||
copy$file:
|
||
procedure (buf$base);
|
||
declare buf$base address;
|
||
declare buffer based buf$base (1) structure (
|
||
record (128) byte);
|
||
declare ok byte;
|
||
declare i address;
|
||
|
||
do forever;
|
||
actbuf = 0;
|
||
ok = true;
|
||
do while ok;
|
||
call mon1 (set$dma,.buffer(actbuf));
|
||
if (ok := (mon2 (read$file,.fcb) = 0)) then
|
||
do;
|
||
ok = ((actbuf := actbuf+1) <> nmbufs);
|
||
end;
|
||
else
|
||
do;
|
||
if actbuf = 0 then return;
|
||
end;
|
||
end;
|
||
do i = 0 to actbuf-1;
|
||
if list$buf (.buffer(i))
|
||
then return;
|
||
end;
|
||
if actbuf <> nmbufs then return;
|
||
end;
|
||
end copy$file;
|
||
|
||
declare spool$buffer (1024) byte;
|
||
declare buffer (1) structure (
|
||
char (128) byte) at (.spool$buffer);
|
||
|
||
declare last$dseg$byte byte
|
||
initial (0);
|
||
|
||
/*
|
||
spool:
|
||
*/
|
||
|
||
spool:
|
||
procedure;
|
||
|
||
spool$pd$adr = os + 2;
|
||
spool$lqcb$adr = spool$pd$adr + 52;
|
||
spool$uqcb.pointer = .spool$lqcb;
|
||
stpspl$cqcb$adr = spool$lqcb$adr + 24 + 128;
|
||
stpspl$uqcb = .stpspl$cqcb;
|
||
|
||
call mon1 (make$queue,.spool$lqcb);
|
||
call mon1 (make$queue,.stpspl$cqcb);
|
||
call mon1 (set$priority,201);
|
||
|
||
do forever;
|
||
call mon1 (read$queue,.spool$uqcb);
|
||
spool$pd.disk$slct = disk$select;
|
||
spool$pd.console = console;
|
||
|
||
call mon1 (detach$list,0);
|
||
if nxt$chr$adr <> 0ffffh
|
||
then nxt$chr$adr = .field(1);
|
||
do while (nxt$chr$adr <> 0) and
|
||
(nxt$chr$adr <> 0FFFFH);
|
||
pcb.field$adr = nxt$chr$adr + 1;
|
||
nxt$chr$adr = mon2a (parse$fname,.pcb);
|
||
if nxt$chr$adr <> 0FFFFH then
|
||
do;
|
||
fcb.fn(5) = (fcb.fn(5) or 80h);
|
||
if mon2 (open$file,.fcb) <> 0FFH then
|
||
do;
|
||
fcb.nr = 0;
|
||
call mon1 (attach$list,0);
|
||
call copy$file (.buffer);
|
||
call mon1 (detach$list,0);
|
||
call mon1 (free$drives,0ffffh);
|
||
if (nxt$chr$adr <> 0) and
|
||
(delim = '[') then
|
||
do;
|
||
pcb.field$adr = nxt$chr$adr + 1;
|
||
pcb.fcb$adr = .spool$buffer;
|
||
nxt$chr$adr = mon2a (parse$fname,.pcb);
|
||
if nxt$chr$adr <> 0ffffh then
|
||
do;
|
||
if spool$buffer(1) = 'D' then
|
||
do;
|
||
fcb.ex = 0;
|
||
call mon1 (delete$file,.fcb);
|
||
end;
|
||
if (nxt$chr$adr <> 0) and
|
||
(delim <> ']') then
|
||
do;
|
||
nxt$chr$adr = 0ffffh;
|
||
end;
|
||
end;
|
||
pcb.fcb$adr = .fcb;
|
||
end;
|
||
end;
|
||
end;
|
||
end; /* of while */
|
||
end;
|
||
end spool;
|
||
/*
|
||
Dummy Main Program
|
||
*/
|
||
do;
|
||
;
|
||
end;
|
||
end spool;
|
||
|