mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 09:24:19 +00:00
793 lines
19 KiB
Plaintext
793 lines
19 KiB
Plaintext
$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;
|
||
|