mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 17:04:19 +00:00
275 lines
6.7 KiB
Plaintext
275 lines
6.7 KiB
Plaintext
$title ('MP/M-86 2.0 Spool Program')
|
||
$compact
|
||
spool:
|
||
do;
|
||
|
||
$include(copyrt.lit)
|
||
|
||
$include(vaxcmd.lit)
|
||
|
||
$include(comlit.lit)
|
||
|
||
dcl mpm$product lit '11h';
|
||
|
||
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;
|
||
|
||
mon3:
|
||
procedure (func,info) address external;
|
||
declare func byte;
|
||
declare info address;
|
||
end mon3;
|
||
|
||
declare fcb (1) byte external;
|
||
declare buff (1) byte external;
|
||
|
||
read$console:
|
||
procedure byte;
|
||
return mon2 (1,0);
|
||
end read$console;
|
||
|
||
print$console$buffer:
|
||
procedure (buff$adr);
|
||
declare buff$adr address;
|
||
call mon1 (9,buff$adr);
|
||
end print$console$buffer;
|
||
|
||
check$console$status:
|
||
procedure byte;
|
||
return mon2 (11,0);
|
||
end check$console$status;
|
||
|
||
version:
|
||
procedure address;
|
||
return mon3(12,0);
|
||
end version;
|
||
|
||
open:
|
||
procedure (fcb$adr) byte public;
|
||
declare fcb$adr address;
|
||
return mon2 (15,fcb$adr);
|
||
end open;
|
||
|
||
readbf:
|
||
procedure (fcb$adr) byte public;
|
||
declare fcb$adr address;
|
||
return mon2 (20,fcb$adr);
|
||
end readbf;
|
||
|
||
set$dma:
|
||
procedure (dma$adr) public;
|
||
declare dma$adr address;
|
||
call mon1 (26,dma$adr);
|
||
end set$dma;
|
||
|
||
free$drives:
|
||
procedure;
|
||
call mon1 (39,0ffffh);
|
||
end free$drives;
|
||
|
||
lo:
|
||
procedure (char) public;
|
||
declare char byte;
|
||
call mon1 (5,char);
|
||
end lo;
|
||
|
||
system$reset:
|
||
procedure;
|
||
call mon1 (0,0);
|
||
end system$reset;
|
||
|
||
crlf:
|
||
procedure;
|
||
call print$console$buffer(.(0ah,0dh,'$'));
|
||
end crlf;
|
||
|
||
/* CP/M, XDOS function numbers */
|
||
|
||
declare
|
||
set$dma$base lit '51',
|
||
get$max$mem lit '53',
|
||
alloc$mem lit '55',
|
||
free$mem lit '57',
|
||
open$queue lit '135',
|
||
read$queue lit '137',
|
||
cond$read$queue lit '138',
|
||
write$queue lit '139',
|
||
detach lit '147',
|
||
parse$fname lit '152',
|
||
attach$list lit '158',
|
||
detach$list lit '159';
|
||
|
||
|
||
declare control$z literally '1AH';
|
||
declare (char,column,itab,jtab,i) byte;
|
||
|
||
declare bufpointer pointer; /* base this structure */
|
||
declare bufptr structure ( /* where memory has been */
|
||
offset word, segment word ) at (@bufpointer); /* allocated */
|
||
declare buffer based bufpointer (128) byte;
|
||
|
||
list$buf:
|
||
procedure (sector) byte;
|
||
declare i byte, sector word;
|
||
|
||
do i = 0 to 127;
|
||
if (char := buffer(i + sector)) = 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 column = 0;
|
||
call lo(char);
|
||
|
||
if check$console$status then
|
||
do;
|
||
i = read$console; /* under MP/M-80 forced a dispatch */
|
||
call system$reset; /* when console detached, causes problems */
|
||
end; /* under MP/M-86 when detached ?? */
|
||
/* leave in for test site since there is */
|
||
/* no abort code and/or stop spooler */
|
||
end;
|
||
end;
|
||
return false;
|
||
end list$buf;
|
||
|
||
declare (nmbufs,actbuf) address;
|
||
|
||
copy$file:
|
||
procedure;
|
||
declare ok byte;
|
||
declare i word; /* for signed compare below */
|
||
|
||
do forever;
|
||
actbuf = 0;
|
||
ok = true;
|
||
do while ok;
|
||
call set$dma (bufptr.offset + actbuf * 128);
|
||
if (ok := (readbf (.fcb) = 0)) then
|
||
do;
|
||
ok = ((actbuf := actbuf+1) < nmbufs);
|
||
end;
|
||
else
|
||
do;
|
||
if actbuf = 0 then return;
|
||
end;
|
||
end;
|
||
do i = 1 to actbuf;
|
||
if list$buf((i - 1) * 128) then
|
||
return;
|
||
end;
|
||
end;
|
||
end copy$file;
|
||
|
||
declare local$buffer (512) byte; /* used if unsuccessful mem allocation */
|
||
|
||
declare pcb structure (
|
||
field$adr address,
|
||
fcb$adr address)
|
||
initial (0,.fcb);
|
||
|
||
declare (ret,ret2) byte;
|
||
declare nxt$chr$adr address;
|
||
|
||
declare reserved$for$disk (3) byte;
|
||
declare mcb structure (
|
||
base word, length word, ext byte) initial (0,0fffh,0); /* alloc 64k max */
|
||
|
||
declare uqcb literally 'structure (
|
||
q$id word, bufadr word, name (8) byte)';
|
||
|
||
declare mode1 lit '6'; /* offset in fcb for r/o attribute */
|
||
|
||
plmstart: procedure public;
|
||
|
||
if high(version) <> mpmproduct then
|
||
do;
|
||
call print$console$buffer(.('Requires MP/M-86',0dh,0ah,'$'));
|
||
call system$reset;
|
||
end;
|
||
|
||
nxt$chr$adr = .buff(0); /* make sure files exit */
|
||
do while (nxt$chr$adr <> 0);
|
||
pcb.field$adr = nxt$chr$adr + 1;
|
||
nxt$chr$adr = mon3 (parse$fname,.pcb);
|
||
fcb(mode1) = fcb(mode1) or 080h; /* open files in read only mode */
|
||
if nxt$chr$adr = 0FFFFH then
|
||
do;
|
||
call print$console$buffer(.(0dh,0ah,'Illegal File Name',0dh,0ah,'$'));
|
||
call system$reset;
|
||
end;
|
||
else if open (.fcb) = 0FFH then
|
||
do;
|
||
call print$console$buffer (.(0dh,0ah,'Can''t Open File = $'));
|
||
fcb(12) = '$';
|
||
call print$console$buffer(.fcb(1));
|
||
call crlf;
|
||
call system$reset;
|
||
end;
|
||
end; /* of while */
|
||
|
||
if ret = mon2(get$max$mem,.mcb) and
|
||
mcb.length >= (size(local$buffer) / 16) + 8 then
|
||
do; /* successful memory allocation and bigger than local buf */
|
||
if (nmbufs := shr (mcb.length,3)) > 512 then /* larger than 64K ? */
|
||
do;
|
||
nmbufs = 512;
|
||
mcb.base = mcb.base + 01000h;
|
||
mcb.length = mcb.length - 01000h;
|
||
mcb.ext = 0;
|
||
call mon1(free$mem,.mcb); /* return extra memory past 64K */
|
||
end;
|
||
call mon1(set$dma$base,mcb.base);
|
||
bufptr.segment = mcb.base;
|
||
bufptr.offset = 0;
|
||
end;
|
||
else /* not enough external memory: */
|
||
do; /* use buffer internal to program */
|
||
bufpointer = @local$buffer;
|
||
nmbufs = size(local$buffer) / 128;
|
||
end;
|
||
|
||
call print$console$buffer(.(
|
||
'MP/M-86 V2.0 Spooler', 0dh, 0ah,
|
||
'- Enter STOPSPLR to abort the spooler', 0dh, 0ah,
|
||
'- Enter ATTACH SPOOL to re-attach console to spooler', 0dh, 0ah,
|
||
'*** Spooler Detaching From Console ***$'));
|
||
call mon1(detach,0);
|
||
|
||
nxt$chr$adr = .buff(0);
|
||
do while (nxt$chr$adr <> 0) and
|
||
(nxt$chr$adr <> 0FFFFH);
|
||
pcb.field$adr = nxt$chr$adr + 1;
|
||
nxt$chr$adr = mon3 (parse$fname,.pcb);
|
||
if nxt$chr$adr <> 0FFFFH then
|
||
do;
|
||
fcb(mode1) = fcb(mode1) or 080h; /* open files in read only mode */
|
||
if open (.fcb) <> 0FFH then
|
||
do;
|
||
fcb(32) = 0;
|
||
call mon1(attach$list,0);
|
||
call copy$file;
|
||
call mon1(detach$list,0);
|
||
call free$drives;
|
||
end;
|
||
end;
|
||
end; /* of while */
|
||
|
||
call system$reset;
|
||
|
||
end plmstart;
|
||
|
||
end spool;
|
||
|