Upload

Digital Research

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/ABORT.PLM

@@ -0,0 +1,126 @@
+$ title ('MP/M-86 2.0 Abort a Program')
+abort:
+do;
+
+$include(copyrt.lit)
+
+$include (vaxcmd.lit)
+
+$include (comlit.lit)
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+  mon3:
+    procedure (f,a) address external;
+      dcl f byte, a address;
+    end mon3;
+
+  declare fcb (1) byte external;
+  declare fcb16 (1) byte external;
+  declare tbuff (1) byte external;
+
+  /**************************************
+   *                                    *
+   *       B D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  print$console$buffer:
+    procedure (buff$adr);
+      declare buff$adr address;
+      call mon1 (9,buff$adr);
+    end print$console$buffer;
+
+  terminate:
+    procedure;
+      call mon1 (143,0);
+    end terminate;
+
+  console$number:
+    procedure byte;
+      return mon2 (153,0);
+    end console$number;
+
+  abort$process:
+    procedure (abort$pb) byte;
+      declare abort$pb address;
+      return mon2 (157,abort$pb);
+    end abort$process;
+
+  dcl
+    mpm$version        lit '12';         /* version function */
+
+  declare abort$pb structure (
+    pd address,
+    term address,
+    cns byte,
+    net byte,
+    pname (8) byte) initial (
+    0,00ffh,0,0,'        ');
+
+  dcl i byte;
+  dcl console address;
+  dcl mpm$86 lit '1130h';
+
+  /*
+    Main Program
+  */
+
+  dcl plmstart label public;
+
+plmstart:
+  do;
+    if mon3(mpm$version,0) <> mpm$86 then
+    do;
+      call print$console$buffer(.(cr,lf,'Requires MP/M-86$'));
+      call mon1(0,0);
+    end;
+
+    if fcb16(1) = ' ' then
+    do;
+      abort$pb.cns = console$number;
+    end;
+    else
+    do;
+      i = 1; console = 0;
+      do while fcb16(i) <> ' ' and i < 4;  
+        if (fcb16(i) := fcb16(i) - '0') <= 9 then
+        do;
+          console = fcb16(i) + 10 * console;
+          i = i + 1;
+        end;
+        else
+          i = 255;                           /* non - numeric */
+      end;
+      if console > 253 or i = 255 then
+      do;
+        call print$console$buffer (.(cr,lf,
+          'Illegal Console, Use 0-253 $'));
+        call terminate;
+      end;
+      abort$pb.cns = low(console);
+    end;
+
+    call move (8,.fcb(1),.abort$pb.pname);
+    if abort$process (.abort$pb) = 0ffh then
+    do;
+      call print$console$buffer (.(cr,lf,
+        'Abort Failed.','$'));
+    end;
+                    /* abort first PD found with same name and console */
+                    /* consistent with MP/M-80 II but not MP/M 1.x     */
+    call terminate;
+  end;
+
+end abort;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/ATTACH.PLM

@@ -0,0 +1,78 @@
+$ title ('Attach Console MP/M-86 2.0')
+$ compact
+
+attach:
+do;
+
+/* Attach the console assigned to this program by the CLI
+   to the process specified in the command line.  Make sure
+   the specified process has the same console number in its PD. */
+
+$include(copyrt.lit)
+
+$include (vaxcmd.lit)
+ 
+$include (comlit.lit)
+$include (proces.lit)
+
+dcl fcb (36) byte external;         /* use upper case for PD name */
+
+dcl cpm$terminate      lit '0',
+    mpm$print$con$buf  lit '9',
+    mpm$version        lit '12',
+    mpm$terminate      lit '143',
+    mpm$conassign      lit '149',
+    mpm$get$con        lit '153',
+    mpm$getpdadr       lit '156';
+
+mon1: procedure(f,a) external;
+  dcl f byte, a address;
+end mon1;
+
+mon2: procedure(f,a) byte external;
+  dcl f byte, a address;
+end mon2;
+
+mon3: procedure(f,a) address external;
+  dcl f byte, a address;
+end mon3;
+
+mon4: procedure(f,a) pointer external;
+  dcl f byte, a address;
+end mon4;
+
+dcl acb structure(
+    cns byte,
+    match byte,
+    pd address,
+    name (8) byte);
+
+dcl pd$pointer pointer;
+dcl pd based pd$pointer pd$structure;
+dcl mpm$86 lit '1130H';
+  
+plmstart: procedure public;
+  dcl ret address;
+
+  if mon3(mpm$version,0) <> mpm$86 then
+  do;
+     call mon1(mpm$print$con$buf,.(cr,lf,'Requires MP/M-86 $'));
+     call mon1(cpm$terminate,0);
+  end;
+
+  acb.cns = mon2(mpm$get$con,0);      /* get console number this program is */
+  acb.match = 0ffh;                  /* running at                         */
+  acb.pd = 0;
+  call move(8,.fcb(1),.acb.name);
+
+  if (ret := mon3(mpm$conassign, .acb)) = 20 then
+    call mon1(mpm$print$con$buf,.(cr,lf,'Can''t Find PD $'));
+  else if ret <> 0 then
+    call mon1(mpm$print$con$buf,.(cr,lf,'Attach Failed $'));
+
+  call mon1(mpm$terminate,0);
+
+end plmstart;
+
+end attach;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/BACKUP.SUB

@@ -0,0 +1,298 @@
+;
+;writes on drives A and B beware !
+;
+;up load plm-86 source, include files and submit files
+;that compile into MP/M-86 utilities on the VAX 
+;
+;log into FRANK on the VAX before running this submit
+;
+user 0
+mode a 0
+mode b 0
+a:
+;
+vax $$a\set def [frank.mpm86.mixcd]
+;
+;creating source on a:  disk #1
+;
+vax abort.plm $$fans
+vax attach.plm $$fans
+vax cons.plm $$fans
+vax dir.plm $$fans
+vax dskrst.plm $$fans
+vax era.plm $$fans
+vax eraq.plm $$fans
+vax ren.plm $$fans
+vax set.plm $$fans
+vax show.plm $$fans
+vax spool.plm $$fans
+vax sspool.plm $$fans
+vax tod.plm $$fasn
+vax type.plm $$fans
+;
+vax mixcd.a86 $$fans
+;
+vax mixall.com $$fans
+vax mpmcmd.com $$fans
+;
+vax copyrt.lit $$fans
+vax flag.lit $$fans
+vax mdsat.lit $$fans
+vax proces.lit $$fans
+vax qd.lit $$fans
+vax sd.lit $$fans
+vax uda.lit $$fans
+;
+;
+;
+dir a:
+;
+;
+sdir a:
+;
+;
+;
+vax $$a\set def [frank.mpm86.sepcd]
+;
+;creating source on b: disk #2
+dskreset
+b:
+;
+vax ed.plm $$fans
+vax pip.plm $$fans
+vax stat86.plm $$fans
+vax scom.plm $$fans
+vax scd.a86 $$fans
+vax smpmcmd.com $$fans
+vax sepall.com $$fans
+vax stat86.com $$fans
+vax comlit.lit $$fans
+vax dpb86.plm $$fans
+vax dpb.lit $$fans
+;
+;
+;
+dir b:
+;
+;
+sdir b:
+;
+;
+;
+vax $$a\set def [frank.mpm86.mpmstat]\
+;
+;creating source on a: disk #3
+;
+dskreset
+a:
+vax stsrsp.plm $$fans
+vax stscmd.plm $$fans
+vax stscom.plm $$fasn
+;
+vax mpmstat.com $$fans
+;
+vax rspasm.a86 $$fans
+vax mcd.a86 $$fans
+;
+vax ccb.lit $$fans
+vax comlit.lit $$fans
+vax copyrt.lit $$fans
+vax flag.lit $$fans
+vax mdsat.lit $$fans
+vax proces.lit $$fans
+vax qd.lit $$fans
+vax sd.lit $$fans
+vax uda.lit $$fans
+;
+;
+;
+dir a:
+;
+;
+sdir a:
+;
+;
+;
+vax $$a\set def [frank.mpm86.sdir]\
+;
+;creating source on b: disk #4
+dskreset
+b:
+;
+vax disp.plm $$fans
+vax dpb80.plm $$fans
+vax dpb86.plm $$fans
+vax main.plm $$fans
+vax main80.plm $$fasn
+vax main86.plm $$fans
+vax scan.plm $$fans
+vax search.plm $$fans
+vax sort.plm $$fans
+vax timest.plm $$fans
+vax util.plm $$fans
+;
+vax comlit.lit $$fans
+vax dpb.lit $$fans
+vax finfo.lit $$fans
+vax format.lit $$fans
+vax mon.lit $$fans
+vax scan.lit $$fans
+vax search.lit $$fans
+vax vers.lit $$fans
+vax xfcb.lit $$fans
+;
+vax scd.a86 $$fans
+;
+vax sdirall.com $$fasn
+;
+;
+;
+;
+dir b:
+;
+;
+sdir b:
+;
+;
+;
+;vax $$a\set def [frank.mpm86.gensys]\
+;
+;creating source on a: disk #5
+dskreset
+a:
+;
+vax gs.plm $$fans
+vax gl.plm $$fans
+vax sd.plm $$fans
+;
+vax mcd.a86 $$fans
+;
+vax gsall.com $$fans
+;
+vax ccb.lit $$fans
+vax sysdat.lit $$fans
+;
+;
+;
+;
+dir a:
+;
+;
+sdir a:
+;
+;
+;
+;
+;vax $$a\set def [frank.mpm86.asm86]
+;
+;creating source on b: disk #6
+dskreset
+b:
+;
+vax brexpr.plm $$fans
+vax cm.plm $$fans
+vax cm2.plm $$fans
+vax cmac1.plm $$fans
+vax cmac2.plm $$fans
+vax cmac3.plm $$fans
+vax cmac4.plm $$fans
+vax cmac5.plm $$fans
+vax cmsubr.plm $$fans
+vax dline.plm $$fans
+vax ermod.plm $$fans
+vax expr.plm $$fans
+vax files.plm $$fans
+vax global.plm $$fans
+vax instr.plm $$fans
+vax io.plm $$fans
+vax mainp.plm $$fans
+vax mnem1.plm $$fans
+vax mnem2.plm $$fans
+vax mnem3.plm $$fans
+vax mnem4.plm $$fans
+vax outp.plm $$fans
+vax predef.plm $$fans
+vax print.plm $$fans
+vax pseud1.plm $$fans
+vax pseud2.plm $$fans
+;
+;
+;
+;
+dir b:
+;
+;
+sdir b:
+;
+;
+;
+;creating source on a: disk #7
+;
+dskreset
+a:
+;
+vax scan.plm $$fans
+vax subr1.plm $$fans
+vax subr2.plm $$fans
+vax symb.plm $$fans
+vax text.plm $$fans
+;
+vax cm.lit $$fans
+vax cmac.lit $$fans
+vax cmacd.lit $$fans
+vax dev.lit $$fans
+vax equals.lit $$fans
+vax ermod.lit $$fans
+vax macro.lit $$fans
+vax mnem.lit $$fans
+vax outp.lit $$fans
+vax struc.lit $$fans
+;
+vax cm.ext $$fans
+vax cm2.ext $$fans
+vax cmlink.ext $$fans
+vax cmsubr.ext $$fans
+vax dline.ext $$fans
+vax ermod.ext $$fans
+vax exglob.ext $$fans
+vax expr.ext $$fans
+vax files.ext $$fans
+vax global.ext $$fans
+vax instr.ext $$fans
+vax io.ext $$fans
+vax mglob.ext $$fans
+vax mnem.ext $$fans
+vax outp.ext $$fans
+vax predef.ext $$fans
+vax print.ext $$fans
+vax pseud1.ext $$fans
+vax pseud2.ext $$fans
+vax scan.ext $$fans
+vax subr1.ext $$fans
+vax subr2.ext $$fans
+vax symb.ext $$fans
+vax text.ext $$fans
+;
+vax brexpr.x86 $$fans
+vax cmsubr.x86 $$fans
+vax dline.x86 $$fans
+vax expr.x86 $$fans
+vax instr.x86 $$fans
+vax pseud1.x86 $$fans
+vax pseud2.x86 $$fans
+vax symb.x86 $$fans
+;
+vax bnf.tex $$fans
+;
+vax c86lnk.asm $$fans
+;
+;
+;
+;
+dir a:
+;
+;
+sdir a:
+;
+;
+;

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/BACKUP1.SUB

@@ -0,0 +1,53 @@
+;MP/M-86 VAX utility backup disk #1 - mixed code and data programs
+;
+;writes on drive B, beware !
+;
+;up load plm-86 source, include files and submit files
+;that compile into MP/M-86 utilities on the VAX 
+;
+;log into FRANK on the VAX before running this submit
+;
+user 0
+mode b 0
+dskreset
+b:
+;
+vax $$a\set def [frank.mpm86.mixcd]\
+;
+vax abort.plm $$fans
+vax attach.plm $$fans
+vax cons.plm $$fans
+vax dir.plm $$fans
+vax dskrst.plm $$fans
+vax era.plm $$fans
+vax eraq.plm $$fans
+vax ren.plm $$fans
+vax set.plm $$fans
+vax show.plm $$fans
+vax spool.plm $$fans
+vax sspool.plm $$fans
+vax tod.plm $$fasn
+vax type.plm $$fans
+;
+vax mcd.a86 $$fans
+;
+vax mixall.com $$fans
+vax mpmcmd.com $$fans
+;
+vax ccb.lit $$fans
+vax comlit.lit $$fans
+vax copyrt.lit $$fans
+vax flag.lit $$fans
+vax mdsat.lit $$fans
+vax proces.lit $$fans
+vax qd.lit $$fans
+vax sd.lit $$fans
+vax uda.lit $$fans
+vax vaxcmd.lit $$fans
+;
+;
+dir
+;
+;
+sdir
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/BACKUP2.SUB

@@ -0,0 +1,43 @@
+;MP/M-86 VAX utility backup disk #2 - separate code and data programs
+;
+;writes on drive B, beware !
+;
+;up load plm-86 source, include files and submit files
+;that compile into MP/M-86 utilities on the VAX 
+;
+;log into FRANK on the VAX before running this submit
+;
+user 0
+mode b 0
+dskreset
+b:
+;
+vax $$a\set def [frank.mpm86.sepcd]
+;
+vax comlit.lit $$fans
+vax copyrt.lit $$fans
+vax dpb.lit $$fans
+vax dpb86.plm $$fans
+vax ed.plm $$fans
+vax gemit.plm $$fans
+vax gencmd.plm $$fans
+vax gendef.com $$fans
+vax gendef.plm $$fans
+vax glit.plb $$fans
+vax gpas.plb $$fans
+vax gscan.plm $$fans
+vax gtoken.plm $$fans
+vax pip.plm $$fans
+vax scd.a86 $$fans
+vax scom.plm $$fans
+vax sepall.com $$fans
+vax smpmcmd.com $$fans
+vax stat86.com $$fans
+vax stat86.plm $$fans
+;
+;
+dir b:
+;
+;
+sdir b:
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/BACKUP3.SUB

@@ -0,0 +1,85 @@
+;MP/M-86 VAX utility backup disk #3 - mpmstat, sdir and gensys source
+;
+;writes on drive B, beware !
+;
+;up load plm-86 source, include files and submit files
+;that compile into MP/M-86 utilities on the VAX 
+;
+;log into FRANK on the VAX before running this submit
+;
+user 0
+mode b 0
+dskreset
+b:
+;
+vax $$a\set def [frank.mpm86.mpmstat]\
+;
+vax stsrsp.plm $$fans
+vax stscmd.plm $$fans
+vax stscom.plm $$fasn
+;
+vax mpmstat.com $$fans
+;
+vax rspasm.a86 $$fans
+vax mcd.a86 $$fans
+;
+vax ccb.lit $$fans
+vax comlit.lit $$fans
+vax copyrt.lit $$fans
+vax fcb.lit $$fans
+vax flag.lit $$fans
+vax mdsat.lit $$fans
+vax proces.lit $$fans
+vax qd.lit $$fans
+vax sd.lit $$fans
+vax uda.lit $$fans
+;
+vax $$a\set def [frank.mpm86.sdir]\
+;
+vax disp.plm $$fans
+vax dpb80.plm $$fans
+vax dpb86.plm $$fans
+vax main.plm $$fans
+vax main80.plm $$fasn
+vax main86.plm $$fans
+vax mon.plm $$fans
+vax scan.plm $$fans
+vax search.plm $$fans
+vax sort.plm $$fans
+vax timest.plm $$fans
+vax util.plm $$fans
+;
+vax comlit.lit $$fans
+vax copyrt.lit $$fans
+vax dpb.lit $$fans
+vax finfo.lit $$fans
+vax format.lit $$fans
+vax scan.lit $$fans
+vax search.lit $$fans
+vax vers.lit $$fans
+vax xfcb.lit $$fans
+;
+vax scd.a86 $$fans
+;
+vax sdirall.com $$fasn
+;
+;vax $$a\set def [frank.mpm86.gensys]\
+;
+vax gs.plm $$fans
+vax gl.plm $$fans
+vax sd.plm $$fans
+;
+vax mcd.a86 $$fans
+;
+vax gsall.com $$fans
+;
+vax ccb.lit $$fans
+vax copyrt.lit $$fans
+vax sysdat.lit $$fans
+;
+;
+dir
+;
+;
+sdir
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/BACKUP4.SUB

@@ -0,0 +1,50 @@
+;MP/M-86 VAX utility backup b: disk #4 - asm86 source - more on disk #5
+;
+;writes on drive B, beware !
+;
+;up load plm-86 source, include files and submit files
+;that compile into MP/M-86 utilities on the VAX 
+;
+;log into FRANK on the VAX before running this submit
+;
+user 0
+mode b 0
+dskreset
+b:
+;
+vax $$a\set def [frank.mpm86.asm86]\
+;
+vax brexpr.plm $$fans
+vax cm.plm $$fans
+vax cm2.plm $$fans
+vax cmac1.plm $$fans
+vax cmac2.plm $$fans
+vax cmac3.plm $$fans
+vax cmac4.plm $$fans
+vax cmac5.plm $$fans
+vax cmsubr.plm $$fans
+vax dline.plm $$fans
+vax ermod.plm $$fans
+vax expr.plm $$fans
+vax files.plm $$fans
+vax global.plm $$fans
+vax instr.plm $$fans
+vax io.plm $$fans
+vax mainp.plm $$fans
+vax mnem1.plm $$fans
+vax mnem2.plm $$fans
+vax mnem3.plm $$fans
+vax mnem4.plm $$fans
+vax outp.plm $$fans
+vax predef.plm $$fans
+vax print.plm $$fans
+vax pseud1.plm $$fans
+vax pseud2.plm $$fans
+;
+;
+dir
+;
+;
+sdir
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/BACKUP5.SUB

@@ -0,0 +1,79 @@
+;MP/M-86 VAX utility backup disk#5 - asm86 source - also on disk #4
+;
+;writes on drive B, beware !
+;
+;up load plm-86 source, include files and submit files
+;that compile into MP/M-86 utilities on the VAX 
+;
+;log into FRANK on the VAX before running this submit
+;
+user 0
+mode b 0
+dskreset
+b:
+;
+vax $$a\set def [frank.mpm86.asm86]\
+;
+vax asm86all.com $$fans
+;
+vax scan.plm $$fans
+vax subr1.plm $$fans
+vax subr2.plm $$fans
+vax symb.plm $$fans
+vax text.plm $$fans
+;
+vax cm.lit $$fans
+vax cmac.lit $$fans
+vax cmacd.lit $$fans
+vax dev.lit $$fans
+vax equals.lit $$fans
+vax ermod.lit $$fans
+vax macro.lit $$fans
+vax mnem.lit $$fans
+vax outp.lit $$fans
+vax struc.lit $$fans
+;
+vax cm.ext $$fans
+vax cm2.ext $$fans
+vax cmlink.ext $$fans
+vax cmsubr.ext $$fans
+vax dline.ext $$fans
+vax ermod.ext $$fans
+vax exglob.ext $$fans
+vax expr.ext $$fans
+vax files.ext $$fans
+vax global.ext $$fans
+vax instr.ext $$fans
+vax io.ext $$fans
+vax mglob.ext $$fans
+vax mnem.ext $$fans
+vax outp.ext $$fans
+vax predef.ext $$fans
+vax print.ext $$fans
+vax pseud1.ext $$fans
+vax pseud2.ext $$fans
+vax scan.ext $$fans
+vax subr1.ext $$fans
+vax subr2.ext $$fans
+vax symb.ext $$fans
+vax text.ext $$fans
+;
+vax brexpr.x86 $$fans
+vax cmsubr.x86 $$fans
+vax dline.x86 $$fans
+vax expr.x86 $$fans
+vax instr.x86 $$fans
+vax pseud1.x86 $$fans
+vax pseud2.x86 $$fans
+vax symb.x86 $$fans
+;
+vax bnf.tex $$fans
+;
+vax c86lnk.asm $$fans
+;
+;
+dir
+;
+;
+sdir
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/CCB.LIT

@@ -0,0 +1,19 @@
+
+                           /* MP/M-86 2.0 Character Control Block */
+  declare ccb$structure lit 'structure (
+    attach word,
+    queue word,
+    flag byte,
+    startcol byte,
+    column byte,
+    nchar byte,
+    mimic byte,
+    msource byte,
+    type byte,
+    xdev byte)';
+
+  declare
+    cf$listcp         lit        '001h',        /* control P toggle */
+    cf$compc          lit        '002h';        /* suppress output  */
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COMA86.SUB

@@ -0,0 +1,10 @@
+;
+;this submit assumes to be running under MP/M II
+;with a vax link, and logged into FRANK on the VAX
+;
+;creates ASM86.H86 file on VAX
+;
+
+vax $$a\set def [frank.mpm86.asm86]\
+vax $$a\submit a86all /param=("$1 $2")\
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COMALL.SUB

@@ -0,0 +1,24 @@
+;
+;Compile all MP/M-86 utilities on VAX.
+;
+;This submit assumes you are
+;running MP/M II on a micro with a VAX link,
+;and are logged into [FRANK] on the VAX 
+;
+;Parameters $1 $2 $3 are to PLM86 compiler.
+;If specifing the XREF option to the compiler, make it param $3,
+;since the ASM86.CMD plm modules already have XREF specified.
+;Compilation of ASM86.CMD is fired off via the coma86.sub submit.
+;
+$include commix $1 $2 $3
+;
+$include comsep $1 $2 $3
+;
+$include comgs $1 $2 $3
+;
+$include comsdir $1 $2 $3
+;
+$include comsts $1 $2 $3
+;
+$include coma86 $1 $2
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COMGS.SUB

@@ -0,0 +1,3 @@
+vax $$a\set def [frank.mpm86.gensys]\
+vax $$a\submit gsall /param=("$1 $2 $3")\
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COMLIT.LIT

@@ -0,0 +1,13 @@
+
+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';
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COMMIX.SUB

@@ -0,0 +1,3 @@
+vax $$a\set def [frank.mpm86.mixcd]\
+vax $$a\submit mixall /param=("$1 $2 $3")\
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COMSDIR.SUB

@@ -0,0 +1,3 @@
+vax $$a\set def [frank.mpm86.sdir]\
+vax $$a\submit sdirall /param=("$1 $2 $3")\
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COMSEP.SUB

@@ -0,0 +1,3 @@
+vax $$a\set def [frank.mpm86.sepcd]\
+vax $$a\submit sepall /param=("$1 $2 $3")\
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COMSTS.SUB

@@ -0,0 +1,3 @@
+vax $$a\set def [frank.mpm86.mpmstat]\
+vax $$a\submit mpmstat /param=("$1 $2 $3")\
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/CONS.PLM

@@ -0,0 +1,115 @@
+$title ('MP/M-86 2.0 Console Identification')
+console:
+do;
+
+$include(copyrt.lit)
+
+$include(vaxcmd.lit)
+
+$include(comlit.lit)
+
+dcl mpmproduct lit '11h';
+dcl cpmversion lit '30h';
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+  mon3:
+    procedure (func,info) address external;
+      dcl func byte, info address;
+    end mon3;
+
+  /**************************************
+   *                                    *
+   *       B D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  print$char: procedure(char);
+    declare char byte;
+    call mon1(2,char);
+  end print$char;
+
+  print$console$buffer:
+    procedure (buffer$address);
+      declare buffer$address address;
+      call mon1 (9,buffer$address);
+    end print$console$buffer;
+
+  version:
+    procedure address;
+      return mon3(12,0);
+    end version;
+
+  /**************************************
+   *                                    *
+   *       X D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  terminate:
+    procedure;
+      call mon1 (143,0);
+    end terminate;
+
+  get$console$number:
+    procedure byte;
+      return mon2 (153,0);
+    end get$console$number;
+
+  printb: procedure;
+    call print$char(' ');
+  end printb;
+
+  pdecimal: procedure(v,prec,zerosup);
+                         /* 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 print$char('0'+d);
+            end;
+        end;
+end pdecimal;
+
+dcl vers address initial (0);
+
+  /*
+    Main Program
+  */
+
+plmstart: procedure public;
+    vers = version;
+    if high(vers) <> mpmproduct or low(vers) <> cpmversion then
+    do;
+       call print$console$buffer(.(0dh,0ah,'Requires MP/M-86 2.0$'));
+       call mon1(0,0);
+    end;
+
+    call print$console$buffer (.(0dh,0ah,'Console = $'));
+    call p$decimal (get$console$number,100,true);
+    call terminate;
+end plmstart;
+
+end console;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/COPYRT.LIT

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

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/DIR.PLM

@@ -0,0 +1,350 @@
+$ TITLE('MP/M 86 --- DIR 2.0')
+dir:
+do;
+
+$include (copyrt.lit)
+
+$include (vaxcmd.lit)
+
+/*
+  Revised:
+    19 Jan  80  by Thomas Rolander
+    28 July 81  by Doug Huskey
+*/
+
+declare
+    true literally '1',
+    false literally '0',
+    forever literally 'while true',
+    lit literally 'literally',
+    proc literally 'procedure',
+    dcl literally 'declare',
+    addr literally 'address',
+    cr literally '13',
+    lf literally '10';
+
+
+  /**************************************
+   *                                    *
+   *       B D O S   INTERFACE          *
+   *                                    *
+   **************************************/
+
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+  mon3:
+    procedure (func,info) address external;
+      declare func byte;
+      declare info address;
+    end mon3;
+
+  declare cmdrv     byte    external;	/* command drive      */
+  declare fcb (1)   byte    external;	/* 1st default fcb    */
+  declare fcb16 (1) byte    external;	/* 2nd default fcb    */
+  declare pass0     address external;	/* 1st password ptr   */
+  declare len0      byte    external;	/* 1st passwd length  */
+  declare pass1     address external;	/* 2nd password ptr   */
+  declare len1      byte    external;	/* 2nd passwd length  */
+  declare tbuff (1) byte    external;	/* default dma buffer */
+
+  read$console:
+    procedure byte;
+      return mon2 (1,0);
+    end read$console;
+
+  write$console:
+    procedure (char);
+      declare char byte;
+      call mon1 (2,char);
+    end write$console;
+
+  print$buf:
+    procedure (buffer$address);
+      declare buffer$address address;
+      call mon1 (9,buffer$address);
+    end print$buf;
+
+  check$con$stat:
+    procedure byte;
+      return mon2 (11,0);
+    end check$con$stat;
+
+  search$first:
+    procedure (fcb$address) byte;
+      declare fcb$address address;
+      return mon2 (17,fcb$address);
+    end search$first;
+
+  search$next:
+    procedure (fcb$address) byte;
+      declare fcb$address address;
+      return mon2 (18,fcb$address);
+    end search$next;
+
+  setdma: procedure(dma);
+    declare dma address;
+    call mon1(26,dma);
+    end setdma;
+
+  get$user$code:
+    procedure byte;
+      return mon2 (32,0ffh);
+    end get$user$code;
+
+  set$user$code:
+    procedure(user);
+      declare user byte;
+      call mon1 (32,user);
+    end set$user$code;
+
+  declare
+    parse$fn structure (
+      buff$adr  address,
+      fcb$adr   address),
+    delimiter based parse$fn.buff$adr byte;
+
+  parse: procedure address;
+    return mon3(152,.parse$fn);
+    end parse;
+
+  terminate:
+    procedure;
+      call mon1 (143,0);
+    end terminate;
+
+  crlf:
+    procedure;
+      call write$console (0dh);
+      call write$console (0ah);
+    end crlf;
+
+
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+
+
+                * * *  GLOBAL VARIABLES  * * *
+
+
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+
+
+declare dir$title (*) byte initial
+  ('Directory for User  x:','$');
+
+declare (sys,temp,dcnt,cnt,user) byte;
+declare 
+   i          byte initial (0),
+   new$user   byte initial (true),
+   sys$exists byte initial (false),
+   incl$sys   byte initial (false),
+   option     byte initial (false);
+
+declare 
+   dirbuf (128) byte;
+
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+
+
+                * * *  DIRECTORY DISPLAY  * * *
+
+
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+
+                  /* display directory heading */
+heading: procedure;
+
+    if user > 9 then
+    do;
+      dir$title(19) = '1';
+      dir$title(20) = user - 10 + '0';
+    end;
+    else
+    do;
+      dir$title(19) = ' ';
+      dir$title(20) = user + '0';
+    end;
+    call print$buf (.dir$title);
+    end heading;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* do next directory display */
+directory: procedure;
+
+    if new$user then do;
+        call heading;
+        new$user = false;
+        end;
+    sys$exists = false;
+    cnt = -1;
+    /* if drive is 0 (default) 
+       then set to current disk */
+    if fcb(0) = 0
+      then fcb(0) = mon2 (25,0) + 1;
+    if fcb(1) = ' ' then
+    /* check for blank filename => wildcard */
+    do i = 1 to 11;
+      fcb(i) = '?';
+    end;
+    /* get first file */
+    if (dcnt := search$first (.fcb)) <> 0ffh then
+    do while dcnt <> 0ffh;
+      temp = ror(dcnt,3) and 0110$0000b;
+      sys = ((dirbuf(temp+10) and 80h) = 80h);
+      if (dirbuf(temp) = user) and
+         (incl$sys or not sys) then
+      do;
+        if ((cnt:=cnt+1) mod 4) = 0 then
+        do;
+          call crlf;
+          call write$console ('A'+fcb(0)-1);
+        end;
+        else
+        do;
+          call write$console (' ');
+        end;
+        call write$console (':');
+        call write$console (' ');
+        do i = 1 to 11;
+          if i = 9 then call write$console (' ');
+          call write$console
+            (dirbuf(temp+i) and 7fh);
+          if check$con$stat then
+          do;
+            dcnt = read$console;
+            call terminate;
+          end;
+        end;
+      end;
+      else if sys then
+        sys$exists = true;
+      dcnt = search$next (.fcb);
+    end;
+    if cnt = -1 then
+    do;
+      call print$buf (.(0dh,0ah,
+        'File not found.','$'));
+    end;
+    if sys$exists then 
+      call print$buf (.(0dh,0ah,
+        'System Files Exist','$'));
+    end directory;
+
+
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+
+
+                    * * *  PARSING  * * *
+
+
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+
+                  /* parse next item */
+parse$next: procedure;
+
+    /* skip comma or space delimiter */
+    parse$fn.buff$adr = parse$fn.buff$adr + 1;
+    parse$fn.buff$adr = parse;
+    if parse$fn.buff$adr = 0ffffh then do;
+        call print$buf (.(0dh,0ah,
+          'Bad entry','$'));
+        call terminate;
+        end;
+    if delimiter = ']' then do;    /* skip */
+        parse$fn.buff$adr = parse$fn.buff$adr + 1;
+        if delimiter = 0 then 
+            parse$fn.buff$adr = 0;
+        option = false;
+        end;
+    if delimiter = '[' then 
+        option = true;
+    if parse$fn.buff$adr = 0 then 
+        option = false;
+    end parse$next;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* parse & interpret option */
+parse$option: procedure;
+
+    parse$fn.fcb$adr = .dirbuf;
+        do while option;
+        call parse$next;
+        if dirbuf(1) = 'S' then
+            incl$sys = true;
+        else if dirbuf(1) = 'G' then do;
+            if dirbuf(3) <> ' ' then 
+                temp = dirbuf(3) - '0' + 10;
+            else if dirbuf(2) <> ' ' then
+                temp = dirbuf(2) - '0';
+            if temp < 16 then do;
+                call set$user$code(user:=temp);
+                new$user = true;
+                end;
+            end;
+        end;
+    parse$fn.fcb$adr = .fcb;
+    end parse$option;
+
+
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+
+
+             * * *  M A I N   P R O G R A M  * * *
+
+
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+declare last$dseg$byte byte
+  initial (0);
+
+plmstart: procedure public;
+
+    user = get$user$code;
+    incl$sys = (fcb16(1) = 'S');
+    call setdma(.dirbuf);
+    parse$fn.buff$adr = .tbuff;
+    parse$fn.fcb$adr = .fcb;
+
+        /* scan for global option */
+        do while tbuff(i:=i+1)=' ';
+        end;
+    if tbuff(i) = '[' then do;   /* skip leading [ */
+        parse$fn.buff$adr = .tbuff(i);
+        option = true;
+        call parse$option;
+        fcb(0) = 0;              /* set current disk */
+        fcb(1) = ' ';            /* clear fcb */
+        call directory;
+        end;
+
+        /* do command line */
+        do while parse$fn.buff$adr <> 0;
+        call parse$next;      /* filename */
+        if option then
+            call parse$option;
+        call directory;
+        end;
+    call terminate;
+end plmstart;
+
+end dir;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/DSKRST.PLM

@@ -0,0 +1,125 @@
+$title ('MP/M-86 2.0  Disk System Reset')
+disk$reset:
+do;
+
+$include (copyrt.lit)
+
+$include (vaxcmd.lit)
+
+/*
+  Revised:
+    19 Jan 80  by Thomas Rolander
+    02 Sep 81  by Danny Horovitz
+*/
+
+declare mpmproduct literally '11h';
+declare cpmversion literally '30h';
+
+declare plmstart label public;
+
+/*  declare start label;
+  declare jmp$to$start structure (
+    jmp$instr byte,
+    jmp$location address ) data  (
+    0C3H,
+    .start-3); */
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon3:
+    procedure (func,info) address external;
+      declare func byte, info address;
+    end mon3;
+
+  declare tbuff (1) byte external;
+
+  /**************************************
+   *                                    *
+   *       B D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  print$con$buffer:
+    procedure (sadr);
+      declare sadr address;
+      call mon1(9,sadr);
+    end print$con$buffer;
+
+  version:
+    procedure address;
+      return mon3(12,0);
+    end version;
+
+  reset$drives:
+    procedure (drive$vector);
+      declare drive$vector address;
+      call mon1 (37,drive$vector);
+    end reset$drives;
+
+  /**************************************
+   *                                    *
+   *       X D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  terminate:
+    procedure;
+      call mon1 (143,0);
+    end terminate;
+
+  declare mask (16) address data (
+    0000000000000001b,
+    0000000000000010b,
+    0000000000000100b,
+    0000000000001000b,
+    0000000000010000b,
+    0000000000100000b,
+    0000000001000000b,
+    0000000010000000b,
+    0000000100000000b,
+    0000001000000000b,
+    0000010000000000b,
+    0000100000000000b,
+    0001000000000000b,
+    0010000000000000b,
+    0100000000000000b,
+    1000000000000000b );
+
+  declare drive$mask address initial (0);
+  declare i byte;
+  declare vers address initial(0);
+
+  /*
+    Main Program
+  */
+
+plmstart:
+  do;
+    vers = version;
+    if high(vers) <> mpmproduct or low(vers) <> cpmversion then
+    do;
+       call print$con$buffer(.(0dh,0ah,'Requires MP/M-86 2.0$'));
+       call mon1(0,0);
+    end;
+    i = 0;
+    if tbuff(0) = 0 then
+    do;
+      drive$mask = 0ffffh;
+    end;
+    else
+    do while (i:=i+1) <= tbuff(0);
+      if (tbuff(i) >= 'A') and (tbuff(i) <= 'P') then
+      do;
+        drive$mask = drive$mask or mask(tbuff(i)-'A');
+      end;
+    end;
+    call reset$drives (drive$mask);
+    call terminate;
+  end;
+
+end disk$reset;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/ERA.PLM

@@ -0,0 +1,439 @@
+$compact
+$title ('MP/M-86 2.0  Erase File')
+erase:
+do;
+
+$include (copyrt.lit)
+
+$include (vaxcmd.lit)
+
+/*
+  Revised:
+    19 Jan  80  by Thomas Rolander (MP/M 1.1)
+    19 July 81  by Doug Huskey     (MP/M II )
+     8 Aug  81  by Danny Horovitz  (MP/M-86 )
+*/
+declare
+    mpmproduct literally '01h', /* requires mp/m */
+    cpmversion literally '30h'; /* requires 3.0 cp/m */
+
+
+declare
+    true    literally '1',
+    false   literally '0',
+    forever literally 'while true',
+    lit     literally 'literally',
+    proc    literally 'procedure',
+    dcl     literally 'declare',
+    addr    literally 'address',
+    cr      literally '13',
+    lf      literally '10',
+    ctrlc   literally '3',
+    ctrlx   literally '18h',
+    bksp    literally '8';
+
+$include (proces.lit)
+$include (uda.lit)
+
+dcl stack$siz lit '16';
+dcl int3 lit '0CCCCh';
+dcl plmstack (stack$siz) word public initial(
+    int3,int3,int3,int3, int3,int3,int3,int3,
+    int3,int3,int3,int3, int3,int3,int3,int3);
+dcl stack$size word public data(stack$siz + stack$siz);
+
+  /**************************************
+   *                                    *
+   *       B D O S   INTERFACE          *
+   *                                    *
+   **************************************/
+
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+  mon3:
+    procedure (func,info) address external;
+      declare func byte;
+      declare info address;
+    end mon3;
+
+  mon4:
+    procedure (func,info) pointer external;
+      declare func byte;
+      declare info address;
+    end mon4;
+
+  declare cmdrv     byte    external;	/* command drive      */
+  declare fcb (1)   byte    external;	/* 1st default fcb    */
+  declare fcb16 (1) byte    external;	/* 2nd default fcb    */
+  declare pass0     address external;	/* 1st password ptr   */
+  declare len0      byte    external;	/* 1st passwd length  */
+  declare pass1     address external;	/* 2nd password ptr   */
+  declare len1      byte    external;	/* 2nd passwd length  */
+  declare tbuff (1) byte    external;	/* default dma buffer */
+
+
+  /**************************************
+   *                                    *
+   *       B D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  read$console:
+    procedure byte;
+      return mon2 (1,0);
+    end read$console;
+
+
+  printchar: 
+    procedure(char);
+    declare char byte;
+    call mon1(2,char);
+    end printchar;
+
+  conin: 
+    procedure byte;
+    return mon2(6,0fdh);
+    end conin;
+
+  check$con$stat:
+    procedure byte;
+      return mon2(11,0);
+    end check$con$stat;
+
+  print$buf:
+    procedure (buffer$address);
+      declare buffer$address address;
+      call mon1 (9,buffer$address);
+    end print$buf;
+
+  version: procedure address;
+    /* returns current cp/m version # */
+    return mon3(12,0);
+    end version;
+
+  setdma: procedure(dma);
+    declare dma address;
+    call mon1(26,dma);
+    end setdma;
+
+  search:
+    procedure (fcb$address) byte;
+      declare fcb$address address;
+      return mon2 (17,fcb$address);
+    end search;
+
+  searchn:
+    procedure byte;
+      return mon2 (18,0);
+    end searchn;
+
+  delete$file:
+    procedure (fcb$address) address;
+      declare fcb$address address;
+      return mon3 (19,fcb$address);
+    end delete$file;
+
+  get$user$code:
+    procedure byte;
+      return mon2 (32,0ffh);
+    end get$user$code;
+
+  /* 0ff => return BDOS errors */
+  return$errors:
+    procedure;
+      call mon1 (45,0ffh);	
+    end return$errors;
+
+  terminate:
+    procedure;
+      call mon1 (143,0);
+    end terminate;
+
+  declare
+    parse$fn structure (
+      buff$adr  address,
+      fcb$adr   address);
+
+  parse: procedure;
+    call mon1(152,.parse$fn);
+    end parse;
+
+
+declare
+    pd$pointer pointer,
+    pd         based pd$pointer pd$structure;
+declare
+    uda$pointer pointer,
+    uda$ptr structure (
+               offset word,
+               segment word) at (@uda$pointer),
+    uda based uda$pointer uda$structure;
+
+get$uda: procedure;
+
+    pd$pointer = mon4(156,0);
+    uda$ptr.segment = pd.uda;
+    uda$ptr.offset = 0;
+    end get$uda;
+
+  /**************************************
+   *                                    *
+   *         GLOBAL VARIABLES           *
+   *                                    *
+   **************************************/
+
+  declare xfcb     byte initial(0);
+  declare successful lit '0FFh';
+
+  /**************************************
+   *                                    *
+   *       S U B R O U T I N E S        *
+   *                                    *
+   **************************************/
+
+
+                  /* upper case character from console */
+crlf:   proc;
+    call printchar(cr);
+    call printchar(lf);
+    end crlf;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* fill string @ s for c bytes with f */
+fill:   proc(s,f,c);
+    dcl s addr,
+        (f,c) byte,
+        a based s byte;
+
+        do while (c:=c-1)<>255;
+        a = f;
+        s = s+1;
+        end;
+    end fill;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* error message routine */
+error:   proc(code);
+   declare
+      code byte;
+
+    call printchar(' ');
+    if code=1 then 
+        call print$buf(.(cr,lf,'BDOS Bad Sector$'));
+    if code=2 then 
+        call print$buf(.(cr,lf,'Drive $'));
+    if code = 3 or code = 2 then
+        call print$buf(.('Read Only$'));
+    if code = 5 then      
+        call print$buf(.('Currently Opened$'));
+    if code = 7 then
+        call print$buf(.('Password Error$'));
+    if code < 3 then 
+        call terminate;
+    end error;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                 /* print file name */
+print$file: procedure(fcbp);
+        declare k byte;
+        declare typ lit '9';        /* file type */
+        declare fnam lit '11';        /* file type */
+        declare
+            fcbp   addr,
+            fcbv   based fcbp (32) byte;
+
+            do k = 1 to fnam;
+            if k = typ then 
+	       call printchar('.');
+            call printchar(fcbv(k) and 7fh);
+            end;
+        end print$file;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+  /* try to delete fcb at fcb$address
+            return error code if unsuccessful */
+  delete:
+    procedure(fcb$address) byte;
+    declare
+       fcb$address address,
+       fcbv based  fcb$address (32) byte,
+       error$code  address,
+       code        byte;
+       
+    if xfcb then 
+        fcbv(5) = fcbv(5) or 80h;
+    call setdma(.fcb16);                   /* password */
+    fcbv(0) = fcb(0);                      /* drive */
+    error$code = delete$file(fcb$address);
+    fcbv(5) = fcbv(5) and 7fh;             /* reset xfcb bit */
+    if low(error$code) = 0FFh then do;
+        code = high(error$code);
+        if (code=1) or (code=2) then 
+            call error(code);
+        return code;
+        end;
+    return successful;      
+    end delete;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* upper case character from console */
+ucase:   proc byte;
+    dcl c byte;
+
+    if (c:=conin) >= 'a' then
+       if c < '{' then
+          return(c-20h);
+    return c;
+    end ucase;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* get password and place at fcb + 16 */
+getpasswd:   proc;
+    dcl (i,c) byte;
+
+    call crlf;
+    call print$buf(.('Password ? ','$'));
+retry:
+    call fill(.fcb16,' ',8);
+        do i = 0 to 7;
+nxtchr:
+        if (c:=ucase) >= ' ' then 
+            fcb16(i)=c;
+        if c = cr then do;
+            call crlf;
+            goto exit;
+            end;
+        if c = ctrlx then
+            goto retry;
+        if c = bksp then do;
+            if i<1 then
+                goto retry;
+            else do;
+                fcb16(i:=i-1)=' ';
+                goto nxtchr;
+                end;
+            end;
+        if c = 3 then
+            call terminate;
+        end;
+exit:
+    c = check$con$stat;   
+    end getpasswd;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* try deleting files one at a time */
+  single$file:
+    procedure;
+    declare (code,dcnt,sav$searchl) byte;
+    declare (fcba,sav$dcnt) addr;
+
+    file$err: procedure;
+        call crlf;
+        call print$buf(.('Not erased: $'));
+        call print$file(fcba);
+        call error(code);
+        end file$err;
+
+    call setdma(.tbuff);
+    dcnt = search(.fcb);
+        do while dcnt <> 0ffh;
+        fcba = shl(dcnt,5) + .tbuff;
+        sav$dcnt = uda.dcnt;
+        sav$searchl = uda.searchl;
+        if (code:=delete(fcba)) = 7 then do;
+            call file$err;
+            call getpasswd;
+            code = delete(fcba);
+            end;
+        if code <> successful then 
+            call file$err;
+        call setdma(.tbuff);
+        /* restore dcnt and search length of 11 */
+        uda.dcnt = sav$dcnt;
+        uda.searchl = sav$searchl;
+        dcnt = searchn;
+        end;
+    end single$file;
+
+  /**************************************
+   *                                    *
+   *       M A I N  P R O G R A M       *
+   *                                    *
+   **************************************/
+
+
+declare (i,response,user,code) byte;
+declare ver address;
+declare last$dseg$byte byte
+  initial (0);
+
+plm$start: procedure public;
+
+    ver = version;
+    if low(ver) <> cpmversion or (high(ver) and 0fh) <> mpmproduct then do;
+      call print$buf (.(
+        'Requires MP/M 2.0','$'));
+      call mon1(0,0);
+      end;
+
+    parse$fn.buff$adr = .tbuff(1);
+    parse$fn.fcb$adr = .fcb;
+    user = get$user$code;
+    call getuda;             /* get uda address */
+    call return$errors;
+    if fcb(17) <> ' ' then 
+        if fcb(17) = 'X' then 
+            xfcb = true;
+        else do;
+            call print$buf (.(
+              'Invalid Parameter$'));
+            call terminate;
+            end;
+
+    i = 0;
+      do while fcb(i:=i+1) = '?';
+      ;
+      end;
+    if i > 11 then
+      if not xfcb then 
+        do;
+        call print$buf (.(
+          'Confirm delete all user files (Y/N)?','$'));
+        response = read$console;
+        if not ((response = 'y') or
+              (response = 'Y'))
+        then call terminate;
+        end;
+    call parse;
+    if (code:=delete(.fcb)) <> successful then do;
+        if code = 0 then 
+            call print$buf (.(cr,lf,
+            'No file','$'));
+        else if code < 3 then 
+            call error(code);            /* fatal errors */
+        else 
+            call single$file;       /* single file error */
+        end;
+    call terminate;
+  end plm$start;
+
+end erase;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/ERAQ.PLM

@@ -0,0 +1,406 @@
+$title ('MP/M-86 2.0  Erase File with Query')
+eraseq:
+do;
+
+$include (copyrt.lit)
+
+$include (vaxcmd.lit)
+
+/*
+  Revised:
+    19 Jan  80  by Thomas Rolander
+    20 July 81  by Doug Huskey
+     6 Aug  81  by Danny Horovitz
+*/
+
+declare
+    mpmproduct literally '01h', /* requires mp/m */
+    cpmversion literally '30h'; /* requires 3.0 cp/m */
+
+
+declare
+    true    literally '1',
+    false   literally '0',
+    forever literally 'while true',
+    lit     literally 'literally',
+    proc    literally 'procedure',
+    dcl     literally 'declare',
+    addr    literally 'address',
+    cr      literally '13',
+    lf      literally '10',
+    ctrlc   literally '3',
+    ctrlx   literally '18h',
+    bksp    literally '8';
+
+
+  /**************************************
+   *                                    *
+   *       B D O S   INTERFACE          *
+   *                                    *
+   **************************************/
+
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+  mon3:
+    procedure (func,info) address external;
+      declare func byte;
+      declare info address;
+    end mon3;
+
+  declare cmdrv     byte    external;	/* command drive      */
+  declare fcb (1)   byte    external;	/* 1st default fcb    */
+  declare fcb16 (1) byte    external;	/* 2nd default fcb    */
+  declare pass0     address external;	/* 1st password ptr   */
+  declare len0      byte    external;	/* 1st passwd length  */
+  declare pass1     address external;	/* 2nd password ptr   */
+  declare len1      byte    external;	/* 2nd passwd length  */
+  declare tbuff (1) byte    external;	/* default dma buffer */
+
+
+  /**************************************
+   *                                    *
+   *       B D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  read$console:
+    procedure byte;
+      return mon2 (1,0);
+    end read$console;
+
+
+  printchar: 
+    procedure(char);
+    declare char byte;
+    call mon1(2,char);
+    end printchar;
+
+  conin: 
+    procedure byte;
+    return mon2(6,0fdh);
+    end conin;
+
+  print$buf:
+    procedure (buffer$address);
+      declare buffer$address address;
+      call mon1 (9,buffer$address);
+    end print$buf;
+
+  check$con$stat:
+    procedure byte;
+      return mon2(11,0);
+    end check$con$stat;
+
+  version: procedure address;
+    /* returns current cp/m version # */
+    return mon3(12,0);
+    end version;
+
+  setdma: procedure(dma);
+    declare dma address;
+    call mon1(26,dma);
+    end setdma;
+
+  search$first:
+    procedure (fcb$address) byte;
+      declare fcb$address address;
+      return mon2 (17,fcb$address);
+    end search$first;
+
+  search$next:
+    procedure byte;
+      return mon2 (18,0);
+    end search$next;
+
+  delete$file:
+    procedure (fcb$address) address;
+      declare fcb$address address;
+      return mon3 (19,fcb$address);
+    end delete$file;
+
+  get$user$code:
+    procedure byte;
+      return mon2 (32,0ffh);
+    end get$user$code;
+
+  /* 0ff => return BDOS errors */
+  return$errors:
+    procedure;
+      call mon1 (45,0ffh);	
+    end return$errors;
+
+
+  terminate:
+    procedure;
+      call mon1 (143,0);
+    end terminate;
+
+  declare
+    parse$fn structure (
+      buff$adr  address,
+      fcb$adr   address);
+
+  parse: procedure;
+    call mon1(152,.parse$fn);
+    end parse;
+
+
+
+  /**************************************
+   *                                    *
+   *         GLOBAL VARIABLES           *
+   *                                    *
+   **************************************/
+
+  declare xfcb     byte initial(0);
+  declare successful lit '0FFh';
+
+  declare dir$entries (128) structure (
+     file (12) byte );
+
+  declare dir$entry$adr address;
+  declare dir$entry based dir$entry$adr (1) byte;
+
+  /**************************************
+   *                                    *
+   *       S U B R O U T I N E S        *
+   *                                    *
+   **************************************/
+
+
+                  /* upper case character from console */
+crlf:   proc;
+    call printchar(cr);
+    call printchar(lf);
+    end crlf;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* fill string @ s for c bytes with f */
+fill:   proc(s,f,c);
+    dcl s addr,
+        (f,c) byte,
+        a based s byte;
+
+        do while (c:=c-1)<>255;
+        a = f;
+        s = s+1;
+        end;
+    end fill;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* error message routine */
+error:   proc(code);
+   declare
+      code byte;
+
+    call printchar(' ');
+    if code=1 then 
+        call print$buf(.(cr,lf,'BDOS Bad Sector$'));
+    if code=2 then 
+        call print$buf(.(cr,lf,'Drive $'));
+    if code = 3 or code = 2 then
+        call print$buf(.('Read Only$'));
+    if code = 5 then      
+        call print$buf(.('Currently Opened$'));
+    if code = 7 then
+        call print$buf(.('Password Error$'));
+    if code < 3 then 
+        call terminate;
+    end error;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+  /* try to delete fcb at fcb$address
+            return error code if unsuccessful */
+  delete:
+    procedure(fcb$address) byte;
+    declare
+       fcb$address address,
+       fcbv based  fcb$address (32) byte,
+       error$code  address,
+       code        byte;
+       
+    if xfcb then 
+        fcbv(5) = fcbv(5) or 80h;
+    call setdma(.fcb16);                   /* password */
+    fcbv(0) = fcb(0);                      /* drive */
+    error$code = delete$file(fcb$address);
+    fcbv(5) = fcbv(5) and 7fh;             /* reset xfcb bit */
+    if low(error$code) = 0FFh then do;
+        code = high(error$code);
+        if (code=1) or (code=2) then 
+            call error(code);
+        return code;
+        end;
+    return successful;      
+    end delete;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* upper case character from console */
+ucase:   proc byte;
+    dcl c byte;
+
+    if (c:=conin) >= 'a' then
+       if c < '{' then
+          return(c-20h);
+    return c;
+    end ucase;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* get password and place at fcb + 16 */
+getpasswd:   proc;
+    dcl (i,c) byte;
+
+    call print$buf(.('Password ? ','$'));
+retry:
+    call fill(.fcb16,' ',8);
+        do i = 0 to 7;
+nxtchr:
+        if (c:=ucase) >= ' ' then 
+            fcb16(i)=c;
+        if c = cr then
+            goto exit;
+        if c = ctrlx then
+            goto retry;
+        if c = bksp then do;
+            if i<1 then
+                goto retry;
+            else do;
+                fcb16(i:=i-1)=' ';
+                goto nxtchr;
+                end;
+            end;
+        if c = 3 then
+            call terminate;
+        end;
+exit:
+    c = check$con$stat;
+    end getpasswd;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* error on deleting a file */
+    file$err: procedure(code);
+        declare code byte;
+
+        call crlf;
+        call print$buf(.('Not erased, $'));
+        call error(code);
+        call crlf;
+        end file$err;
+
+
+
+  /**************************************
+   *                                    *
+   *       M A I N  P R O G R A M       *
+   *                                    *
+   **************************************/
+
+
+declare (i,j,k,code,response,user,dcnt) byte;
+declare ver address;
+
+declare last$dseg$byte byte
+  initial (0);
+
+plm$start: procedure public;
+    ver = version;
+    if low(ver) <> cpmversion or (high(ver) and 0fh) <> mpmproduct then do;
+      call print$buf (.(
+        'Requires MP/M 2.0','$'));
+      call mon1(0,0);
+      end;
+
+    if fcb(17) <> ' ' then 
+        if fcb(17) = 'X' then 
+            xfcb = true;
+        else do;
+            call print$buf (.(
+              'Invalid Parameter$'));
+            call terminate;
+            end;
+
+    if len0 <> 0 then do;
+      parse$fn.buff$adr = .tbuff(1);
+      parse$fn.fcb$adr = .fcb;
+      call parse;
+      end;
+    if fcb(0) = 0 then
+      fcb(0) = low (mon2 (25,0)) + 1;
+    i = -1;
+    user = get$user$code;
+    call return$errors;
+    dcnt = search$first (.fcb);
+    do while dcnt <> 0ffh;
+      dir$entry$adr = .tbuff(ror(dcnt,3) and 110$0000b);
+      if dir$entry(0) = user then
+      do;
+        if (i:=i+1) = 128 then
+        do;
+          call print$buf (.(
+            'Too many directory entries for query.','$'));
+          call terminate;
+        end;
+        call move (12,.dir$entry(1),.dir$entries(i));
+      end;
+      dcnt = search$next;
+    end;
+    if i = -1 then
+    do;
+      call print$buf (.(
+        'No file','$'));
+    end;
+    else
+    do j = 0 to i;
+      call printchar ('A'+fcb(0)-1);
+      call printchar (':');
+      call printchar (' ');
+      do k = 0 to 10;
+        if k = 8
+          then call printchar ('.');
+        call printchar (dir$entries(j).file(k));
+      end;
+      call printchar (' ');
+      call printchar ('?');
+      response = read$console;
+      call printchar (0dh);
+      call printchar (0ah);
+      if (response = 'y') or
+         (response = 'Y') then
+      do;
+        call move (12,.dir$entries(j),.fcb(1));
+        if (code:=delete(.fcb)) <> successful then do;
+            if code < 3 then 
+                call error(code);            /* fatal errors */
+            else if code = 7 then do;
+                call file$err(code);
+                call getpasswd;
+                code = delete(.fcb);
+                end;
+            if code <> successful then 
+                call file$err(code);
+            call crlf;
+            end;
+      end;
+    end;
+    call terminate;
+  end plm$start;
+
+end eraseq;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/FLAG.LIT

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

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/GENA86.SUB

@@ -0,0 +1,8 @@
+;
+; log into FRANK on VAX before running this submit
+; creates ASM86.CMD after COMASM86.SUB is run
+;
+vax $$a\set def [frank.mpm86.asm86]
+vax asm86.h86 $$fans
+gencmd asm86 data[b4ad m44e, xfff]
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/GENALL.SUB

@@ -0,0 +1,9 @@
+;
+;generate CMD files for MP/M-86 utilities complied on the VAX
+;
+$include genmix
+;
+$include gensep
+;
+$include gena86
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/GENMIX.SUB

@@ -0,0 +1,70 @@
+;login into frank on VAX before running this submit
+;
+;generate CMD files for mixed code and data utilities
+;for MP/M-86 2.0, after H86 files have been created on VAX
+;
+;
+vax $$a\set def [frank.mpm86.mixcd]\
+;
+vax abort.h86 $$fans
+gencmd abort
+;
+vax attach.h86 $$fans
+gencmd attach
+;
+vax cons.h86 $$fans
+era console.h86
+ren console.h86=cons.h86
+gencmd console
+;
+vax dir.h86 $$fans
+gencmd dir
+;
+vax dskrst.h86 $$fans
+era dskreset.h86
+ren dskreset.h86=dskrst.h86
+gencmd dskreset
+;
+vax era.h86 $$fans
+gencmd era
+;
+vax eraq.h86 $$fans
+gencmd eraq
+;
+vax ren.h86 $$fans
+gencmd ren
+;
+vax set.h86 $$fans
+gencmd set
+;
+vax show.h86 $$fans
+gencmd show
+;
+vax spool.h86 $$fans
+gencmd spool
+;
+vax sspool.h86 $$fans
+era stopsplr.h86
+ren stopsplr.h86=sspool.h86
+gencmd stopsplr
+;
+vax tod.h86 $$fans
+gencmd tod
+;
+vax type.h86 $$fans
+gencmd type
+;
+vax $$a\set def [frank.mpm86.gensys]\
+vax gensys.h86 $$fans
+gencmd gensys
+;
+vax $$a\set def [frank.mpm86.mpmstat]\
+vax stsrsp.h86 $$fans
+gencmd stsrsp
+era mpmstat.rsp
+ren mpmstat.rsp=stsrsp.cmd
+vax stscmd.h86 $$fans
+gencmd stscmd
+era mpmstat.cmd
+ren mpmstat.cmd=stscmd.cmd
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/GENSEP.SUB

@@ -0,0 +1,32 @@
+;get pip, ed, stat, sdir, 'H86' files from VAX
+;and GENCMD them into CMD files
+;
+;the beginning of the data for these files is obtained
+;from the '.MP2' files generated by LOC86.
+;
+vax $$a\set def [frank.mpm86.sepcd]\
+;
+vax pip.h86 $$fans
+gencmd pip data[b1c3 m374 x980]
+;
+vax ed.h86 $$fans
+gencmd ed data[b1a5 m253 xfff]
+;
+vax gencmd.h86 $$fans
+gencmd gencmd data[bc5 m2b0 xff0]
+;
+vax gendef.h86 $$fans
+gencmd gendef data[b17c]
+;
+vax stat86.h86 $$fans
+era stat.h86
+ren stat.h86=stat86.h86
+gencmd stat data[b12f m352 xfff]
+;
+vax $$a\set def [frank.mpm86.sdir]
+;
+vax sdir86.h86 $$fans
+era sdir.h86
+ren sdir.h86 = sdir86.h86
+gencmd sdir data[b271 m3c5 xfff]
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/MCD.A86

@@ -0,0 +1,82 @@
+;
+;	MP/M-86 2.0 with BDOS version 3.0
+;	Interface for PLM-86 with mixed code and data
+;	Code org'd at 100h
+;	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'	;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	100h		; for mixed 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
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/MDSAT.LIT

@@ -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)';
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/MIXALL.CPM

@@ -0,0 +1,18 @@
+set verify
+set def [frank.mpm86.mixcd]
+$ asm86 mcd.a86
+$ @mpmcmd abort 'p1' 'p2' 'p3'
+$ @mpmcmd attach 'p1' 'p2' 'p3'
+$ @mpmcmd cons 'p1' 'p2' 'p3'
+$ @mpmcmd dir 'p1' 'p2' 'p3'
+$ @mpmcmd dskrst 'p1' 'p2' 'p3'
+$ @mpmcmd era 'p1' 'p2' 'p3'
+$ @mpmcmd eraq 'p1' 'p2' 'p3'
+$ @mpmcmd ren 'p1' 'p2' 'p3'
+$ @mpmcmd set 'p1' 'p2' 'p3'
+$ @mpmcmd show 'p1' 'p2' 'p3'
+$ @mpmcmd spool 'p1' 'p2' 'p3'
+$ @mpmcmd sspool 'p1' 'p2' 'p3'
+$ @mpmcmd tod 'p1' 'p2' 'p3'
+$ @mpmcmd type 'p1' 'p2' 'p3'
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/MPM86GEN.TEX

@@ -0,0 +1,71 @@
+
+MP/M-86 is created in four different stages:
+
+1) Kernal and A86 files:
+
+    A)	The A86 assembly modules that make up the operating system
+	are assembled on an 8080, Z-80, or 8086 based micro using ASM86.
+	GENCMD is run on each file and then they are renamed to type
+	MPM.  These modules are:
+
+	SUP.MPM, RTM.MPM, MEM.MPM, CIO.MPM, BDOS.MPM, XIOS.MPM
+
+    B)	RSP files are like the MPM files above, they are renamed
+	CMD files.  The H86 files are the output of ASM86.
+
+	TMP.RSP, ECHO.RSP, CLOCK.RSP, SUBMIT.CMD, LDBDOS.H86, LDMPM.H86,
+	LDBIOS.H86
+
+    C)	Files on the distribution diskettes created by combining
+	the above files.  The end user can also create these files.
+
+	MPM.SYS, MPMLDR.CMD 
+ 
+
+2) Utilities compiled on the VAX
+
+	There are several directories on the VAX of utility source.
+	Submit jobs, using files of type COM, are run on the vax
+	to compile, link, located and 'H86' the utilities.
+	These submit jobs can be initiated from a micro via
+	submit jobs run under MP/M II - see the files
+	with names such as COMALL.SUB or COMMIX.SUB.
+	Once the utilities are compiled on the VAX,
+	submits are run under MP/M II to upload and gencmd
+	the H86 files - see the files with names such as GENALL.SUB,
+	GENMIX.SUB.
+
+	The utilities created in this manner are:
+
+	ABORT.CMD, ATTACH.CMD, ASM86.CMD, CONSOLE.CMD, DIR.CMD
+	DSKRESET.CMD, ED.CMD, ERA.CMD, ERAQ.CMD, GENSYS.CMD,
+	MPMSTAT.CMD, MPMSTAT.RSP, PIP.CMD, REN.CMD, SDIR.CMD,
+	SET.CMD, SHOW.CMD, SPOOL.CMD, STAT.CMD, STOPSPLR.CMD,
+	TOD.CMD, TYPE.CMD
+	
+
+3) Utilities compiled on a micro
+
+	These PL/M programs are compiled under CP/M running the ISIS
+	interface.  They are:
+
+	DDT86.CMD, GENCMD.CMD, GENDEF.CMD 
+
+
+4) Text and source files included on the distribution diskettes:
+
+	DEBLOCK.LIB, ROM.A86, SINGLES.DEF, SINGLES.LIB, SYSDAT.LIB,
+	SYSTEM.LIB, TMP.A86, XIOS.A86, ROM.A86
+
+
+
+Th<EFBFBD> entir<69> sourc<72> fo<66> MP/M-8<> 2.<2E> i<> backe<6B> u<> o<> tap<61> create<74> o<>
+th<EFBFBD> VAX<41>  Thi<68> include<64> th<74> file<6C> tha<68> ar<61> compile<6C> o<> assemble<6C>
+o<EFBFBD> micros<6F>  Th<54> entir<69> sourc<72> i<> als<6C> duplicate<74> o<> singl<67>
+densit<EFBFBD> <20> inc<6E> floppies<65> writte<74> b<> ALTO<54> machines<65>  Archiev<65>
+copie<EFBFBD> o<> th<74> diskette<74> an<61> tape<70> ar<61> kep<65> i<> th<74> Digita<74>
+Researc<EFBFBD> ban<61> vault.
+
+Source and compiled and assembled list files are on the VAX in
+sub-directories of DRB0:[FRANK.MPM86].
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/MPMCMD.CPM

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

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/PIPALL.SUB

@@ -0,0 +1,7 @@
+;
+;transfer CMD files created on VAX to floppy on drive $1
+;
+mode $1 0
+pip $1[g0]=*.cmd[v]
+pip $1[g0]=*.rsp[v]
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/PROCES.LIT

@@ -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';
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/QD.LIT

@@ -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 )';
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/REN.PLM

@@ -0,0 +1,527 @@
+$compact
+$title ('MP/M-86 2.0  Rename File')
+ren:
+do;
+
+$include (copyrt.lit)
+
+$include (vaxcmd.lit)
+
+/*
+  Revised:
+    19 Jan  80  by Thomas Rolander
+    31 July 81  by Doug Huskey
+     6 Aug  81  by Danny Horovitz
+*/
+
+
+declare
+    mpmproduct literally '01h', /* requires mp/m */
+    cpmversion literally '30h'; /* requires 3.0 cp/m */
+
+
+declare
+    true    literally '0FFh',
+    false   literally '0',
+    forever literally 'while true',
+    lit     literally 'literally',
+    proc    literally 'procedure',
+    dcl     literally 'declare',
+    addr    literally 'address',
+    cr      literally '13',
+    lf      literally '10',
+    ctrlc   literally '3',
+    ctrlx   literally '18h',
+    bksp    literally '8';
+
+$include (proces.lit)
+$include (uda.lit)
+
+
+  /**************************************
+   *                                    *
+   *       B D O S   INTERFACE          *
+   *                                    *
+   **************************************/
+
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+  mon3:
+    procedure (func,info) address external;
+      declare func byte;
+      declare info address;
+    end mon3;
+
+  mon4:
+    procedure (func,info) pointer external;
+      declare func byte;
+      declare info address;
+    end mon4;
+
+  declare cmdrv     byte    external;	/* command drive      */
+  declare fcb (1)   byte    external;	/* 1st default fcb    */
+  declare fcb16 (1) byte    external;	/* 2nd default fcb    */
+  declare pass0     address external;	/* 1st password ptr   */
+  declare len0      byte    external;	/* 1st passwd length  */
+  declare pass1     address external;	/* 2nd password ptr   */
+  declare len1      byte    external;	/* 2nd passwd length  */
+  declare tbuff (1) byte    external;	/* default dma buffer */
+
+
+  /**************************************
+   *                                    *
+   *       B D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  read$console:
+    procedure byte;
+      return mon2 (1,0);
+    end read$console;
+
+  conin: 
+    procedure byte;
+    return mon2(6,0fdh);
+    end conin;
+
+  printchar:
+    procedure (char);
+      declare char byte;
+      call mon1 (2,char);
+    end printchar;
+
+  check$con$stat:
+    procedure byte;
+      return mon2(11,0);
+    end check$con$stat;
+
+  print$buf:
+    procedure (buffer$address);
+      declare buffer$address address;
+      call mon1 (9,buffer$address);
+    end print$buf;
+
+  version: procedure address;
+    /* returns current cp/m version # */
+    return mon3(12,0);
+    end version;
+
+  search$first:
+    procedure (fcb$address) byte;
+      declare fcb$address address;
+      return mon2 (17,fcb$address);
+    end search$first;
+
+  search$next:
+    procedure byte;
+      return mon2 (18,0);
+    end search$next;
+
+  delete$file:
+    procedure (fcb$address);
+      declare fcb$address address;
+      call mon1 (19,fcb$address);
+    end delete$file;
+
+  rename$file:
+    procedure (fcb$address) address;
+      declare fcb$address address;
+      return mon3 (23,fcb$address);
+    end rename$file;
+
+  setdma: procedure(dma);
+    declare dma address;
+    call mon1(26,dma);
+    end setdma;
+
+  /* 0ff => return BDOS errors */
+  return$errors:
+    procedure(mode);
+    declare mode byte;
+      call mon1 (45,mode);	
+    end return$errors;
+
+  terminate:
+    procedure;
+      call mon1 (143,0);
+    end terminate;
+
+  declare
+    parse$fn structure (
+      buff$adr  address,
+      fcb$adr   address);
+
+  parse: procedure address;
+    return mon3(152,.parse$fn);
+    end parse;
+
+  declare
+    pd$pointer      pointer,
+    pd              based pd$pointer pd$structure;
+  declare
+    uda$pointer pointer,
+    uda$ptr structure (
+      offset word,
+      segment word) at (@uda$pointer),
+    uda based uda$pointer uda$structure;
+
+  get$uda: procedure;
+    pd$pointer = mon4(156,0);
+    uda$ptr.segment = pd.uda;
+    uda$ptr.offset = 0;
+    end get$uda;
+
+
+  /**************************************
+   *                                    *
+   *         GLOBAL VARIABLES           *
+   *                                    *
+   **************************************/
+
+  /* Note: there are three fcbs used by
+     this program:
+
+         1) new$fcb: the new file name
+            (this can be a wildcard if it
+            has the same pattern of question
+            marks as the old file name)
+            Any question marks are replaced
+            with the corresponding filename
+            character in the old$fcb before
+            doing the rename function.
+
+         2) cur$fcb: the file to be renamed
+            specified in the rename command.
+            (any question marks must correspond
+            to question marks in new$fcb).
+
+         3) old$fcb: a fcb in the directory
+            matching the cur$fcb and used in
+            the bdos rename function.  This
+            cannot contain any question marks.
+  */         
+
+  declare successful lit '0FFh';
+  declare failed       (*) byte data(cr,lf,'Not renamed: $'),
+          read$only    (*) byte data(cr,lf,'Drive Read Only$'),
+          bad$wildcard (*) byte data('Invalid Wildcard$');
+  declare passwd (8) byte;
+  declare 
+      new$fcb$adr address,       /* new name */
+      new$fcb based  new$fcb$adr (32) byte;
+  declare cur$fcb (33) byte;      /* current fcb (old name) */
+
+  /**************************************
+   *                                    *
+   *       S U B R O U T I N E S        *
+   *                                    *
+   **************************************/
+
+
+                  /* upper case character from console */
+crlf:   proc;
+    call printchar(cr);
+    call printchar(lf);
+    end crlf;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* fill string @ s for c bytes with f */
+fill:   proc(s,f,c);
+    dcl s addr,
+        (f,c) byte,
+        a based s byte;
+
+        do while (c:=c-1)<>255;
+        a = f;
+        s = s+1;
+        end;
+    end fill;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* error message routine */
+error:   proc(code);
+   declare
+      code byte;
+
+    if code = 0 then do;  
+        call print$buf(.('No such file to rename$'));
+        call terminate;
+        end;
+    if code=1 then do;
+        call print$buf(.(cr,lf,'BDOS Bad Sector$'));
+        call terminate;
+        end;
+    if code=2 then do;
+        call print$buf(.read$only);
+        call terminate;
+        end;
+    if code = 3 then
+        call print$buf(.read$only(8));
+    if code = 5 then      
+        call print$buf(.('Currently Opened$'));
+    if code = 7 then
+        call print$buf(.('Password Error$'));
+    if code = 8 then      
+        call print$buf(.('already exists$'));
+    if code = 9 then do;
+        call print$buf(.bad$wildcard);
+        call terminate;
+        end;
+    end error;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                 /* print file name */
+print$file: procedure(fcbp);
+        declare k byte;
+        declare typ lit '9';        /* file type */
+        declare fnam lit '11';        /* file type */
+        declare
+            fcbp   addr,
+            fcbv   based fcbp (32) byte;
+
+            do k = 1 to fnam;
+            if k = typ then 
+	       call printchar('.');
+            call printchar(fcbv(k) and 7fh);
+            end;
+        end print$file;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+  /* try to rename fcb at old$fcb$adr to name at new$fcb$adr 
+            return error code if unsuccessful */
+  rename:
+    procedure(old$fcb$adr) byte;
+    declare
+       old$fcb$adr address,
+       old$fcb based  old$fcb$adr (32) byte,
+       error$code  address,
+       code        byte;
+       
+    call move (16,new$fcb$adr,old$fcb$adr+16);
+    call setdma(.passwd);                   /* password    */
+    call return$errors(0FFh);        /* return bdos errors */
+    error$code = rename$file (old$fcb$adr);
+    call return$errors(0);           /* normal error mode  */
+    if low(error$code) = 0FFh then do;
+        code = high(error$code);
+        if code < 3 then 
+            call error(code);
+        return code;
+        end;
+    return successful;      
+    end rename;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* upper case character from console */
+ucase:   proc(c) byte;
+    dcl c byte;
+
+    if c >= 'a' then
+       if c < '{' then
+          return(c-20h);
+    return c;
+    end ucase;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* get password and place at fcb + 16 */
+getpasswd:   proc;
+    dcl (i,c) byte;
+
+    call crlf;
+    call print$buf(.('Password ? ','$'));
+retry:
+    call fill(.passwd,' ',8);
+        do i = 0 to 7;
+nxtchr:
+        if (c:=ucase(conin)) >= ' ' then 
+            passwd(i)=c;
+        if c = cr then do;
+            call crlf;
+            goto exit;
+            end;
+        if c = ctrlx then
+            goto retry;
+        if c = bksp then do;
+            if i<1 then
+                goto retry;
+            else do;
+                passwd(i:=i-1)=' ';
+                goto nxtchr;
+                end;
+            end;
+        if c = ctrlc then
+            call terminate;
+        end;
+exit:
+    c = check$con$stat;
+    end getpasswd;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* check for wildcard in rename command */
+wildcard:   proc byte;
+    dcl (i,wild) byte;
+
+    wild = false;
+        do i=1 to 11;
+        if cur$fcb(i) = '?' then
+            if new$fcb(i) <> '?' then do;
+                call print$buf(.failed);
+                call print$buf(.bad$wildcard);
+                call terminate;
+                end;
+            else
+                wild = true;
+        end;
+    return wild;
+    end wildcard;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* set up new name for rename function */
+set$new$fcb:   proc(old$fcb$adr);
+    dcl old$fcb$adr address,
+        old$fcb based old$fcb$adr (32) byte;
+    dcl i byte;
+
+    old$fcb(0) = cur$fcb(0);    /* set up drive */
+        do i=1 to 11;
+        if cur$fcb(i) = '?' then 
+            new$fcb(i) = old$fcb(i);
+        end;
+    end set$new$fcb;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* try deleting files one at a time */
+  single$file:
+    procedure;
+    declare (code,dcnt,savsearchl) byte;
+    declare (old$fcb$adr,savdcnt,savsearcha) addr;
+    declare old$fcb based old$fcb$adr (32) byte;
+ 
+    file$err: procedure(fcba);
+        dcl fcba address;
+        call print$buf(.failed);
+        call print$file(fcba);
+        call printchar(' ');
+        call error(code);
+        end file$err;
+
+    call setdma(.tbuff);
+    if (dcnt:=search$first(.cur$fcb)) = 0ffh then
+        call error(0);
+
+        do while dcnt <> 0ffh;
+        old$fcb$adr = shl(dcnt,5) + .tbuff;
+        savdcnt = uda.dcnt;
+        savsearcha = uda.searcha;
+        savsearchl = uda.searchl;
+        call set$new$fcb(old$fcb$adr);
+        if (code:=rename(old$fcb$adr)) = 8 then do;
+            call file$err(new$fcb$adr);
+            call print$buf(.(', delete (Y/N)?$'));
+            if ucase(read$console) = 'Y' then do;
+                call delete$file(new$fcb$adr);
+                code = rename(old$fcb$adr);
+                end;
+            else
+                go to next;
+            end;
+        if code = 7 then do;
+            call file$err(old$fcb$adr);
+            call getpasswd;
+            code = rename(old$fcb$adr);
+            end;
+        if code <> successful then 
+            call file$err(old$fcb$adr);
+        else do;
+            call crlf;
+            call print$file(new$fcb$adr);
+            call printchar('=');
+            call print$file(old$fcb$adr);
+            end;
+next:
+        call setdma(.tbuff);
+        uda.dcnt = savdcnt;
+        uda.searcha = savsearcha;
+        uda.searchl = savsearchl;
+        dcnt = search$next;
+        end;
+    end single$file;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* invalid rename command */
+bad$entry:   proc;
+
+    call print$buf(.failed);
+    call print$buf(.('Invalid File','$'));
+    call terminate;
+    end bad$entry;
+
+
+  /**************************************
+   *                                    *
+   *       M A I N  P R O G R A M       *
+   *                                    *
+   **************************************/
+
+declare ver address;
+
+declare last$dseg$byte byte
+  initial (0);
+
+plm$start:
+  procedure public;
+    ver = version;
+    if low(ver) <> cpmversion or high(ver) < mpmproduct then 
+        call print$buf (.(
+          'Requires MP/M 2.0','$'));
+    else do;
+        call get$uda;
+        parse$fn.buff$adr = .tbuff(1);
+        new$fcb$adr, parse$fn.fcb$adr = .fcb;
+        if (parse$fn.fcb$adr:=parse) <> 0FFFFh then do; /* old file */
+            parse$fn.buff$adr = parse$fn.fcb$adr + 1; /* skip delim */
+            parse$fn.fcb$adr  = .cur$fcb;
+            parse$fn.fcb$adr = parse;                /* new file */
+            call move (8,.cur$fcb+16,.passwd);       /* password */
+            end;
+        if parse$fn.fcb$adr = 0ffffh then 
+            call bad$entry;
+        if fcb(0) <> 0 then
+            if cur$fcb(0) <> 0 then do;
+                if fcb(0) <> cur$fcb(0) then
+                    call bad$entry;
+                end;
+            else
+                cur$fcb(0) = new$fcb(0);        /* set drive */
+        if wildcard then
+            call singlefile;
+        else if rename(.cur$fcb) <> successful then 
+            call singlefile;
+        end;
+    call mon1(0,0);
+    end plm$start;
+
+end ren;
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/SD.LIT

@@ -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';
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/SPOOL.PLM

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

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/SSPOOL.PLM

@@ -0,0 +1,122 @@
+$title('MP/M-86 2.0 Stop Spooler Program')
+stopsplr:
+do;
+
+$include (copyrt.lit)
+
+$include (vaxcmd.lit)
+
+$include (comlit.lit)
+
+  declare fcb (1) byte external;
+  declare fcb16 (1) byte external;
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+ mon3:
+   procedure (f,a) address external;
+     dcl f byte, a address;
+   end mon3;
+
+  print$console$buffer:
+    procedure (buff$adr);
+      declare buff$adr address;
+      call mon1 (9,buff$adr);
+    end print$console$buffer;
+
+  system$reset:
+    procedure;
+      call mon1 (0,0);
+    end system$reset;
+
+  console$number:
+    procedure byte;
+      return mon2 (153,0);
+    end console$number;
+
+  abort$process:
+    procedure (abort$pb$adr) byte;
+      declare abort$pb$adr address;
+      return mon2 (157,abort$pb$adr);
+    end abort$process;
+
+  dcl mpm$version   lit '12';
+  dcl mpm$terminate lit '143';
+
+  declare abort$param$block structure (
+    pd address,
+    term address,
+    cns byte,
+    net byte,
+    pname (8) byte) initial (
+    0,00ffh,0,0,'SPOOL   ');
+
+  dcl mpm$86 lit '1130H';
+  dcl i byte;
+  dcl console address;
+  dcl plmstart label public;
+
+/*
+  plmstart:
+*/
+
+ 
+plmstart:
+  if mon3(mpm$version,0) <> mpm$86 then
+  do;
+    call print$console$buffer(.(cr,lf,'Requires MP/M-86$'));
+    call mon1(0,0);
+  end;
+  if fcb(1) = ' ' then
+  do;
+    abort$param$block.cns = console$number;
+  end;
+  else
+  do;
+    i = 1; console = 0;
+    do while fcb(i) <> ' ' and i < 4;  
+      if (fcb(i) := fcb(i) - '0') <= 9 then
+      do;
+        console = fcb(i) + 10 * console;
+        i = i + 1;
+      end;
+      else
+        i = 255;                           /* non - numeric */
+    end;
+    if console > 253 or i = 255 then
+    do;
+      call print$console$buffer (.(cr,lf,
+        'Illegal Console, Use 0-253 $'));
+      call mon1(mpm$terminate,0);
+    end;
+    abort$param$block.cns = low(console);
+  end;
+
+
+  if abort$process (.abort$param$block) = 0 then
+  do;
+    do while abort$process (.abort$param$block) = 0;
+      ;
+    end;
+    call print$console$buffer (.(
+           'Spooler aborted','$'));
+  end;
+  else
+  do;
+    call print$console$buffer (.(
+           'Spooler not running','$'));
+  end;
+  call system$reset;
+
+end stopsplr;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/TOD.PLM

@@ -0,0 +1,462 @@
+$compact
+$title ('MP/M-86 2.0 Time and Date')
+tod:
+do;
+
+$include(copyrt.lit)
+
+$include(vaxcmd.lit)
+
+declare dcl literally 'declare';
+dcl lit literally 'literally';
+dcl forever lit 'while 1';
+
+dcl mpmproduct lit '11h';
+dcl cpmversion lit '30h';
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+  mon3:
+    procedure (func,info) address external;
+      declare func byte;
+      declare info address;
+    end mon3;
+
+  mon4:
+    procedure (func,info) pointer external;
+      declare func byte;
+      declare info address;
+    end mon4;
+
+  declare fcb (1) byte external;
+  declare fcb16 (1) byte external;
+  declare buff (1) byte external;
+
+
+  read$console:
+    procedure byte;
+      return mon2 (1,0);
+    end read$console;
+
+  write$console:
+    procedure (char);
+      declare char byte;
+      call mon1 (2,char);
+    end write$console;
+
+  print$buffer:
+    procedure (buffer$address);
+      declare buffer$address address;
+      call mon1 (9,buffer$address);
+    end print$buffer;
+
+  check$console$status:
+    procedure byte;
+      return mon2 (11,0);
+    end check$console$status;
+
+  version:
+    procedure address;
+      return mon3(12,0);
+    end version;
+
+  terminate:
+    procedure;
+      call mon1 (0,0);
+    end terminate;
+
+  get$sysdat:
+    procedure pointer;
+      return (mon4(154,0));
+    end get$sysdat;
+
+  crlf:
+    procedure;
+      call write$console (0dh);
+      call write$console (0ah);
+    end crlf;
+
+error:
+  procedure;
+    call print$buffer (.(
+      'Illegal time/date specification.','$'));
+    call terminate;
+  end;
+
+/*****************************************************
+
+          Time & Date ASCII Conversion Code
+
+ *****************************************************/
+
+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);
+    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 chr byte;
+
+gnc: procedure;
+    /* get next command byte */
+    if chr = 0 then return;
+    if index = 20 then
+    do;
+      chr = 0;
+      return;
+    end;
+    chr = string(index := index + 1);
+    end gnc;
+
+deblank: procedure;
+        do while chr = ' ';
+        call gnc;
+        end;
+    end deblank;
+
+numeric: procedure byte;
+    /* test for numeric */
+    return (chr - '0') < 10;
+    end numeric;
+
+scan$numeric: procedure(lb,ub) byte;
+    declare (lb,ub) byte;
+    declare b byte;
+    b = 0;
+    call deblank;
+    if not numeric then call error;
+        do while numeric;
+        if (b and 1110$0000b) <> 0 then call error;
+        b = shl(b,3) + shl(b,1); /* b = b * 10 */
+        if carry then call error;
+        b = b + (chr - '0');
+        if carry then call error;
+        call gnc;
+        end;
+    if (b < lb) or (b > ub) then call error;
+    return b;
+    end scan$numeric;
+
+scan$delimiter: procedure(d,lb,ub) byte;
+    declare (d,lb,ub) byte;
+    call deblank;
+    if chr <> d then call error;
+    call gnc;
+    return scan$numeric(lb,ub);
+    end scan$delimiter;
+
+declare
+    base$year lit '78',   /* base year for computations */
+    base$day  lit '0',    /* starting day for base$year 0..6 */
+    month$size (*) byte data
+    /* jan feb mar apr may jun jul aug sep oct nov dec */
+    (   31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
+    month$days (*) word 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 word;
+
+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;
+
+set$date$time: procedure;
+    declare
+        (i, leap$flag) byte; /* temporaries */
+    month = scan$numeric(1,12) - 1;
+    /* may be feb 29 */
+    if (leap$flag := month = 1) then i = 29;
+        else i = month$size(month);
+    day   = scan$delimiter('/',1,i);
+    year  = scan$delimiter('/',base$year,99);
+    /* ensure that feb 29 is in a leap year */
+    if leap$flag and day = 29 and (year and 11b) <> 0 then
+        /* feb 29 of non-leap year */ call error;
+    /* compute total days */
+     tod.date = month$days(month)
+                + 365 * (year - base$year)
+                + day
+                - leap$days(base$year,0)
+                + leap$days(year,month);
+
+    tod.hrs   = bcd (scan$numeric(0,23));
+    tod.min   = bcd (scan$delimiter(':',0,59));
+    if tod.opcode = 2 then
+    /* date, hours and minutes only */
+    do;
+      if chr = ':'
+        then i = scan$delimiter (':',0,59);
+      tod.sec = 0;
+    end;
+    /* include seconds */
+    else tod.sec   = bcd (scan$delimiter(':',0,59));
+
+    end set$date$time;
+
+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 word;
+    year = base$year;
+        do forever;
+        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 word;   /* 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;
+    call emitn(.day$list(shl(week$day,2)));
+    call emitchar(' ');
+    call emit$slant(month);
+    call emit$slant(day);
+    call emit$bin$pair(year);
+    call emitchar(' ');
+    call emit$colon(hrs);
+    call emit$colon(min);
+    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 then
+    do;
+      call get$date$time;
+      index = -1;
+      call emit$date$time;
+    end;
+    else
+    do;
+      if (tod.opcode = 1) or
+         (tod.opcode = 2) then
+      do;
+        chr = string(index:=0);
+        call set$date$time;
+        ret = .string(index);
+      end;
+      else
+      do;
+        call error;
+      end;
+    end;
+  end tod$ASCII;
+
+/********************************************************
+ ********************************************************/
+
+  declare tod$pointer pointer;
+  declare tod$ptr structure (
+    offset word,
+    segment word) at (@tod$pointer);
+  declare extrnl$tod based tod$pointer structure (
+    date address,
+    hrs byte,				/* in system data area */
+    min byte,
+    sec byte );
+
+  declare lcltod structure (		/* local to this program */
+    opcode byte,
+    date address,
+    hrs byte,
+    min byte,
+    sec byte,
+    ASCII (21) byte );
+
+  declare i byte;
+  declare ret address;
+
+  display$tod:
+    procedure;
+
+      lcltod.opcode = 0; 		/* read tod */
+      call movb (@extrnl$tod.date,@lcltod.date,5);
+      call tod$ASCII (.lcltod);
+      call write$console (0dh);
+      do i = 0 to 20;
+        call write$console (lcltod.ASCII(i));
+      end;
+    end display$tod;
+
+
+  /*
+    Main Program
+  */
+
+declare tod$sd$offset lit '7eh';   /* offset of TOD structure in MP/M-86 */
+declare vers address;
+declare last$dseg$byte byte
+  initial (0);
+
+plmstart:
+  procedure public;
+    vers = version;
+    if low (vers) <> cpmversion or high (vers) <> mpmproduct then
+    do;
+       call print$buffer(.(0dh,0ah,'Requires MP/M-86 2.0','$'));
+       call mon1(0,0);
+    end;
+
+    tod$pointer = get$sysdat;
+    tod$ptr.offset = tod$sd$offset;
+    if (fcb(1) <> ' ') and (fcb(1) <> 'P') then
+    do;
+      call move (21,.buff(1),.lcltod.ASCII);
+      lcltod.opcode = 1;
+      call tod$ASCII (.lcltod);
+      call print$buffer (.(
+        'Strike key to set time','$'));
+      ret = read$console;
+      call movb (@lcltod.date,@extrnl$tod.date,5);	/* use pl/m-86 move */
+      call crlf;
+    end;
+    do while fcb(1) = 'P';
+      call display$tod;
+      if check$console$status then
+      do;
+        ret = read$console;
+        fcb(1) = 0;
+      end;
+    end;
+    call display$tod;
+    call terminate;
+  end plmstart;
+
+end tod;
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/TYPE.PLM

@@ -0,0 +1,335 @@
+$title ('MP/M-86 2.0  Type a File')
+type:
+do;
+
+$include (copyrt.lit)
+
+$include(vaxcmd.lit)
+
+/*
+  Revised:
+    19 Jan  80  by Thomas Rolander (mp/m 1.1)
+    21 July 81  by Doug Huskey (mp/m 2.0)
+     6 Aug  81  by Danny Horovitz (mp/m-86 2.0)
+*/
+
+$include (copyrt.lit)
+
+declare
+    mpmproduct literally '11h', /* requires mp/m */
+    cpmversion literally '30h'; /* requires 3.0 cp/m */
+
+
+declare
+    true    literally '0FFh',
+    false   literally '0',
+    forever literally 'while true',
+    lit     literally 'literally',
+    proc    literally 'procedure',
+    dcl     literally 'declare',
+    addr    literally 'address',
+    cr      literally '13',
+    lf      literally '10',
+    ctrlc   literally '3',
+    ctrlx   literally '18h',
+    bksp    literally '8';
+   
+
+  /**************************************
+   *                                    *
+   *       B D O S   INTERFACE          *
+   *                                    *
+   **************************************/
+
+
+  mon1:
+    procedure (func,info) external;
+      declare func byte;
+      declare info address;
+    end mon1;
+
+  mon2:
+    procedure (func,info) byte external;
+      declare func byte;
+      declare info address;
+    end mon2;
+
+  mon3:
+    procedure (func,info) address external;
+      declare func byte;
+      declare info address;
+    end mon3;
+
+  declare cmdrv     byte    external;	/* command drive      */
+  declare fcb (1)   byte    external;	/* 1st default fcb    */
+  declare fcb16 (1) byte    external;	/* 2nd default fcb    */
+  declare pass0     address external;	/* 1st password ptr   */
+  declare len0      byte    external;	/* 1st passwd length  */
+  declare pass1     address external;	/* 2nd password ptr   */
+  declare len1      byte    external;	/* 2nd passwd length  */
+  declare tbuff (1) byte    external;	/* default dma buffer */
+
+
+  /**************************************
+   *                                    *
+   *       B D O S   Externals          *
+   *                                    *
+   **************************************/
+
+  read$console:
+    procedure byte;
+      return mon2 (1,0);
+    end read$console;
+
+  printchar:
+    procedure (char);
+      declare char byte;
+      call mon1 (2,char);
+    end printchar;
+
+  conin: 
+    procedure byte;
+    return mon2(6,0fdh);
+    end conin;
+
+  print$buf:
+    procedure (buff$adr);
+      declare buff$adr address;
+      call mon1 (9,buff$adr);
+    end print$buf;
+
+  check$con$stat:
+    procedure byte;
+      return mon2(11,0);
+    end check$con$stat;
+
+  version: procedure address;
+    /* returns current cp/m version # */
+    return mon3(12,0);
+    end version;
+
+  con$status:
+    procedure byte;
+      return mon2 (11,0);
+    end con$status;
+
+  open$file:
+    procedure (fcb$address) address;
+      declare fcb$address address;
+    return mon3 (15,fcb$address);
+    end open$file;
+
+  close$file:
+    procedure (fcb$address) byte;
+      declare fcb$address address;
+      return mon2 (16,fcb$address);
+    end close$file;
+
+  read$record:
+    procedure (fcb$address) byte;
+      declare fcb$address address;
+      return mon2 (20,fcb$address);
+    end read$record;
+
+  setdma: procedure(dma);
+    declare dma address;
+    call mon1(26,dma);
+    end setdma;
+
+  /* 0ff => return BDOS errors */
+  return$errors:
+    procedure(mode);
+    declare mode byte;
+      call mon1 (45,mode);	
+    end return$errors;
+
+  terminate:
+    procedure;
+      call mon1 (143,0);
+    end terminate;
+
+  declare
+    parse$fn structure (
+      buff$adr  address,
+      fcb$adr   address);
+
+  parse: procedure;
+    call mon1(152,.parse$fn);
+    end parse;
+
+
+  /**************************************
+   *                                    *
+   *       S U B R O U T I N E S        *
+   *                                    *
+   **************************************/
+
+
+
+                  /* upper case character from console */
+crlf:   proc;
+    call printchar(cr);
+    call printchar(lf);
+    end crlf;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* fill string @ s for c bytes with f */
+fill:   proc(s,f,c);
+    dcl s addr,
+        (f,c) byte,
+        a based s byte;
+
+        do while (c:=c-1)<>255;
+        a = f;
+        s = s+1;
+        end;
+    end fill;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* upper case character from console */
+ucase:   proc byte;
+    dcl c byte;
+
+    if (c:=conin) >= 'a' then
+       if c < '{' then
+          return(c-20h);
+    return c;
+    end ucase;
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+                  /* get password and place at fcb + 16 */
+getpasswd:   proc;
+    dcl (i,c) byte;
+
+    call crlf;
+    call crlf;
+    call print$buf(.('Password ? ','$'));
+retry:
+    call fill(.fcb16,' ',8);
+        do i = 0 to 7;
+nxtchr:
+        if (c:=ucase) >= ' ' then 
+            fcb16(i)=c;
+        if c = cr then
+            goto exit;
+        if c = ctrlx then
+            goto retry;
+        if c = bksp then do;
+            if i<1 then
+                goto retry;
+            else do;
+                fcb16(i:=i-1)=' ';
+                goto nxtchr;
+                end;
+            end;
+        if c = 3 then
+            call terminate;
+        end;
+exit:
+    c = check$con$stat;
+    end getpasswd;
+
+  /**************************************
+   *                                    *
+   *       M A I N  P R O G R A M       *
+   *                                    *
+   **************************************/
+
+
+  declare (eod,i,char) byte;
+  declare control$z literally '1AH';
+
+  /*
+    Main Program
+  */
+
+declare (cnt,tcnt) byte;
+declare (ver, error$code)  address;
+
+declare last$dseg$byte byte
+  initial (0);
+
+plm$start: procedure public;
+    ver = version;
+    if low(ver) <> cpmversion or high(ver) <> mpmproduct then do;
+      call print$buf (.(
+        'Requires MP/M 2.0','$'));
+      call mon1(0,0);
+      end;
+
+    tcnt,
+    cnt = 0;
+    if fcb16(1) = 'P' then
+      do;
+      if fcb16(2) = ' ' or fcb16(2) = 'A' then   
+        cnt = 24;
+      else
+        cnt = (fcb16(2)-'0')*10
+           +(fcb16(3)-'0');
+      end;
+    if len0 <> 0 then do;
+      parse$fn.buff$adr = .tbuff(1);
+      parse$fn.fcb$adr = .fcb;
+      call parse;                       /* get password */
+      end;
+    call return$errors(0FEh);           /* return after error message */
+    call setdma(.fcb16);                /* set dma to password */
+    fcb(6) = fcb(6) or 80h;             /* open in RO mode     */
+    error$code = open$file (.fcb);
+    if low(error$code) = 0FFh then 
+      if high(error$code) = 7 then do;
+         call getpasswd;
+         call crlf;
+         call setdma(.fcb16);                /* set dma to password */
+         fcb(6) = fcb(6) or 80h;             /* open in RO mode     */
+         error$code = open$file(.fcb);
+         end;
+    if low(error$code) <> 0FFH then
+    do;
+      call return$errors(0);        /* reset error mode */
+      call setdma(.tbuff);
+      fcb(32) = 0;
+      eod = 0;
+      do while (not eod) and (read$record (.fcb) = 0);
+        do i = 0 to 127;
+          if (char := tbuff(i)) = control$z
+            then eod = true;
+          if not eod then
+          do;
+            if con$status then
+            do;
+              i = read$console;
+              call terminate;
+            end;
+            if cnt <> 0 then
+            do;
+              if char = 0ah then
+              do;
+                if (tcnt:=tcnt+1) = cnt then
+                do;
+                  tcnt = read$console;
+                  tcnt = 0;
+                end;
+              end;
+            end;
+            call printchar (char);
+          end;
+        end;
+      end;
+    /*
+      call close (.fcb);
+      *** Warning ***
+      If this call is left in, the file can be destroyed.
+    */
+    end;
+    else if high(error$code) = 0 then
+      call print$buf (.('No file.','$'));
+    call terminate;
+end plm$start;
+
+end type;
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/UDA.LIT

@@ -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)';
+
+

MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/07/VAXCMD.LIT

@@ -0,0 +1,22 @@
+
+/* VAX commands for generation - read the name of this program
+in place of 'p1' and 'progname' below.
+
+asm86 mcd.a86
+plm86 'p1'.plm 'p2' 'p3' 'p4' optimize(3) debug
+link86 mcd.obj,'p1'.obj  to 'p1'.lnk
+loc86 'p1'.lnk od(sm(dats,code,data,stack,const)) -
+       ad(sm(dats(0),code(0)))  ss(stack(+32))
+h86 'p1'
+
+then on a micro
+
+vax progname.h86 $fans
+gencmd progname
+
+Notes:	Stack is increased for interrupts.  Const(ants) are last
+	to force hex generation.
+
+*/
+
+