seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-26 09:54:20 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Upload

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

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

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


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

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


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

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


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

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


1868
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/ED.PLM Normal file
View File

File diff suppressed because it is too large Load Diff

342
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GEMIT.PLM Normal file
View File

@@ -0,0 +1,342 @@
$title('EMIT module for GENDEF')
emit:
do;
/* D I S K D E F l i b g e n e r a t o r e m i t t e r */
mon1: procedure(f,a) external;
declare f byte, a address;
end mon1;
mon2: procedure(f,a) byte external;
declare f byte, a address;
end mon2;
boot: procedure public;
call mon1(0,0);
end boot;
abort: procedure(msg) external;
declare msg address;
end abort;
/* global variables */
declare
parm (26) byte external; /* initial parameters */
/* a b c d e f g h i j k l m n o p q r s t u v w x y z
0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2
0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 */
declare
acclen byte external, /* accumulator length */
accum(32)byte external; /* accumulator */
declare
lbuff(75) byte external, /* physical line */
lblen byte external, /* lbuff length */
lineready byte external, /* line ready flag */
lineout byte external, /* true if current line out */
cbuff(8) byte external; /* line prefix */
declare
lit literally 'literally',
true lit '1',
false lit '0',
forever lit 'while true',
eofile lit '1ah', /* end of file */
tab lit '09h', /* horizontal tab */
cr lit '0dh',
lf lit '0ah';
declare dcnt byte external;
close: procedure(fcb) external;
declare fcb address;
end close;
delete: procedure(fcb) external;
declare fcb address;
end delete;
diskwrite: procedure(fcb) byte external;
declare fcb address;
end diskwrite;
make: procedure(fcb) external;
declare fcb address;
end make;
rename: procedure(fcb) external;
declare fcb address;
end rename;
setdma: procedure(dma) external;
declare dma address;
end setdma;
/* local variables */
declare
fcb (33) byte external,
ifcb (33) byte at (.fcb), /* initial input file control block */
efcb (33) byte, /* .asm file control block */
eufb byte at (.efcb(13)),/* unfilled bytes field */
efcbr byte at (.efcb(32));/* next record field */
/* buffers */
declare
comcol lit '32', /* beginning column for comments */
ecolumn byte, /* output column 0,1,... */
ebuff (512) byte, /* emit file buffer */
ebp address; /* emit buffer pointer */
/* sector size definitions */
declare
sectsize lit '128', /* bytes per sector */
sectmsk lit '7fh', /* sectsize - 1 */
sectshf lit '7'; /* shl(1,sectshf) = sectsize */
setemit: procedure public;
/* set up code emitter file */
call move(16,.ifcb(0),.efcb(0)); /* copy name */
call move(4,.('LIB',0),.efcb(9));/* copy type */
if ifcb(16) <> 0 then /* select destination drive */
efcb(0) = ifcb(16);
call delete(.efcb);
call make(.efcb);
if dcnt = 255 then /* no space */
call abort(.('no ".LIB" directory space$'));
efcbr,ebp,ecolumn = 0;
lineout = true; /* prevent initial line write */
end setemit;
clearebuff: procedure;
/* clear the ebuff buffer up to (not including) ebp */
declare (i,n) byte;
/* skip the case of no buffers to write */
if low(n:=shr(ebp,7)-1) = 255 then return;
/* n is last buffer to write */
ebp = 0;
do i = 0 to n;
call setdma(.ebuff(ebp));
if diskwrite(.efcb) <> 0 then
call abort(.('".LIB" disk full$'));
ebp = ebp + sectsize;
end;
ebp = 0;
end clearebuff;
emitbyte: procedure(b) public;
declare b byte;
/* write b to emit file */
if b = cr then
ecolumn = 0;
if b = tab then
ecolumn = (ecolumn + 8) and 11111000b;
if b >= ' ' then
ecolumn = ecolumn + 1;
if ebp >= length(ebuff) then call clearebuff;
ebuff(ebp) = b;
ebp = ebp + 1;
end emitbyte;
efinis: procedure public;
/* emit file finis */
/* eufb = 0; /* clear the unfilled bytes field */
/* do while (low(ebp) and sectmsk) <> 0; */
/* eufb = eufb + 1; /* counts unfilled bytes */
/* call emitbyte(eofile); */
/* end; Illegal under BDOS 3.0 */
call clearebuff; /* write all buffers */
call close(.efcb);
if dcnt = 255 then
call abort(.('cannot close ".LIB"$'));
end efinis;
emitcrlf: procedure public;
/* emit end of physical line */
call emitbyte(cr);
call emitbyte(lf);
end emitcrlf;
emittab: procedure public;
call emitbyte(tab);
end emittab;
emitcomma: procedure public;
call emitbyte(',');
end emitcomma;
emitdigit: procedure(d);
declare d byte;
/* emit the decimal digit given by d */
call emitbyte('0'+d);
end emitdigit;
emitnulcom: procedure public;
call emitbyte(';');
call emitcrlf;
end emitnulcom;
declare
/* literals for decimal output control */
zsup$on lit 'true', /* zero suppression on */
zsup$off lit 'false', /* zero suppression off */
bsup$on lit 'true', /* blank suppress */
bsup$off lit 'false', /* blank suppress off */
byte$base lit '100', /* byte value */
word$base lit '10000'; /* word value */
emitdecz: procedure(v,zsup,bsup,base) public;
declare
v address, /* value to emit */
zsup byte, /* zero suppress if true */
bsup byte, /* blank suppression */
base address, /* 100 for byte, 10000 for word */
d byte;
do while base <> 0;
d = v/base mod 10;
if (zsup := zsup and (d = 0) and (base > 1)) then
do;
if not bsup then call emitbyte(' ');
end; else
call emitdigit(d);
base = base/10;
end;
end emitdecz;
emitnib: procedure(n);
declare n byte;
if n > 9 then
n = n - 10 + 'A'; else
n = n + '0';
call emitbyte(n);
end emitnib;
emithex8: procedure(h) public;
declare h byte;
call emitnib(shr(h,4));
call emitnib(h and 0fh);
end emithex8;
emithex16: procedure(a) public;
declare a address;
call emithex8(high(a));
call emithex8(low(a));
end emithex16;
emitaddr: procedure(a) public;
declare a address;
call emithex16(a);
call emitbyte('h');
end emitaddr;
emitdec8: procedure(b) public;
declare b byte;
call emitdecz(b,zsup$on,bsup$on,byte$base);
end emitdec8;
emitdec16: procedure(w) public;
declare w address;
call emitdecz(w,zsup$on,bsup$on,word$base);
end emitdec16;
emitdecb: procedure(w) public;
declare w address;
call emitdecz(w,zsup$on,bsup$off,word$base);
end emitdecb;
emitline: procedure public;
/* write current line to emit file */
declare i byte;
if lineready then /* line is ready to write */
do;
if lineout then return; /* already written */
lineout = true;
if lblen = 0 then return;
/* non - zero line length */
call emitbyte(';');
call emittab;
i = 0;
do while (i:=i+1) < lblen;
call emitbyte(lbuff(i-1));
end;
call emitcrlf;
end;
end emitline;
emitchar: procedure(a) public;
/* emit literal string */
declare a address;
declare s based a byte;
do while s <> '$';
call emitbyte(s);
a = a + 1;
end;
end emitchar;
emitcharn: procedure(a,n) public;
declare
a address,
n byte;
/* emitchar(a), followed by number */
call emitchar(a);
call emitdecz(n,zsup$on,bsup$on,byte$base);
end emitcharn;
emitop: procedure(a) public;
/* tab, operator */
declare a address;
call emittab;
call emitchar(a);
end emitop;
emitoptab: procedure(a) public;
/* emit tab, operator, tab */
declare a address;
call emitop(a);
call emittab;
end emitoptab;
emitcomment: procedure(a) public;
declare a address;
do while ecolumn < comcol;
call emittab;
end;
call emitbyte(';');
call emitchar(a);
call emitcrlf;
end emitcomment;
emitdw: procedure public;
call emitoptab(.('dw$'));
end emitdw;
emitdb: procedure public;
call emitoptab(.('db$'));
end emitdb;
emitdwn: procedure(n) public;
declare n address;
call emitdw;
call emitdec16(n);
end emitdwn;
emitdbn: procedure(n) public;
declare n byte;
call emitdb;
call emitdec8(n);
end emitdbn;
emitdwnc: procedure(n,c) public;
declare (n,c) address;
call emitdwn(n);
call emitcomment(c);
end emitdwnc;
emitdbnc: procedure(n,c) public;
declare n byte, c address;
call emitdbn(n);
call emitcomment(c);
end emitdbnc;
end;


793
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GENCMD.PLM Normal file
View File

@@ -0,0 +1,793 @@
$title('GENCMD - Generate CMD File')
GENCMD:
DO;
/* CP/M 8086 CMD file generator
COPYRIGHT (C) 1981
DIGITAL RESEARCH
BOX 579 PACIFIC GROVE
CALIFORNIA 93950
*/
/* VAX Generation Commands
asm86 scd.a86
plm86 gencmd.plm xref pagewidth(100) optimize(3) debug
link86 scd.obj,gencmd.obj to gencmd.lnk
loc86 gencmd.lnk od(sm(code,dats,data,stack,const)) -
ad(sm(code(0))) ss(stack(+32))
h86 gencmd
then on a micro
vax gencmd $fans
gencmd gencmd data[bc5 m2b0 xff0]
Notes:
The 'const segment' is extended for interrupts and comes
last to force hex generation. The 'bc5' value is
derived from the file gencmd.mp2 which is generated
by LOC86.
*/
DECLARE
digital$code literally '0081h', /*DR code record */
digital$data literally '0082h', /* DR data record */
digital02 literally '0085h', /* DR 02 records */
paragraph literally '16',
ex literally '12', /* extent */
nr literally '32', /* current record */
maxb address external,
fcba(33) byte external, /* DEFAULT FILE CONTROL BLOCK */
buffa(128) byte external; /* DEFAULT BUFFER ADDRESS */
DECLARE COPYRIGHT(*) BYTE DATA
(' COPYRIGHT (C) 1981, DIGITAL RESEARCH ');
MON1: PROCEDURE(F,A) EXTERNAL;
DECLARE F BYTE, A ADDRESS;
END MON1;
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
DECLARE F BYTE, A ADDRESS;
END MON2;
DECLARE SP ADDRESS;
BOOT: PROCEDURE;
call mon1 (0,0);
END BOOT;
declare segmts(11) structure (name(5) byte,begin$add address)
initial ('CODE ',00h,'DATA ',0ffffh,'EXTRA',0ffffh,'STACK',0,
'X1 ',0,'X2 ',0,'X3 ',0,'X4 ',0,'8080 ',0,'NZERO',0,
'NHEAD',0);
declare header (15) structure
(typseg byte,file$length address,absolute$add address,
minimum$mem address,
maximum$mem address) initial (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
plmstart: PROCEDURE public;
DECLARE FCB (33) BYTE AT (.FCBA),
DFCBA LITERALLY 'FCBA';
DECLARE BUFFER (128) BYTE AT (.BUFFA),
DBUFF LITERALLY 'BUFFA';
DECLARE SFCB(33) BYTE, /* SOURCE FILE CONTROL BLOCK */
BSIZE LITERALLY '1024',
EOFILE LITERALLY '1AH',
SBUFF(BSIZE) BYTE, /* SOURCE FILE BUFFER */
RFLAG BYTE, /* READER FLAG */
SBP ADDRESS; /* SOURCE FILE BUFFER POINTER */
declare tbp address; /* pointer to command tail */
declare count$command$tail byte at (.buffa);
declare (t8080,nozero) byte;
DECLARE
TRUE LITERALLY '1',
FALSE LITERALLY '0',
FOREVER LITERALLY 'WHILE TRUE',
CR LITERALLY '13',
LF LITERALLY '10',
WHAT LITERALLY '63';
patch: procedure;
declare i byte;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
i = i + 0;
end patch;
PRINTCHAR: PROCEDURE(CHAR);
DECLARE CHAR BYTE;
CALL MON1(2,CHAR);
END PRINTCHAR;
CRLF: PROCEDURE;
CALL PRINTCHAR(CR);
CALL PRINTCHAR(LF);
END CRLF;
PRINTNIB: PROCEDURE(N);
DECLARE N BYTE;
IF N > 9 THEN CALL PRINTCHAR(N+'A'-10); ELSE
CALL PRINTCHAR(N+'0');
END PRINTNIB;
PRINTHEX: PROCEDURE(B);
DECLARE B BYTE;
CALL PRINTNIB(SHR(B,4)); CALL PRINTNIB(B AND 0FH);
END PRINTHEX;
PRINTADDR: PROCEDURE(A);
DECLARE A ADDRESS;
CALL PRINTHEX(HIGH(A)); CALL PRINTHEX(LOW(A));
END PRINTADDR;
PRINTM: PROCEDURE(A);
DECLARE A ADDRESS;
CALL MON1(9,A);
END PRINTM;
PRINT: PROCEDURE(A);
DECLARE A ADDRESS;
/* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
NEXT DOLLAR SIGN IS ENCOUNTERED WITH PRECEDING CRLF */
CALL CRLF;
CALL PRINTM(A);
END PRINT;
declare mbuffadr address,
LA ADDRESS; /* CURRENT LOAD ADDRESS */
declare head byte;
PERROR: PROCEDURE(A);
/* PRINT ERROR MESSAGE */
DECLARE A ADDRESS;
CALL PRINT(.('ERROR: $'));
CALL PRINTM(A);
CALL PRINTM(.(', LOAD ADDRESS $'));
CALL PRINTADDR(LA);
CALL BOOT;
END PERROR;
diskerror: procedure;
call perror(.('DISK WRITE$'));
end diskerror;
DECLARE DCNT BYTE;
setdma: procedure(a);
declare a address;
call mon1 (26,a);
end setdma;
OPEN: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(15,FCB);
END OPEN;
CLOSE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(16,FCB);
END CLOSE;
SEARCH: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(17,FCB);
END SEARCH;
SEARCHN: PROCEDURE;
DCNT = MON2(18,0);
END SEARCHN;
DELETE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
CALL MON1(19,FCB);
END DELETE;
DISKREAD: PROCEDURE(FCB) BYTE;
DECLARE FCB ADDRESS;
RETURN MON2(20,FCB);
END DISKREAD;
DISKWRITE: PROCEDURE(FCB) BYTE;
DECLARE FCB ADDRESS;
RETURN MON2(21,FCB);
END DISKWRITE;
MAKE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(22,FCB);
END MAKE;
RENAME: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
CALL MON1(23,FCB);
END RENAME;
MOVE: PROCEDURE(S,D,N);
DECLARE (S,D) ADDRESS, N BYTE,
A BASED S BYTE, B BASED D BYTE;
DO WHILE (N:=N-1) <> 255;
B = A; S=S+1; D=D+1;
END;
END MOVE;
declare char byte;
comline$error: procedure;
declare i byte;
call crlf;
do i = 1 to tbp;
call printchar (buffer(i));
end;
call printchar ('?');
call crlf;
call boot;
end comline$error;
retchar: procedure byte;
/* get another character from command tail */
if (tbp :=tbp+1) <= count$command$tail then
return buffer(tbp);
else return (0dh);
end retchar;
tran: procedure(b) byte;
declare b byte;
if b < ' ' then return 0dh; /* non-graphic */
if b - 'a' < ('z' - 'a') then
b = b and 101$1111b; /* upper case */
return b;
end tran;
next$non$blank: procedure;
char=tran(retchar);
do while char= ' ';
char= tran(retchar);
end;
end next$non$blank;
CHECK$ONE$HEX: PROCEDURE (h) BYTE;
/* READ ONE HEX CHARACTER FROM THE INPUT */
DECLARE H BYTE;
IF H - '0' <= 9 THEN RETURN H - '0';
IF H - 'A' > 5 THEN
return (0ffh);
RETURN H - 'A' + 10;
END CHECK$ONE$HEX;
MAKE$DOUBLE: PROCEDURE(H,L) ADDRESS;
/* CREATE A BOUBLE BYTE VALUE FROM TWO SINGLE BYTES */
DECLARE (H,L) BYTE;
RETURN SHL(DOUBLE(H),8) OR L;
END MAKE$DOUBLE;
delimiter: procedure byte; /* logical */
declare i byte;
declare del (*) byte data (0dh,'[], ');
do i = 0 to last(del);
if char = del(i) then return true;
end;
return false;
end delimiter;
get$num: procedure address;
declare paradd address;
paradd = 0;
char = retchar;
do while not delimiter ;
if (char:=check$one$hex(char)) = 0ffh then
call comline$error; else
paradd = paradd * 16 + char;
char = retchar;
end;
return paradd;
end get$num;
GETCHAR: PROCEDURE BYTE;
/* GET NEXT CHARACTER FROM DISK BUFFER */
DECLARE I BYTE;
IF (SBP := SBP+1) <= LAST(SBUFF) THEN
RETURN SBUFF(SBP);
/* OTHERWISE READ ANOTHER BUFFER FULL */
DO SBP = 0 TO LAST(SBUFF) BY 128;
IF (I:=DISKREAD(.SFCB)) = 0 THEN
CALL MOVE(.buffer,.SBUFF(SBP),80H); ELSE
DO;
IF I<>1 THEN CALL PERROR(.('DISK READ$'));
SBUFF(SBP) = EOFILE;
SBP = LAST(SBUFF);
END;
END;
SBP = 0; RETURN SBUFF(0);
END GETCHAR;
DECLARE
STACKPOINTER LITERALLY 'STACKPTR';
/* INTEL HEX FORMAT LOADER */
RELOC: PROCEDURE;
DECLARE (RL, CS, RT,K) BYTE;
declare multi$segments byte;
DECLARE
tabs address, /* temporary value */
TA ADDRESS, /* TEMP ADDRESS */
SA ADDRESS, /* START ADDRESS */
FA ADDRESS, /* FINAL ADDRESS */
NB ADDRESS, /* NUMBER OF BYTES LOADED */
nxb byte, /* next byte in stream */
segadjst address, /* segment adjust */
seg$length (8) address, /* length of each segment */
write$add address,
MBUFF based mbuffadr (256) BYTE,
P BYTE;
declare high$add address;
SETMEM: PROCEDURE(B);
/* set mbuff to b at location la */
DECLARE (B) BYTE;
if (.memory+la) > maxb then
do;
call print (.('INSUFFICIENT MEMORY TO CREATE CMD FILE $'));
call boot;
end;
MBUFF(LA) = B;
END SETMEM;
zero$mem: procedure;
do while (.memory +la) <maxb and not nozero;
mbuff(la) = 0;
la = la +1;
end;
end zero$mem;
DIAGNOSE: PROCEDURE;
DECLARE M BASED TA BYTE;
NEWLINE: PROCEDURE;
CALL CRLF; CALL PRINTADDR(TA); CALL PRINTCHAR(':');
CALL PRINTCHAR(' ');
END NEWLINE;
/* PRINT DIAGNOSTIC INFORMATION AT THE CONSOLE */
CALL PRINT(.('LOAD ADDRESS $')); CALL PRINTADDR(TA);
CALL PRINT(.('ERROR ADDRESS $')); CALL PRINTADDR(LA);
CALL PRINT(.('BYTES READ:$')); CALL NEWLINE;
DO WHILE TA < LA;
IF (LOW(TA) AND 0FH) = 0 THEN CALL NEWLINE;
CALL PRINTHEX(MBUFF(TA)); TA=TA+1;
CALL PRINTCHAR(' ');
END;
CALL CRLF;
CALL BOOT;
END DIAGNOSE;
write$record: procedure;
call setdma(write$add);
if diskwrite(.fcba) <> 0 then call diskerror;
p = p+1;
end write$record;
empty$buffers: procedure;
write$add = .memory;
do while write$add+127 <= (.memory+fa);
call write$record;
write$add = write$add+128;
end;
if not multi$segments then
do;
call write$record;
return;
end;
call move (write$add,.memory,(la:=.memory+fa+1-write$add));
end empty$buffers;
READHEX: PROCEDURE BYTE;
/* READ ONE HEX CHARACTER FROM THE INPUT */
declare khex byte;
if (khex := check$one$hex(getchar)) <> 0ffh then return khex;
else
DO; CALL PRINT(.('INVALID HEX DIGIT$'));
CALL DIAGNOSE;
end;
end readhex;
READBYTE: PROCEDURE BYTE;
/* READ TWO HEX DIGITS */
RETURN SHL(READHEX,4) OR READHEX;
END READBYTE;
READCS: PROCEDURE BYTE;
/* READ BYTE WHILE COMPUTING CHECKSUM */
DECLARE B BYTE;
CS = CS + (B := READBYTE);
RETURN B;
END READCS;
hex$input: procedure;
if rt = 2 or rt > 84h then
segadjst = shl(make$double(readcs,readcs),4); else
do;
/* PROCESS EACH BYTE */
DO WHILE (RL := RL - 1) <> 255;
CALL SETMEM(READCS); LA = LA+1;
END;
IF LA > FA THEN FA = LA - 1;
end;
/* NOW READ CHECKSUM AND COMPARE */
IF CS + READBYTE <> 0 THEN
DO; CALL PRINT(.('CHECK SUM ERROR $'));
CALL DIAGNOSE;
END;
end hex$input;
get$buffer$len: procedure;
multi$segments = true;
if rt = 84h then rt = 83h;
else if rt = 83h then rt = 84h;
if seg$length (rt-81h) < (high$add:=la+rl-1) then
do;
seg$length (rt-81h) = high$add;
header(rt-81h).typseg = rt-80h;
end;
end get$buffer$len;
/* INITIALIZE */
SA, FA, NB = 0;
P = 0; /* PARAGRAPH COUNT */
SBUFF(0) = EOFILE;
fcb(nr) = 0;
if head then fcb(nr) = 1;
multi$segments = false;
segadjst = 0;
do k= 0 to 7;
seglength(k) = 0;
end;
call zero$mem;
ta=0;
la=1;
/* READ RECORDS UNTIL :00XXXX IS ENCOUNTERED */
DO FOREVER;
/* SCAN THE : */
DO WHILE (nxb:=getchar) <> ':';
if nxb = eofile then go to second;
/* MAY BE THE END OF TAPE */
END;
/* SET CHECK SUM TO ZERO, AND SAVE THE RECORD LENGTH */
CS = 0;
nb = nb +(rl:=readcs);
TA, LA = MAKE$DOUBLE(READCS,READCS) + segadjst;
IF SA = 0 THEN SA = LA;
/* READ THE RECORD TYPE */
/* skip all records except type 0 2 81 */
if (rt:=readcs) > digital$code and rt < digital02 then
do;
if not t8080 then
call get$buffer$len; else
call hex$input;
end; else
do;
if (rt = digital$code) then
do;
call hex$input;
header(0).typseg = 1;
end; else
do;
if (rt = 0 and la < segmts(1).begin$add and la >= segmts(0).begin$add)
or rt = 2 then
do;
la = la-segmts(0).begin$add;
call hex$input;
header(0).typseg = 1;
end;
if (rt = 0 and la >= segmts(1).begin$add) then
do;
multi$segments = true;
if seg$length(1) <
(high$add:=la+rl-segmts(1).begin$add-1) then
do;
seg$length(1) = high$add;
header(1).typseg=2;
end;
end;
end;
end;
end;
second:
call empty$buffers;
ta = (la+paragraph-1) and 0fff0h;
header(0).file$length=fa/16+1;
if header(0).minimum$mem = 0 then header(0).minimum$mem = fa/16+1;
fa=ta;
if not multi$segments then go to fin;
call zero$mem;
multi$segments = false;
sfcb(ex),sfcb(nr) = 0;
call open(.sfcb);
call setdma(.buffer);
do k = 1 to 7;
if seg$length(k) <> 0 then
do;
seg$length(k) = seg$length(k)+paragraph and 0fff0h;
header(k).file$length = seg$length(k)/16;
if header(k).minimum$mem=0 then
header(k).minimum$mem=seg$length(k)/16;
end;
end;
segadjst = 0;
seg$length(0) = ta;
sbp=length(sbuff);
DO FOREVER;
/* SCAN THE : */
DO WHILE (nxb:=getchar) <> ':';
if nxb = eofile then go to afin;
END;
cs = 0;
rl = readcs;
la = segadjst+make$double(readcs,readcs);
if (rt := readcs) = eofile then go to afin;
if rt = 84h then rt = 83h;
else if rt = 83h then rt = 84h;
if rt > digital$code and rt < digital02 then
do;
do k = 0 to (rt-82h);
la = la + seg$length(k);
end;
call hex$input;
end;
if (rt = 0 and la > segmts(1).begin$add) or rt = 2 then
do;
la = la - segmts(1).begin$add + seg$length(0);
call hex$input;
end;
END;
afin:
call empty$buffers;
FIN:
/* PRINT FINAL STATISTICS */
CALL PRINT(.('BYTES READ $')); CALL PRINTADDR(NB);
CALL PRINT(.('RECORDS WRITTEN $')); CALL PRINTHEX(P+1);
CALL CRLF;
/* write the header record */
call close(.fcba);
if head then
do;
fcb(ex),fcb(nr) = 0;
call open(.fcba);
call move (.header,.buffer,128);
call setdma(.buffer);
if diskwrite(.fcba) <> 0 then call diskerror;
end;
END RELOC;
declare seg$number byte;
ignore$filename: procedure;
tbp = 0;
char = buffer(tbp);
call next$non$blank;
do while (char:=buffer(tbp)) <> ' ';
tbp = tbp +1;
end;
end ignore$filename;
parse$tail: procedure;
declare seg$index byte;
get$segmt: procedure byte;
/* get the segment name */
declare ( kentry, match$flag,j, no$match) byte;
declare user$segmt(5) byte;
do j = 0 to last (user$segmt);
if delimiter then
user$segmt(j) = ' '; else
do;
user$segmt(j) = char;
char = tran(retchar);
end;
end;
seg$index = 0;
no$match, matchflag = true;
do while no$match and seg$index < 11;
match$flag=true;
kentry = 0;
do while match$flag and kentry <= last (segmts.name);
if usersegmt(kentry) <> segmts(seg$index).name(kentry) then
matchflag = false; else
kentry = kentry +1;
end;
if matchflag then no$match = false; else
seg$index = seg$index +1;
end;
if no$match then seg$index = 0ffh;
return seg$index;
end get$segmt;
get$switches: procedure;
do while char <> ']' and char <> cr;
call next$non$blank;
if char= 'A' then header(seg$index).absolute$add = (get$num);
else if
char= 'M' then
do;
header(seg$index).minimum$mem = (get$num);
header(seg$index).typseg = seg$index+1;
end;
else if
char= 'X' then header(seg$index).maximum$mem = (get$num);
else if
char= 'B' then segmts(seg$index).begin$add = (get$num*16);
else do;
call comline$error;
call boot;
end ;
end;
end get$switches;
do forever;
call next$non$blank;
if char = cr then return;
if get$segmt = 0ffh then
do;
call comline$error;
call boot;
end;
if seg$index < 8 then call get$switches; else
do;
if seg$index = 8 then t8080 = true; else
do;
if seg$index = 9 then nozero = true; else
head = false;
end;
end;
end;
end parse$tail;
/* ARRIVE HERE FROM THE SYSTEM MONITOR, READY TO READ THE HEX TAPE */
/* SET UP STACKPOINTER IN THE LOCAL AREA */
DECLARE STACK(64) ADDRESS;
SP = STACKPOINTER; STACKPOINTER = .STACK(LENGTH(STACK));
LA = 0h;
mbuffadr = .memory;
t8080 = false;
nozero = false;
head = true;
SBP = LENGTH(SBUFF);
/* SET UP THE SOURCE FILE */
CALL MOVE(.FCBA,.SFCB,33);
CALL MOVE(.('H86',0),.SFCB(9),4);
CALL OPEN(.SFCB);
IF DCNT = 255 THEN CALL PERROR(.('CANNOT OPEN SOURCE$'));
CALL MOVE(.('CMD'),.FCBA+9,3);
/* REMOVE ANY EXISTING FILE BY THIS NAME */
CALL DELETE(.FCBA);
/* THEN OPEN A NEW FILE */
CALL MAKE(.FCBA); CALL OPEN(.FCBA);
IF DCNT = 255 THEN CALL PERROR(.('NO MORE DIRECTORY SPACE$')); ELSE
DO;
call ignore$filename;
call parse$tail;
CALL RELOC;
CALL CLOSE(.FCBA);
IF DCNT = 255 THEN CALL PERROR(.('CANNOT CLOSE FILE$'));
END;
CALL CRLF;
CALL BOOT;
END plmstart;
END;


11
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GENDEF.CPM Normal file
View File

@@ -0,0 +1,11 @@
set verify
set def [frank.mpm86.sepcd]
$ plm86 gendef.plm 'p1' 'p3' 'p4' optimize(3) debug
$ plm86 gtoken.plm 'p1' 'p3' 'p4' optimize(3) debug
$ plm86 gscan.plm 'p1' 'p3' 'p4' optimize(3) debug
$ plm86 gemit.plm 'p1' 'p3' 'p4' optimize(3) debug
$ link86 scd.obj, gendef.obj, gtoken.obj, gscan.obj, gemit.obj to gendef.lnk
$ loc86 gendef.lnk od(sm(code,dats,data,stack,const)) -
ad(sm(code(0))) ss(stack(+32))
$ h86 gendef


838
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GENDEF.PLM Normal file
View File

@@ -0,0 +1,838 @@
$title ('GENDEF - Library Generator for DISKDEF')
gd:
do;
/* l i b r a r y g e n e r a t o r f o r D I S K D E F */
$include(copyrt.lit)
/* Generation Procedure on VAX
asm86 scd.a86
plm86 gendef.plm debug xref optimize(3) date(10/5/81) pagewidth(100)
plm86 gscan.plm debug xref optimize(3) date(10/5/81) pagewidth(100)
plm86 emit.plm debug xref optimize(3) date(10/5/81) pagewidth(100)
plm86 token.plm debug xref optimize(3) date(10/5/81) pagewidth(100)
link86 scd.obj,gendef.obj,gscan.obj,emit.obj,token.obj -
to gendef.lnk
loc86 gendef.mod od(sm(code,dats,data,stack,const)) -
ad(sm(code(0h))) ss(stack(+32))
h86 gendef
Then on a micro
vax gendef $fans
gencmd gendef data[b17c]
notes:
b17c is derived from module map in the GENDEF.MP2 file generated
by LOC86. The 'CONST segment' is located last to force hex
generation. Stack is extended to insure against interrupts on
MP/M-86.
*/
$include (:f1:glit.plb)
declare
true lit '1',
false lit '0',
forever lit 'while true',
cr lit '0dh',
tab lit '09h';
/* global procedures */
boot: procedure external;
end boot;
printchar: procedure(c) external;
declare c byte;
end printchar;
print: procedure(a) external;
declare a address;
end print;
crlf: procedure external;
end crlf;
abort: procedure(msg) external;
declare msg address;
end abort;
scan: procedure external;
end scan;
scan$ini: procedure external;
end scan$ini;
setup: procedure external;
/* set up the input file on each pass */
end setup;
putline: procedure external;
end putline;
writerrs: procedure external;
end writerrs;
errptr: procedure(msg) external;
declare msg address;
end errptr;
/* code emitters */
emitbyte: procedure(b) external;
declare b byte;
end emitbyte;
emitcrlf: procedure external;
end emitcrlf;
emitoptab: procedure(a) external;
declare a address;
end emitoptab;
emitcomma: procedure external;
end emitcomma;
emitaddr: procedure(a) external;
declare a address;
end emitaddr;
emitchar: procedure(a) external;
declare a address;
end emitchar;
emitline: procedure external;
end emitline;
emitcharn: procedure(a,n) external;
declare a address, n byte;
/* symbol, followed by two digit n */
end emitcharn;
emitcomment: procedure(a) external;
declare a address;
end emitcomment;
emitdec8: procedure(b) external;
declare b byte;
end emitdec8;
emitdec16: procedure(w) external;
declare w address;
end emitdec16;
emitdecb: procedure(w) external;
declare w address;
end emitdecb;
emitdw: procedure external;
end emitdw;
emitdb: procedure external;
end emitdb;
emitdwn: procedure(n) external;
declare n address;
end emitdwn;
emitdbn: procedure(n) external;
declare n byte;
end emitdbn;
emitdwnc: procedure(n,c) external;
declare (n,c) address;
end emitdwnc;
emitdbnc: procedure(n,c) external;
declare n byte, c address;
end emitdbnc;
efinis: procedure external;
end efinis;
emittab: procedure external;
end emittab;
emitnulcom: procedure external;
end emitnulcom;
/* global variables */
declare
parm (26) byte external,
comm$tog byte at (.parm(2)), /* disk comment */
off$tog byte at (.parm(14)), /* generate 'offset' */
scan$tog byte at (.parm(18)), /* scanner trace */
z80$tog byte at (.parm(25)); /* z80, 8080, 8085 mode */
declare
errset byte external,
eofset byte external,
cbuff(8) byte external,
value address external,
nextc byte external,
token byte external,
continue byte external,
acclen byte external,
accum(32) byte external;
/* code emitters */
setemit: procedure external;
end setemit;
prnib: procedure(d);
declare d byte;
/* print nibble d */
if d > 9 then
d = 'A' + d - 10; else
d = d + '0';
call printchar(d);
end prnib;
prhex: procedure(h);
declare h byte;
call prnib(shr(h,4));
call prnib(h and 0fh);
end prhex;
praddr: procedure(a);
declare a address;
call prhex(high(a));
call prhex(low(a));
end praddr;
prdig: procedure(d);
declare d byte;
/* print the decimal number given by d */
call printchar('0'+d);
end prdig;
prdec: procedure(b);
declare b byte;
/* print the decimal value of b */
call prdig(b/100);
call prdig(b/10 mod 10);
call prdig(b mod 10);
end prdec;
/* trace functions */
declare
ident lit '1',
number lit '2',
string lit '3',
special lit '4';
trace: procedure(msga);
declare
msga address,
(i,c) byte;
if scan$tog then
do;
call putline;
call print(msga);
call printchar(',');
do i = 1 to acclen;
if (c:=accum(i-1)) < ' ' then
do;
call printchar('#');
call prhex(c);
end; else
call printchar(c);
end;
call printchar(':');
call prdec(token);
if token = number then
do;
call printchar(',');
call praddr(value);
call printchar('H');
end;
if eofset then
call print(.('End-File$'));
end;
end trace;
/* parsing procedures for non terminals */
bypass: procedure(x) byte;
declare x byte;
if token = x then
do;
call scan;
return true;
end;
return false;
end bypass;
declare eltinx byte; /* index into set when 'element' returns true */
element: procedure(list) byte;
declare list address; /* address of set to search */
/* element searches for the current token in the set of
tokens addressed by 'list' and returns true if item is
found. as a side-effect, 'eltinx' is set to the item's index */
declare set based list (1) byte, x byte;
eltinx = -1;
do forever;
if (x := set(eltinx:=eltinx+1)) = 0 then return false;
if token = x then return true;
end;
end element;
endline: procedure byte;
/* return true if end of line or file */
return (token = cr) or eofset;
end endline;
recover: procedure;
do while not endline;
call scan;
end;
end recover;
emitdollar: procedure;
if not z80$tog then
call emitchar(.('offset $'));
call emitbyte('$');
end emitdollar;
declare
/* diskdef parameter values */
maxdisks lit '16',
ndisks byte, /* number of disks */
diskset (maxdisks) byte; /* true if included in diskdef */
disks: procedure;
/* handle the disks n macro */
declare i byte;
if ndisks > 0 then
ndisks = 0; else
if token = number then
ndisks = value; else
ndisks = 0;
if ndisks = 0 or ndisks > maxdisks then
call errptr(.('bad val$'));
call scan;
/* dpbase equ $ */
call emitchar(.('dpbase$'));
call emitoptab(.('equ$'));
if off$tog then
call emitdollar; else
call emitbyte('$');
call emitcomment(.('Base of Disk Parameter Blocks$'));
do i = 1 to ndisks;
/* dpe00: dw xlt00,0000h */
call emitcharn(.('dpe$'),i-1);
if z80$tog then
call emitbyte(':');
call emitdw;
call emitcharn(.('xlt$'),i-1);
call emitcomma;
call emitaddr(0);
call emitcomment(.('Translate Table$'));
/* dw 0000h,0000h */
call emitdw;
call emitaddr(0);
call emitcomma;
call emitaddr(0);
call emitcomment(.('Scratch Area$'));
/* dw dirbuf,dpb00 */
call emitdw;
call emitchar(.('dirbuf,$'));
call emitcharn(.('dpb$'),i-1);
call emitcomment(.('Dir Buff, Parm Block$'));
/* dw csv00,alv00 */
call emitdw;
call emitcharn(.('csv$'),i-1);
call emitcomma;
call emitcharn(.('alv$'),i-1);
call emitcomment(.('Check, Alloc Vectors$'));
end;
end disks;
declare
npar lit '11',
rpar lit '9', /* no. of required parms */
dn lit '0', /* disk number */
fsc lit '1', /* first sector */
lsc lit '2', /* last sector */
skf lit '3', /* skew factor */
bls lit '4', /* block size */
dks lit '5', /* disk size */
dir lit '6', /* directory size */
cks lit '7', /* check sum size */
ofs lit '8', /* offset tracks */
com lit '9', /* CP/M 1.4 compatibility flag */
prm lit '10'; /* permanent disk drive */
declare
lower (*) address data
/* dn fsc lsc skf bls */
(0000, 0000, 0001, 0000, 1024,
/* dks dir cks ofs com */
0001, 0001, 0000, 0000, 0000,
/* prm */
0000),
upper (*) address data
/* dn fsc lsc skf bls */
(0015, 0015, 65535, 0255, 16384,
/* dks dir cks ofs com */
65535, 65534, 65534, 65535, 0000,
/* prm */
0000),
optional (*) byte data
/* dn fsc lsc skf bls */
(false, false, false, true, false,
/* dks dir cks ofs com */
false, false, false, false, true,
/* prm */
true);
declare
dsmax (*) address data
/* value of bls */
/* 1024 2048 4096 8192 16384 */
( 8192, 4096, 2048, 1024, 512 );
declare
bsh (*) byte data
/* 1024 2048 4096 8192 16384 */
( 3, 4, 5, 6, 7 ),
blm (*) byte data
/* 1024 2048 4096 8192 16384 */
( 7, 15, 31, 63, 127 ),
dsm (*) byte data
/* 1024 2048 4096 8192 16384 */
( 0, 1, 3, 7, 15 );
declare
ddir (*) address data
/* 1024 2048 4096 8192 16384 */
( 32, 64, 128, 256, 512 );
range: procedure;
call errptr(.('range $'));
end range;
diskdef: procedure;
/* handle diskdef, first item scanned */
declare
pv (npar) address,
parmissing (npar) byte,
(pc, i) byte,
(d, v) address;
declare
sectors address,
(nxtsec, nxtbas, neltst, nelts) address;
gcd: procedure(m,n) address;
declare (m,n,r) address;
do forever;
r = m mod n;
if r = 0 then
return n;
m = n;
n = r;
end;
end gcd;
equiv: procedure(a,b);
declare (a,b) address;
/* dpb1 equ dpb0 */
call emitcharn(a,pv(0));
call emitoptab(.('equ$'));
call emitcharn(a,pv(1));
call emitcomment(b);
end equiv;
comment: procedure(v,a);
declare (v, a) address;
/* write diskdef comment line */
call emitbyte(';');
call emittab;
call emitdecb(v);
call emitbyte(':');
call emittab;
call emitchar(a);
call emitcrlf;
end comment;
do i = 0 to last(parmissing);
parmissing(i) = true;
end;
pc = 0;
token = ',';
do while not (endline or pc = npar);
call trace(.(' diskparm$'));
pv(pc) = 0;
if not bypass(',') then
call errptr(.('delimit$')); else
if (parmissing (pc) :=
(token = cr or token = ',')) then
do;
if not optional(pc) then
call errptr(.('missing$'));
end; else
do;
if token <> number then
call errptr(.('numeric$')); else
do;
/* numeric value, check range */
if value < lower(pc) or
value > upper(pc) then
call range; else
/* make special range checks */
if pc = dn then
do;
if diskset(value) then
call errptr(.('duplic $'));
diskset(value) = true;
end; else
if pc = lsc and value <= pv(fsc) then
call range; else
if pc = skf and
value > (pv(lsc) - pv(fsc)) then
call range; else
if pc = bls then
do;
if value = 1024 then value = 0; else
if value = 2048 then value = 1; else
if value = 4096 then value = 2; else
if value = 8192 then value = 3; else
if value = 16384 then value = 4; else
call range;
end; else
if pc = dks then
do;
if value > 256 and pv(bls) = 0 then
call range; else
if value > dsmax(pv(bls)) then
call range;
end; else
if pc = dir then
do;
if (value and 11b) <> 0 then
call range; else
do;
/* compute alloc vector */
v = 0;
d = value;
/* loop until zero or negative */
do while not rol(high(d-1),1);
d = d - ddir(pv(bls));
if low(v) then
do;
call errptr(.('Alloc $'));
d = 0;
end; else
v = shr(v,1) or 8000h;
end;
end;
end; else
if pc = cks and ((value and 11b) <> 0 or
value > pv(dir)) then
call range;
if pc = prm and pv(cks) > 0 then
call errptr(.('conflict$'));
pv(pc) = value;
end;
call scan;
end;
if errset then
return;
pc = pc + 1;
end;
/* check for abbreviated form */
if not endline then
return;
if pc = 2 then
do;
if not diskset(pv(1)) then
call errptr(.('no disk$'));
if comm$tog then
do;
call emitnulcom;
call emitbyte(';');
call emittab;
call emitchar(.('Disk $'));
call emitdec8(pv(0));
call emitchar(.(' is the same as Disk $'));
call emitdec8(pv(1));
call emitcrlf;
call emitnulcom;
end;
call equiv(.('dpb$'),.('Equivalent Parameters$'));
call equiv(.('als$'),.('Same Allocation Vector Size$'));
call equiv(.('css$'),.('Same Checksum Vector Size$'));
call equiv(.('xlt$'),.('Same Translate Table$'));
return;
end; else
if pc < rpar then
do;
call errptr(.('too few$'));
return;
end;
/* write general disk statistics */
sectors = pv(lsc) - pv(fsc) + 1;
if pv(skf) = 0 then parmissing(skf) = true;
if comm$tog then
do;
/* ;<crlf>;<tab>Disk 000 is CP/M 1.4 Single(/Double) .. */
call emitnulcom;
if not parmissing(com) then
do;
call emitbyte(';');
call emittab;
call emitchar(.('Disk $'));
call emitdec8(pv(dn));
call emitchar(
.(' is CP/M 1.4 Double Density Compatible$'));
call emitcrlf;
end;
/* pv(dks) * 8/16/32/64/128 for 1k/2k/4k/8k/16k */
d = pv (dks) * shl(100b,pv(bls)+1);
call emitbyte(';');
call emittab;
if d > 0 then
call emitdecb(d); else
call emitchar(.('65536$'));
call emitbyte(':');
call emittab;
call emitchar(.('128 Byte Record Capacity$'));
call emitcrlf;
/* pv(dks) * 1k/2k/4k/8k/16k */
d = 1;
if pv(bls) > 0 then
d = shl(d,pv(bls));
call comment(pv(dks) * d,.('Kilobyte Drive Capacity$'));
call comment(pv(dir),.('32 Byte Directory Entries$'));
call comment(pv(cks),.('Checked Directory Entries$'));
if not parmissing(com) then
d = 128; else
do;
/* extents are folded */
if pv(dks) > 256 then
d = 32; else d = 64;
d = shl(d,pv(bls)+1);
end;
call comment(d,.('Records / Extent$'));
call comment(shl(100b,pv(bls)+1),
.('Records / Block$'));
call comment(sectors,.('Sectors / Track$'));
call comment(pv(ofs),.('Reserved Tracks$'));
if not parmissing(skf) then
call comment(pv(skf),.('Sector Skew Factor$'));
call emitnulcom;
end;
/* dpb0 equ $ */
call emitcharn(.('dpb$'),pv(dn));
call emitoptab(.('equ$'));
call emitdollar;
call emitcomment(.('Disk Parameter Block$'));
call emitdwnc(sectors,
.('Sectors Per Track$'));
call emitdbnc(bsh(pv(bls)),
.('Block Shift$'));
call emitdbnc(blm(pv(bls)),
.('Block Mask$'));
i = pv(bls);
if pv(dks) > 256 then
i = i - 1;
if parmissing(com) then
call emitdbnc(dsm(i),.('Extnt Mask$')); else
call emitdbnc(pv(com),.('1.4 Compatible$'));
call emitdwnc(pv(dks)-1,.('Disk Size - 1$'));
call emitdwnc(pv(dir)-1,.('Directory Max$'));
/* compute allocation vector initialization */
call emitdbnc(high(v),.('Alloc0$'));
call emitdbnc(low(v),.('Alloc1$'));
if parmissing(prm) then
call emitdwnc(pv(cks)/4,.('Check Size$')); else
call emitdwnc(8000h,.('Permanent Disk$'));
call emitdwnc(pv(ofs),.('Offset$'));
/* generate allocation vector */
call emitcharn(.('xlt$'),pv(dn));
call emitoptab(.('equ$'));
if parmissing(skf) then
do;
call emitdec8(0);
call emitcomment(.('No Translate Table$'));
end; else
do;
call emitdollar;
call emitcomment(.('Translate Table$'));
nxtsec, nxtbas = 0;
neltst = sectors/gcd(sectors,pv(skf));
nelts = neltst;
do d = 0 to sectors-1;
if d mod 4 <> 0 then
call emitcomma; else
do;
if d > 0 then
call emitcrlf;
if sectors < 256 then
call emitdb; else
call emitdw;
end;
call emitdec16(nxtsec+pv(fsc));
nxtsec = nxtsec + pv(skf);
if nxtsec >= sectors then
nxtsec = nxtsec - sectors;
if (nelts := nelts - 1) = 0 then
do;
nxtsec = (nxtbas := nxtbas + 1);
nelts = neltst;
end;
end;
call emitcrlf;
end;
/* generate allocation vector size */
call emitcharn(.('als$'),pv(dn));
call emitoptab(.('equ$'));
d = pv(dks)/8;
if pv(dks) mod 8 <> 0 then
d = d + 1;
call emitdec16(d);
call emitcomment(.('Allocation Vector Size$'));
/* generate checksum vector size */
call emitcharn(.('css$'),pv(dn));
call emitoptab(.('equ$'));
call emitdec16(pv(cks)/4);
call emitcomment(.('Check Vector Size$'));
end diskdef;
endef: procedure;
/* generate end of disk def code */
declare i byte;
reserve: procedure;
if z80$tog then
/* $z set for z80, 8080, or 8085 */
call emitoptab(.('ds$')); else
call emitoptab(.('rs$'));
end reserve;
call emitnulcom;
call emitbyte(';');
call emittab;
call emitchar(.('Uninitialized Scratch Memory Follows:$'));
call emitcrlf;
call emitnulcom;
/* begdat equ $ */
call emitchar(.('begdat$'));
call emitoptab(.('equ$'));
call emitdollar;
call emitcomment(.('Start of Scratch Area$'));
/* dirbuf: ds/rs 128 */
call emitchar(.('dirbuf$'));
if z80$tog then
call emitbyte(':');
call reserve;
call emitdec8(128);
call emitcomment(.('Directory Buffer$'));
/* alv0: ds als0, csv0: ds css0 */
do i = 0 to last(diskset);
if diskset(i) then
do;
call emitcharn(.('alv$'),i);
if z80$tog then
call emitbyte(':');
call reserve;
call emitcharn(.('als$'),i);
call emitcomment(.('Alloc Vector$'));
call emitcharn(.('csv$'),i);
if z80$tog then
call emitbyte(':');
call reserve;
call emitcharn(.('css$'),i);
call emitcomment(.('Check Vector$'));
end;
end;
/* enddat equ $, datsiz equ $-begdat */
call emitchar(.('enddat$'));
call emitoptab(.('equ$'));
call emitdollar;
call emitcomment(.('End of Scratch Area$'));
call emitchar(.('datsiz$'));
call emitoptab(.('equ$'));
call emitdollar;
call emitchar(.('-begdat$'));
call emitcomment(.('Size of Scratch Area$'));
call emitdbnc(0,.('Marks End of Module$'));
end endef;
program: procedure;
/* handle the entire genlib program */
declare
i byte;
do i = 0 to last(diskset);
diskset(i) = false;
end;
ndisks = 0;
do while not eofset;
errset = false;
call scan;
call emitline;
call trace(.('program$'));
if token <> cr then
if not element(.(
tmaclib,
tdisks,
tdiskdef,
tendef,
0)) then
call errptr(.('No Stmt$')); else
do;
do case eltinx;
/* maclib */
do;
call scan;
call trace(.(' maclib$'));
call scan;
call trace(.(' macpar$'));
end;
/* disks */
do;
call scan;
call trace(.(' disks$'));
call disks;
end;
/* diskdef (10 parameters) */
do;
call trace(.(' diskdef$'));
call diskdef;
end;
/* endef */
do;
call scan;
call endef;
end;
end;
if token <> cr then
call errptr(.('extra $'));
end;
call recover;
end;
end program;
plmstart: procedure public;
/* main program, called from transient interface */
call setemit; /* setup the code emitters */
call scan$ini; /* initialize the scanner */
call setup; /* set up the input file */
call program;
call writerrs;
call efinis; /* close the code file */
call boot;
end plmstart;
end;


31
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GLIT.PLB Normal file
View File

@@ -0,0 +1,31 @@
/* literal declarations for basic tokens */
declare
lit literally 'literally',
tiden lit '01', tnumb lit '02', tstrng lit '03', tspecl lit '04',
/* token# is the base token number for each set of tokens */
token2 lit '140', token3 lit '160', token4 lit '180',
token5 lit '200', token6 lit '210', token7 lit '220',
token8 lit '230',
tokenm lit '7',
/* single character tokens ! " # $ % & ( ) * + , - * / : ; < = > ?
are all represented by their ascii values */
/* special two character sequences (started by single character) */
/* two character tokens: */
/* three character tokens: */
/* four character tokens: */
/* five character tokens: */
tdisks lit '200', tendef lit '201',
/* six character tokens: */
tmaclib lit '210',
/* seven character tokens: */
tdiskdef lit '220';


72
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GPAS.PLB Normal file
View File

@@ -0,0 +1,72 @@
declare
true literally '1',
false literally '0',
forever literally 'while true',
cr literally '13',
lf literally '10';
printchar: procedure(char) public;
declare char byte;
call mon1(2,char);
end printchar;
crlf: procedure public;
call printchar(cr);
call printchar(lf);
end crlf;
printn: procedure(a) public;
declare a address;
call mon1(9,a);
end printn;
print: procedure(a) public;
declare a address;
/* print the string starting at address a until the
next dollar sign is encountered */
call crlf;
call printn(a);
end print;
declare dcnt byte public;
open: procedure(fcb) public;
declare fcb address;
dcnt = mon2(15,fcb);
end open;
close: procedure(fcb) public;
declare fcb address;
dcnt = mon2(16,fcb);
end close;
delete: procedure(fcb) public;
declare fcb address;
call mon1(19,fcb);
end delete;
diskread: procedure(fcb) byte public;
declare fcb address;
return mon2(20,fcb);
end diskread;
diskwrite: procedure(fcb) byte public;
declare fcb address;
return mon2(21,fcb);
end diskwrite;
make: procedure(fcb) public;
declare fcb address;
dcnt = mon2(22,fcb);
end make;
rename: procedure(fcb) public;
declare fcb address;
call mon1(23,fcb);
end rename;
setdma: procedure(dma) public;
declare dma address;
call mon1(26,dma);
end setdma;


424
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GSCAN.PLM Normal file
View File

@@ -0,0 +1,424 @@
$title('SCAN module for GENDEF')
scanmod:
do;
/* D I S K D E F l i b s c a n n e r m o d u l e */
declare
major literally '''1''', /* major release number */
minor literally '''0'''; /* minor release number */
declare
parm (26) byte public; /* initial parameters */
/* a b c d e f g h i j k l m n o p q r s t u v w x y z
0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2
0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 */
declare
defbuf literally '0080h'; /* default buffer */
mon1: procedure(f,a) external;
declare f byte, a address;
end mon1;
mon2: procedure(f,a) byte external;
declare f byte, a address;
end mon2;
boot: procedure external;
end boot;
$include (:f1:gpas.plb)
/* file control blocks */
declare
fcb (16) byte external,
fcb16 (16) byte external,
parms (8) byte at (.fcb16(1)), /* $ parameters */
ifcb (33) byte at (.fcb), /* default input fcb */
ifcbr byte at (.fcb(32)); /* record to read next */
/* buffers */
declare
dbuff (512) byte, /* disk input buffer 128 * 4 */
dbp address, /* disk buffer pointer */
lbuff(75) byte public, /* 80 character line (5 char prefix) */
lbp byte, /* line buffer pointer */
lblen byte public, /* line buffer length */
lineout byte public, /* true if line out to .asm file */
lineready byte public; /* true if line is prepared for output */
declare
errset byte public, /* true if error already flagged */
eofset byte public, /* true if eof encountered */
cbuff (8) byte public;
/* miscellaneous non graphic characters */
declare
lit literally 'literally',
eofile lit '1ah', /* ascii end of file */
eject lit '0ch', /* page eject for title */
tab lit '09h'; /* horizontal tab */
/* code emitters for inline mode */
emitbyte: procedure(b) external;
declare b byte;
end emitbyte;
emitcrlf: procedure external;
end emitcrlf;
declare
title (*) byte data
(eject,' DISKDEF Table Generator, Vers ',major,'.',minor,
cr,lf,'$');
/* error message */
declare
/* the first positions are counted up in the errptr subroutine */
errmsg (17) byte initial(' Error(s)$');
abort: procedure(msg) public;
/* print message and reboot */
declare msg address;
call crlf;
call print(msg);
call boot;
end abort;
gnd: procedure byte;
/* get next disk character */
checkeof: procedure byte;
/* check for end of file before returning */
declare c byte;
if (c := dbuff(dbp)) = eofile then eofset = true;
return c;
end checkeof;
if eofset then return eofile;
if (dbp := dbp + 1) <= last(dbuff) then return checkeof;
/* otherwise, read buffers to dbuff */
dbp = 0;
do while dbp < length(dbuff);
call setdma(.dbuff(dbp));
if diskread(.ifcb) <> 0 then /* end of file */
do; dbuff(dbp) = eofile; dbp = length(dbuff);
end;
else /* disk read was successful */
dbp = dbp + 128;
end;
dbp = 0;
return checkeof;
end gnd;
incline: procedure(buffa);
declare buffa address;
/* increment line number in buff */
declare buff based buffa (4) byte;
declare (i,c) byte;
i = 4;
do while (i := i - 1) <> 255;
if (c := buff(i)) = ' ' then c = '0';
if (buff(i) := c + 1) > '9' then
buff(i) = '0'; else i = 0;
end;
end incline;
putline: procedure public;
/* print the current line */
declare i byte;
if lineready then /* line has not yet been sent */
do;
call print(.cbuff); /* 7 character prefix */
if lblen > 0 then
do i = 0 to lblen-1;
call printchar(lbuff(i));
end;
end;
lineready = false; /* marked as sent */
end putline;
getline: procedure;
/* read next line and place into lbuff */
declare char byte;
putchar: procedure(c);
declare c byte;
if lbp+1 < length(lbuff) then
do; lbuff(lbp:=lbp+1) = c;
end;
end putchar;
/* read line until overflow or lf or eofile */
call putline;
lbp = -1; lblen = 0;
if (char := gnd) <> eofile then
do; call incline(.cbuff);
do while not (char = lf or char = eofile);
if char = cr then call putchar(cr); else
if char = tab then /* expand to next tab position */
do; call putchar(' ');
do while ((lbp + 1) and 111b) <> 0;
call putchar(' '); /* tabs at every 8 columns */
end;
end; else
if char >= ' ' then /* graphic */
do; /* convert lower to upper case alphabetics */
if char <> 7fh then /* not a delete character */
do; if (char - 'a') < 26 then /* lower alpha */
char = char and 5fh; /* converted */
call putchar(char); /* placed into line buffer */
end;
end;
char = gnd;
end; /* end of file is detected in gnt */
lblen = lbp + 1;
lineready = true; /* not yet sent, but ready */
lineout = false; /* not yet sent to .asm file */
end;
lbp = 0;
end getline;
setup: procedure public;
declare (i,c) byte;
/* get the initial parameters */
do i = 0 to last(parm);
parm(i) = false;
end;
if parms(0) = '$' then
do i = 1 to 7;
if (c := parms(i) - 'A') < 26 then
parm(c) = true;
end;
/* set up the input file */
if ifcb(9) = ' ' then
call move(4,.('DEF',0),.ifcb(9));
call setdma(defbuf); /* reset to default area */
call open(.ifcb);
if dcnt = 255 then /* not present */
do;
call print(.(cr,lf,'No Input File Present, Command Form is:',
cr,lf,cr,lf,
'GENDEF x $'));
call printchar('$');
call printn(.('<parameters>',
cr,lf,
'Where x.DEF Holds Disk Definitions',
cr,lf,
'With Optional Parameters <parameters>:',
cr,lf,
'C: Create Diskdef Comment',
cr,lf,
'O: Generate Offset-Relative Labels',
cr,lf,
'Z: Z80, 8080, or 8085 (else 8086, 8088)',
cr,lf,
'x.LIB is Created Upon Completion.',
cr,lf,'$'));
call boot;
end;
errset,eofset,lineready = false;
ifcbr = 0; /* read starting at record 00 */
dbp = length(dbuff); /* causes immediate read from disk */
/* initialize line and error counts */
do i=0 to last(cbuff);
cbuff(i) = ' ';
errmsg(i) = ' ';
end;
cbuff(last(cbuff)) = '$';
/* print title line */
call print(.title);
call getline; /* reads the first line */
end setup;
writerrs: procedure public;
/* write error message at end of pass */
call putline;
if errmsg(6) = ' ' then
do; errmsg(5)='N'; errmsg(6)='o';
end;
call print(.errmsg(2));
end writerrs;
errptr: procedure(msg) public;
declare msg address;
/* place question mark under error position */
declare i byte;
if errset then return;
/* push line if not already printed */
call putline;
errset = true;
call incline(.errmsg(3)); /* count errors up */
call print(msg); /* message is seven characters long */
i = lbp - acclen;
do while (i := i - 1) > 0;
call printchar(' ');
end;
call printchar('?');
end errptr;
/* literals for scanner tokens */
declare
ident lit '1', /* identifier */
number lit '2', /* number token */
string lit '3', /* character string */
special lit '4'; /* special character */
/* scanner declarations */
declare
value address public, /* value for number token */
nextc byte public, /* next character look ahead symbol */
token byte public, /* vocabulary number for item scanned */
continue byte public, /* set if more of the same token remains */
acclen byte public, /* accumulator length */
accum(32) byte public; /* accumulator */
putemitchar: procedure(b);
declare b byte;
if b <> 0 then call emitbyte(b);
end putemitchar;
gnc: procedure byte;
/* get next input character, check for line boundaries */
declare c byte;
do while lbp >= lblen;
call getline;
if eofset then return eofile;
end;
/* line read, character ready */
c = lbuff(lbp); lbp = lbp + 1;
return c;
end gnc;
declare
errv lit '0',
binv lit '2',
octv lit '8',
decv lit '10',
hexv lit '16';
gnt: procedure public;
declare
(b, i, d, stype, lastc) byte,
v address;
numeric: procedure byte; return (nextc-'0') <= 9;
end numeric;
hex: procedure byte; return numeric or ((nextc-'A') <= 5);
end hex;
letter: procedure byte; return (nextc-'A') <= 25;
end letter;
alphanum: procedure byte; return numeric or letter;
end alphanum;
stype, acclen = 0;
if continue then
continue = false; else token = 0;
do while token = 0;
/* deblank input */
if nextc = ' ' or nextc = 0 then nextc = gnc; else
if letter then token = ident; else
if numeric then token = number; else
if nextc = '''' then
do; token = string; nextc = 0;
end; else
token = special;
if eofset then
call abort(.('Premature End-of-File$'));
end; /* of token = 0 */
/* scan remainder of token */
do forever;
if nextc <> 0 then
do;
accum(acclen) = nextc;
if (acclen := acclen + 1) > last (accum) then
do;
if token = string then
do;
continue = true;
return;
end;
call errptr(.('Length $'));
acclen = 0;
end;
end;
lastc = nextc;
nextc = gnc;
if token = ident then
do;
if nextc = '$' then nextc = 0; else
if not alphanum then
return;
end; else
if token = number then
do;
if nextc = '$' then nextc = 0; else
if not hex then
do; /* look for radix indicator */
if (nextc='O') or (nextc='Q') then stype = octv; else
if nextc = 'H' then stype = hexv;
if stype > 0 then nextc = 0; else
if lastc = 'B' then
do; acclen = acclen - 1; stype = binv;
end; else
if lastc = 'D' then
do; acclen = acclen - 1; stype = decv;
end; else stype = decv;
/* now convert the number and place into value */
do;
value = 0;
do i = 1 to acclen;
if (d := accum(i-1)) >= 'A' then
d = d - 'A' + 10; else d = d - '0';
if (b:=stype) <= d then token = errv;
v = value; value = d;
do while b <> 0;
v = shl(v,1);
if (b:=shr(b,1)) then
do; value = value + v;
if carry then token = errv;
end;
end;
end;
end;
if token = errv then
call errptr(.('Convert$'));
token = number;
return;
end;
end; else
if token = string then
do;
if nextc = '''' then
do; if (nextc:=gnc) <> '''' then return;
end;
if nextc = cr then
do;
call errptr(.('Quote $'));
return;
end;
end; else
/* must be special */
return;
end; /* of do forever */
end gnt;
scan$ini: procedure public;
/* initialize scanner parameters */
value,nextc,token = 0;
continue = false;
end scan$ini;
end;


116
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/GTOKEN.PLM Normal file
View File

@@ -0,0 +1,116 @@
$title('TOKEN module for GENDEF')
token:
do;
$include (:f1:glit.plb)
declare
cr lit '0dh';
/* token tables given below are each addressed by tokadr(length), and
each start with the number of items in the table of that particular
length. the tables are in sorted order so that they could be searched
with a binary search algorithm (sequential is used at this time) */
declare
/* tokens are not listed for length 0,1 */
tok0 (*) byte data(0), tok1 (*) byte data(0),
/* single character tokens are given by their ascii representation */
tok2 (*) byte data
(0),
tok3 (*) byte data
(0),
tok4 (*) byte data
(0),
tok5 (*) byte data
(2,'DISKS','ENDEF'),
tok6 (*) byte data
(1,'MACLIB'),
tok7 (*) byte data
(1,'DISKDEF');
declare
/* index to base address of each table */
tokadr (*) address data
(.tok0,.tok1,.tok2,.tok3,.tok4,.tok5,.tok6,.tok7),
/* starting token number for each length */
tokbas (*) byte data
(0,0,token2,token3,token4,token5,token6,token7);
/* external declarations */
declare
nextc byte external, /* next char (lookahead) */
token byte external, /* current token */
continue byte external, /* true for long idents, strings */
acclen byte external, /* accumulator length */
accum(32) byte external; /* actual characters scanned */
gnt: procedure external;
/* produces token = tiden, tnumb, tstrng, or tspecl */
end gnt;
scan: procedure public;
/* scan produces the actual token number for each item returned by
gnt (get next token). in the case of identifiers and special chars,
the token tables are searched before returning the token number */
nextchar: procedure(lookchr) byte;
declare lookchr byte;
/* nextchar is used to look ahead for special two character
sequences. if 'lookchr' is found, then nextc is zeroed and true is
returned from the call */
declare tf byte;
if (tf := nextc = lookchr) then nextc = 0;
return tf;
end nextchar;
declare /* local variables for the token matching */
ta address, /* set to beginning of string of symbols */
tokstr based ta (tokenm) byte, /* string template at ta */
n byte, /* number of symbols remaining to scan in string */
i byte; /* index used while matching characters */
call gnt; /* sets external variables */
if token = tstrng or token = tnumb then return;
/* otherwise token = tspecl or token = tiden */
if token = tspecl then
do;
/* may be a comment */
if accum(0) = ';' then
do while accum(0) <> cr;
call gnt;
end;
token = accum(0);
return;
end;
if acclen > tokenm then
/* cannot be a reserved word */
return;
ta = tokadr(acclen); /* ta is set to the base string to match */
n = tokstr(0); /* n is the number of symbols in the string */
/* token must be set to tiden at this point */
token = tokbas(acclen); /* base token number */
do while n > 0; /* more match attempts */
n = n - 1; i = acclen;
do while i > 0 and accum(i-1) = tokstr(i);
/* one more character has been matched */
i = i - 1;
end;
if i = 0 then /* a complete match was found */
return;
/* current token does not match, try again */
token = token + 1; /* move to next token in sequence */
ta = ta + acclen; /* base address advanced to next item */
end;
/* cannot find the token, leave 'token' set to tiden */
token = tiden;
return;
end scan;
end;


1811
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/PIP.PLM Normal file
View File

File diff suppressed because it is too large Load Diff

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

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


1323
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/SCOM.PLM Normal file
View File

File diff suppressed because it is too large Load Diff

9
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/SEPALL.CPM Normal file
View File

@@ -0,0 +1,9 @@
set verify
set def [frank.mpm86.sepcd]
$ asm86 scd.a86
$ @smpmcmd ed 'p1' 'p2' 'p3'
$ @smpmcmd pip 'p1' 'p2' 'p3'
$ @smpmcmd gencmd 'p1' 'p2' 'p3'
$ @gendef 'p1' 'p2' 'p3'
$ @stat86 'p1' 'p2' 'p3'


8
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/SMPMCMD.CPM Normal file
View File

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


9
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/STAT86.CPM Normal file
View File

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


32
MPM OPERATING SYSTEMS/MPM-86/MPM-86 2.0 SOURCES/08/STAT86.PLM Normal file
View File

@@ -0,0 +1,32 @@
$title ('STATUS - MP/M-86 2.0')
stat:
do;
$include(copyrt.lit)
/* commands used to generate */
/* (on VAX)
asm86 scd.a86
plm86 stat86.plm 'p2' 'p3' 'p4' optimize(3) debug
plm86 dpb86.plm 'p2' 'p3' 'p4' optimize(3) debug
link86 scd.obj,stat86.obj,dpb86.obj to stat86.lnk
loc86 stat86.lnk od(sm(code,dats,data,stack,const)) -
ad(sm(code(0))) ss(stack(+32))
h86 stat86
(on a micro)
vax stat86.h86 $fans
gencmd stat86 data[b12f m352 xfff]
* note the beginning of the data segment will change when
* the program is changed. see the 'MP2' file generated by
* LOC86. also the constants are last to force hex generation
* 352h paragraphs is enough for 512 directory entries
*/
declare plmstart label public;
$include(scom.plm)