893 lines
27 KiB
Plaintext
893 lines
27 KiB
Plaintext
|
|
'BEGIN'
|
|
'BYTE''ARRAY' DIG[1:20],IDN[0:100];
|
|
|
|
'INTEGER' INDEV,DEV,SIZE,CHAR,LINE,BS,DECL,TYPE,NLAB,FIRST,
|
|
MAX,LDPT,NADR,DBASE,NODEC,ADDR,HEL1,DEPTH,FIXSP,HMPD,
|
|
DEVT,ITEM,MAXNID,MAXLAB,DOS,ILFP,FRFP;
|
|
|
|
'BOOLEAN' SECOND,DOLL,LETTER,DIGIT,FOUND,
|
|
TABLES,FRED,HOL1,STRING,CPR;
|
|
|
|
'INTEGER''PROCEDURE' FREESP; IOC(10);
|
|
|
|
MAXNID:=FREESP%2; 'IF' MAXNID<0 'THEN' MAXNID:=MAXNID+32767;
|
|
MAXNID:=(MAXNID-1500)%6;
|
|
MAXLAB:=150;
|
|
|
|
'BEGIN'
|
|
'INTEGER''ARRAY' ILNP,VADR[1:MAXNID],
|
|
FRNP,FRLN,FLINE[1:MAXLAB];
|
|
'BYTE''ARRAY' IL[0:MAXNID*6],ILVT,ILBD[1:MAXNID],
|
|
FLVT,FLBD[1:MAXLAB],FRN[0:MAXLAB*6];
|
|
|
|
'PROCEDURE' INCH;
|
|
'BEGIN'
|
|
'IF' HOL1 'THEN' HOL1:='FALSE'
|
|
'ELSE''BEGIN' CHIN(,CHAR);
|
|
'IF' CHAR=13 'THEN' LINE:=LINE+1;
|
|
'END';
|
|
'END';
|
|
|
|
'PROCEDURE' ABS;
|
|
'BEGIN' 'IF' DOLL 'THEN''BEGIN' WARN(27); 'GOTO' EPROG;
|
|
'END' READING BEYOND THE END;
|
|
LYY: 'IF' HOL1 'THEN' HOL1:='FALSE'
|
|
'ELSE''BEGIN' CHIN(,CHAR);
|
|
'IF' CHAR=13 'THEN''BEGIN' LINE:=LINE+1;
|
|
'GOTO' LYY; 'END';
|
|
'END';
|
|
'IF'CHAR=39'THEN'
|
|
'BEGIN' CHIN(,CHAR);
|
|
BS:=40*(CHAR-64);
|
|
CHIN(,CHAR); BS:=BS+CHAR-64;
|
|
'IF'BS<64'THEN'BS:=BS+64;
|
|
LZZ: CHIN(,CHAR);
|
|
'IF' CHAR#39 'THEN''GOTO' LZZ;
|
|
DIGIT:='FALSE'; LETTER:='FALSE'; DOLL:='FALSE';
|
|
'END''ELSE'
|
|
'IF' CHAR<33 'THEN''GOTO' LYY 'ELSE'
|
|
'IF' CHAR<58 'THEN''BEGIN' LETTER:='FALSE';
|
|
DOLL:=CHAR=36; DIGIT:=CHAR>47;
|
|
BS:=CHAR; 'END''ELSE'
|
|
'IF' CHAR<65 'THEN''BEGIN' BS:=CHAR;
|
|
'IF' BS=58 'THEN''BEGIN'
|
|
INCH; 'IF' CHAR=61 'THEN' BS:=33
|
|
'ELSE' HOL1:='TRUE';
|
|
'END''ELSE''IF' BS=60 'THEN''BEGIN'
|
|
INCH; 'IF' CHAR=61 'THEN' BS:=63
|
|
'ELSE' HOL1:='TRUE';
|
|
'END''ELSE''IF' BS=62 'THEN''BEGIN'
|
|
INCH; 'IF' CHAR=61 'THEN' BS:=38
|
|
'ELSE' HOL1:='TRUE';
|
|
'END';
|
|
LETTER:='FALSE'; DIGIT:='FALSE'; DOLL:='FALSE';
|
|
'END' BS<65
|
|
'ELSE''BEGIN' BS:=CHAR-64;
|
|
LETTER:=BS<27; DIGIT:='FALSE'; DOLL:='FALSE';
|
|
'END' CHAR>=65;
|
|
'END' ABS;
|
|
|
|
'BOOLEAN''PROCEDURE' TERM;
|
|
TERM:=BS=214 'OR' BS=59 'OR' BS=212 'OR' BS=36;
|
|
|
|
'PROCEDURE' SEMI(FNO); 'VALUE' FNO; 'INTEGER' FNO;
|
|
'BEGIN' CHFAIL(59,FNO); COMMENT 'END';
|
|
|
|
'PROCEDURE' COMMENT;
|
|
L: 'IF' BS=135 'THEN'
|
|
'BEGIN' CL: INCH; 'IF' CHAR#59 'THEN''GOTO' CL 'ELSE'
|
|
'BEGIN' ABS; 'GOTO' L
|
|
'END'
|
|
'END' CHECK FOR COMMENT;
|
|
|
|
'BOOLEAN''PROCEDURE' BTYPE;
|
|
BTYPE:=TYPE=3 'OR' TYPE=7 'OR' TYPE=13;
|
|
|
|
'PROCEDURE' DEFINE(L1,L2); 'VALUE' L1,L2; 'INTEGER' L1,L2;
|
|
'BEGIN' SKIP(); WRITE(,"L",L1);
|
|
'IF' DOS=2 'THEN' WRITE(," EQU ") 'ELSE' WRITE(,"=");
|
|
WRITE(,"L",L2); SKIP();
|
|
ITEM:=0;
|
|
'END';
|
|
|
|
'INTEGER''PROCEDURE' LOWER(X); 'VALUE' X; 'INTEGER' X;
|
|
LOWER:=X-X%256*256;
|
|
|
|
'PROCEDURE' IDENT;
|
|
'BEGIN''INTEGER' I,J;
|
|
IDN[0]:='IF' BS<27 'THEN' BS+64 'ELSE' BS+21;
|
|
I:=1;
|
|
NCH: INCH;
|
|
'IF' CHAR>64 'AND' CHAR<91 'THEN'
|
|
'BEGIN'
|
|
IDN[I]:=CHAR; I:=I+1; 'GOTO' NCH;
|
|
'END'
|
|
'ELSE''IF' CHAR>47 'AND' CHAR<58 'THEN'
|
|
'BEGIN'
|
|
IDN[I]:=CHAR; I:=I+1; 'GOTO' NCH;
|
|
'END'
|
|
'ELSE''IF' CHAR<33 'THEN''GOTO' NCH;
|
|
IDN[I]:=0; HOL1:='TRUE'; ABS; FOUND:='FALSE';
|
|
'FOR' DECL:=NODEC 'STEP' -1 'UNTIL' 1 'DO'
|
|
'BEGIN' J:=ILNP[DECL];
|
|
'FOR' I:=0 'STEP' 1 'UNTIL' 100 'DO'
|
|
'BEGIN''IF' IL[J+I] # IDN[I] 'THEN''GOTO' ID5;
|
|
'IF' IDN[I]=0 'THEN'
|
|
'BEGIN' FOUND:='TRUE';
|
|
TYPE:=ILVT[DECL]; ADDR:=VADR[DECL];
|
|
'GOTO' ESRC;
|
|
'END' IDENTIFIER FOUND;
|
|
'END' LOOK AT ONE CHARACTER;
|
|
ID5: 'END' LOOK AT ONE IDENTIFIER;
|
|
ESRC:
|
|
'END' SEARCH DECLARATION LIST;
|
|
|
|
'PROCEDURE' CODE(X); 'VALUE' X; 'INTEGER' X;
|
|
'BEGIN' 'IF' ITEM=0 'THEN'
|
|
'BEGIN' SKIP();
|
|
'IF' DOS>1 'THEN' WRITE(," DB ");
|
|
'END'
|
|
'ELSE' WRITE(,",");
|
|
WRITE(,X); ITEM:=ITEM+1;
|
|
'IF' ITEM>8 'THEN' ITEM:=0;
|
|
SIZE:=SIZE+1;
|
|
'END' CODE OUTPUT;
|
|
|
|
'PROCEDURE' SIXBIT(CONST); 'VALUE' CONST; 'INTEGER' CONST;
|
|
'IF' CONST=0 'THEN' CODE(29)
|
|
'ELSE''IF' CONST>64 'THEN'
|
|
'BEGIN' CODE(42); CODE(CONST) 'END'
|
|
'ELSE' CODE(63+CONST);
|
|
|
|
'PROCEDURE' LDEC(LNO); 'VALUE' LNO; 'INTEGER' LNO;
|
|
'BEGIN' SKIP(); WRITE(,"L",LNO);
|
|
'IF' DOS=3 'THEN'
|
|
'BEGIN' WRITE(,"="); CHOUT(,36) 'END'
|
|
'ELSE' WRITE(,":");
|
|
ITEM:=0;
|
|
'END';
|
|
|
|
'PROCEDURE' LABEL(LNO); 'VALUE' LNO; 'INTEGER' LNO;
|
|
'BEGIN' SKIP();
|
|
'IF' DOS>1 'THEN' WRITE(," DW OFFSET L")
|
|
'ELSE' WRITE(,"#L");
|
|
WRITE(,LNO); SIZE:=SIZE+2; ITEM:=0;
|
|
'END';
|
|
|
|
'INTEGER''PROCEDURE' JMPNEW;
|
|
'BEGIN' JMP(NLAB);
|
|
JMPNEW:=NLAB; NLAB:=NLAB+1 'END';
|
|
|
|
'PROCEDURE' JMP(LNO); 'VALUE' LNO; 'INTEGER' LNO;
|
|
'BEGIN' CODE(9); LABEL(LNO) 'END';
|
|
|
|
'INTEGER''PROCEDURE' CJMP;
|
|
'BEGIN' CODE(28); LABEL(NLAB);
|
|
CJMP:=NLAB; NLAB:=NLAB+1 'END';
|
|
|
|
'PROCEDURE' SID;
|
|
'BEGIN''INTEGER' I;
|
|
'IF' TABLES 'THEN'
|
|
'BEGIN' SKIP(DEVT); IDOUT;
|
|
WRITE(DEVT," ",ADDR," ",TYPE); CHOUT(DEV);
|
|
'END';
|
|
'IF' NODEC=MAXNID 'THEN' WARN(15) 'ELSE' NODEC:=NODEC+1;
|
|
'IF' FOUND 'AND' DECL>DBASE 'THEN' WARN(1);
|
|
'IF' TYPE#4 'AND' TYPE<10 'THEN'
|
|
'BEGIN' 'IF' ADDR>FIXSP 'THEN' FIXSP:=ADDR;
|
|
'IF' ADDR>255 'THEN' WARN(5)
|
|
'END';
|
|
ILNP[NODEC]:=ILFP;
|
|
'FOR' I:=0 'STEP' 1 'UNTIL' 100 'DO'
|
|
'BEGIN' IL[ILFP+I]:=IDN[I];
|
|
'IF' IDN[I]=0 'THEN'
|
|
'BEGIN' ILFP:=ILFP+I+1;
|
|
'IF' ILFP>=MAXNID*6 'THEN' WARN(15);
|
|
'GOTO' SID1;
|
|
'END' END OF NAME;
|
|
'END';
|
|
SID1:
|
|
ILVT[NODEC]:=TYPE; ILBD[NODEC]:=DEPTH;
|
|
VADR[NODEC]:=ADDR;
|
|
'END' STORE IDENT IN LIST;
|
|
|
|
'PROCEDURE' DARR;
|
|
'BEGIN''INTEGER' FIRST, COUNT,STYP;
|
|
STYP:=TYPE;
|
|
DAR1: FIRST:=NADR; COUNT:=1;
|
|
DAR2: IDENT; TYPE:=STYP;
|
|
ADDR:=NADR; NADR:=NADR+1; SID;
|
|
'IF' BS=44 'THEN''BEGIN' COUNT:=COUNT+1;
|
|
ABS; 'GOTO' DAR2 'END';
|
|
CHFAIL(27,18); GET INTEGER;
|
|
CHFAIL(58,18); GET INTEGER;
|
|
CHFAIL(29,18);
|
|
'IF' STYP=8 'THEN' CODE(53) 'ELSE' CODE(1);
|
|
CODE(COUNT); CODE(FIRST);
|
|
'IF' BS#59 'THEN''BEGIN' CHFAIL(44,18); 'GOTO' DAR1 'END';
|
|
ABS; COMMENT 'END' DECLARE ARRAY;
|
|
|
|
'PROCEDURE' DTV;
|
|
'BEGIN''INTEGER' STYP; STYP:=TYPE;
|
|
DTV1: IDENT; TYPE:=STYP; ADDR:=NADR; NADR:=NADR+1;
|
|
SID; 'IF' BS=44 'THEN''BEGIN' ABS; 'GOTO' DTV1 'END';
|
|
'IF' BS=59 'THEN''BEGIN' ABS; COMMENT 'END''ELSE' ABS;
|
|
'END' DECLARE VARIABLE LIST;
|
|
|
|
|
|
'PROCEDURE' GET INTEGER;
|
|
AE;
|
|
|
|
'PROCEDURE' SFR;
|
|
'BEGIN''INTEGER' I,J,K;
|
|
'IF' FOUND 'AND' (DECL<=10 'OR' TYPE>9 'OR'
|
|
DEPTH=ILBD[DECL]) 'THEN''GOTO' ESFR;
|
|
'IF' LDPT#0 'THEN'
|
|
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
|
|
'BEGIN' J:=FRNP[I];
|
|
'FOR' K:=0 'STEP' 1 'UNTIL' 100 'DO'
|
|
'BEGIN' 'IF' IDN[K] # FRN[J+K] 'THEN''GOTO' NO;
|
|
'IF' IDN[K]=0 'THEN'
|
|
'BEGIN''IF' DEPTH=FLBD[I] 'OR' TYPE>9 'THEN'
|
|
'BEGIN' ADDR:=FRLN[I];
|
|
'IF' FLVT[I]#TYPE 'THEN' WARN(52);
|
|
'GOTO' ESFR;
|
|
'END' FORWARD REFERENCE EXISTS ALREADY;
|
|
'GOTO' NO;
|
|
'END' NAME MATCHES;
|
|
'END' LOOK AT ONE CHARACTER;
|
|
NO: 'END' LOOK AT ONE FORWARD REFERNECE;
|
|
|
|
'IF' LDPT=MAXLAB 'THEN' WARN(30) 'ELSE' LDPT:=LDPT+1;
|
|
'IF' LDPT>MAX 'THEN' MAX:=LDPT;
|
|
FRNP[LDPT]:=FRFP;
|
|
'FOR' I:=0 'STEP' 1 'UNTIL' 100 'DO'
|
|
'BEGIN' FRN[FRFP+I]:=IDN[I];
|
|
'IF' IDN[I]=0 'THEN'
|
|
'BEGIN' FRFP:=FRFP+I+1;
|
|
'GOTO' SFR1;
|
|
'IF' FRFP>=MAXLAB*6 'THEN' WARN(30);
|
|
'END' END OF NAME;
|
|
'END';
|
|
SFR1:
|
|
FLVT[LDPT]:=TYPE; FLBD[LDPT]:=DEPTH;
|
|
ADDR:=NLAB; FRLN[LDPT]:=NLAB; NLAB:=NLAB+1; FLINE[LDPT]:=LINE;
|
|
ESFR:
|
|
'END' RETURN PROCEDURE LABEL IF DECLARED, ELSE SET FORWARD REF;
|
|
|
|
'PROCEDURE' DLAB;
|
|
'BEGIN''INTEGER' I,J,K;
|
|
ADDR:=NLAB; SID; LDEC(NLAB); NLAB:=NLAB+1;
|
|
'IF' LDPT#0 'THEN'
|
|
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
|
|
'BEGIN' J:=FRNP[I];
|
|
'FOR' K:=0 'STEP' 1 'UNTIL' 100 'DO'
|
|
'BEGIN' 'IF' IDN[K] # FRN[J+K] 'THEN''GOTO' NO;
|
|
'IF' IDN[K]=0 'THEN'
|
|
'BEGIN''IF' DEPTH=FLBD[I] 'OR' TYPE>9 'THEN'
|
|
'BEGIN' DEFINE(FRLN[I],ADDR);
|
|
'IF' FLVT[I]#TYPE 'THEN' WARN(52);
|
|
D2ELETE(I); I:=I-1;
|
|
'END' DELETE SATISFIED REFERENCE;
|
|
'GOTO' NO;
|
|
'END' NAME MATCHES;
|
|
'END' LOOK AT ONE CHARACTER;
|
|
NO: 'END' LOOK AT ONE FORWARD REFERNECE;
|
|
'END' PUT LABEL OR PROCEDURE DECLARATION IN LIST;
|
|
|
|
'PROCEDURE' D2ELETE(ITEM); 'VALUE' ITEM; 'INTEGER' ITEM;
|
|
'IF' ITEM=LDPT 'THEN'
|
|
'BEGIN' LDPT:=LDPT-1; FRFP:=FRNP[ITEM];
|
|
'END' DELETE LAST ITEM
|
|
'ELSE'
|
|
'BEGIN''INTEGER' I,J,K,LEN;
|
|
FRNP[LDPT+1]:=FRFP; FRFP:=FRNP[ITEM];
|
|
'FOR' I:=ITEM 'STEP' 1 'UNTIL' LDPT-1 'DO'
|
|
'BEGIN' K:=FRNP[I+1]; LEN:=FRNP[I+2] - K;
|
|
FRNP[I]:=FRFP;
|
|
'FOR' J:=0 'STEP' 1 'UNTIL' LEN-1 'DO'
|
|
FRN[FRFP+J]:=FRN[K+J];
|
|
FRFP:=FRFP + LEN;
|
|
FLVT[I]:=FLVT[I+1]; FLBD[I]:=FLBD[I+1];
|
|
FLINE[I]:=FLINE[I]+1; FRLN[I]:=FRLN[I+1];
|
|
'END' MOVE 1 ITEM DOWN;
|
|
LDPT:=LDPT-1;
|
|
'END' DELETE INTERNAL ITEM;
|
|
|
|
'PROCEDURE' PCALL; 'BEGIN' 'INTEGER' STYP; STYP:=TYPE;
|
|
'IF' FOUND 'AND' DECL<=10 'THEN'
|
|
'BEGIN' CHFAIL(40,32);
|
|
'IF' ADDR=1 'THEN'
|
|
'BEGIN''IF' BS#41 'THEN'
|
|
'BEGIN' GET INTEGER; CODE(2);
|
|
'END' DEVICE NUMBER GIVEN;
|
|
CODE(40); 'GOTO' ECAL
|
|
'END' COMPILE SKIP
|
|
'ELSE''IF' ADDR=2 'THEN'
|
|
'BEGIN''IF' BS#44 'THEN'
|
|
'BEGIN' GET INTEGER; CODE(49);
|
|
'END' DEVICE GIVEN;
|
|
CAL1: 'IF' BS#44 'THEN''GOTO' ECAL; ABS;
|
|
CODE(3); IDENT; PUTOUT; 'GOTO' CAL1
|
|
'END' COMPILE READ
|
|
'ELSE''IF' ADDR=3 'THEN'
|
|
'BEGIN''IF' BS#44 'THEN'
|
|
'BEGIN' GET INTEGER; CODE(2);
|
|
'END' DEVICE NUMBER GIVEN;
|
|
CAL2: 'IF' BS#44 'THEN''GOTO' ECAL; ABS;
|
|
'IF' BS=34 'THEN'
|
|
'BEGIN'
|
|
STRING:='TRUE'; INCH; CODE(5);
|
|
CAL3: CODE(CHAR); INCH;
|
|
'IF' CHAR#34 'THEN''GOTO' CAL3;
|
|
ABS; CODE(0);
|
|
SKIP(); ITEM:=0; STRING:='FALSE'; 'GOTO' CAL2
|
|
'END'
|
|
'ELSE''BEGIN' GET INTEGER; CODE(6);
|
|
'GOTO' CAL2
|
|
'END'
|
|
'END' COMPILE WRITE
|
|
'ELSE''IF' ADDR=4 'THEN'
|
|
'BEGIN''IF' BS#44 'THEN'
|
|
'BEGIN' GET INTEGER; CODE(49);
|
|
'END' DEVICE NUMBER GIVEN;
|
|
'IF' BS#44 'THEN''GOTO' ECAL; ABS;
|
|
CODE(7); IDENT; PUTOUT
|
|
'END' COMPILE CHIN
|
|
'ELSE''IF' ADDR=5 'THEN'
|
|
'BEGIN''IF' BS#44 'THEN'
|
|
'BEGIN' GET INTEGER; CODE(2);
|
|
'END' DEVICE NUMBER GIVEN;
|
|
'IF' BS#44 'THEN''GOTO' ECAL; ABS;
|
|
GET INTEGER; CODE(8);
|
|
'END' COMPILE CHOUT
|
|
'ELSE''IF' ADDR=6 'THEN''BEGIN' GET INTEGER; CODE(39)
|
|
'END' COMPILE IOC
|
|
'ELSE' 'IF' ADDR=7 'THEN' 'BEGIN' GETINTEGER; CODE(48)
|
|
'END' COMPILE CLOSE
|
|
'ELSE' 'IF' ADDR=8 'THEN'
|
|
'BEGIN' GETINTEGER; CODE(50) 'END' COMPILE DELETE
|
|
'ELSE' 'IF' ADDR=9 'OR' ADDR=10 'THEN'
|
|
'BEGIN' CODE(42+ADDR); IDENT; PUTOUT 'END' COMPILE INPUT AND OUTPUT
|
|
'END' CALL OF BUILT IN ROUTINES
|
|
'ELSE''BEGIN' 'INTEGER' COUNT,PRAD;
|
|
SFR; 'IF' BS#40 'THEN'
|
|
'BEGIN' CODE(11); LABEL(ADDR); 'GOTO' ECL2
|
|
'END' CALL OF PARAMETERLESS PROCEDURE;
|
|
COUNT:=0; PRAD:=ADDR; ABS;
|
|
NPAR: 'IF' 'NOT' LETTER 'THEN'
|
|
'BEGIN' 'IF' BS=575 'OR' BS=818 'OR' BS=241 'THEN' BE
|
|
'ELSE' AE
|
|
'END' PARAMETER NOT STARTING WITH LETTER
|
|
'ELSE'
|
|
'BEGIN' IDENT; 'IF''NOT' FOUND 'THEN' WARN(29);
|
|
FRED:='TRUE'; EXPRESSION;
|
|
'END' PARAM STARTING WITH IDENT;
|
|
COUNT:=COUNT+1; 'IF' BS=44 'THEN'
|
|
'BEGIN' ABS; 'GOTO' NPAR
|
|
'END';
|
|
'IF' COUNT<5 'THEN'
|
|
'BEGIN' CODE(COUNT+42); LABEL(PRAD)
|
|
'END'
|
|
'ELSE''BEGIN' CODE(36);
|
|
CODE(COUNT); LABEL(PRAD);
|
|
'END'
|
|
'END' USER DECLARED PROCEDURE CALL;
|
|
ECAL: CHFAIL(41,21);
|
|
ECL2: TYPE:=STYP 'END' PROCEDURE CALL;
|
|
|
|
|
|
'PROCEDURE' STATEMENT;
|
|
'BEGIN'
|
|
ST:
|
|
'IF' LETTER 'THEN'
|
|
'BEGIN' IDENT;
|
|
'IF' BS=58 'THEN'
|
|
'BEGIN' TYPE:=4; DLAB; ABS; 'GOTO' ST 'END'
|
|
'ELSE''IF' BS=27 'OR' BS=33 'THEN' ASSIGNMENT
|
|
'ELSE' 'BEGIN' TYPE:=10; PCALL 'END'
|
|
'END' UNCONDITIONAL NON-GOTO
|
|
|
|
'ELSE''IF' BS=366 'THEN'
|
|
'BEGIN''INTEGER' L1,L2;
|
|
L1:=IFCLAUSE; STATEMENT;
|
|
'IF' BS#212 'THEN' LDEC(L1)
|
|
'ELSE''BEGIN' ABS; L2:=JMPNEW; LDEC(L1);
|
|
STATEMENT; LDEC(L2) 'END'
|
|
'END' CONDITIONAL
|
|
|
|
'ELSE' 'IF' BS=295 'THEN'
|
|
'BEGIN' ABS; IDENT; TYPE:=4; SFR;
|
|
JMP(ADDR);
|
|
'END' GOTO STATEMENT
|
|
|
|
'ELSE' 'IF' BS=255 'THEN'
|
|
'BEGIN''INTEGER' L1,L2,L3,CVA,GLOBAL;
|
|
ABS; IDENT; 'IF''NOT' FOUND 'OR' TYPE#2 'THEN' WARN(13);
|
|
CVA:=ADDR;
|
|
GLOBAL:='IF' DECL<=HMPD 'AND' CPR 'THEN' 0 'ELSE' 2;
|
|
ASSIGNMENT; CHFAIL(780,22);
|
|
L1:=NLAB; L2:=NLAB+1; NLAB:=NLAB+2;
|
|
JMP(L1); LDEC(L2);
|
|
GET INTEGER; CHFAIL(854,22);
|
|
GET INTEGER; CHFAIL(175,22);
|
|
CODE(34); CODE(GLOBAL); CODE(CVA);
|
|
L3:=CJMP; LDEC(L1); STATEMENT;
|
|
JMP(L2); LDEC(L3);
|
|
'END' FORSTATEMENT
|
|
|
|
'ELSE' 'IF' BS=85 'THEN'
|
|
'BEGIN''INTEGER' I,J,SDBASE,SNADR,SILFP,JPPL;
|
|
'BOOLEAN' PLS,BLOCK;
|
|
ABS; COMMENT; PLS:='FALSE'; BLOCK:='FALSE';
|
|
NDEC: 'IF' BS=374 'OR' BS=95 'THEN'
|
|
'BEGIN' 'IF''NOT' BLOCK 'THEN'
|
|
'BEGIN' BLOCK:='TRUE'; DEPTH:=DEPTH+1;
|
|
SDBASE:=DBASE; DBASE:=NODEC; SNADR:=NADR;
|
|
SILFP:=ILFP;
|
|
'END';
|
|
TYPE:='IF' BS=374 'THEN' 2 'ELSE' 3; ABS;
|
|
'IF' BS=658 'THEN'
|
|
'BEGIN' ABS; 'IF' 'NOT' PLS 'THEN'
|
|
'BEGIN' JPPL:=JMPNEW; PLS:='TRUE'
|
|
'END';
|
|
DPROC; 'GOTO' NDEC
|
|
'END' TYPE PROCEDURE
|
|
'ELSE' 'IF' BS=122 'THEN'
|
|
'BEGIN' ABS;
|
|
ADEC: 'IF' PLS 'THEN'
|
|
'BEGIN' LDEC(JPPL); PLS:='FALSE'
|
|
'END';
|
|
TYPE:=TYPE+4; DARR; 'GOTO' NDEC
|
|
'END' INTEGER OR BOOLEAN ARRAY
|
|
'ELSE'
|
|
'BEGIN' DTV; 'GOTO' NDEC;
|
|
'END' UNSUBSCRIPTED VARIABLE
|
|
'END' DECLARATION STARTS INTEGER OR BOOLEAN
|
|
'ELSE''IF' BS=658 'THEN'
|
|
'BEGIN' 'IF''NOT' BLOCK 'THEN'
|
|
'BEGIN' BLOCK:='TRUE'; DEPTH:=DEPTH+1;
|
|
SDBASE:=DBASE; DBASE:=NODEC; SNADR:=NADR;
|
|
SILFP:=ILFP;
|
|
'END';
|
|
TYPE:=0; ABS; 'IF' 'NOT' PLS 'THEN'
|
|
'BEGIN' JPPL:=JMPNEW; PLS:='TRUE'
|
|
'END';
|
|
DPROC; 'GOTO' NDEC
|
|
'END' PROCEDURE
|
|
'ELSE''IF' BS=105 'THEN'
|
|
'BEGIN' ABS;
|
|
'IF' BS=122 'THEN' ABS;
|
|
TYPE:=4; 'GOTO' ADEC;
|
|
'END' BYTE ARRAY;
|
|
|
|
'IF' PLS 'THEN''BEGIN' PLS:='FALSE'; LDEC(JPPL) 'END';
|
|
TAIL: STATEMENT; 'IF' BS=59 'THEN'
|
|
'BEGIN' ABS; COMMENT; 'GOTO' TAIL 'END'
|
|
'ELSE''IF' BS#214 'THEN' FAIL(16);
|
|
ECOM: ABS; 'IF''NOT' TERM 'THEN''GOTO' ECOM;
|
|
|
|
'IF' BLOCK 'THEN'
|
|
'BEGIN'
|
|
DEPTH:=DEPTH-1; NODEC:=DBASE; DBASE:=SDBASE; NADR:=SNADR;
|
|
ILFP:=SILFP; RESOLVE;
|
|
'END' BLOCK END
|
|
'END' BLOCK OR COMPOUND;
|
|
'END' STATEMENT;
|
|
|
|
'PROCEDURE' RESOLVE;
|
|
'BEGIN''INTEGER' I,J,K,L,M,FTYP;
|
|
'IF' LDPT#0 'THEN'
|
|
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
|
|
'IF' FLBD[I]>DEPTH 'THEN'
|
|
'BEGIN' FLBD[I]:=DEPTH; FTYP:=FLVT[I];
|
|
'FOR' J:=NODEC 'STEP' -1 'UNTIL' 11 'DO'
|
|
'BEGIN' K:=ILNP[J]; L:=FRNP[I];
|
|
'FOR' M:=0 'STEP' 1 'UNTIL' 100 'DO'
|
|
'BEGIN''IF' FRN[L+M] # IL[K+M] 'THEN''GOTO' NO;
|
|
'IF' FRN[L+M]=0 'THEN'
|
|
'BEGIN'
|
|
'IF' ILBD[J]=DEPTH 'OR' FTYP>9 'THEN'
|
|
'BEGIN' DEFINE(FRLN[I],VADR[J]);
|
|
'IF' FTYP#ILVT[J] 'THEN'
|
|
WARN(53);
|
|
D2ELETE(I); I:=I-1; 'GOTO' EXLOOP;
|
|
'END' DECLARATION FOUND, CORRECT DEPTH;
|
|
'END' NAME MATCHES;
|
|
'END' CHARACTER LOOP;
|
|
NO: 'END' DECLARED VARIABLE;
|
|
EXLOOP:
|
|
'END' FORWARD LABEL SATISFACTION DEPTH CHANGE;
|
|
'END' RESOLVE LABELS AT BLOCK/PROCEDURE END;
|
|
|
|
'PROCEDURE' DPROC;
|
|
'BEGIN' 'INTEGER' SNADR,SDBASE,SFIXSP,SILFP,
|
|
PINL,SLTYP;
|
|
CPR:='TRUE';
|
|
SLTYP:=TYPE+10; IDENT; TYPE:=SLTYP; DLAB;
|
|
SILFP:=ILFP; HMPD:=NODEC; SFIXSP:=FIXSP; SNADR:=NADR;
|
|
SDBASE:=DBASE; DBASE:=NODEC; DEPTH:=DEPTH+1;
|
|
FIXSP:=3; NADR:=4; LABEL(NLAB);
|
|
PINL:=NLAB; NLAB:=NLAB+1;
|
|
'IF' BS=40 'THEN'
|
|
'BEGIN' ABS; TYPE:=0; DTV 'END';
|
|
SEMI(28);
|
|
LOOP: 'IF' BS=881 'THEN'
|
|
'BEGIN'
|
|
LOP: ABS; 'IF' BS#59 'THEN''GOTO' LOP;
|
|
ABS; 'GOTO' LOOP
|
|
'END' IGNORE VALUE
|
|
'ELSE''IF' BS=374 'OR' BS=95 'THEN'
|
|
'BEGIN' 'BOOLEAN' BOOL; BOOL:=BS=95; ABS;
|
|
LOP: IDENT; 'IF''NOT' FOUND 'OR' TYPE#0 'THEN' WARN(29)
|
|
'ELSE'
|
|
ILVT[DECL]:='IF' BOOL 'THEN' 3 'ELSE' 2;
|
|
ILBD[DECL]:=DEPTH;
|
|
'IF' BS=44 'THEN''BEGIN' ABS; 'GOTO' LOP 'END'
|
|
'ELSE''BEGIN' SEMI(43); 'GOTO' LOOP 'END'
|
|
'END' TYPE SPECIFICATION;
|
|
'FOR' DECL:=NODEC 'STEP' -1 'UNTIL' DBASE+1 'DO'
|
|
'IF' ILVT[DECL]=0 'THEN' WARN(40);
|
|
STATEMENT;
|
|
CODE('IF' SLTYP>10 'THEN' 47 'ELSE' 10);
|
|
SKIP(); ITEM:=0;
|
|
WRITE(,"L",PINL);
|
|
'IF' DOS=2 'THEN' WRITE(," EQU ") 'ELSE' WRITE(,"=");
|
|
WRITE(,FIXSP); SKIP(); ITEM:=0;
|
|
NADR:=SNADR; NODEC:=HMPD; FIXSP:=SFIXSP;
|
|
ILFP:=SILFP; DBASE:=SDBASE; DEPTH:=DEPTH-1;
|
|
SEMI(23); CPR:='FALSE';
|
|
RESOLVE;
|
|
'END' DECLARE PROCEDURE;
|
|
|
|
'PROCEDURE' SUBSCRIPT;
|
|
'BEGIN''INTEGER' STYPE; STYPE:=TYPE-4;
|
|
'IF' STYPE=4 'THEN' STYPE:=2; 'COMMENT' BYTE ARRAY;
|
|
CHFAIL(27,3); GETINTEGER; CHFAIL(29,4);
|
|
TYPE:=STYPE 'END';
|
|
|
|
'PROCEDURE' FETCH;
|
|
'BEGIN'
|
|
'IF' FRED 'THEN' FRED:='FALSE''ELSE' IDENT;
|
|
'IF' 'NOT' FOUND 'THEN' TYPE:=TYPE+10;
|
|
'IF' TYPE>10 'THEN'
|
|
'BEGIN' PCALL; TYPE:=TYPE-10
|
|
'END'
|
|
'ELSE' 'IF' TYPE>4 'THEN'
|
|
'BEGIN' 'INTEGER' SDEC,STYP;
|
|
'IF' BS=29 'THEN'
|
|
'BEGIN' ABS; 'GOTO' GETV;
|
|
'END' FETCH ADDRESS OF ELEMENT 0;
|
|
STYP:=TYPE; SDEC:=DECL;
|
|
SUBSCRIPT;
|
|
'IF' STYP=8 'THEN' CODE(54) 'ELSE' CODE(14);
|
|
CODE(VADR[SDEC]);
|
|
'END' ARRAY NAME
|
|
'ELSE'
|
|
GETV: GETOUT;
|
|
'END' FETCH VARIABLE;
|
|
|
|
'PROCEDURE' EXPRESSION;
|
|
'IF' BTYPE 'THEN' BE 'ELSE' AE;
|
|
|
|
'PROCEDURE' ASSIGNMENT;
|
|
'BEGIN' 'IF''NOT' FOUND 'THEN' WARN(17);
|
|
'IF' TYPE>10 'THEN'
|
|
'BEGIN' CHFAIL(33,24); TYPE:=TYPE-10; EXPRESSION;
|
|
CODE(147); 'COMMENT' STORE LOCAL 3;
|
|
'END'
|
|
'ELSE''IF' TYPE>4 'THEN'
|
|
'BEGIN' 'INTEGER' SDEC,STYP;
|
|
STYP:=TYPE; SDEC:=DECL;
|
|
SUBSCRIPT; CHFAIL(33,24); EXPRESSION;
|
|
'IF' STYP=8 'THEN' CODE(55) 'ELSE' CODE(15);
|
|
CODE(VADR[SDEC]);
|
|
'END'
|
|
'ELSE''BEGIN''INTEGER' SDECL;
|
|
SDECL:=DECL; CHFAIL(33,24); EXPRESSION;
|
|
ADDR:=VADR[SDECL]; DECL:=SDECL; PUTOUT;
|
|
'END'
|
|
'END' ASSIGNMENT;
|
|
|
|
'PROCEDURE' IDOUT;
|
|
'BEGIN''INTEGER' I; I:=0;
|
|
L: CHOUT(DEVT,IDN[I]); I:=I+1;
|
|
'IF' IDN[I]#0 'THEN''GOTO' L;
|
|
'END' OUTPUT IDENTIFIER;
|
|
|
|
'PROCEDURE' WARN(X); 'VALUE' X; 'INTEGER' X;
|
|
'BEGIN' SKIP(DEVT); DELETE(DEV); DEV:=0;
|
|
WRITE(DEVT,"FAIL ",X," LINE ",LINE,
|
|
" CHAR ",CHAR," BS ",BS," IDENT ");
|
|
IDOUT; WRITE(DEVT," TYPE ",TYPE);
|
|
CHOUT(0);
|
|
'END' FAILURE WARNING;
|
|
|
|
'PROCEDURE' FAIL(X); 'VALUE' X; 'INTEGER' X;
|
|
'BEGIN' WARN(X); 'IF' TERM 'THEN' ABS;
|
|
NEXT: ABS; 'IF''NOT' TERM 'THEN''BEGIN' ABS; 'GOTO' NEXT 'END';
|
|
'END' FAILURE OUTPUT;
|
|
|
|
'PROCEDURE' CHFAIL(SYM,FNO); 'VALUE' SYM,FNO; 'INTEGER' SYM,FNO;
|
|
'BEGIN''IF' BS#SYM 'THEN' WARN(FNO); ABS 'END';
|
|
|
|
'PROCEDURE' APRIME;
|
|
'BEGIN''BOOLEAN' NEG;
|
|
'IF' FRED 'THEN''BEGIN' FETCH; 'GOTO' EAPR
|
|
'END';
|
|
'IF' BS=43 'THEN''BEGIN' ABS; NEG:='FALSE' 'END'
|
|
'ELSE''IF' BS=45 'THEN''BEGIN' ABS; NEG:='TRUE' 'END'
|
|
'ELSE' NEG:='FALSE';
|
|
|
|
'IF' BS=40 'THEN'
|
|
'BEGIN' ABS; AE; CHFAIL(41,12)
|
|
'END'
|
|
'ELSE''IF' LETTER 'THEN'
|
|
'BEGIN' TYPE:=2;
|
|
FETCH; 'IF' TYPE#2 'THEN' WARN(17);
|
|
'END'
|
|
'ELSE''IF' BS=38 'THEN'
|
|
'BEGIN' CHIN(,CHAR); SIXBIT(CHAR); ABS;
|
|
TYPE:=2;
|
|
'END' CHARACTER LITERAL
|
|
'ELSE' 'BEGIN''INTEGER' I,J,K,L; I:=0;
|
|
'IF''NOT' DIGIT 'THEN' FAIL(10);
|
|
APR1: I:=I+1; DIG[I]:=BS;
|
|
ABS; 'IF' DIGIT 'THEN''GOTO' APR1;
|
|
K:=0; L:=0;
|
|
'FOR' J:=1 'STEP' 1 'UNTIL' I 'DO'
|
|
'BEGIN' K:=10*K+DIG[J]-48; L:=L*10;
|
|
'IF' K>=256 'THEN'
|
|
'BEGIN' L:=L+K%256;
|
|
K:=K-256*(K%256)
|
|
'END';
|
|
'IF' L>255 'THEN' WARN(44);
|
|
'END';
|
|
'IF' K=0 'AND' L=0 'THEN' CODE(29)
|
|
'ELSE' 'IF' L=0 'THEN'
|
|
'BEGIN' SIXBIT(K) 'END'
|
|
'ELSE'
|
|
'BEGIN' CODE(16); CODE(K); CODE(L) 'END'
|
|
'END';
|
|
'IF' NEG 'THEN' CODE(17);
|
|
EAPR: 'END' ARITHMETIC PRIMARY;
|
|
|
|
'PROCEDURE' AFAC;
|
|
'BEGIN' APRIME;
|
|
AFA1: 'IF' BS=30 'THEN'
|
|
'BEGIN' ABS; APRIME; CODE(18);
|
|
'GOTO' AFA1
|
|
'END';
|
|
'END' ARITHMETIC FACTOR;
|
|
|
|
|
|
|
|
'PROCEDURE' ATERM;
|
|
'BEGIN'
|
|
AFAC;
|
|
ATE1: 'IF' BS=42 'THEN'
|
|
'BEGIN' ABS; AFAC; CODE(19);
|
|
'GOTO' ATE1
|
|
'END' MULTIPLY CASE
|
|
'ELSE''IF' BS=47 'THEN' WARN(19)
|
|
'ELSE''IF' BS=37 'THEN'
|
|
'BEGIN' ABS; AFAC;
|
|
CODE(20); 'GOTO' ATE1
|
|
'END' INTEGER DIVISION CASE;
|
|
'END' ARITHMETIC TERM;
|
|
|
|
'PROCEDURE' SAE;
|
|
'BEGIN' ATERM;
|
|
SAE1: 'IF' BS=43 'THEN'
|
|
'BEGIN' ABS; ATERM;
|
|
CODE(13); 'GOTO' SAE1
|
|
'END' ADDITION CASE
|
|
'ELSE''IF' BS=45 'THEN'
|
|
'BEGIN' ABS; ATERM;
|
|
CODE(21); 'GOTO' SAE1
|
|
'END' SUBTRACTION CASE;
|
|
'END' SIMPLE ARITHMETIC EXPRESSION;
|
|
|
|
'PROCEDURE' AE;
|
|
'IF' BS=366 'THEN'
|
|
'BEGIN' 'INTEGER' L1,L2;
|
|
L1:=IFCLAUSE; SAE; CHFAIL(212,7);
|
|
L2:=JMPNEW; LDEC(L1); AE;
|
|
LDEC(L2);
|
|
'END'
|
|
'ELSE' SAE;
|
|
|
|
|
|
|
|
'PROCEDURE' SETO(I); 'VALUE' I;
|
|
'INTEGER' I; IOC(12);
|
|
|
|
'INTEGER' 'PROCEDURE' SWLIST; IOC(16);
|
|
|
|
|
|
'PROCEDURE' RE;
|
|
'BEGIN''INTEGER' SBS;
|
|
AE; SBS:=BS; ABS; AE;
|
|
'IF' SBS=61 'THEN' CODE(22)
|
|
'ELSE''IF' SBS=35 'THEN' CODE(23)
|
|
'ELSE''IF' SBS=60 'THEN' CODE(24)
|
|
'ELSE''IF' SBS=62 'THEN' CODE(25)
|
|
'ELSE''IF' SBS=63 'THEN' CODE(26)
|
|
'ELSE''IF' SBS=38 'THEN' CODE(27)
|
|
'ELSE' FAIL(9);
|
|
'END' RELATIONAL BOOLEAN;
|
|
|
|
'PROCEDURE' PUTOUT;
|
|
'IF' DECL<=HMPD 'THEN'
|
|
'BEGIN' 'IF' ADDR>31 'THEN'
|
|
'BEGIN' CODE(37); CODE(ADDR);
|
|
'END' STORE GLOBAL>31
|
|
'ELSE' CODE(160+ADDR)
|
|
'END' GLOBAL VARIABLE
|
|
'ELSE'
|
|
'BEGIN' 'IF' ADDR>15 'THEN'
|
|
'BEGIN' CODE(4); CODE(ADDR);
|
|
'END' STORE LOCAL>15
|
|
'ELSE' CODE(144+ADDR)
|
|
'END' LOCAL VARIABLE;
|
|
|
|
'PROCEDURE' GETOUT;
|
|
'IF' DECL<=HMPD 'THEN'
|
|
'BEGIN' 'IF' ADDR>63 'THEN'
|
|
'BEGIN' CODE(38); CODE(ADDR);
|
|
'END' FETCH GLOBAL >63
|
|
'ELSE' CODE(192+ADDR);
|
|
'END' FETCH GLOBAL
|
|
'ELSE'
|
|
'BEGIN' 'IF' ADDR>15 'THEN'
|
|
'BEGIN' CODE(12); CODE(ADDR);
|
|
'END' FETCH LOCAL>15
|
|
'ELSE' CODE(128+ADDR);
|
|
'END' FETCH LOCAL;
|
|
|
|
'INTEGER''PROCEDURE' IFCLAUSE;
|
|
'BEGIN' ABS; BE; CHFAIL(808,25);
|
|
IFCLAUSE:=CJMP 'END' IFCLAUSE;
|
|
|
|
'PROCEDURE' BPRIM;
|
|
'BEGIN' 'BOOLEAN' NOT;
|
|
'IF' FRED 'THEN''BEGIN' FETCH; 'GOTO' EBPRIM 'END';
|
|
'IF' BS=575 'THEN''BEGIN' NOT:='TRUE'; ABS 'END''ELSE' NOT:='FALSE';
|
|
'IF' BS=818 'THEN'
|
|
'BEGIN' ABS; CODE(29); CODE(30) 'END'
|
|
'ELSE''IF' BS=241 'THEN'
|
|
'BEGIN' ABS; CODE(29) 'END'
|
|
'ELSE''IF' LETTER 'THEN'
|
|
'BEGIN' TYPE:=3; IDENT; FRED:='TRUE';
|
|
'IF' BTYPE 'THEN' FETCH 'ELSE' RE; TYPE:=3;
|
|
'END'
|
|
'ELSE''IF' BS=40 'THEN'
|
|
'BEGIN' ABS; BE; CHFAIL(41,14) 'END'
|
|
'ELSE' RE;
|
|
'IF' NOT 'THEN' CODE(30);
|
|
EBPRIM:
|
|
'END' BPRIME;
|
|
|
|
'PROCEDURE' BTERM;
|
|
'BEGIN' BPRIM;
|
|
BTM1: 'IF' BS=118 'THEN'
|
|
'BEGIN' ABS; BPRIM; CODE(31); 'GOTO' BTM1 'END';
|
|
'END' BOOL TERM;
|
|
|
|
'PROCEDURE' SBE;
|
|
'BEGIN' BTERM;
|
|
SBE1: 'IF' BS=618 'THEN'
|
|
'BEGIN' ABS; BTERM; CODE(32); 'GOTO' SBE1 'END';
|
|
'END' SIMPLE BOOLEAN EXPRESSION;
|
|
|
|
'PROCEDURE' BE;
|
|
'BEGIN''IF' BS#366 'THEN' SBE 'ELSE'
|
|
'BEGIN''INTEGER' L1,L2;
|
|
L1:=IFCLAUSE; SBE; CHFAIL(212,8);
|
|
L2:=JMPNEW; LDEC(L1);
|
|
BE; LDEC(L2) 'END';
|
|
'END' BOOLEAN EXPRESSION;
|
|
|
|
'PROCEDURE' STID(LEN); 'VALUE' LEN; 'INTEGER' LEN;
|
|
'BEGIN' DECL:=DECL+1; ILNP[DECL]:=ILFP;
|
|
IL[ILFP+LEN]:=0; ILFP:=ILFP+LEN+1; SETO(IL] + ILFP);
|
|
ILVT[DECL]:=10; ILBD[DECL]:=0;
|
|
VADR[DECL]:=DECL;
|
|
'END' PUT STANDARD IDENTIFIER IN THE LIST;
|
|
|
|
ITEM:=0; MAX:=0;
|
|
STRT: SKIP(1);
|
|
WRITE(1,"RHA (Minisystems) Ltd subset Algol compiler"); SKIP(1);
|
|
|
|
WRITE(1,"CP/M-80, CP/M-86 or MS-DOS [1, 2 or 3] : ");
|
|
READ(1,DOS);
|
|
'IF' DOS<0 'OR' DOS>3 'THEN''GOTO' STRT;
|
|
'IF' DOS>1 'THEN'
|
|
'BEGIN' WRITE(1,"Origin in decimal : "); READ(1,FIRST);
|
|
SKIP(1);
|
|
'END';
|
|
|
|
HOL1:='FALSE'; CPR:='FALSE'; STRING:='FALSE';
|
|
HMPD:=0; LDPT:=0; FIXSP:=0; DEPTH:=0; DOLL:='FALSE'; LINE:=1;
|
|
NLAB:=1; NODEC:=10; NADR:=1; FRED:='FALSE'; SECOND:='FALSE';
|
|
ILFP:=0; FRFP:=0; SIZE:=4;
|
|
IOC(8); IOC(3); SETO(SWLIST+13);
|
|
WRITE(10,"IAG"); INPUT(INDEV);
|
|
'IF' INDEV>0 'THEN' 'GOTO' IOK;
|
|
IOC(5); INPUT(INDEV);
|
|
'IF' INDEV<0 'THEN' 'GOTO' IOCH; IOC(3); IOC(6); 'GOTO' IOK;
|
|
IOCH: IOC(2); SETO(SWLIST+13); WRITE(10,"IAG");
|
|
INPUT(INDEV); 'IF' INDEV<0 'THEN' 'GOTO' IOCH;
|
|
IOK: SETO(SWLIST+13);
|
|
'IF' DOS=1 'THEN' WRITE(10,"ZSM")
|
|
'ELSE''IF' DOS=2 'THEN' WRITE(10,"A86")
|
|
'ELSE' WRITE(10,"ASM");
|
|
OUTPUT(DEV);
|
|
SETO(SWLIST+13); WRITE(10,"MON"); OUTPUT(DEVT);
|
|
SETO(SWLIST+13); WRITE(10,"IAG"); IOC(7);
|
|
TABLES:=DEVT>0;
|
|
'IF' DEVT<1 'THEN' DEVT:=1;
|
|
'IF' TABLES 'THEN''BEGIN' SKIP(DEVT);
|
|
WRITE(DEVT,"IDENTIFIER TABLE SIZE = ",MAXNID); SKIP(DEVT);
|
|
'END';
|
|
|
|
SKIP(DEV);
|
|
'IF' DOS=1 'THEN'
|
|
'BEGIN' WRITE(DEV,"BASE QUERY 'ORIGIN'");
|
|
SKIP(DEV); WRITE(DEV,"ORG BASE"); SKIP(DEV);
|
|
WRITE(DEV,"#L0");
|
|
'END'
|
|
'ELSE' 'BEGIN'
|
|
'IF' DOS=3 'THEN'
|
|
WRITE(DEV,"DATA SEGMENT COMMON 'ALGOL'")
|
|
'ELSE' WRITE(DEV,"DSEG");
|
|
SKIP(DEV); WRITE(DEV,"ORG ",FIRST,"D");
|
|
SKIP(DEV); WRITE(DEV," DW OFFSET L0");
|
|
'END';
|
|
SKIP(DEV);
|
|
|
|
DECL:=0; SETO(IL]);
|
|
WRITE(10,"SKIP"); STID(4);
|
|
WRITE(10,"READ"); STID(4);
|
|
WRITE(10,"WRITE"); STID(5);
|
|
WRITE(10,"CHIN"); STID(4);
|
|
WRITE(10,"CHOUT"); STID(5);
|
|
WRITE(10,"IOC"); STID(3);
|
|
WRITE(10,"CLOSE"); STID(5);
|
|
WRITE(10,"DELETE"); STID(6);
|
|
WRITE(10,"INPUT"); STID(5);
|
|
WRITE(10,"OUTPUT"); STID(6);
|
|
|
|
CHOUT(DEV); CHIN(INDEV); ABS; STATEMENT;
|
|
'IF' BS#36 'THEN' WARN(6); CODE(18);
|
|
'IF' LDPT#0 'THEN'
|
|
'FOR' DECL:=1 'STEP' 1 'UNTIL' LDPT 'DO'
|
|
'BEGIN'
|
|
'FOR' FIRST:=0 'STEP' 1 'UNTIL' 100 'DO'
|
|
IDN[FIRST]:=FRN[FRNP[DECL]+FIRST];
|
|
LINE:=FLINE[DECL]; WARN(2)
|
|
'END';
|
|
FIXSP:=FIXSP+FIXSP+2;
|
|
|
|
SKIP(DEV);
|
|
'IF' DOS=3 'THEN'
|
|
'BEGIN' WRITE(DEV,"L0="); CHOUT(,36); 'END'
|
|
'ELSE' WRITE(DEV,"L0:");
|
|
SKIP();
|
|
'IF' DOS=1 'THEN' WRITE(,"#") 'ELSE' WRITE(," DW ");
|
|
WRITE(,FIXSP);
|
|
'IF' DOS=3 'THEN'
|
|
'BEGIN' SKIP(DEV); WRITE(DEV,"DATA ENDS"); 'END';
|
|
SKIP(DEV); WRITE(DEV,"END");
|
|
SKIP(DEV);
|
|
|
|
EPROG: CLOSE(DEV); CLOSE(INDEV); CLOSE(DEVT); SKIP(1);
|
|
WRITE(1,"SIZE ",SIZE);
|
|
WRITE(1," MAX ",MAX);
|
|
'END' IDENT TABLE BLOCK
|
|
'END' OF INTEGER SUBSET COMPILER
|
|
$$$$$$$$
|
|
|
|
|