seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-23 08:24:18 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Upload

Browse Source 
Digital Research
This commit is contained in:
Sepp J Morris
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/CCB.LIT Normal file
View File

@@ -0,0 +1,3 @@
%TYPE-W, error opening _DRB0:[FRANK.MPM86.SDIR]CCB.LIT; as input
-RMS-E, file not found


14
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/COMLIT.LIT Normal file
View File

@@ -0,0 +1,14 @@
declare
lit literally 'literally',
dcl lit 'declare',
true lit '0ffh',
false lit '0',
boolean lit 'byte',
forever lit 'while true',
cr lit '13',
lf lit '10',
tab lit '9',
ff lit '12',
sectorlen lit '128';


9
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/COPYRT.LIT Normal file
View File

@@ -0,0 +1,9 @@
/*
Copyright (C) 1981
Digital Research
P.O. Box 579
Pacific Grove, CA 93950
*/


506
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/DISP.PLM Normal file
View File

@@ -0,0 +1,506 @@
$title ('SDIR - Display Files')
display:
do;
/* Display Module for SDIR */
$include(comlit.lit)
$include(mon.plm)
dcl (cur$drv, cur$usr) byte external;
dcl (os,bdos) byte external;
$include(vers.lit)
dcl used$de address external; /* number of used directory entries */
dcl sorted boolean external;
dcl filesfound address external;
$include (search.lit)
dcl find find$structure external;
dcl format byte external, /* format is one of the following */
page$len address external, /* page size before printing new headers */
message boolean external, /* print titles and msg when no file found */
formfeeds boolean external; /* use form feeds to separate headers */
$include(format.lit)
dcl file$displayed boolean public initial (false);
/* true if we ever display a file, from any drive or user */
/* used by main.plm for file not found message */
dcl dir$label byte external;
$include(fcb.lit)
$include(xfcb.lit)
dcl
buf$fcb$adr address external, /* index into directory buffer */
buf$fcb based buf$fcb$adr (32) byte,
/* fcb template for dir */
(f$i$adr,last$f$i$adr,first$f$i$adr) address external,
cur$file address; /* number of file currently */
/* being displayed */
$include(finfo.lit)
/* structure of file info */
dcl file$info based f$i$adr f$info$structure;
dcl x$i$adr address external,
xfcb$info based x$i$adr x$info$structure;
dcl f$i$indices$base address external, /* if sorted then f$i$indices */
f$i$indices based f$i$indices$base (1) address; /* are here */
/* -------- Routines in util.plm -------- */
printchar: procedure (char) external;
dcl char byte;
end printchar;
print: procedure (string$adr) external; /* BDOS call # 9 */
dcl string$adr address;
end print;
printb: procedure external;
end printb;
crlf: procedure external;
end crlf;
printfn: procedure(fname$adr) external;
dcl fname$adr address;
end printfn;
pdecimal: procedure(v,prec,zerosup) external;
/* print value val, field size = (log10 prec) + 1 */
/* with leading zero suppression if zerosup = true */
declare v address, /* value to print */
prec address, /* precision */
zerosup boolean; /* zero suppression flag */
end pdecimal;
p3byte: procedure(byte3adr,prec)external;
/* print 3 byte value with 0 suppression */
dcl (byte3adr,prec) address; /* assume high order bit is < 10 */
end p3byte;
add3byte: procedure (byte3$adr,word$amt) external;
dcl (byte3$adr, word$amt) address;
end add3byte; /* add word to 3 byte structure */
add3byte3: procedure (byte3$adr,byte3) external;
dcl (byte3$adr, byte3) address;
end add3byte3; /* add 3 byte quantity to 3 byte total */
shr3byte: procedure (byte3$adr) external;
dcl byte3$adr address;
end shr3byte;
/* -------- Routines in search.plm -------- */
search$first: procedure(fcb$adr) byte external;
dcl fcb$adr address;
end search$first;
search$next: procedure byte external;
end search$next;
break: procedure external;
end break;
match: procedure boolean external;
dcl fcb$adr address;
end match;
/* -------- Other external routines -------- */
display$time$stamp: procedure (ts$adr) external; /* in dts.plm */
dcl ts$adr address;
end display$time$stamp;
terminate: procedure external; /* in main.plm */
end terminate;
mult23: procedure(index) address external; /* in sort.plm */
dcl index address;
end mult23;
/* -------- From dpb86.plm or dpb80.plm -------- */
$include(dpb.lit)
dpb$byte: procedure (dpb$index) byte external;
dcl dpb$index byte;
end dpb$byte;
dpb$word: procedure (dpb$index) address external;
dcl dpb$index byte;
end dpb$word;
/* -------- routines and data structures local to this module -------- */
dcl total$kbytes structure ( /* grand total k bytes of files matched */
lword address,
hbyte byte),
total$recs structure ( /* grand total records of files matched */
lword address,
hbyte byte),
total$1k$blocks structure( /* how many 1k blocks are allocated */
lword address,
hbyte byte);
add$totals: procedure;
call add3byte(.total$kbytes,file$info.kbytes);
call add3byte3(.total$recs,.file$info.recs$lword); /* records in file */
call add3byte(.total$1k$blocks,file$info.onekblocks);
end add$totals;
dcl files$per$line byte;
dcl cur$line address;
dcl hdr (*) byte data (' Name Bytes Recs Attributes $');
dcl hdr$bars (*) byte data ('------------ ------ ------ ------------$');
dcl hdr$pu (*) byte data (' Prot Update $');
dcl hdr$xfcb$bars (*) byte data (' ------ -------------- --------------$');
dcl hdr$access (*) byte data (' Access $');
dcl hdr$create (*) byte data (' Create $');
/* example date 04/02/55 00:34 */
display$file$info: procedure;
/* print filename.typ */
call printfn(.file$info.name(0));
call printb;
call pdecimal(file$info.kbytes,10000,true);
call printchar('k'); /* up to 32 Meg - Bytes */
/* or 32,000k */
call printb;
call p3byte(.file$info.recs$lword,1); /* records */
call printb;
if rol(file$info.name(f$dirsys-1),1) then /* Type */
call print(.('Sys$'));
else call print(.('Dir$'));
call printb;
if rol(file$info.name(f$rw-1),1) then
call print(.('RO$'));
else call print(.('RW$'));
call printb;
if rol(file$info.name(f$arc-1),1) then /* arc bit was on in all */
call print$char('A'); /* dir entries */
else call printb;
if rol(file$info.name(0),1) then
call print$char('1');
else call printb;
if rol(file$info.name(1),1) then
call print$char('2');
else call printb;
if rol(file$info.name(2),1) then
call print$char('3');
else call printb;
if rol(file$info.name(3),1) then
call print$char('4');
else call printb;
end display$file$info;
display$xfcb$info: procedure;
if file$info.x$i$adr <> 0 then
do;
call printb;
x$i$adr = file$info.x$i$adr;
if (xfcb$info.passmode and pm$read) <> 0 then
call print(.('Read $'));
else if (xfcb$info.passmode and pm$write) <> 0 then
call print(.('Write $'));
else if (xfcb$info.passmode and pm$delete) <> 0 then
call print(.('Delete$'));
else
call print(.('None $'));
call printb;
if (xfcb$info.update(0) <> 0 or xfcb$info.update(1) <> 0) then
call display$timestamp(.xfcb$info.update);
else call print(.(' $'));
call printb; call printb;
if (xfcb$info.create(0) <> 0 or xfcb$info.create(1) <> 0) then
call display$timestamp(.xfcb$info.create(0));
/* Create/Access */
end;
end display$xfcb$info;
dcl first$title boolean initial (true);
display$title: procedure;
if formfeeds then
call print$char(ff);
else if not first$title then
call crlf;
call print(.('Directory For Drive $'));
call printchar('A'+ cur$drv); call printchar(':');
if bdos >= bdos20 then
do;
call print(.(' User $'));
call pdecimal(cur$usr,10,true);
end;
call crlf;
cur$line = 2;
first$title = false;
end display$title;
short$display: procedure (fname$adr);
dcl fname$adr address;
if cur$file mod files$per$line = 0 then
do;
if cur$line mod page$len = 0 then
do; call crlf;
call display$title;
call crlf;
end;
else
call crlf;
cur$line = cur$line + 1;
call printchar(cur$drv + 'A');
end;
else call printb;
call print(.(': $'));
call printfn(fname$adr);
call break;
cur$file = cur$file + 1;
end short$display;
test$att: procedure(char,off,on) boolean;
dcl (char,off,on) byte;
if (80h and char) <> 80h and off then
return(true);
if (80h and char) = 80h and on then
return(true);
return(false);
end test$att;
right$attributes: procedure(name$adr) boolean;
dcl name$adr address,
name based name$adr (1) byte;
return
test$att(name(f$rw-1),find.rw,find.ro) and
test$att(name(f$dirsys-1),find.dir,find.sys);
end right$attributes;
short$dir: procedure; /* looks like "DIR" command */
dcl dcnt byte;
fcb(f$drvusr) = '?';
files$per$line = 4;
dcnt = search$first(.fcb);
do while dcnt <> 0ffh;
buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
if (buf$fcb(f$drvusr) and 0f0h) = 0 and
buf$fcb(f$ex)<= dpb$byte(extmsk$b) then /* no dir labels, xfcbs */
if match then
if right$attributes(.buf$fcb(f$name)) then
call short$display(.buf$fcb(f$name));
dcnt = search$next;
end;
end short$dir;
dcl (last$plus$one,index) address;
getnxt$file$info: procedure; /* set f$i$adr to base file$info on file */
dcl right$usr boolean; /* to be displayed, f$i$adr = 0ffffh if end */
right$usr = false;
if sorted then
do; index = index + 1;
f$i$adr = mult23(f$i$indices(index));
do while file$info.usr <> cur$usr and index <> filesfound;
index = index + 1;
f$i$adr = mult23(f$i$indices(index));
end;
if index = files$found then
f$i$adr = last$plus$one; /* no more files */
end;
else /* not sorted display in order found in directory */
do; /* use last$plus$one to avoid wrap around problems */
f$i$adr = f$i$adr + size(file$info);
do while file$info.usr <> cur$usr and f$i$adr <> last$plus$one;
f$i$adr = f$i$adr + size(file$info);
end;
end;
end getnxt$file$info;
size$display: procedure;
if (format and form$size) <> 0 then
files$per$line = 3;
else files$per$line = 4;
do while f$i$adr <> last$plus$one;
if ((file$info.x$i$adr <> 0 and find.xfcb) or
file$info.x$i$adr = 0 and find.nonxfcb) and
right$attributes(.file$info.name(0)) then
do;
call add$totals;
call short$display(.file$info.name(0));
call pdecimal(file$info.kbytes,10000,true);
call print(.('k$'));
end;
call getnxt$file$info;
end;
end size$display;
display$no$dirlabel: procedure;
files$per$line = 2;
do while f$i$adr <> last$plus$one;
if ((file$info.x$i$adr <> 0 and find.xfcb) or
(file$info.x$i$adr = 0 and find.nonxfcb)) and
right$attributes(.file$info.name(0)) then
do;
if cur$file mod files$per$line = 0 then /* need new line */
do;
if cur$line mod page$len = 0 then
do; call crlf;
call display$title;
call crlf;
call print(.hdr);
call printb; /* two sets of hdrs */
call print(.hdr);
call crlf;
call print(.hdr$bars);
call printb;
call print(.hdr$bars);
call crlf;
cur$line = cur$line + 3;
end;
else
do; call crlf;
cur$line = cur$line + 1;
end;
end;
else
call printb; /* separate the files */
call display$file$info;
cur$file = cur$file + 1;
call add$totals;
call break;
end;
call getnxt$file$info;
end;
end display$no$dirlabel;
display$with$dirlabel: procedure;
files$per$line = 1;
do while f$i$adr <> last$plus$one;
if ((file$info.x$i$adr <> 0 and find.xfcb) or
(file$info.x$i$adr = 0 and find.nonxfcb)) and
right$attributes(.file$info.name(0)) then
do;
cur$file = cur$file + 1;
if cur$line mod page$len = 0 then
do; call crlf;
call display$title;
call crlf;
call print(.hdr);
call print(.hdr$pu);
if (dirlabel and dl$access) <> 0 then
call print(.hdr$access);
else
call print(.hdr$create);
call crlf;
call print(.hdr$bars);
call print(.hdr$xfcb$bars);
cur$line = cur$line + 2;
end;
call crlf;
call display$file$info; /* display non bdos 3.0 file info */
call display$xfcb$info;
call break;
cur$line = cur$line + 1;
call add$totals;
end;
call getnxt$file$info;
end;
end display$with$dirlabel;
display$files: procedure public; /* MODULE ENTRY POINT */
/* display the collected data */
cur$line, cur$file = 0; /* force titles and new line */
totalkbytes.lword, totalkbytes.hbyte, totalrecs.lword, totalrecs.hbyte =0;
total$1k$blocks.lword, total$1k$blocks.hbyte = 0;
f$i$adr = first$f$i$adr - size(file$info); /* initial if no sort */
last$plus$one = last$f$i$adr + size(file$info);
index = 0ffffh; /* initial if sorted */
call getnxt$file$info; /* base file info record */
if format > 2 then
do;
call print(.('Illegal Format Value$'));
call terminate; /* default could be patched - watch it */
end;
do case format; /* format = */
call short$dir; /* form$short */
call size$display; /* form$size */
/* form = full */
if (dir$label and dl$exists) <> 0 then
call display$with$dirlabel;
else
call display$no$dirlabel;
/* don't display if no dir */
end; /* label and finding xfcbs */
if format <> form$short and cur$file > 0 then /* print totals */
do;
if cur$line + 4 > page$len and formfeeds then
do;
call printchar(cr);
call printchar(ff); /* need a new page ? */
end;
else
do;
call crlf;
call crlf;
end;
call print(.( 'Total Bytes = $'));
call p3byte(.total$kbytes,1); /* 6 digit max */
call printchar('k');
call print(.(' Total Records = $'));
call p3byte(.total$recs,10); /* 7 digit max */
call print(.(' Files Found = $'));
call pdecimal(cur$file,1000,true); /* 4 digit max */
call print(.(cr,lf,'Total 1k Blocks = $'));
call p3byte(.total$1k$blocks,1); /* 6 digit max */
call print(.(' Used/Max Dir Entries For Drive $'));
call print$char('A' + cur$drv);
call print$char(':'); call printb;
call pdecimal(used$de,1000,true);
call print$char('/');
call pdecimal(dpb$word(dirmax$w) + 1,1000,true);
end;
if cur$file = 0 then
do;
if message then
do; call crlf;
call display$title;
call print(.('File Not Found.',cr,lf,'$'));
end;
call break;
end;
else
do; file$displayed = true;
if not formfeeds then
call print(.(cr,lf,'$'));
end;
end display$files;
end display;


14
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/DPB.LIT Normal file
View File

@@ -0,0 +1,14 @@
/* indices into disk parameter block, used as parameters to dpb procedure */
dcl spt$w lit '0',
blkshf$b lit '2',
blkmsk$b lit '3',
extmsk$b lit '4',
blkmax$w lit '5',
dirmax$w lit '7',
dirblk$w lit '9',
chksiz lit '11',
offset$w lit '13';


46
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/DPB80.PLM Normal file
View File

@@ -0,0 +1,46 @@
$title ('SDIR 8080 - Get Disk Parameters')
dpb80:
do;
/* the purpose of this module is to allow independence */
/* of processor, i.e., 8080 or 8086 */
$include (comlit.lit)
/* function call 32 in 2.0 or later BDOS, returns the address of the disk
parameter block for the currently selected disk, which consists of:
spt (2 bytes) number of sectors per track
blkshf (1 byte) block size = shl(double(128),blkshf)
blkmsk (1 byte) sector# and blkmsk = block number
extmsk (1 byte) logical/physical extents
blkmax (2 bytes) max alloc number
dirmax (2 bytes) size of directory-1
dirblk (2 bytes) reservation bits for directory
chksiz (2 bytes) size of checksum vector
offset (2 bytes) offset for operating system
*/
$include(dpb.lit)
declare bytes$per$block address public;
declare dpb$base address;
declare dpb$array based dpb$base (15) byte;
dcl get$dpb lit '31';
dpb$byte: procedure(param) byte public;
dcl param byte;
return(dpb$array(param));
end dpb$byte;
dpb$word: procedure(param) address public;
dcl param byte;
return(dpb$array(param) + shl(double(dpb$array(param+1)),8));
end dpb$word;
base$dpb: procedure public;
dpb$base = mon3(get$dpb,0);
bytes$per$block = shl(double(sector$len), dpb$word(blkshf$b));
end base$dpb;
end dpb80;


51
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/DPB86.PLM Normal file
View File

@@ -0,0 +1,51 @@
$compact
$title ('SDIR 8086 - Get Disk Parameters')
dpb86:
do;
/* the purpose of this module is to allow independence */
/* of processor, i.e., 8080 or 8086 */
$include (comlit.lit)
/* function call 32 in 2.0 or later BDOS, returns the address of the disk
parameter block for the currently selected disk, which consists of:
spt (2 bytes) number of sectors per track
blkshf (1 byte) block size = shl(double(128),blkshf)
blkmsk (1 byte) sector# and blkmsk = block number
extmsk (1 byte) logical/physical extents
blkmax (2 bytes) max alloc number
dirmax (2 bytes) size of directory-1
dirblk (2 bytes) reservation bits for directory
chksiz (2 bytes) size of checksum vector
offset (2 bytes) offset for operating system
*/
$include(dpb.lit)
declare k$per$block byte public;
declare dpb$base pointer;
declare dpb$array based dpb$base (15) byte;
mon4: procedure (f,a) pointer external;
dcl f byte, a address;
end mon4;
dcl get$dpb lit '31';
dpb$byte: procedure(param) byte public;
dcl param byte;
return(dpb$array(param));
end dpb$byte;
dpb$word: procedure(param) address public;
dcl param byte;
return(dpb$array(param) + shl(double(dpb$array(param+1)),8));
end dpb$word;
base$dpb: procedure public;
dpb$base = mon4(get$dpb,0);
k$per$block = shr(dpb$byte(blkmsk$b)+1 ,3);
end base$dpb;
end dpb86;


22
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/FCB.LIT Normal file
View File

@@ -0,0 +1,22 @@
declare
f$drvusr lit '0', /* drive/user byte */
f$name lit '1', /* file name */
f$namelen lit '8', /* file name length */
f$type lit '9', /* file type field */
f$typelen lit '3', /* type length */
f$rw lit '9', /* high bit is R/W attribute */
f$dirsys lit '10', /* high bit is dir/sys attribute */
f$arc lit '11', /* high bit is archive attribute */
f$ex lit '12', /* extent */
f$s1 lit '13', /* module byte */
f$rc lit '15', /* record count */
f$diskmap lit '16', /* file disk map */
diskmaplen lit '16', /* disk map length */
f$drvusr2 lit '16', /* fcb2 */
f$name2 lit '17',
f$type2 lit '25',
f$rrec lit '33', /* random record */
f$rreco lit '35'; /* " " overflow */


16
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/FINFO.LIT Normal file
View File

@@ -0,0 +1,16 @@
/* file info record for SDIR - note if this structure changes in size */
/* the multXX: routine in the sort.plm module must also change */
declare
f$info$structure lit 'structure(
usr byte, name (8) byte, type (3) byte, onekblocks address,
kbytes address, recs$lword address, recs$hbyte byte,
hash$link address, x$i$adr address)';
declare
x$info$structure lit 'structure (
create (4) byte,
update (4) byte,
passmode byte)';


8
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/FLAG.LIT Normal file
View File

@@ -0,0 +1,8 @@
/* Flag Format */
dcl flag$structure lit 'structure(
pd word,
ignore byte)';


6
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/FORMAT.LIT Normal file
View File

@@ -0,0 +1,6 @@
dcl form$short lit '0', /* format values for SDIR */
form$size lit '1',
form$full lit '2';


3
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/GL.PLM Normal file
View File

@@ -0,0 +1,3 @@
%TYPE-W, error opening _DRB0:[FRANK.MPM86.SDIR]GL.PLM; as input
-RMS-E, file not found


3
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/GS.PLM Normal file
View File

@@ -0,0 +1,3 @@
%TYPE-W, error opening _DRB0:[FRANK.MPM86.SDIR]GS.PLM; as input
-RMS-E, file not found


3
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/GSALL.CPM Normal file
View File

@@ -0,0 +1,3 @@
%TYPE-W, error opening _DRB0:[FRANK.MPM86.SDIR]GSALL.COM; as input
-RMS-E, file not found


548
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/MAIN.PLM Normal file
View File

@@ -0,0 +1,548 @@
/* C P / M - M P / M D I R E C T O R Y C O M M O N (SDIR) */
/* B E G I N N I N G O F C O M M O N M A I N M O D U L E */
/* This module is included in main80.plm or main86.plm. */
/* The differences between 8080 and 8086 versions are */
/* contained in the modules main80.plm, main86.plm and */
/* dpb80.plm, dpb86.plm and the submit files showing */
/* the different link and location addresses. */
$include (comlit.lit)
$include (mon.plm)
dcl patch (128) address;
/* Scanner Entry Points in scan.plm */
scan: procedure(pcb$adr) external;
declare pcb$adr address;
end scan;
scan$init: procedure(pcb$adr) external;
declare pcb$adr address;
end scan$init;
/* -------- Routines in other modules -------- */
search$init: procedure external; /* initialization of search.plm */
end search$init;
get$files: procedure external; /* entry to search.plm */
end get$files;
sort: procedure external; /* entry to sort.plm */
end sort;
mult23: procedure (num) address external; /* in sort.plm */
dcl num address;
end mult23;
display$files: procedure external; /* entry to disp.plm */
end display$files;
/* -------- Routines in util.plm -------- */
printb: procedure external;
end printb;
print$char: procedure(c) external;
dcl c byte;
end print$char;
print: procedure(string$adr) external;
dcl string$adr address;
end print;
crlf: procedure external;
end crlf;
p$decimal: procedure(value,fieldsize,zsup) external;
dcl value address,
fieldsize address,
zsup boolean;
end p$decimal;
/* ------------------------------------- */
dcl debug boolean public initial (false);
/* -------- version information -------- */
dcl (os,bdos) byte public;
$include (vers.lit)
$include (fcb.lit)
$include(search.lit)
dcl find find$structure public initial
(false,false,false,false, false,false,false,false);
dcl
num$search$files byte public initial(0),
search (max$search$files) search$structure public;
dcl first$f$i$adr address external;
dcl get$all$dir$entries boolean public;
dcl first$pass boolean public;
dcl usr$vector address public initial(0), /* bits for user #s to scan */
active$usr$vector address public, /* active users on curdrv */
drv$vector address initial (0); /* bits for drives to scan */
$include (format.lit)
dcl format byte public initial (form$full),
page$len address public initial (0ffffh),
/* lines on a page before printing new headers, 0 forces initial hdrs */
message boolean public initial(false),/* show titles when no files found*/
formfeeds boolean public initial(false);/* use form feeds */
dcl file$displayed boolean external;
/* true if 1 or more files displayed by dsh.plm */
dcl sort$op boolean initial (true); /* default is to do sorting */
dcl sorted boolean external; /* if successful sort */
dcl cur$usr byte public, /* current user being searched */
cur$drv byte public; /* current drive " " */
/* -------- BDOS calls --------- */
get$version: procedure address; /* returns current version information */
return mon2(12,0);
end get$version;
select$drive: procedure(d);
declare d byte;
call mon1(14,d);
end select$drive;
search$first: procedure(d) byte external;
dcl d address;
end search$first;
search$next: procedure byte external;
end search$next;
get$cur$drv: procedure byte; /* return current drive number */
return mon2(25,0);
end get$cur$drv;
getlogin: procedure address; /* get the login vector */
return mon3(24,0);
end getlogin;
getusr: procedure byte; /* return current user number */
return mon2(32,0ffh);
end getusr;
terminate: procedure public;
if os = mpm then
call mon1(0,143); /* MP/M */
else
call mon1 (0,0); /* CP/M */
end terminate;
/* -------- Utility routines -------- */
number: procedure (char) boolean;
dcl char byte;
return(char >= '0' and char <= '9');
end number;
make$numeric: procedure(char$adr,len,val$adr) boolean;
dcl (char$adr, val$adr, place) address,
chars based char$adr (1) byte,
value based val$adr address,
(i,len) byte;
value = 0;
place = 1;
do i = 1 to len;
if not number(chars(len - i)) then
return(false);
value = value + (chars(len - i) - '0') * place;
place = place * 10;
end;
return(true);
end make$numeric;
set$vec: procedure(v$adr,num) public;
dcl v$adr address, /* set bit number given by num */
vector based v$adr address, /* 0 <= num <= 15 */
num byte;
if num = 0 then
vector = vector or 1;
else
vector = vector or shl(double(1),num);
end set$vec;
bit$loc: procedure(vector) byte;
/* return location of right most on bit vector */
dcl vector address, /* 0 - 15 */
i byte;
i = 0;
do while i < 16 and (vector and double(1)) = 0;
vector = shr(vector,1);
i = i + 1;
end;
return(i);
end bit$loc;
get$nxt: procedure(vector$adr) byte;
dcl i byte,
(vector$adr,mask) address,
vector based vector$adr address;
/* if debug then
do; call print(.(cr,lf,'getnxt: vector = $'));
call pdecimal(vector,10000,false);
end; */
if (i := bit$loc(vector)) > 15 then
return(0ffh);
mask = 1;
if i > 0 then
mask = shl(mask,i);
vector = vector xor mask; /* turn off bit */
/* if debug then
do; call print(.(cr,lf,'getnxt: vector, i, mask $'));
call pdecimal(vector,10000,false);
call printb;
call pdecimal(i,10000,false);
call printb;
call pdecimal(mask,10000,false);
end; */
return(i);
end get$nxt; /* too bad plm rotates only work on byte values */
help: procedure; /* show options for this program */
call print(.(cr,lf,
tab,tab,tab,'SDIR EXAMPLES',cr,lf,lf,
'sdir file.one',tab,tab,tab,
'(find a file on current user and default drive)',cr,lf,
'sdir *.com d:*.pli',tab,tab,'(find matching files on default and d: drive)',
cr,lf,
'sdir [rw]',tab,tab,tab,'(find files that are read/write)',cr,lf,
'sdir [ro dir sys]',tab,tab,'(same for read/only, directory, system)',cr,lf,
'sdir [xfcb]',tab,tab,tab,'(find files with XFCB''s)',cr,lf,
'sdir [nonxfcb]',tab,tab,tab,'(find files without XFCB''s)',cr,lf,
'sdir [exclude] *.com',tab,tab,'(find files that don''t end in ''com'')',cr,lf,
'sdir [nosort]',tab,tab,tab,'(don''t sort the files)',cr,lf,
'sdir [full]',tab,tab,tab,'(show all file information)',cr,lf,
'sdir [size]',tab,tab,tab,'(show name and size in kilobytes)',cr,lf,
'sdir [short]',tab,tab,tab,'(show just the file names)',cr,lf,
'sdir [drive = all]',tab,tab,'(search all logged in drives)',cr,lf,
'sdir [drive = (a,b,p)]',tab,tab,
'(search specified drives, ''disk'' is synonym)',cr,lf,
'sdir [user = all]',tab,tab,'(find files with any user number)',cr,lf,
'sdir [user = (0,1,15)]',tab,tab,'(find files with specified user number)',
cr,lf,
'sdir [length = n]',tab,tab,'(print headers every n lines)',cr,lf,
'sdir [ff]',tab,tab,tab,'(print form feeds between headers)',cr,lf,
'sdir [message user=all]',tab,tab,'(show user/drive areas with no files)',
cr,lf,
'sdir [help]',tab,tab,tab,'(show this message)',cr,lf,
'sdir [dir sys rw ro sort xfcb nonxfcb full] d:*.*',tab,'(defaults)$'));
call terminate;
end help;
/* -------- Scanner Infor -------- */
$include (scan.lit)
dcl pcb pcb$structure
initial (0,.buff(0),.fcb,0,0,0,0) ;
dcl token based pcb.token$adr (12) byte;
dcl got$options boolean;
get$options: procedure;
dcl temp byte;
do while pcb.scan$adr <> 0ffffh and ((pcb.tok$typ and t$op) <> 0);
if pcb.nxt$token <> t$mod then
do; /* options with no modifiers */
if token(1) = 'D' and token(2) = 'I' then
find.dir = true;
/* else if token(1) = 'D' and token(2) = 'E' then
debug = true; */
else if token(1) = 'E' then
find.exclude = true;
else if token(1) = 'F'then
if token(2) = 'F' then
formfeeds = true;
else if token(2) = 'U' then
format = form$full;
else goto op$err;
else if token(1) = 'H' then
call help;
else if token(1) = 'M' then
message = true;
else if token(1) = 'N' then
if token(4) = 'X' then
find.nonxfcb = true;
else if token(3) = 'S' then
sort$op = false;
else goto op$err;
/* else if token(1) = 'P' then
find.pass = true; */
else if token(1) = 'S' then
if token(2) = 'Y' then
find.sys = true;
else if token(2) = 'H' then
format = form$short;
else if token(2) = 'I' then
format = form$size;
else if token(2) = 'O' then
sort$op = true;
else goto op$err;
else if token(1) = 'R' and token(2) = 'O' then
find.ro = true;
else if token(1) = 'R' and token(2) = 'W' then
find.rw = true;
else if token(1) = 'X' then
find.xfcb = true;
else goto op$err;
call scan(.pcb);
end;
else
do; /* options with modifiers */
if token(1) = 'L' then
do;
call scan(.pcb);
if (pcb.tok$typ and t$numeric) <> 0 then
if make$numeric(.token(1),pcb.token$len,.page$len) then
if page$len < 5 then
goto op$err;
else call scan(.pcb);
else goto op$err;
else goto op$err;
end;
else if token(1) = 'U' then
do;
/* if debug then
call print(.(cr,lf,'In User option$')); */
call scan(.pcb);
if ((pcb.tok$typ and t$mod) = 0) or bdos < bdos20 then
goto op$err;
do while (pcb.tok$typ and t$mod) <> 0 and
pcb.scan$adr <> 0ffffh;
if token(1) = 'A' and token(2) = 'L' then
usr$vector = 0ffffh;
else if (pcb.tok$typ and t$numeric) <> 0
and pcb.token$len < 3 then
do;
if pcb.token$len = 1 then
temp = token(1) - '0';
else
temp = (token(1) - '0') * 10 + (token(2) - '0');
if temp >= 0 and temp <= 15 then
call set$vec(.usr$vector,temp);
else goto op$err;
end;
else goto op$err;
call scan(.pcb);
end;
end;
else if token(1) = 'D' and (token(2) = 'R' or token(2) = 'I') then
do; /* allow DRIVE or DISK */
call scan(.pcb);
if (pcb.tok$typ and t$mod) = 0 then
goto op$err;
do while (pcb.tok$typ and t$mod ) <> 0 and
pcb.scan$adr <> 0ffffh;
if token(1) = 'A' and token(2) = 'L' then
do;
drv$vector = 0ffffh;
drv$vector = drv$vector and get$login;
end;
else if token(1) >= 'A' and token(1) <= 'P' then
call set$vec(.drv$vector,token(1) - 'A');
else goto op$err;
call scan(.pcb);
end;
end; /* drive option */
else goto op$err;
end; /* options with modifiers */
end; /* do while */
got$options = true;
return;
op$err:
call print(.('Illegal Option or Modifier$'));
call terminate;
end get$options;
get$file$spec: procedure;
dcl i byte;
if num$search$files < max$search$files then
do;
call move(f$namelen + f$typelen,.token(1),
.search(num$search$files).name(0));
if search(num$search$files).name(f$name - 1) = ' ' and
search(num$search$files).name(f$type - 1) = ' ' then
search(num$search$files).anyfile = true; /* match on any file */
else search(num$search$files).anyfile = false;/* speedier compare */
if token(0) = 0 then
search(num$search$files).drv = 0ffh; /* no drive letter with */
else /* file spec */
search(num$search$files).drv = token(0) - 1;
/* 0ffh in drv field indicates to look on all drives that will be */
/* scanned as set by the "drive =" option, see "match:" proc in */
/* search.plm module */
num$search$files = num$search$files + 1;
end;
else
do; call print(.('File Spec Limit is $'));
call p$decimal(max$search$files,100,true);
call crlf;
end;
call scan(.pcb);
end get$file$spec;
set$defaults: procedure;
/* set defaults if not explicitly set by user */
if not (find.dir or find.sys) then
find.dir, find.sys = true;
if not(find.ro or find.rw) then
find.rw, find.ro = true;
if find.xfcb or find.nonxfcb then
do; if format = form$short then
format = form$full;
end;
else /* both xfcb and nonxfcb are off */
find.nonxfcb, find.xfcb = true;
if num$search$files = 0 then
do;
search(num$search$files).anyfile = true;
search(num$search$files).drv = 0ffh;
num$search$files = 1;
end;
if drv$vector = 0 then
do i = 0 to num$search$files - 1;
if search(i).drv = 0ffh then search(i).drv = cur$drv;
call set$vec(.drv$vector,search(i).drv);
end;
else /* a "[drive =" option was found */
do i = 0 to num$search$files - 1;
if search(i).drv <> 0ffh and search(i).drv <> cur$drv then
do; call print(.('Illegal Global/Local Drive Spec Mixing$'));
call terminate;
end;
end;
if usr$vector = 0 then
call set$vec(.usr$vector,get$usr);
end set$defaults;
dcl (save$uvec,temp) address;
dcl i byte;
declare last$dseg$byte byte
initial (0);
plm$start: procedure public;
os = high(get$version);
bdos = low(get$version);
/* note - initialized declarations set defaults */
cur$drv = get$cur$drv;
call scan$init(.pcb);
call scan(.pcb);
got$options = false;
do while pcb.scan$adr <> 0ffffh;
if (pcb.tok$typ and t$op) <> 0 then
if got$options = false then
call get$options;
else
do;
call print (.('Group Options Together$'));
call terminate;
end;
else if (pcb.tok$typ and t$filespec) <> 0 then
call get$file$spec;
else
do;
call print(.('Illegal Command Tail$'));
call terminate;
end;
end;
call set$defaults;
/* main control loop */
call search$init; /* set up memory pointers for subsequent storage */
do while (cur$drv := get$nxt(.drv$vector)) <> 0ffh;
call select$drive(cur$drv);
save$uvec = usr$vector; /* user numbers to search on each drive */
active$usr$vector = 0; /* users active on cur$drv */
cur$usr = get$nxt(.usr$vector); /* get first user num and mask */
get$all$dir$entries = false; /* off it off */
if usr$vector <> 0 and format <> form$short then
/* find high water mark if */
do; /* more than one user requested */
fcb(f$drvusr) = '?';
i = search$first(.fcb); /* get first directory entry */
temp = 0;
do while i <> 255;
temp = temp + 1;
i = search$next;
end; /* is there enough space in the */
/* worst case ? */
if maxb > mult23(temp) + shl(temp,1) then
get$all$dir$entries = true; /* location of last possible */
end; /* file info record and add */
first$pass = true; /* room for sort indices */
active$usr$vector = 0ffffh;
do while cur$usr <> 0ffh;
/* if debug then
call print(.(cr,lf,'in user loop $')); */
call set$vec(.temp,cur$usr);
if (temp and active$usr$vector) <> 0 then
do;
if format <> form$short and
(first$pass or not get$all$dir$entries) then
do;
call getfiles; /* collect files in memory and */
first$pass = false; /* build the active usr vector */
sorted = false; /* sort module will set sorted */
if sort$op then /* to true, if successful sort */
call sort;
end;
call display$files;
end;
cur$usr = get$nxt(.usr$vector);
end;
usr$vector = save$uvec; /* restore user vector for nxt */
end; /* do while drv$usr drive scan */
if not file$displayed and not message then
call print(.('File Not Found.$'));
call terminate;
end plm$start;
error:
call terminate;
end sdir;


13
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/MAIN80.PLM Normal file
View File

@@ -0,0 +1,13 @@
$title ('SDIR 8080 - Main Module')
sdir: /* SDIR FOR 8080 */
do:
$include(copyrt.lit)
declare plmstart label;
declare jmp byte data('0c3h');
declare startadr address data(.plmstart);
$include(dm.plm)


36
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/MAIN86.PLM Normal file
View File

@@ -0,0 +1,36 @@
$title ('SDIR 8086 - Main Module')
sdir:
do;
$include (copyrt.lit)
/* commands used to generate */
/*
asm86 scd.a86
plm86 main86.plm debug object(main86) optimize(3) 'p2' 'p3' 'p4'
plm86 scan.plm debug object(scan) optimize(3) 'p2' 'p3' 'p4'
plm86 search.plm debug object(search) optimize(3) 'p2' 'p3' 'p4'
plm86 sort.plm debug object(sort) optimize(3) 'p2' 'p3' 'p4'
plm86 disp.plm debug object(disp) optimize(3) 'p2' 'p3' 'p4'
plm86 dpb86.plm debug object(dpb86) optimize(3) 'p2' 'p3' 'p4'
plm86 util.plm debug object(util) optimize(3) 'p2' 'p3' 'p4'
plm86 timest.plm debug object(timest) optimize(3) 'p2' 'p3' 'p4'
link86 scd.obj,main86,scan,search,sort,disp,util,dpb86,timest to sdir86.lnk
loc86 sdir86.lnk od(sm(code,dats,data,const,stack)) -
ad(sm(code(0))) ss(stack(+32))
h86 sdir86
(on a micro)
vax sdir86.h86 $fans
gencmd sdir86 data[b270 m3c5 xfff]
* note the beginning of the data segment will change when
* the program is changed. see the 'MP2' file generated by
* LOC86. also the constants are last to force hex generation.
* a minimum data of 3c5h paragraphs is 12K plus the data space
* of SDIR, enough for 512 directory entries
*/
$include (main.plm)


3
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/MCD.A86 Normal file
View File

@@ -0,0 +1,3 @@
%TYPE-W, error opening _DRB0:[FRANK.MPM86.SDIR]MCD.A86; as input
-RMS-E, file not found


24
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/MDSAT.LIT Normal file
View File

@@ -0,0 +1,24 @@
declare md$structure literally
'structure(
link word,
start word,
length word,
plist word,
unused word)';
declare ms$structure literally
'structure(
link word,
start word,
length word,
flags word,
mau word)';
declare sat$structure literally
'structure(
start word,
len word,
num$allocs byte)';


20
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/MON.PLM Normal file
View File

@@ -0,0 +1,20 @@
/* definitions for assembly interface module */
declare
fcb (33) byte external, /* default file control block */
maxb address external, /* top of memory */
buff(128)byte external; /* default buffer */
mon1: procedure(f,a) external;
declare f byte, a address;
end mon1;
mon2: procedure(f,a) byte external;
declare f byte, a address;
end mon2;
mon3: procedure(f,a) address external;
declare f byte, a address;
end mon3;


15
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/MPMSTAT.CPM Normal file
View File

@@ -0,0 +1,15 @@
set verify
$ set def [frank.mpm86.mpmstat]
$ asm86 rspasm.a86
$ plm86 stsrsp.plm optimize(3) debug 'p1' 'p2' 'p3'
$ link86 rspasm.obj, stsrsp.obj to stsrsp.lnk
$ loc86 stsrsp.lnk od(sm(dats,code,data,const)) -
ad(sm(dats(0),code(0))) ss(stack(0))
$ h86 stsrsp
$ asm86 mcd.a86
$ plm86 stscmd.plm 'p1' 'p2' 'p3' optimize(3) debug
$ link86 mcd.obj,stscmd.obj to stscmd.lnk
$ loc86 stscmd.lnk od(sm(dats,code,data,stack,const)) -
ad(sm(dats(0),code(0))) ss(stack(+32))
$ h86 stscmd


39
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/PROCES.LIT Normal file
View File

@@ -0,0 +1,39 @@
/*
Proces Literals MP/M-8086 II
*/
declare pnamsiz literally '8';
declare pd$hdr literally 'structure
(link word,thread word,stat byte,prior byte,flag word,
name (8) byte,uda word,dsk byte,user byte,ldsk byte,luser byte,
mem word';
declare pd$structure literally 'pd$hdr,
dvract word,wait word,org byte,net byte,parent word,
cns byte,abort byte,cin byte,cout byte,lst byte,sf3 byte,sf4 byte,sf5 byte,
reservd (4) byte,pret word,scratch word)';
declare psrun lit '00',
pspoll lit '01',
psdelay lit '02',
psswap lit '03',
psterm lit '04',
pssleep lit '05',
psdq lit '06',
psnq lit '07',
psflagwait lit '08',
psciowait lit '09';
declare pfsys lit '00001h',
pf$keep lit '00002h',
pf$kernal lit '00004h',
pf$pure lit '00008h',
pf$table lit '00010h',
pf$resource lit '00020h',
pf$raw lit '00040h',
pf$ctlc lit '00080h',
pf$active lit '00100h';


40
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/QD.LIT Normal file
View File

@@ -0,0 +1,40 @@
/* Queue Descriptor */
dcl qnamsiz lit '8';
dcl qd$structure lit 'structure(
link word,
net byte,
org byte,
flags word,
name(qnamsiz) byte,
msglen word,
nmsgs word,
dq word,
nq word,
msgcnt word,
msgout word,
buffer word)';
/* queue flag values */
dcl qf$mx lit '001h'; /* Mutual Exclusion */
dcl qf$keep lit '002h'; /* NO DELETE */
dcl qf$hide lit '004h'; /* Not User writable */
dcl qf$rsp lit '008h'; /* rsp queue */
dcl qf$table lit '010h'; /* from qd table */
dcl qf$rpl lit '020h'; /* rpl queue */
dcl qf$dev lit '040h'; /* device queue */
/* Queue Parameter Block */
dcl qpb$structure lit 'structure(
flgs byte,
net byte,
qaddr word,
nmsgs word,
buffptr word,
name (qnamsiz) byte )';


96
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/RSPASM.A86 Normal file
View File

@@ -0,0 +1,96 @@
; Code and Data Interface for MP/M-86 PLM RSPs
; August 10, 1981
cgroup group code
dgroup group dats
public xdos,mon1,mon2,mon3,mon4
public rsplink,buff,fcb,fcb16
extrn plmstart:near
assume cs:cgroup,ds:dgroup
dats segment 'DATA'
org 0
rsphdr_len equ 16
pd_len equ 30H
uda_len equ 100H
rsp_top equ 0
rsp_pd equ rsp_top + rsphdr_len
rsp_uda equ rsp_pd + pd_len
rsp_bottom equ rsp_uda + uda_len
org rsp_top
;RSP header
rsplink dw 0 ;becomes system data page paragraph
sdatvar dw 0
ncopies db 0
dw 0,0,0,0, 0
db 0
org rsp_pd
pd dw 0,0 ;link fields
db 0 ;status
db 190 ;priority
dw 3 ;flags - system and keep
db 'MPMSTAT ' ;name
dw rsp_uda/10h ;uda paragraph
db 0,0 ;disk,user
db 0,0 ;ldisk,luser
dw 0 ;puremem - not re-entrant
;rest of pd
org rsp_uda ;start of uda
uda dw 0
dw offset dma
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
dw offset stk_top
org rsp_bottom
dma db 0
buff equ dma
org offset $ + 128
stk dw 0CCCCH,0CCCCH,0CCCCH,0CCCCH, 0CCCCH,0CCCCH,0CCCCH,0CCCCH
dw 0CCCCH,0CCCCH,0CCCCH,0CCCCH, 0CCCCH,0CCCCH,0CCCCH,0CCCCH
dw 0CCCCH,0CCCCH,0CCCCH,0CCCCH, 0CCCCH,0CCCCH,0CCCCH,0CCCCH
dw 0CCCCH,0CCCCH,0CCCCH,0CCCCH, 0CCCCH,0CCCCH,0CCCCH,0CCCCH
dw 0CCCCH,0CCCCH,0CCCCH,0CCCCH, 0CCCCH,0CCCCH,0CCCCH,0CCCCH
dw 0CCCCH,0CCCCH,0CCCCH,0CCCCH, 0CCCCH,0CCCCH,0CCCCH,0CCCCH
dw 0CCCCH,0CCCCH,0CCCCH,0CCCCH, 0CCCCH,0CCCCH,0CCCCH,0CCCCH
dw 0CCCCH,0CCCCH,0CCCCH,0CCCCH, 0CCCCH,0CCCCH,0CCCCH,0CCCCH
stk_top dw plmstart
dw 0,0 ;segment and flags - unknown
fcb dw 0,0,0,0, 0,0,0,0
fcb16 dw 0,0,0,0, 0,0,0,0
cr db 0
rr dw 0
rovfl db 0
datsend equ offset $
dats ends
code segment public 'CODE'
org datsend
db 'COPYRIGHT (C) 1981,'
db ' DIGITAL RESEARCH '
db '654321'
db ' MP/M-86 2.0 10/5/81'
xdos proc
push bp
mov bp,sp
mov dx,[bp+4]
mov cx,[bp+6]
int 224
pop bp
ret 4
xdos endp
mon1 equ xdos
mon2 equ xdos
mon3 equ xdos
mon4 equ xdos
code ends
end


23
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SCAN.LIT Normal file
View File

@@ -0,0 +1,23 @@
declare
pcb$structure literally 'structure (
state address,
scan$adr address,
token$adr address,
tok$typ byte,
token$len byte,
p$level byte,
nxt$token byte)';
declare
t$null lit '0',
t$param lit '1',
t$op lit '2',
t$mod lit '4',
t$identifier lit '8',
t$string lit '16',
t$numeric lit '32',
t$filespec lit '64',
t$error lit '128';


732
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SCAN.PLM Normal file
View File

@@ -0,0 +1,732 @@
$title ('Utility Command Line Scanner')
scanner:
do;
$include(comlit.lit)
$include(mon.plm)
dcl debug boolean initial (false);
dcl eob lit '0'; /* end of buffer */
$include(fcb.lit)
/* -------- Some routines used for diagnostics if debug mode is on -------- */
printchar: procedure(char) external;
declare char byte;
end printchar;
printb: procedure external;
end printb;
crlf: procedure external;
end crlf;
pdecimal: procedure(v,prec,zerosup) external;
/* print value v, field size = (log10 prec) + 1 */
/* with leading zero suppression if zerosup = true */
declare v address, /* value to print */
prec address, /* precision */
zerosup boolean, /* zero suppression flag */
d byte; /* current decimal digit */
end pdecimal;
/*
show$buf: procedure;
dcl i byte;
i = 1;
call crlf;
call mon1(9,.('buff = $'));
do while buff(i) <> 0;
i = i + 1;
end;
buff(i) = '$';
call mon1(9,.buff(1));
buff(i) = 0;
end show$buf; */
/* -------- -------- */
white$space: procedure (str$adr) byte;
dcl str$adr address,
str based str$adr (1) byte,
i byte;
i = 0;
do while (str(i) = ' ') or (str(i) = tab);
i = i + 1;
end;
return(i);
end white$space;
delimiter: procedure(char) boolean;
dcl char byte;
if char = '[' or char = ']' or char = '(' or char = ')' or
char = '=' or char = ',' or char = 0 then
return (true);
return(false);
end delimiter;
dcl string$marker lit '05ch';
deblank: procedure(buf$adr);
dcl (buf$adr,dest) address,
buf based buf$adr (128) byte,
(i,numspaces) byte,
string boolean;
string = false;
if (numspaces := white$space(.buf(1))) > 0 then
call move(buf(0) - numspaces + 1,.buf(numspaces+1),.buf(1));
i = 1;
do while buf(i) <> 0;
/* call show$buf;*/
do while ((numspaces := white$space(.buf(i))) = 0 and (buf(i) <> 0))
and not string;
/* call mon1(9,.(cr,lf,'2numspaces = $'));
call pdecimal(numspaces,100,false);*/
/* call show$buf;*/
if buf(i) = '"' then
do;
string = true;
buf(i) = string$marker;
end;
i = i + 1;
end;
do while string and buf(i) <> 0;
if buf(i) = '"' then
if buf(i+1) = '"' then
call move(buf(0) - i + 1,.buf(i+1), .buf(i));
else
do;
buf(i) = string$marker;
string = false;
end;
i = i + 1;
end;
if (numspaces := white$space(.buf(i))) > 0 then
do;
/* call mon1(9,.(cr,lf,'1numspaces = $'));
call pdecimal(numspaces,100,false);*/
buf(i) = ' ';
dest = .buf(i+1); /* save space for ',' */
if i > 1 then
if delimiter(buf(i-1)) or delimiter(buf(i+numspaces)) then
/* write over ' ' with */
dest = dest - 1; /* a = [ ] ( ) */
call move(((buf(0)+1)-(i+numspaces-1)),
.buf(i+numspaces),dest);
if buf(i) = '"' then
string = true;
i = i + 1;
end;
end;
if buf(i - 1) = ' ' then /* no trailing blanks */
buf(i - 1) = 0;
/* if debug then
call show$buf; */
end deblank;
upper$case: procedure (buf$adr);
dcl buf$adr address,
buf based buf$adr (1) byte,
i byte;
i = 0;
do while buf(i) <> eob;
if buf(i) >= 'a' and buf(i) <= 'z' then
buf(i) = buf(i) - ('a' - 'A');
i = i + 1;
end;
end upper$case;
dcl option$max lit '11';
dcl done$scan lit '0ffffh';
dcl ident$max lit '11';
dcl token$max lit '11';
dcl t$null lit '0',
t$param lit '1',
t$option lit '2',
t$modifier lit '4',
t$identifier lit '8',
t$string lit '16',
t$numeric lit '32',
t$filespec lit '64',
t$error lit '128';
dcl pcb$base address;
dcl pcb based pcb$base structure (
state address,
scan$adr address,
token$adr address,
token$type byte,
token$len byte,
p$level byte,
nxt$token byte);
dcl scan$adr address,
inbuf based scan$adr (1) byte,
in$ptr byte,
token$adr address,
token based token$adr (1) byte,
t$ptr byte,
(char, nxtchar, tcount) byte;
digit: procedure (char) boolean;
dcl char byte;
return (char >= '0' and char <= '9');
end digit;
letter: procedure (char) boolean;
dcl char byte;
return (char >= 'A' and char <= 'Z');
end letter;
eat$char: procedure;
char = inbuf(in$ptr := inptr + 1);
nxtchar = inbuf(in$ptr + 1);
end eat$char;
put$char: procedure(charx);
dcl charx byte;
if pcb.token$adr <> 0ffffh then
token(t$ptr := t$ptr + 1) = charx;
end put$char;
get$identifier: procedure (max) byte;
dcl max byte;
tcount = 0;
/* call mon1(9,.(cr,lf,'getindentifier$'));*/
if not letter(char) and char <> '$' then
return(tcount);
do while (letter(char) or digit(char) or char = '_' or
char = '$' ) and tcount <= max;
call put$char(char);
call eat$char;
tcount = tcount + 1;
end;
do while letter(char) or digit(char) or char = '_'
or char = '$' ;
call eat$char;
tcount = tcount + 1;
end;
pcb.token$type = t$identifier;
/* call mon1(9,.(cr,lf,'end of getident$')); */
pcb.token$len = tcount;
return(tcount);
end get$identifier;
file$char: procedure (x) boolean;
dcl x byte;
return(letter(x) or digit(x) or x = '*' or x = '?'
or x = '_' or x = '$');
end file$char;
expand$wild$cards: procedure(field$size) boolean;
dcl (i,leftover,field$size) byte,
save$inptr address;
field$size = field$size + t$ptr;
do while filechar(char) and t$ptr < field$size;
if char = '*' then
do; leftover = t$ptr;
save$inptr = inptr;
call eatchar;
do while filechar(char);
leftover = leftover + 1;
call eatchar;
end;
if leftover >= field$size then /* too many chars */
do; inptr = save$inptr;
return(false);
end;
do i = 1 to field$size - leftover;
call putchar('?');
end;
inptr = save$inptr;
end;
else
call putchar(char);
call eatchar;
end;
return(true);
end expand$wild$cards;
get$file$spec: procedure boolean;
dcl i byte;
do i = 1 to f$name$len + f$type$len;
token(i) = ' ';
end;
if nxtchar = ':' then
if char >= 'A' and char <= 'P' then
do;
call putchar(char - 'A' + 1);
call eat$char; /* skip ':' */
call eat$char; /* 1st char of file name */
end;
else
return(false);
else
call putchar(0); /* use default drive */
if not (letter(char) or digit(char) or char = '$' or char = '_'
or char = '*' or char = '?' ) then
if token(0) = 0 then
return(false);
if not expand$wild$cards(f$namelen) then
return(false); /* blank name is illegal */
if char = '.' then
do; call eat$char;
if filechar(char) then
do; t$ptr = f$namelen;
if not expand$wild$cards(f$typelen) then
return(false);
end;
end;
pcb.token$len = f$name$len + f$type$len + 1;
pcb.token$type = t$file$spec;
return(true);
end get$file$spec;
get$numeric: procedure(max) boolean;
dcl max byte;
if not digit(char) then
return(false);
do while digit(char) and pcb.token$len <= max and
char <> eob;
call putchar(char);
call eat$char;
pcb.token$len = pcb.token$len + 1;
end;
if char = 'H' or char = 'D' or char = 'B' then
if pcb.token$len < max then
do;
call putchar(char);
call eat$char;
pcb.token$len = pcb.token$len + 1;
end;
else
return(false);
pcb.token$type = t$numeric;
return(true);
end get$numeric;
get$string: procedure(max) boolean;
dcl max byte;
if char <> string$marker then
return(false);
call eatchar;
do while char <> string$marker and char <> eob
and pcb.token$len < token$max;
call putchar(char);
call eatchar;
pcb.token$len = pcb.token$len + 1;
end;
do while char <> string$marker and char <> eob;
call eat$char;
end;
if char <> string$marker then
return(false);
pcb.token$type = t$string;
call eat$char;
return(true);
end get$string;
get$token$all: procedure boolean;
dcl save$inptr byte;
/* call mon1(9,.(cr,lf,'gettokenall$'));*/
save$inptr = in$ptr;
if get$file$spec then
return(true);
/* call mon1(9,.(cr,lf,'gettokenall - no file$')); */
in$ptr = save$inptr - 1; /* need to re-scan, reset buffer pointers */
call eat$char;
t$ptr = 255;
call putchar(0); /* zero drive byte */
if get$identifier(token$max) = 0 then
if not get$string(token$max) then
if not get$numeric(token$max) then
return(false);
/* call mon1(9,.(cr,lf,'end gettokenall$'));*/
return(true);
end get$token$all;
get$modifier: procedure boolean;
if char = ',' or char = ')' or char = 0 then
do;
pcb.token$type = t$modifier or t$null;
return(true);
end;
if get$token$all then
do;
pcb.token$type = pcb.token$type or t$modifier;
return(true);
end;
return(false);
end get$modifier;
get$option: procedure boolean;
call putchar(0);
if get$identifier(token$max) > 0 then
do;
pcb.token$type = pcb.token$type or t$option;
if pcb.token$len > token$max then
pcb.token$len = token$max;
return(true);
end;
return(false);
end get$option;
get$param: procedure boolean;
if char = ',' or char = ')' or char = 0 then
do;
pcb.token$type = t$param or t$null;
return(true);
end;
if get$token$all then
do;
pcb.token$type = pcb.token$type or t$param;
return(true);
end;
return(false);
end get$param;
dcl gotatoken boolean;
dcl parens byte initial (0);
end$state: procedure boolean;
if gotatoken then
do;
pcb.state = .end$state;
return(true);
end;
pcb.token$type = t$null;
pcb.scan$adr = 0ffffh;
return(true);
end end$state;
state8: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state8, char = $'));
call printchar(char); end;
if char = 0 then
return(end$state);
if char = ']' then
do;
call eatchar;
if char = ',' or nxtchar = '(' or nxtchar = ')' then
return(state2);
else if char = 0 then
return(end$state);
else
return(state1);
end;
else if char = ' ' or char = ',' then
do;
call eatchar;
return(state3);
end;
return(state3);
end state8;
state7:procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state7, char = $'));
call printchar(char); end;
if char = 0 then
return(end$state);
if char = ' ' or char = ',' then
do;
call eat$char;
return(state6);
end;
else
if char = ')' then
do;
call eat$char;
return(state8);
end;
return(false);
end state7;
state6: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state6, char = $'));
call printchar(char); end;
if gotatoken then
do;
pcb.state = .state6;
pcb.nxt$token = t$modifier;
return(true);
end;
if (gotatoken := get$modifier) then
return(state7);
return(false);
end state6;
state5:procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state5, nxtchar = $'));
call printchar(nxtchar); end;
if char = '(' then
do;
call eat$char;
return(state6);
end;
if gotatoken then
do;
pcb.state = .state5;
pcb.nxt$token = t$modifier;
return(true);
end;
if (gotatoken := get$modifier) then
return(state8);
return(false);
end state5;
state4: procedure boolean reentrant;
dcl temp byte;
if debug then do;
call mon1(9,.(cr,lf,'state4, char = $'));
call printchar(char); end;
if char = 0 then
return(end$state);
temp = char;
call eatchar;
if temp = ',' or temp = ' ' then
return(state3);
if temp = ']' then
if char = '(' or char = ',' or char = ')' then
return(state2);
else if char = 0 then
return(end$state);
else
return(state1);
if temp = '=' then
return(state5);
return(false);
end state4;
state3: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state3, char = $'));
call printchar(char); end;
if gotatoken then
do;
pcb.state = .state3;
pcb.nxt$token = t$option;
return(true);
end;
if (pcb.plevel := parens ) > 128 then
return(false);
if (gotatoken := get$option) then
return(state4);
return(false);
end state3;
state2: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state2, char = $'));
call printchar(char); end;
do while char = ')' or char = 0;
if char = 0 then
return(end$state);
call eat$char;
parens = parens - 1;
end;
if char = '[' then
do;
call eat$char;
return(state3);
end;
if char = ' ' or char = ',' or char = '(' then
do;
if char = '(' then
parens = parens + 1;
call eat$char;
return(state1);
end;
return(state1);
end state$2;
state1: procedure boolean reentrant;
if debug then do;
call mon1(9,.(cr,lf,'state1, char = $'));
call printchar(char); end;
if gotatoken then
do;
pcb.nxt$token = t$param;
pcb.state = .state1;
return(true);
end;
do while char = '(' ;
parens = parens + 1;
call eat$char;
end;
if (pcb.plevel := parens) > 128 then
return(false);
if (gotatoken := get$param) then
return(state2);
return(false);
end state1;
start$state: procedure boolean;
if char = '@' then do;
debug = true;
call eat$char;
call mon1(9,.(cr,lf,'startstate, char = $'));
call printchar(char); end;
if char = 0 then
return(end$state);
if char = ')' then
return(false);
if char = '(' then
do;
parens = parens + 1;
call eat$char;
return(state1);
end;
if char = '[' then
do;
call eat$char;
return(state3);
end;
if (gotatoken := get$param) then
return(state2);
return(false);
end start$state;
/* display$all: procedure; /* called if debug set */
/* call mon1(9,.(cr,lf,'scanadr=$'));
call pdecimal(pcb.scanadr,10000,false);
call mon1(9,.(', tadr=$'));
call pdecimal(pcb.token$adr,10000, false);
call mon1(9,.(', tlen=$'));
call pdecimal(double(pcb.token$len),100, false);
call mon1(9,.(', ttype=$'));
call pdecimal(double(pcb.token$type),100,false);
call mon1(9,.(', plevel=$'));
call pdecimal(double(pcb.plevel),100,false);
call mon1(9,.(', ntok=$'));
call pdecimal(double(pcb.nxt$token),100,false);
if (pcb.token$type and t$option) <> 0 then
call mon1(9,.(cr,lf,'option =$'));
if (pcb.token$type and t$param) <> 0 then
call mon1(9,.(cr,lf,'parm =$'));
if (pcb.token$type and t$modifier) <> 0 then
call mon1(9,.(cr,lf,'modifier=$'));
if (pcb.token$type and t$filespec) <> 0 then
do;
if fcb(0) = 0 then
call print$char('0');
else call print$char(fcb(0) + 'A' - 1);
call print$char(':');
fcb(12) = '$';
call mon1(9,.fcb(1));
call mon1(9,.(' (filespec)$'));
end;
if ((pcb.token$type and t$string) or (pcb.token$type and
t$identifier) or (pcb.token$type and t$numeric)) <> 0 then
do;
fcb(pcb.token$len + 1) = '$';
call mon1(9,.fcb(1));
end;
if pcb.token$type = t$error then
do;
call mon1(9,.(cr,lf,'scanner error$'));
return;
end;
if (pcb.token$type and t$identifier) <> 0 then
call mon1(9,.(' (identifier)$'));
if (pcb.token$type and t$string) <> 0 then
call mon1(9,.(' (string)$'));
if (pcb.token$type and t$numeric) <> 0 then
call mon1(9,.(' (numeric)$'));
if (pcb.nxt$token and t$option) <> 0 then
call mon1(9,.(cr,lf,'nxt tok = option $'));
if (pcb.nxt$token and t$param) <> 0 then
call mon1(9,.(cr,lf,'nxt tok = parm $'));
if (pcb.nxt$token and t$modifier) <> 0 then
call mon1(9,.(cr,lf,'nxt tok = modifier$'));
call crlf;
end display$all; */
scan: procedure (pcb$adr) public;
dcl status boolean,
pcb$adr address;
pcb$base = pcb$adr;
scan$adr = pcb.scan$adr;
token$adr = pcb.token$adr;
in$ptr, t$ptr = 255;
call eatchar;
gotatoken = false;
pcb.nxt$token = t$null;
pcb.token$len = 0;
if pcb.token$type = t$error then /* after one error, return */
return; /* on any following calls */
else if pcb.state = .start$state then
status = start$state;
else if pcb.state = .state$1 then
status = state$1;
else if pcb.state = .state$3 then
status = state$3;
else if pcb.state = .state$5 then
status = state$5;
else if pcb.state = .state$6 then
status = state$6;
else if pcb.state = .end$state then /* repeated calls go here */
status = end$state; /* after first end$state */
else
status = false;
if not status then
pcb.token$type = t$error;
if pcb.scan$adr <> 0ffffh then
pcb.scan$adr = pcb.scan$adr + inptr;
/* if debug then
call display$all; */
end scan;
scan$init: procedure(pcb$adr) public;
dcl pcb$adr address;
pcb$base = pcb$adr;
call deblank(pcb.scan$adr);
call upper$case(pcb.scan$adr := pcb.scan$adr + 1);
pcb.state = .start$state;
end scan$init;
end scanner;


82
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SCD.A86 Normal file
View File

@@ -0,0 +1,82 @@
;
; MP/M-86 2.0 with BDOS version 3.0
; Interface for PLM-86 with separate code and data
; Code org'd at 0
; October 5, 1981
dgroup group dats,stack
cgroup group code
assume cs:cgroup, ds:dgroup, ss:dgroup
stack segment word stack 'STACK'
stack_base label byte
stack ends
dats segment para public 'DATA' ;CP/M page 0 - LOC86'd at 0H
org 4
bdisk db ?
org 6
maxb dw ?
org 50h
cmdrv db ?
pass0 dw ?
len0 db ?
pass1 dw ?
len1 db ?
org 5ch
fcb db 16 dup (?)
fcb16 db 16 dup (?)
cr db ?
rr dw ?
ro db ?
buff db 128 dup (?)
tbuff equ buff
buffa equ buff
fcba equ fcb
public bdisk,maxb,cmdrv,pass0,len0
public pass1,len1,fcb,fcb16,cr,rr
public ro,buff,tbuff,buffa,fcba
dats ends
code segment public 'CODE'
public xdos,mon1,mon2,mon3,mon4
extrn plmstart:near
org 0h ; for separate code and data
jmp pastserial
db 'COPYRIGHT (C) 1981, DIGITAL RESEARCH '
db '654321'
db ' MP/M-86 2.0, 10/5/81 '
pastserial:
pushf
pop ax
cli
mov cx,ds
mov ss,cx
lea sp,stack_base
push ax
popf
jmp plmstart
xdos proc
push bp
mov bp,sp
mov dx,[bp+4]
mov cx,[bp+6]
int 224
pop bp
ret 4
xdos endp
mon1 equ xdos ; no returned value
mon2 equ xdos ; returns byte in AL
mon3 equ xdos ; returns address or word BX
mon4 equ xdos ; returns pointer in BX and ES
code ends
end


53
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SD.LIT Normal file
View File

@@ -0,0 +1,53 @@
/* System Data Page */
dcl sysdat$pointer pointer;
dcl sysdat$ptr structure(
offset word,
segment word) at (@sysdat$pointer);
declare sd based sysdat$pointer structure (
supmod (4) word,
/* rtmmod (4) word,
memmod (4) word,
ciomod (4) word,
bdosmod (4) word,
xiosmod (4) word,
netmod (4) word,
reservd (4) word */
space(28) word,
mpmseg word,
rspseg word,
endseg word,
module$map byte,
ncns byte,
nlst byte,
nccb byte,
nflags byte,
srchdisk byte,
mmp word,
nslaves byte,
rsrvd(3) byte,
lul word,
ccb word,
flags word,
mdul word,
mfl word,
pul word,
qul word,
qmau (4) word,
rlr word,
dlr word,
drl word,
plr word,
slr word,
thrdrt word,
qlr word,
mal word,
version word);
declare sd$byte based sysdat$pointer (1) byte;
dcl ncondev lit '83h',
nlstdev lit '84h',
nciodev lit '85h';


3
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SD.PLM Normal file
View File

@@ -0,0 +1,3 @@
%TYPE-W, error opening _DRB0:[FRANK.MPM86.SDIR]SD.PLM; as input
-RMS-E, file not found


16
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SDIRALL.CPM Normal file
View File

@@ -0,0 +1,16 @@
set verify
set def [frank.mpm86.sdir]
$ asm86 scd.a86
$ plm86 main86.plm debug object(main86) optimize(3) 'p1' 'p2' 'p3'
$ plm86 scan.plm debug object(scan) optimize(3) 'p1' 'p2' 'p3'
$ plm86 search.plm debug object(search) optimize(3) 'p1' 'p2' 'p3'
$ plm86 sort.plm debug object(sort) optimize(3) 'p1' 'p2' 'p3'
$ plm86 disp.plm debug object(disp) optimize(3) 'p1' 'p2' 'p3'
$ plm86 dpb86.plm debug object(dpb86) optimize(3) 'p1' 'p2' 'p3'
$ plm86 util.plm debug object(util) optimize(3) 'p1' 'p2' 'p3'
$ plm86 timest.plm debug object(timest) optimize(3) 'p1' 'p2' 'p3'
$ link86 scd.obj,main86,scan,search,sort,disp,util,dpb86,timest to sdir86.lnk
$ loc86 sdir86.lnk od(sm(code,dats,data,const,stack)) -
ad(sm(code(0))) ss(stack(+32))
$ h86 sdir86


23
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SEARCH.LIT Normal file
View File

@@ -0,0 +1,23 @@
declare /* what kind of file user wants to find */
find$structure lit 'structure (
dir byte,
sys byte,
ro byte,
rw byte,
pass byte,
xfcb byte,
nonxfcb byte,
exclude byte)';
declare
max$search$files literally '10';
declare
search$structure lit 'structure(
drv byte,
name(8) byte,
type(3) byte,
anyfile boolean)'; /* match on any drive if true */


391
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SEARCH.PLM Normal file
View File

@@ -0,0 +1,391 @@
$title ('SDIR - Search For Files')
search:
do;
/* search module for extended dir */
$include (comlit.lit)
$include (mon.plm)
dcl debug boolean external;
dcl first$pass boolean external;
dcl get$all$dir$entries boolean external;
dcl usr$vector address external;
dcl active$usr$vector address external;
dcl used$de address public; /* used directory entries */
dcl filesfound address public; /* num files collected in memory */
$include(fcb.lit)
$include(xfcb.lit)
declare
deleted$type lit '0E5H';
$include (search.lit)
dcl find find$structure external; /* what kind of files to look for */
dcl num$search$files byte external;
dcl search (max$search$files) search$structure external;
/* file specs to match on */
/* other globals */
dcl cur$usr byte external,
cur$drv byte external, /* current drive " " */
dir$label byte public; /* directory label for BDOS 3.0 */
/* -------- BDOS calls -------- */
read$char: procedure byte;
return mon2 (1,0);
end read$char;
/* -------- in sort.plm -------- */
mult23: procedure(f$info$index) address external;
dcl f$info$index word;
end mult23;
/* -------- in util.plm -------- */
print: procedure(string$adr) external;
dcl string$adr address;
end print;
print$char: procedure(char) external;
dcl char byte;
end print$char;
pdecimal:procedure(val,prec,zsup) external;
dcl (val, prec) address;
dcl zsup boolean;
end pdecimal;
printfn: procedure(fnameadr) external;
dcl fnameadr address;
end printfn;
crlf: procedure external; /* print carriage return, linefeed */
end crlf;
add3byte: procedure(byte3adr,num) external;
dcl (byte3adr,num) address;
end add3byte;
/* add three byte number to 3 byte accumulater */
add3byte3: procedure(totalb,numb) external;
dcl (totalb,numb) address;
end add3byte3;
/* divide 3 byte value by 8 */
shr3byte: procedure(byte3adr) external;
dcl byte3adr address;
end shr3byte;
/* -------- In dpb86.plm -------- */
$include(dpb.lit)
dcl k$per$block byte external; /* set in dpb module */
base$dpb: procedure external;
end base$dpb;
dpb$byte: procedure(param) byte external;
dcl param byte;
end dpb$byte;
dpb$word: procedure(param) address external;
dcl param byte;
end dpb$word;
/* -------- Some Utility Routines -------- */
check$console$status: procedure byte;
return mon2 (11,0);
end check$console$status;
search$first: procedure (fcb$address) byte public;
declare fcb$address address; /* shared with disp.plm */
return mon2 (17,fcb$address); /* for short display */
end search$first;
search$next: procedure byte public; /* shared with disp.plm */
return mon2 (18,0);
end search$next;
terminate: procedure external; /* in main.plm */
end terminate;
set$vec: procedure(vector,value) external; /* in main.plm */
dcl vector address,
value byte;
end set$vec;
break: procedure public; /* shared with disp.plm */
dcl x byte;
if check$console$status then
do;
x = read$char;
call terminate;
end;
end break;
/* -------- file information record declaration -------- */
$include(finfo.lit)
declare
buf$fcb$adr address public, /* index into directory buffer */
buf$fcb based buf$fcb$adr (32) byte,
/* fcb template for dir */
(first$f$i$adr, f$i$adr, last$f$i$adr) address public,
/* indices into file$info array */
file$info based f$i$adr f$info$structure,
x$i$adr address public,
xfcb$info based x$i$adr x$info$structure;
compare: procedure(length, str1$adr, str2$adr) boolean;
dcl (length,i) byte,
(str1$adr, str2$adr) address,
str1 based str1$adr (1) byte,
str2 based str2$adr (1) byte;
/* str2 is the possibly wildcarded filename we are looking for */
do i = 0 to length - 1;
if ((str1(i) and 7fh) <> (str2(i) and 7fh)) and str2(i) <> '?' then
return(false);
end;
return(true);
end compare;
match: procedure boolean public;
dcl i byte,
temp address;
if (i := (buf$fcb(f$drvusr) and 0fh)) <> cur$usr then
if not get$all$dir$entries then /* Not looking for this user */
return(false); /* and not buffering all other*/
else /* specified user files on */
do; temp = 0; /* this drive. */
call set$vec(.temp,i);
if (temp and usr$vector) = 0 then /* Getting all dir entries, */
return(false); /* with user number corresp'g */
end; /* to a bit on in usr$vector */
if usr$vector <> 0 and i <> 0 and first$pass <> 0 then
call set$vec(.active$usr$vector,i); /* skip cur$usr files */
/* build active usr vector for this drive */
do i = 0 to num$search$files - 1;
if search(i).drv = 0ffh or search(i).drv = cur$drv then
/* match on any drive if 0ffh */
if search(i).anyfile = true then
return(not find.exclude); /* file found */
else if compare(11,.buf$fcb(f$name),.search(i).name(0)) then
return(not find.exclude); /* file found */
end;
return(find.exclude); /* file not found */
end match; /* find.exclude = the exclude option value */
dcl hash$table$size lit '128', /* must be power of 2 */
hash$table (hash$table$size) address at (.memory),
/* must be initialized on each*/
hash$entry$adr address, /* disk scan */
hash$entry based hash$entry$adr address; /* where to put a new entry's */
/* address */
hash$look$up: procedure boolean;
dcl (i,found,hash$index) byte;
hash$index = 0;
do i = f$name to f$namelen + f$typelen;
hash$index = hash$index + (buf$fcb(i) and 7fh); /* attributes may */
end; /* only be set w/ 1st extent */
hash$index = hash$index + cur$usr;
hash$index = hash$index and (hash$table$size - 1);
hash$entry$adr = .hash$table(hash$index); /* put new entry in table if */
f$i$adr = hash$table(hash$index); /* unused ( = 0) */
found = false;
do while f$i$adr <> 0 and not found;
if file$info.usr = (buf$fcb(f$drvusr) and 0fh) and
compare(f$namelen + f$typelen,.file$info.name(0),.buf$fcb(f$name))
then
found = true;
else /* table entry used - collison */
do; hash$entry$adr = .file$info.hash$link; /* resolve by linked */
f$i$adr = file$info.hash$link; /* list */
end;
end;
if f$i$adr = 0 then
return(false); /* didn't find it, used hash$entry to keep new info */
else return(true); /* found it, file$info at matched entry */
end hash$look$up;
$eject
store$file$info: procedure boolean;
/* Look for file name of last found fcb or xfcb in fileinfo */
/* array, if not found put name in fileinfo array. Copy other */
/* info to fileinfo or xfcbinfo. The lookup is hash coded with */
/* collisions handled by linking up file$info records through */
/* the hash$link field of the previous file$info record. */
/* The file$info array grows upward in memory and the xfcbinfo */
/* grows downward. */
/*
-------------------------<---.memory
__ | HASH TABLE |
hash = \ of filename -->| root of file$info list|------------>-----------|
func /__ letters | . | |
| . | |
lower memory ------------------------- <-- first$f$i$adr |
| file$info entry | |
(hash) -----<--| . | <----------------------|
(collision) | | . |
------->| . |
| . |-------------------->|
| last file$info entry | <- last$f$i$adr |
|-----------------------| |
| | |
| | |
| unused by dsearch, | |
| used by dsort | |
| for indices | |
| | |
| | |
|-----------------------| |
| last$xfcb entry | <- x$i$adr |
| . | |
| . | |
| . | <-------------------|
| first xfcb entry |
|-----------------------|
| un-usuable memory | <- maxb
higher memory ------------------------- */
dcl (i, j, d$map$cnt) byte,
temp address;
if not hash$look$up then /* not in table already */
/* hash$entry is where to put adr of new entry */
do; /* copy to new position in file info array */
if (temp := mult23(files$found + 1)) > x$i$adr then
return(false); /* out of memory */
if (temp < first$f$i$adr) then
return(false); /* wrap around - out of memory */
f$i$adr = (last$f$i$adr := last$f$i$adr + size(file$info));
filesfound = filesfound + 1;
call move(f$namelen + f$typelen, .buf$fcb(f$name),.file$info.name);
file$info.usr = buf$fcb(f$drvusr) and 0fh;
file$info.onekblocks,file$info.kbytes,file$info.recs$lword,
file$info.recs$hbyte, file$info.x$i$adr,file$info.hash$link = 0;
hash$entry = f$i$adr; /* save the address of file$info */
end; /* zero totals for the new file */
/* else hash$lookup has set f$i$adr to the file entry already in the */
/* hash table */
/* save xfcb or fcb type info */
if (buf$fcb(f$drvusr) and xfcb$type) <> 0 then
do; /* XFCB */
if last$f$i$adr + size(file$info) > x$i$adr - size(xfcb$info) then
return(false); /* out of memory */
x$i$adr = x$i$adr - size(xfcb$info);
call move(8,.buf$fcb(xf$create),.xfcb$info.create);
xfcb$info.passmode = buf$fcb(xf$passmode);
file$info.x$i$adr = x$i$adr;
end;
else /* regular fcb, file$info is already positioned */
do; /* add to number of records */
call move(f$namelen + f$typelen, .buf$fcb(f$name),.file$info.name);
/* attributes are not in XFCBs to copy again in case */
/* XFCB came first in directory */
file$info.name(f$arc-1) = file$info.name(f$arc-1) and buf$fcb(f$arc);
/* 0 archive bit if it is 0 in any dir entry */
d$map$cnt = 0; /* count kilobytes for current dir entry */
i = 1; /* 1 or 2 byte block numbers ? */
if dpb$word(blk$max$w) > 255 then
i = 2;
do j = f$diskmap to f$diskmap + diskmaplen - 1 by i;
temp = buf$fcb(j);
if i = 2 then /* word block numbers */
temp = temp or buf$fcb(j+1);
if temp <> 0 then /* allocated */
d$map$cnt = d$map$cnt + 1;
end;
if d$map$cnt > 0 then
do;
call add3byte
(.file$info.recs$lword,
d$map$cnt * (dpb$byte(blkmsk$b) + 1) -
( (128 - buf$fcb(f$rc)) and dpb$byte(blkmsk$b) )
);
file$info.onekblocks = file$info.onekblocks +
d$map$cnt * k$per$block -
shr( (128 - buf$fcb(f$rc)) and dpb$byte(blkmsk$b), 3 );
/* treat each directory entry separately for sparse files */
/* if copied to single density diskette, the number of 1kblocks */
file$info.kbytes = file$info.kbytes + d$map$cnt * k$per$block;
end;
end;
return(true); /* success */
end store$file$info;
/* Module Entry Point */
get$files: procedure public; /* with one scan through directory get */
dcl dcnt byte; /* files from currently selected drive */
last$f$i$adr = first$f$i$adr - size(file$info);
/* after hash table */
/* last$f$i$adr is the address of the highest file info record */
/* in memory */
do dcnt = 0 to hash$table$size - 1; /* init hash table */
hash$table(dcnt) = 0;
end;
x$i$adr = maxb; /* top of mem, put xfcb info here */
call base$dpb;
dir$label,filesfound, used$de = 0;
fcb(f$drvusr) = '?'; /* match all dir entries */
dcnt = search$first(.fcb);
do while dcnt <> 255;
buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
if buf$fcb(f$drvusr) <> deleted$type then
do;
used$de = used$de + 1;
if buf$fcb(f$drvusr) = dirlabel$type then /* dir label ? */
dir$label = buf$fcb(f$ex); /* save label info */
else if match then
do;
if not store$file$info then /* store fcb or xfcb info */
do; /* out of space */
call print (.('Out of Memory',cr,lf,'$'));
return;
end;
end;
end;
call break;
dcnt = search$next; /* to next entry in directory */
end; /* of do while dcnt <> 255 */
end get$files;
search$init: procedure public; /* called once from main.plm */
if (first$f$i$adr := (.hash$table + size(hash$table))) + size(file$info)
> maxb then
do;
call print(.('Not Enough Memory',cr,lf,'$'));
call terminate;
end;
end search$init;
end search;


119
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SORT.PLM Normal file
View File

@@ -0,0 +1,119 @@
$title ('SDIR - Sort Module')
sort:
do;
/* sort module for extended dir */
$include(comlit.lit)
print: procedure(str$adr) external; /* in util.plm */
dcl str$adr address;
end print;
dcl sorted boolean public; /* set by this module if successful sort */
$include(finfo.lit)
declare
buf$fcb$adr address external, /* index into directory buffer */
buf$fcb based buf$fcb$adr (32) byte,
/* fcb template for dir */
(f$i$adr, first$f$i$adr, last$f$i$adr, x$i$adr, filesfound)
address external,
/* indices into file$info array */
file$info based f$i$adr f$info$structure,
mid$adr address,
mid$file$info based mid$adr f$info$structure;
mult23: procedure(index) address public;
dcl index address; /* return address of file$info numbered by index */
return shl(index, 4) + shl(index,2) + shl(index,1) + index + first$f$i$adr;
/* index * size(file$info) + base of file$info array */
end mult23;
lessthan: procedure( str1$adr, str2$adr) boolean;
dcl (i,c1,c2) byte, /* true if str1 < str2 */
(str1$adr, str2$adr) address, /* sorting on name and type field */
str1 based str1$adr (1) byte, /* only, assumed to be first in */
str2 based str2$adr (1) byte; /* file$info record */
do i = 1 to 11;
if (c1:=(str1(i) and 7fh)) <> (c2:=(str2(i) and 7fh)) then
return(c1 < c2);
end;
return(false);
end lessthan;
dcl f$i$indices$base address public,
f$i$indices based f$i$indices$base (1) address;
qsort: procedure(l,r); /* no recursive quick sort, sorting largest */
dcl (l,r,i,j,temp) address,/* partition first */
stacksiz lit '14', /* should always be able to sort 2 ** stacksiz */
stack (stack$siz) structure (l address, r address),
sp byte;
sp = 0; stack(0).l = l; stack(0).r = r;
do while sp < stack$siz - 1;
l = stack(sp).l; r = stack(sp).r; sp = sp - 1;
do while l < r;
i = l; j = r;
mid$adr = mult23(f$i$indices(shr(l+r,1)));
do while i <= j;
f$i$adr = mult23(f$i$indices(i));
do while lessthan(f$i$adr,mid$adr);
i = i + 1;
f$i$adr = mult23(f$i$indices(i));
end;
f$i$adr = mult23(f$i$indices(j));
do while lessthan(mid$adr,f$i$adr);
j = j - 1;
f$i$adr = mult23(f$i$indices(j));
end;
if i <= j then
do; temp = f$i$indices(i); f$i$indices(i) = f$i$indices(j);
f$i$indices(j) = temp;
i = i + 1;
if j > 0 then j = j - 1;
end;
end; /* while i <= j */
if j - l < r - i then /* which partition is larger */
do; if i < r then
do; sp = sp + 1; stack(sp).l = i; stack(sp).r = r;
end;
r = j; /* continue sorting left partition */
end;
else
do; if l < j then
do; sp = sp + 1; stack(sp).l = l; stack(sp).r = j;
end;
l = i; /* continue sorting right partition */
end;
end; /* while l < r */
end; /* while sp < stack$siz - 1 */
if sp <> 255 then
call print(.(cr,lf,lf,'Sort Stack Overflow',cr,lf,'$'));
else sorted = true;
end qsort;
sort: procedure public;
dcl i address;
f$i$indices$base = last$f$i$adr + size(file$info);
if filesfound < 2 then
return;
if shr((x$i$adr - f$i$indices$base),1) < filesfound then
do;
call print(.('Not Enough Memory for Sort',cr,lf,'$'));
return;
end;
do i = 0 to filesfound - 1;
f$i$indices(i) = i; /* initialize f$i$indices */
end;
call qsort(0,filesfound - 1);
sorted = true;
end sort;
end sort;


102
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/STSCMD.PLM Normal file
View File

@@ -0,0 +1,102 @@
$title('MP/M-86 2.0 Status Process - Transient')
$compact
/* want 32 bit pointers */
status:
do;
$include (copyrt.lit)
/* VAX generation commands
asm86 mcd.a86
plm86 stscmd.plm 'p1' 'p2' 'p3' optimize(3) debug
link86 mcd.obj,stscmd.obj to stscmd.lnk
loc86 stscmd.lnk od(sm(dats,code,data,stack,const)) -
ad(sm(dats(0),code(0))) ss(stack(+32))
h86 stscmd
then on a micro
vax stscmd.h86
gencmd stscmd
ren mpmstat.cmd=stscmd.cmd
Notes:
Stack is expanded for interrupts. Const(ants) come
last to force hex generation
*/
$include (stscom.plm)
dcl cpmversion lit '30h'; /* BDOS 3.0 or later */
dcl mpmproduct lit '11h'; /* MP/M-86 */
plmstart: procedure public;
dcl (temp,repeat) boolean,
i byte,
ver address;
dcl vers$str$pointer pointer;
dcl vers$str$ptr structure (
offset word,
segment word) at (@vers$str$pointer);
ver = get$version;
if low(ver) <> cpmversion or high(ver) <> mpmproduct then
do;
call print$buffer (.('Requires MP/M-86 2.0','$'));
call reboot; /* use CP/M exit */
end;
else
do;
sysdat$pointer = get$sysdat;
ccb$ptr.segment,flag$ptr.segment,md$ptr.segment,ms$ptr.segment,
sat$ptr.segment,qd$ptr.segment,pd$ptr.segment, sysdat$ptr.segment
= sysdat$ptr.segment;
repeat = false;
do i = 1 to buff(0);
if buff(i) = 'p' or buff(i) = 'P' then
repeat = true;
end;
temp = true; /* show display at least once */
do while repeat or temp;
call crlf;
vers$str$ptr.offset = sd.version + 3; /* skip cr, lf's */
vers$str$ptr.segment = sd.supmod(1);
call display$text(0,vers$str$pointer);
call print$buffer (.(
'****** Status Display - Values Shown In Hexadecimal *****',
cr,lf,lf,'$'));
call display$config;
call display$ready;
call display$DQ;
call display$NQ;
call display$delay;
call display$poll;
call display$flag$wait;
call display$flag$set;
call display$queues;
call display$ccb(.('Consoles:$'),0,sd$byte(ncondev));
call display$ccb(.('Printers:$'),sd$byte(ncondev), sd$byte(nciodev));
call display$memory;
if repeat then
do;
call print$buffer(.(cr,lf,'Hit a Key to Continue,',
' Control C to Stop $'));
call crlf;
i = conin;
end;
temp = false;
end;
end;
call terminate;
end plmstart;
end status;


540
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/STSCOM.PLM Normal file
View File

@@ -0,0 +1,540 @@
/* Common Include Module for RSP and Transient MPMSTAT */
$include(comlit.lit)
dcl buff(128) byte external;
mon1:
procedure (func,info) external;
dcl func byte;
dcl info address;
end mon1;
mon2:
procedure (func,info) byte external;
dcl func byte;
dcl info address;
end mon2;
mon3:
procedure (func,info) address external;
dcl func byte;
dcl info address;
end mon3;
mon4:
procedure (func,info) pointer external;
dcl func byte;
dcl info address;
end mon4;
dcl screenwidth lit '80',
lparen byte data ('['),
rparen byte data (']'),
dummy lit '0';
$include(mdsat.lit)
$include(proces.lit)
$include(sd.lit)
$include(qd.lit)
$include(ccb.lit)
$include(flag.lit)
dcl pd$pointer pointer; /* double word bases for MP/M-86 data structures */
dcl pd$ptr structure(
offset word,
segment word) at (@pd$pointer);
dcl pd based pd$pointer pd$structure;
dcl qd$pointer pointer;
dcl qd$ptr structure(
offset word,
segment word) at (@qd$pointer);
dcl qd based qd$pointer qd$structure;
dcl md$pointer pointer;
dcl md$ptr structure(
offset word,
segment word) at (@md$pointer);
dcl md based md$pointer md$structure;
dcl ms$pointer pointer;
dcl ms$ptr structure(
offset word,
segment word) at (@ms$pointer);
dcl ms based ms$pointer ms$structure;
dcl sat$pointer pointer;
dcl sat$ptr structure(
offset word,
segment word) at (@sat$pointer);
dcl sat based sat$pointer sat$structure;
dcl flag$pointer pointer;
dcl flag$ptr structure(
offset word,
segment word) at (@flag$pointer);
dcl flag based flag$pointer flag$structure;
dcl ccb$pointer pointer;
dcl ccb$ptr structure (
offset word,
segment word) at (@ccb$pointer);
dcl ccb based ccb$pointer ccb$structure;
/*dcl lst$pointer pointer;
dcl lst$ptr structure (
offset word,
segment word) at (@lst$pointer);
dcl lst based lst$pointer lst$structure;*/
/* BDOS Calls */
reboot:
procedure;
call mon1(0,0);
end reboot;
conin:
procedure byte;
return(mon2(1,0));
end conin;
co:
procedure (char);
dcl char byte;
call mon1 (2,char);
end co;
print$buffer:
procedure (bufferadr);
dcl bufferadr address;
call mon1 (9,bufferadr);
end print$buffer;
read$buffer:
procedure (bufferadr);
dcl bufferadr address;
call mon1 (10,bufferadr);
end read$buffer;
get$version:
procedure word;
return mon3(12,0);
end get$version;
terminate:
procedure;
call mon1(143,0);
end terminate;
get$sysdat:
procedure pointer;
return mon4(154,0);
end get$sysdat;
/* XDOS Function Definitions */
dcl qmake lit '134';
dcl qopen lit '135';
dcl qread lit '137';
dcl dispatch lit '142';
dcl setprior lit '145';
dcl condetach lit '147';
dcl setdefcon lit '148';
/* utility functions */
crlf:
procedure;
call co (0DH);
call co (0AH);
end crlf;
dcl hex$digit (*) byte data ('0123456789ABCDEF');
display$hex$byte:
procedure (value);
dcl value byte;
call co (hex$digit(shr(value,4)));
call co (hex$digit(value mod 16));
end display$hex$byte;
display$hex$word:
procedure (value);
dcl value word;
call display$hex$byte (high(value));
call display$hex$byte (low (value));
end display$hex$word;
display$text: /* does byte at a time console write */
procedure (count,source); /* from possibly another segment */
dcl count byte;
dcl source pointer;
dcl char based source byte;
dcl src$ptr structure(
offset word,
segment word) at (@source);
dcl i byte;
if count = 0 then
do while char <> '$';
call co (char and 7fh);
src$ptr.offset = src$ptr.offset + 1;
end;
else
do i = 1 to count;
call co (char and 7fh);
src$ptr.offset = src$ptr.offset + 1;
end;
end display$text;
dcl link$list (64) word; /* used by display$links & display$memory */
display$links:
procedure (title$adr,root$offset,dis$con,init$col);
dcl dis$con boolean; /* Print linked list of PDs starting with */
dcl count byte; /* root$offset. Print title if not dummy */
dcl init$col byte; /* display console number if dis$con = true */
dcl title$adr address; /* First line starts on column init$col */
dcl root$offset address;
dcl char based title$adr byte;
dcl col byte; /* column number relative to 1 */
dcl (n,k) byte;
if title$adr <> dummy then
do;
call crlf;
call print$buffer (title$adr);
col = screenwidth + 1; /* start new line */
end;
else
col = init$col; /* initial column position from calling procedure */
n = -1;
disable; /* critical section required to obtain list */
pd$ptr.offset = root$offset;
do while (pd$ptr.offset <> 0) and (n <> 63);
link$list(n := n + 1) = pd$ptr.offset;
pd$ptr.offset = pd.link;
end;
call mon1 (dispatch,0); /* enable interrupts by dispatching */
if n = - 1 then return;
do k = 0 to n;
pd$ptr.offset = link$list(k);
if col > screenwidth - 13 then /* 13 chars could be used already */
do;
call crlf;
col = 1;
end;
call co (' '); /* 13 characters for pd */
call display$text (pnamsiz,@pd.name);
if pd.mem <> 0ffh and dis$con then /* display console number ? */
do;
call co (lparen);
call display$hex$byte(pd.cns); /* prints 2 chars */
call co (rparen);
end;
else
call print$buffer(.(' $')); /* not printing console # */
col = col + 13; /* but pad to make things */
end; /* line up */
enable;
end display$links;
display$config:
procedure;
dcl count byte, qsize word;
call print$buffer(.('Number of Physical Consoles = $'));
call display$hex$byte (sd.ncns);
call print$buffer(.(0dh,0ah,'Number of Virtual Consoles = $'));
call display$hex$byte (sd.nccb - (sd.nlst + sd.ncns));
call print$buffer (.(0dh,0ah,'Number of List Devices = $'));
call display$hex$byte (sd.nlst);
call print$buffer (.(0dh,0ah,'Number of Free Process Descriptors = $'));
pd$ptr.offset = sd.pul;
count = 0;
do while pd$ptr.offset <> 0;
count = count + 1;
pd$ptr.offset = pd.link;
end;
call display$hex$byte(count);
call print$buffer (.(0dh,0ah,'Number of Free Memory Descriptors = $'));
md$ptr.offset = sd.mdul;
count = 0;
do while md$ptr.offset <> 0;
count = count + 1;
md$ptr.offset = md.link;
end;
call display$hex$byte (count);
call print$buffer(.(0dh,0ah,'Number of Free Queue Control Blocks = $'));
qd$ptr.offset = sd.qul;
count = 0;
do while qd$ptr.offset <> 0;
count = count + 1;
qd$ptr.offset = qd.link;
end;
call display$hex$byte (count);
call print$buffer(.(0dh,0ah,'Free Queue Buffer Area = $'));
md$ptr.offset = .sd.qmau(0);
sat$ptr.segment = md.start;
sat$ptr.offset = size(sat);
qsize = 0;
do while sat.start <> 0; /* byte offset for q buffer area */
if sat.num$allocs = 0 then
qsize = qsize + sat.len;
sat$ptr.offset = size(sat) + sat$ptr.offset;
end;
call display$hex$word (qsize);
call print$buffer(.(0dh,0ah,'Number of Flags = $'));
call display$hex$byte (sd.nflags);
call print$buffer(.(0dh,0ah,'Maximum Paragraphs Per Process = $'));
call display$hex$word (sd.mmp);
call crlf;
end display$config;
display$ready:
procedure;
call display$links (.('Ready Process(es): $'),sd.rlr,true,1);
end display$ready;
display$DQ:
procedure;
call crlf;
call print$buffer (.('Process(es) DQing: $'));
qd$ptr.offset = sd.qlr;
do while qd$ptr.offset <> 0;
if qd.dq <> 0 then
do;
call print$buffer (.(0DH,0AH,' $'));
call co(lparen);
call display$text (8,@qd.name);
call co(rparen);
call print$buffer(.(' $'));
call display$links (dummy,qd.dq,true,14);
end;
qdptr.offset = qd.link;
end;
end display$DQ;
display$NQ:
procedure;
call crlf;
call print$buffer (.('Process(es) NQing:','$'));
qdptr.offset = sd.qlr;
do while qdptr.offset <> 0;
if qd.nq <> 0 then
do;
call print$buffer (.(0DH,0AH,' $'));
call co(lparen);
call display$text (8,@qd.name);
call co(rparen);
call print$buffer(.(' $'));
call display$links (dummy,qd.nq,true,14);
end;
qdptr.offset = qd.link;
end;
end display$NQ;
display$delay:
procedure;
call display$links (.('Delayed Process(es):$'),sd.dlr,true,1);
end display$delay;
display$poll:
procedure;
call display$links (.('Polling Process(es):$'),sd.plr,true,1);
end display$poll;
display$flag$wait:
procedure;
dcl i integer;
call crlf;
flag$ptr.offset = sd.flags;
call print$buffer(.('Process(es) Flag Waiting:$'));
do i = 0 to signed(sd.nflags - 1);
if flag.pd < 0FFFEH then
do;
call crlf;
call co (' ');
call co (' ');
call display$hex$byte (low(unsign(i)));
call print$buffer (.(' - $'));
call display$links (dummy,flag.pd,true,14);
end;
flag$ptr.offset = flag$ptr.offset + size(flag);
end;
end display$flag$wait;
display$flag$set:
procedure;
dcl (j,i) byte;
flag$ptr.offset = sd.flags;
call crlf;
call print$buffer (.('Flag(s) Set:$'));
i = 0;
j = screenwidth;
do while i < sd.nflags;
if flag.pd = 0fffeh then
do;
if j >= screenwidth then
do;
call crlf; j = 0;
end;
call co (' ');
call co (' ');
call display$hex$byte (i);
j = j + 4;
end;
flag$ptr.offset = flag$ptr.offset + size(flag);
i = i + 1;
end;
end display$flag$set;
display$queues:
procedure;
dcl i byte;
qd$ptr.offset = sd.qlr;
call print$buffer(.(cr,lf,'Queue(s):$'));
i = screenwidth;
do while qd$ptr.offset <> 0;
if i > screenwidth - 19 then
do;
call crlf; i = 0;
end;
call co (' ');
call display$text (8,@qd.name);
if (qd.flags and qf$mx) and (qd.buffer <> 0) then
do;
pdptr.offset = qd.buffer; /* addr of of owning process */
call co (lparen);
call display$text (pnamsiz,@pd.name);
call co (rparen);
end;
else
call print$buffer(.(' $'));
qd$ptr.offset = qd.link;
i = i + 19;
end;
end display$queues;
display$ccb:
procedure(name,first$ccb,last$ccb);
dcl name address,
(i,first$ccb, last$ccb) byte,
name$offset lit '6';
if last$ccb - first$ccb = 0 then
return;
ccb$ptr.offset = sd.ccb + size(ccb) * first$ccb;
call print$buffer (.(0dh,0ah,'Process(es) Attached to $'));
call print$buffer (name);
do i = 0 to last$ccb - first$ccb - 1;
call print$buffer (.(0dh,0ah,' $'));
call co(lparen);
call display$hex$byte(i);
call co(rparen);
call print$buffer (.(' - $'));
if ccb.attach = 0 then
call print$buffer(.('Unattached$'));
else if ccb.attach = 0ffffh then
do;
call print$buffer(.('Control P - Console $'));
call co(lparen);
call display$hex$byte(ccb.msource);
call co(rparen);
end;
else
do;
pd$ptr.offset = ccb.attach;
call display$text(pnamsiz,@pd.name);
end;
ccb$ptr.offset = ccb$ptr.offset + size(ccb);
end;
ccb$ptr.offset = sd.ccb + size(ccb) * first$ccb;
call print$buffer (.(0dh,0ah,'Process(es) Waiting for $'));
call print$buffer (name);
do i = 0 to last$ccb - first$ccb - 1;
if ccb.queue <> 0 then
do;
call print$buffer (.(0dh,0ah,' $'));
call co(lparen);
call display$hex$byte (i);
call co (rparen);
call print$buffer(.(' -$')); /* put out 13 chars to */
call display$links (dummy,ccb.queue,false,13); /* line up */
end; /* with other PD displays */
ccb$ptr.offset = ccb$ptr.offset + size(ccb);
end;
end display$ccb;
display$memory:
procedure;
dcl (i,n,col) byte;
call crlf;
call print$buffer(.('Memory Partitions:$'));
call crlf;
do col = 1 to screen$width / 23;
call print$buffer(.('Start Length Process | $'));
end;
col = screenwidth + 1; /* force new line */
n = -1;
disable; /* critical section required to obtain list */
pd$ptr.offset = sd.thrdrt;
do while (pd$ptr.offset <> 0) and (n <> 63);
link$list(n := n + 1) = pd$ptr.offset;
pd$ptr.offset = pd.thread;
end;
call mon1 (dispatch,0); /* enable interrupts by dispatching */
if n = - 1 then return;
do i = 0 to n;
pd$ptr.offset = link$list(i);
if col > screenwidth - 23 then
do;
call crlf; col = 1;
end;
if pd.mem <> 0 and pd.mem <> 8 then
do;
ms$ptr.offset = pd.mem;
md$ptr.offset = ms.mau; /* the mau field of a MS descriptor */
call display$hex$word(md.start); /* one or more partitions */
call print$buffer(.(' $')); /* described by the MAU */
call display$hex$word(md.length);
call print$buffer(.(' $'));
call display$text(pnamsiz,@pd.name);
call print$buffer(.(' $'));
col = col + 23;
end;
end;
md$ptr.offset = sd.mfl;
do while md$ptr.offset <> 0; /* don't need critical */
if col > screenwidth - 23 then /* region for MD list - */
do; /* they aren't deleted */
call crlf; col = 0;
end;
call display$hex$word (md.start);
call print$buffer(.(' $'));
call display$hex$word (md.length);
call print$buffer(.(' * FREE * $'));
md$ptr.offset = md.link;
col = col + 23;
end;
enable;
end display$memory;


93
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/STSRSP.PLM Normal file
View File

@@ -0,0 +1,93 @@
$title('MP/M-86 2.0 Status Process - RSP')
$compact
status: /* use compact model for 32 bit pointers */
do;
$include(copyrt.lit)
/* VAX generation commands
asm86 rspasm.a86
plm86 stsrsp.plm optimize(3) debug 'p1' 'p2' 'p3'
link86 rspasm.obj, stsrsp.obj to stsrsp.lnk
loc86 stsrsp.lnk od(sm(dats,code,data,const)) -
ad(sm(dats(0),code(0))) ss(stack(0))
h86 stsrsp
then on a micro
vax stsrsp.h86 $fans
gencmd stsrsp
ren mpmstat.rsp=stsrsp.cmd
Notes:
The stack is declared in the assemble module, RSPASM.A86.
The const(ants) come last to force hex generation.
*/
$include (stscom.plm)
dcl rsplink word external;
dcl sts$qd qd$structure initial (
0,0,0,qf$keep + qf$rsp,'MPMSTAT ',131,1,0,0,0,0,.sts$qd$buf);
dcl sts$qd$buf (131) byte; /* not copied if within 64K of sysdat */
dcl sts$cmd structure( /* info from qd$buf copied here */
pd address, tail (129) byte);
dcl sts$qpb qpb$structure initial(0,0,0,1,.sts$cmd,'MPMSTAT ');
plm$start:
procedure public;
dcl vers word;
dcl vers$str$pointer pointer;
dcl vers$str$ptr structure (
offset word,
segment word) at (@vers$str$pointer);
call mon1(qmake,.sts$qd); /* make MPMSTAT queue */
call mon1(qopen,.sts$qpb); /* open it */
ccb$ptr.segment,flag$ptr.segment,md$ptr.segment,ms$ptr.segment,
sat$ptr.segment,qd$ptr.segment,pd$ptr.segment, sysdat$ptr.segment
= rsplink;
sysdat$ptr.offset = 0;
vers$str$ptr.offset = sd.version + 3; /* skip cr, lf's */
vers$str$ptr.segment = sd.supmod(1);
call mon1(setprior,200); /* back to the same as transients */
do while true;
call mon1(qread,.sts$qpb);
pd$ptr.offset = sts$cmd.pd;
call mon1(setdefcon,pd.cns); /* to who typed MPMSTAT */
call crlf;
call display$text(0,vers$str$pointer);
call print$buffer (.(
'****** Status Display - Values Shown In Hexadecimal *****',
cr,lf,lf,'$'));
call display$config;
call display$ready;
call display$DQ;
call display$NQ;
call display$delay;
call display$poll;
call display$flag$wait;
call display$flag$set;
call display$queues;
call display$ccb(.('Consoles:$'), 0, sd$byte(ncondev));
call display$ccb(.('Printers:$'), sd$byte(ncondev), sd$byte(nciodev));
call display$memory;
call mon1 (condetach,dummy);
end;
end plmstart;
end status;


3
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/SYSDAT.LIT Normal file
View File

@@ -0,0 +1,3 @@
%TYPE-W, error opening _DRB0:[FRANK.MPM86.SDIR]SYSDAT.LIT; as input
-RMS-E, file not found


226
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/TIMEST.PLM Normal file
View File

@@ -0,0 +1,226 @@
$title('SDIR - Display Time Stamps')
timestamp:
do;
/* Display time stamp module for extended directory */
/* Time & Date ASCII Conversion Code */
/* From MP/M 1.1 TOD program */
$include(comlit.lit)
print$char: procedure (char) external;
declare char byte;
end print$char;
terminate: procedure external;
end terminate;
declare tod$adr address;
declare tod based tod$adr structure (
opcode byte,
date address,
hrs byte,
min byte,
sec byte,
ASCII (21) byte );
declare string$adr address;
declare string based string$adr (1) byte;
declare index byte;
emitchar: procedure(c);
declare c byte;
string(index := index + 1) = c;
end emitchar;
emitn: procedure(a);
declare a address;
declare c based a byte;
do while c <> '$';
string(index := index + 1) = c;
a = a + 1;
end;
end emitn;
emit$bcd: procedure(b);
declare b byte;
call emitchar('0'+b);
end emit$bcd;
emit$bcd$pair: procedure(b);
declare b byte;
call emit$bcd(shr(b,4));
call emit$bcd(b and 0fh);
end emit$bcd$pair;
emit$colon: procedure(b);
declare b byte;
call emit$bcd$pair(b);
call emitchar(':');
end emit$colon;
emit$bin$pair: procedure(b);
declare b byte;
call emit$bcd(b/10); /* makes garbage if not < 10 */
call emit$bcd(b mod 10);
end emit$bin$pair;
emit$slant: procedure(b);
declare b byte;
call emit$bin$pair(b);
call emitchar('/');
end emit$slant;
declare
base$year lit '78', /* base year for computations */
base$day lit '0', /* starting day for base$year 0..6 */
month$days (*) address data
/* jan feb mar apr may jun jul aug sep oct nov dec */
( 000,031,059,090,120,151,181,212,243,273,304,334);
leap$days: procedure(y,m) byte;
declare (y,m) byte;
/* compute days accumulated by leap years */
declare yp byte;
yp = shr(y,2); /* yp = y/4 */
if (y and 11b) = 0 and month$days(m) < 59 then
/* y not 00, y mod 4 = 0, before march, so not leap yr */
return yp - 1;
/* otherwise, yp is the number of accumulated leap days */
return yp;
end leap$days;
declare word$value address;
get$next$digit: procedure byte;
/* get next lsd from word$value */
declare lsd byte;
lsd = word$value mod 10;
word$value = word$value / 10;
return lsd;
end get$next$digit;
bcd:
procedure (val) byte;
declare val byte;
return shl((val/10),4) + val mod 10;
end bcd;
declare (month, day, year, hrs, min, sec) byte;
bcd$pair: procedure(a,b) byte;
declare (a,b) byte;
return shl(a,4) or b;
end bcd$pair;
compute$year: procedure;
/* compute year from number of days in word$value */
declare year$length address;
year = base$year;
do while true;
year$length = 365;
if (year and 11b) = 0 then /* leap year */
year$length = 366;
if word$value <= year$length then
return;
word$value = word$value - year$length;
year = year + 1;
end;
end compute$year;
declare
week$day byte, /* day of week 0 ... 6 */
day$list (*) byte data
('Sun$Mon$Tue$Wed$Thu$Fri$Sat$'),
leap$bias byte; /* bias for feb 29 */
compute$month: procedure;
month = 12;
do while month > 0;
if (month := month - 1) < 2 then /* jan or feb */
leapbias = 0;
if month$days(month) + leap$bias < word$value then return;
end;
end compute$month;
declare
date$test byte, /* true if testing date */
test$value address; /* sequential date value under test */
get$date$time: procedure;
/* get date and time */
hrs = tod.hrs;
min = tod.min;
sec = tod.sec;
word$value = tod.date;
/* word$value contains total number of days */
week$day = (word$value + base$day - 1) mod 7;
call compute$year;
/* year has been set, word$value is remainder */
leap$bias = 0;
if (year and 11b) = 0 and word$value > 59 then
/* after feb 29 on leap year */ leap$bias = 1;
call compute$month;
day = word$value - (month$days(month) + leap$bias);
month = month + 1;
end get$date$time;
emit$date$time: procedure;
if tod.opcode = 0 then
do;
call emitn(.day$list(shl(week$day,2)));
call emitchar(' ');
end;
call emit$slant(month);
call emit$slant(day);
call emit$bin$pair(year);
call emitchar(' ');
call emit$colon(hrs);
call emit$colon(min);
if tod.opcode = 0 then
call emit$bcd$pair(sec);
end emit$date$time;
tod$ASCII:
procedure (parameter);
declare parameter address;
declare ret address;
ret = 0;
tod$adr = parameter;
string$adr = .tod.ASCII;
if (tod.opcode = 0) or (tod.opcode = 3) then
do;
call get$date$time;
index = -1;
call emit$date$time;
end;
else
call terminate; /* error */
end tod$ASCII;
declare lcltod structure (
opcode byte,
date address,
hrs byte,
min byte,
sec byte,
ASCII (21) byte );
display$time$stamp: procedure (tsadr) public;
dcl tsadr address,
i byte;
lcltod.opcode = 3; /* display time and date stamp, no seconds */
call move (4,tsadr,.lcltod.date); /* don't copy seconds */
call tod$ASCII (.lcltod);
do i = 0 to 13;
call printchar (lcltod.ASCII(i));
end;
end display$time$stamp;
dcl last$data$byte byte initial(0);
end timestamp;


19
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/UDA.LIT Normal file
View File

@@ -0,0 +1,19 @@
/* MP/M-86 II User Data Area format - August 8, 1981 */
declare uda$structure lit 'structure (
dparam word,
dma$ofst word,
dma$seg word,
func byte,
searchl byte,
searcha word,
searchabase word,
dcnt word,
dblk word,
error$mode byte,
mult$cnt byte,
df$password (8) byte,
pd$cnt byte)';


149
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/UTIL.PLM Normal file
View File

@@ -0,0 +1,149 @@
$title('SDIR - Utility Routines')
utility:
do;
/* Utility Module for SDIR */
$include(comlit.lit)
/* -------- arithmetic functions -------- */
add3byte: procedure(byte3adr,num) public;
dcl (byte3adr,num) address,
b3 based byte3adr structure (
lword address,
hbyte byte),
temp address;
temp = b3.lword;
if (b3.lword := b3.lword + num) < temp then /* overflow */
b3.hbyte = b3.hbyte + 1;
end add3byte;
/* add three byte number to 3 byte value structure */
add3byte3: procedure(totalb,numb) public;
dcl (totalb,numb) address,
num based numb structure (
lword address,
hbyte byte),
total based totalb structure (
lword address,
hbyte byte);
call add3byte(totalb,num.lword);
total.hbyte = num.hbyte + total.hbyte;
end add3byte3;
/* divide 3 byte value by 8 */
shr3byte: procedure(byte3adr) public;
dcl byte3adr address,
b3 based byte3adr structure (
lword address,
hbyte byte),
temp1 based byte3adr (2) byte,
temp2 byte;
temp2 = ror(b3.hbyte,3) and 11100000b; /* get 3 bits */
b3.hbyte = shr(b3.hbyte,3);
b3.lword = shr(b3.lword,3);
temp1(1) = temp1(1) or temp2; /* or in 3 bits from hbyte */
end shr3byte;
/* ------- print routines -------- */
mon1: procedure(f,a) external;
declare f byte, a address;
end mon1;
break: procedure external;
end break;
$include(fcb.lit)
/* BDOS calls */
print$char: procedure(char) public;
declare char byte;
call mon1(2,char);
end print$char;
print: procedure(string$adr) public;
dcl string$adr address;
call mon1(9,string$adr);
end print;
printb: procedure public;
call print$char(' ');
end printb;
crlf: procedure public;
call print$char(cr);
call print$char(lf);
end crlf;
printfn: procedure(fname$adr) public;
dcl fname$adr address,
file$name based fname$adr (1) byte,
i byte; /* <filename> ' ' <filetype> */
do i = 0 to f$namelen - 1;
call printchar(file$name(i) and 7fh);
end;
call printchar(' ');
do i = f$namelen to f$namelen + f$typelen - 1;
call printchar(file$name(i) and 7fh);
end;
end printfn;
pdecimal: procedure(v,prec,zerosup) public;
/* print value v, field size = (log10 prec) + 1 */
/* with leading zero suppression if zerosup = true */
declare v address, /* value to print */
prec address, /* precision */
zerosup boolean, /* zero suppression flag */
d byte; /* current decimal digit */
do while prec <> 0;
d = v / prec; /* get next digit */
v = v mod prec; /* get remainder back to v */
prec = prec / 10; /* ready for next digit */
if prec <> 0 and zerosup and d = 0 then
call printb;
else
do;
zerosup = false;
call printchar('0'+d);
end;
end;
end pdecimal;
p3byte: procedure(byte3adr,prec) public;
/* print 3 byte value with 0 suppression */
dcl byte3adr address, /* assume high order bit is < 10 */
prec address,
b3 based byte3adr structure (
lword address,
hbyte byte),
i byte;
/* prec = 1 for 6 chars, 2 for 7 */
if b3.hbyte <> 0 then
do;
call pdecimal(b3.hbyte,prec,true); /* 3 for 8 chars printed */
call pdecimal(b3.lword,10000,false);
end;
else
do;
i = 1;
do while i <= prec;
call printb;
i = i * 10;
end;
call pdecimal(b3.lword,10000,true);
end;
end p3byte;
end utility;


8
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/VERS.LIT Normal file
View File

@@ -0,0 +1,8 @@
declare
bdos20 lit '20H', /* Version constants */
bdos30 lit '30H',
mpm lit '10H',
mpm86 lit '11H';


23
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/09/XFCB.LIT Normal file
View File

@@ -0,0 +1,23 @@
declare /* XFCB */
xfcb$type lit '10h', /* identifier on disk */
xf$passmode lit '12', /* pass word protection mode */
xf$pass lit '16', /* XFCB password */
passlen lit '8', /* password length */
xf$create lit '24', /* creation/access time stamp */
xf$update lit '28'; /* update time stamp */
declare /* directory label: special case of XFCB */
dirlabeltype lit '20h', /* identifier on disk */
dl$password lit '128', /* masks on data byte */
dl$access lit '64',
dl$update lit '32',
dl$makexfcb lit '16',
dl$exists lit '1';
declare /* password mode of xfcb */
pm$read lit '80h',
pm$write lit '40h',
pm$delete lit '20h';