dos_compilers/RHA (Minisystems) ALGOL v55/ALGOL.IAG
2024-07-06 09:53:43 -07:00

1711 lines
53 KiB
Plaintext

'BEGIN'
'BYTE''ARRAY' DIG,LBUF[1:100],LNAM[1:100],IDN[0:100];
'INTEGER''ARRAY' ILEV,NLEV,LLEV[1:5];
'INTEGER' INDEV,DEV,CHAR,LINE,BS,DECL,TYPE,NLAB,FIRST,
LDPT,SIZE,NADR,DBASE,NODEC,ND1,ND2,ADDR,
DEPTH,LBP,MAXNID,
ADEPTH,PDEPTH,FIXSP,NPN,SCHAR,BSIZE,RSIZE,
DEVT,BYTES,ITEM,ILEP,NAPT,MAXLAB,TLIN,
ILFP,FRFP,MAX,MXV;
'BOOLEAN' SECOND,DOLL,LETTER,DIGIT,FOUND,FRED,FFET,AEREAD,
HOL1,FULL,STRING,BUGS,RERUN,LIST,IDTAB,PRECOM,BITSTR,
LTAB,DIAGNOSTICS;
'COMMENT' 10/10/80 COMPACT OUTPUT;
'COMMENT' 4/11/82 TANDY MULTIPLES, FASTER INPUT;
'COMMENT' 12/6/83 RING CHARACTER BUFFER, LINE NUMBERS FROM
START OF FILE;
'COMMENT' 27/2/84 EXTERNAL REFERENCES,
AUG-84, ADDITION OF VDEP, OCT-84 MULTIPLE ASSIGNMENTS
AND PARAMETER RECOGNITION IMPROVED, ADDITION OF
CASE, REPEAT AND WHILE;
'COMMENT' 26/4/85 INDEFINITE LENGTH IDENTIFIERS;
'INTEGER' 'PROCEDURE' FREESP; IOC(10);
MAXNID:=FREESP%2; 'IF' MAXNID<0 'THEN' MAXNID:=32767+MAXNID;
MAXNID:=(MAXNID-700)%7;
MAXLAB:=MAXNID%4; MAXNID:=MAXNID-MAXLAB;
'BEGIN''INTEGER''ARRAY' ILNP,VADR,VDEP[1:MAXNID],
FRNP,FRLN,FLINE[1:MAXLAB];
'BYTE''ARRAY' IL[0:MAXNID*6],ILVT,ILBD[1:MAXNID],
FRN[0:MAXLAB*6],FLVT,FLBD[1:MAXLAB];
'COMMENT' IOC(17) FINDS OUTPUT CHANNEL,
IOC(21) SELECTS OUTPUT CHANNEL,
IOC(22) FLUSHES OUT HALF FILLED BYTES,
BS2() OUTPUTS 2 BIT CODE,
BS8() OUTPUTS 1 BYTE,
BS16() OUTPUTS 1 WORD,
BITQ() OUTPUTS CODES FOR BYTES OR WORDS;
'PROCEDURE' BS2(N); 'VALUE' N; 'INTEGER' N;
IOC(18);
'PROCEDURE' BS8(N); 'VALUE' N; 'INTEGER' N;
IOC(19);
'PROCEDURE' BS16(N); 'VALUE' N; 'INTEGER' N;
IOC(20);
'PROCEDURE' BITQ(N,M); 'VALUE' N,M; 'INTEGER' N,M;
'BEGIN' 'IF' N>255 'THEN'
'BEGIN' BS2(3); BS2(M); IOC(20); 'END'
'ELSE' 'BEGIN' BS2(M); IOC(19); 'END';
'END';
'PROCEDURE' SNAM;
'IF' ILEP=1 'THEN' WRITE(DEVT,"MAIN SOURCE")
'ELSE''BEGIN''INTEGER' I;
WRITE(DEVT,"LIBRARY "); I:=NAPT;
LNOU: 'IF' LNAM[I]#0 'THEN'
'BEGIN' CHOUT(DEVT,LNAM[I]); I:=I+1; 'GOTO' LNOU;
'END';
'END' OUTPUT SOURCE NAME;
'PROCEDURE' INCH;
LOOP:
'IF' HOL1 'THEN' HOL1:='FALSE''ELSE'
'BEGIN' CHIN(,CHAR);
'COMMENT' FOR TRS-80 DO 'IF' CHAR=64 'THEN' CHAR:=94 'ELSE';
'IF' CHAR=26 'THEN'
'BEGIN' CLOSE(INDEV);
'IF' (LTAB 'OR' IDTAB) 'AND''NOT' LIST 'THEN'
'BEGIN' SKIP(DEVT); WRITE(DEVT,"END OF ");
SNAM;
'END';
'IF' ILEP=1 'THEN'
'BEGIN' INPUT(INDEV);
'IF' INDEV>0 'THEN'
'BEGIN' CHIN(INDEV); 'GOTO' LOOP 'END';
INDEV:=0; CHIN(0);
WARN(49); 'GOTO' EPROG;
'END' NOT LIBRARY FILE 'ELSE'
'BEGIN' ILEP:=ILEP-1; INDEV:=ILEV[ILEP];
LNAM[NAPT]:=0; NAPT:=NLEV[ILEP];
LINE:=LLEV[ILEP]; CHIN(INDEV);
'GOTO' LOOP;
'END' LIBRARY CALL
'END' END OF FILE;
LBP:=LBP+1; 'IF' LBP=101 'THEN' LBP:=1;
LBUF[LBP]:=CHAR;
'IF' CHAR=13 'THEN'
'BEGIN' LINE:=LINE+1; TLIN:=TLIN+1;
'END';
'IF' LIST 'THEN'
'BEGIN' 'IF' CHAR=13 'THEN'
'BEGIN' SKIP(DEVT);
WRITE(DEVT,TLIN,":",LINE,">");
'END''ELSE'
'IF' CHAR # 10 'THEN' CHOUT(DEVT,CHAR);
'END';
'END' NEW INPUT NEEDED;
'PROCEDURE' MSYM(I,K,J);'VALUE'I,K,J;'INTEGER'I,K,J;
'IF' BS=I 'THEN'
'BEGIN' INCH;
'IF'CHAR=K 'THEN' BS:=J 'ELSE' HOL1:='TRUE';
'END';
'PROCEDURE' LBS;
'BEGIN' BS:=40*(CHAR-64);
INCH; BS:=BS+CHAR-64;
'IF'BS<64'THEN'BS:=BS+64;
'IF' BS=725 'THEN''BEGIN' INCH;
'IF' CHAR=80 'THEN' BS:=726;
'END' FIND IF REPEAT OR REAL;
'END' LONG BASIC SYMBOL;
'PROCEDURE' ABS;
'BEGIN'
L5:
'IF' DOLL 'THEN''BEGIN' WARN(27); 'GOTO' EPROG;
'END' READING BEYOND THE END;
LYY: INCH;
'IF'CHAR<33'THEN''GOTO'LYY;
'IF'CHAR>95'THEN'BS:=CHAR-96'ELSE'
'IF'CHAR>90'THEN'BS:=CHAR-64'ELSE'
'IF'CHAR=39'THEN'
'BEGIN' INCH; LBS;
LZZ: INCH;
'IF' CHAR#39 'THEN''GOTO' LZZ 'ELSE' 'GOTO' CHKLBS;
'END'
'ELSE''IF' CHAR<65 'THEN'
'BEGIN' BS:=CHAR;
'IF' CHAR>57 'THEN'
'BEGIN' MSYM(58,61,7000);MSYM(60,61,63);MSYM(62,61,38);
'COMMENT' FOR TRS80 DO MSYM(60,60,27) MSYM(62,62,29);
'END' POSSIBLE MULTIPLE
'END'
'ELSE''IF'FULL'THEN'
'BEGIN' LBS;
LAA: INCH;
'IF'CHAR>64'AND'CHAR<91'THEN''GOTO'LAA;
HOL1:='TRUE';
CHKLBS:
'IF' BS=123 'THEN'
'BEGIN''IF' DIAGNOSTICS 'THEN''GOTO' L5
'ELSE' 'BEGIN' L6: ABS; 'IF' BS#203 'THEN'
'GOTO' L6 'ELSE''GOTO' L5;
'END' DIAGNOSTICS ARE COMMENTS;
'END' CC FOUND;
'IF' BS=203 'THEN''GOTO' L5;
'IF' BS=489 'THEN'
'BEGIN' 'INTEGER' J;
ILEV[ILEP]:=INDEV;
LLEV[ILEP]:=LINE; LINE:=1;
NLEV[ILEP]:=NAPT; J:=NAPT;
L4: 'IF' LNAM[J]#0 'THEN''BEGIN' J:=J+1; 'GOTO' L4;
'END' FIND END OF CURRENT NAME;
NAPT:=J; ILEP:=ILEP+1;
L1: INCH;
'IF' CHAR#34 'THEN' 'GOTO' L1; IOC(1);
L2: INCH;
'IF' CHAR=34 'THEN' 'GOTO' L3;
LNAM[J]:=CHAR; J:=J+1; LNAM[J]:=0;
CHOUT(7,CHAR); 'GOTO' L2;
L3: IOC(5); INPUT(INDEV);
'IF' INDEV<1 'THEN'
'BEGIN' WARN(51); 'GOTO' EPROG; 'END';
CHIN(INDEV);
'IF' (LTAB 'OR' IDTAB) 'AND''NOT' LIST 'THEN'
'BEGIN' SKIP(DEVT); WRITE(DEVT,"START OF ");
SNAM;
'END';
'GOTO' LYY;
'END' LIBRARY CALL;
'END' LONG BASIC SYMBOL
'ELSE'BS:=CHAR-64;
DIGIT:=BS>47 'AND' BS<58; LETTER:=BS<27; DOLL:=BS=249;
'END' ABS;
'BOOLEAN''PROCEDURE' TERM;
TERM:=BS=214 'OR' BS=854 'OR' BS=59 'OR' BS=212 'OR' DOLL;
'BOOLEAN''PROCEDURE' ATYPE;
ATYPE:=TYPE>4 'AND' TYPE<8;
'BOOLEAN''PROCEDURE' BTYPE;
BTYPE:=TYPE=3 'OR' TYPE=7 'OR' TYPE=13 'OR' TYPE=18 'OR' TYPE=23;
'INTEGER''PROCEDURE' EXPAND(X); 'VALUE' X; 'INTEGER' X;
'BEGIN'
'IF' X<=31 'THEN' X:=X+64;
EXPAND:=X;
'END' EXPAND;
'PROCEDURE' DEFINE(L1,L2); 'VALUE' L1,L2; 'INTEGER' L1,L2;
'IF' BITSTR 'THEN'
'BEGIN' IOC(21); BITQ(L1,2); BS2(1); BITQ(L2,1); 'END'
'ELSE''BEGIN' SKIP(DEV); WRITE(DEV,"L",L1,"=L",L2); ITEM:=0;
SKIP(DEV); 'END';
'INTEGER''PROCEDURE' LOWER(X); 'VALUE' X; 'INTEGER' X;
LOWER:=X-X%BSIZE*BSIZE;
'PROCEDURE' IDENT;
'BEGIN''INTEGER' I,J;
IDN[0]:='IF' BS<27 'THEN' BS+64 'ELSE' BS+21;
I:=1;
NCH: INCH;
'IF' CHAR>95 'THEN'
'BEGIN'
IDN[I]:=CHAR-32; 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' 'NOT' FULL 'AND' CHAR>64 'AND' CHAR<91 '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'; ADDR:=VADR[DECL];
TYPE:=ILVT[DECL];
'IF' ATYPE 'THEN' ADDR:=LOWER(ADDR);
'GOTO' ESRC;
'END' IDENTIFIER FOUND;
'END' LOOK AT ONE CHARACTER;
ID5: 'END' LOOK AT ONE IDENTIFIER;
ESRC:
'END' READ IDENT AND SEARCH DECLARATION LIST;
'PROCEDURE' CODE(X); 'VALUE' X; 'INTEGER' X;
'BEGIN'
'IF' BITSTR 'THEN''BEGIN'
IOC(21); BITQ(X,0);
'END''ELSE''BEGIN'
WRITE(DEV,X,","); ITEM:=ITEM+1;
'IF' ITEM>20 'THEN''BEGIN'
SKIP(DEV); ITEM:=0; 'END';
'END' NOT BITSTREAM;
SIZE:=SIZE+1;
'END' OUTPUT CODE;
'PROCEDURE' SIXBIT(CONSTANT);
'VALUE' CONSTANT; 'INTEGER' CONSTANT;
'IF' CONSTANT=0 'THEN' CODE(29)
'ELSE''IF' CONSTANT>64 'THEN'
'BEGIN' CODE(42); CODE(CONSTANT) 'END'
'ELSE' CODE(127+CONSTANT);
'PROCEDURE' LDEC(LNO); 'VALUE' LNO; 'INTEGER' LNO;
'IF' BITSTR 'THEN''BEGIN'
IOC(21); BITQ(LNO,2); BS2(0);
'END''ELSE''BEGIN' 'IF' ITEM>0 'THEN' SKIP(DEV);
ITEM:=0; WRITE(DEV,"L",LNO,":");
'END';
'PROCEDURE' LABEL(LNO); 'VALUE' LNO; 'INTEGER' LNO;
'BEGIN' SIZE:=SIZE+2;
'IF' BITSTR 'THEN''BEGIN'
IOC(21); BITQ(LNO,1);
'END''ELSE''BEGIN' WRITE(DEV,"#L",LNO,","); ITEM:=ITEM+2;
'IF' ITEM>20 'THEN''BEGIN' SKIP(DEV); ITEM:=0;
'END';
'END';
'END';
'INTEGER' 'PROCEDURE' JMPNEW;
'BEGIN' JMP(NLAB);
JMPNEW:=NEWLAB 'END';
'PROCEDURE' JMP(LNO); 'INTEGER' LNO; 'VALUE' LNO;
'BEGIN' CODE(9); LABEL(LNO) 'END';
'INTEGER ''PROCEDURE' NEWLAB;
'BEGIN' NEWLAB:=NLAB; NLAB:=NLAB+1 'END';
'PROCEDURE' VINFO(DECL); 'VALUE' DECL; 'INTEGER' DECL;
'BEGIN'
CODE(ILBD[DECL]); CODE(LOWER(VADR[DECL]));
'END';
'PROCEDURE' NEWADR;
'BEGIN' ADDR:=NADR; NADR:=NADR+1 'END';
'PROCEDURE' FSCHK;
'IF' ADDR>FIXSP 'THEN'
'BEGIN' FIXSP:=ADDR; 'IF' ADDR>=BSIZE 'THEN' WARN(5)
'END';
'PROCEDURE' SID;
'BEGIN''INTEGER' I, NB;
'BOOLEAN' EXTRA;
NB:=BYTES; 'IF' NB>63 'THEN' NB:=NB-64;
'IF' NB>31 'THEN''BEGIN' NB:=NB-32; EXTRA:='TRUE';
'END''ELSE' EXTRA:='FALSE';
'IF' NODEC>=MAXNID 'OR' ILFP>=MAXNID*6 'THEN'
'BEGIN' WARN(15); 'GOTO' SID1;
'END''ELSE' NODEC:=NODEC+1;
'IF' NODEC>MXV 'THEN' MXV:=NODEC;
'IF' FOUND 'AND' DECL>DBASE 'THEN' WARN(1);
'IF' TYPE<10 'THEN' FSCHK;
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;
'GOTO' SID1;
'END' END OF NAME;
'END';
SID1:
VADR[NODEC]:=ADDR; VDEP[NODEC]:=DEPTH;
ILVT[NODEC]:=TYPE; ILBD[NODEC]:=PDEPTH;
'IF' IDTAB 'OR' LTAB 'AND' TYPE>=10 'THEN'
'BEGIN' SKIP(DEVT);
'IF' IDTAB 'AND' TYPE>=10 'THEN' WRITE(DEVT," ");
IDOUT;
WRITE(DEVT," ",ADDR," ");
'IF' TYPE>=10 'AND' TYPE<14 'THEN'
WRITE(DEVT,"(",PDEPTH,")")
'ELSE' WRITE(DEVT,PDEPTH);
WRITE(DEVT," ",LINE," ",SIZE-2," ");
'IF'TYPE=0'THEN'WRITE(DEVT,"PARAMETER")'ELSE'
'IF'TYPE=1'THEN'WRITE(DEVT,"REAL")'ELSE'
'IF'TYPE=2'THEN'WRITE(DEVT,"INTEGER")'ELSE'
'IF'TYPE=3'THEN'WRITE(DEVT,"BOOLEAN")'ELSE'
'IF'TYPE=5'THEN'WRITE(DEVT,"REAL ARRAY")'ELSE'
'IF'TYPE=6 'AND' NB=2'THEN'
WRITE(DEVT,"INT ARRAY")'ELSE'
'IF'TYPE=6 'AND' NB=1 'THEN'
WRITE(DEVT,"BYTE ARRAY") 'ELSE'
'IF'TYPE=7'THEN'WRITE(DEVT,"BOOL ARRAY")'ELSE'
'IF'TYPE=8'THEN'WRITE(DEVT,"SWITCH")'ELSE'
'IF'TYPE=10'THEN'WRITE(DEVT,"PROCEDURE")'ELSE'
'IF'TYPE=11'THEN'WRITE(DEVT,"REAL PROC")'ELSE'
'IF'TYPE=12'THEN'WRITE(DEVT,"INT PROC")'ELSE'
'IF'TYPE=13'THEN'WRITE(DEVT,"BOOL PROC")'ELSE'
'IF'TYPE=14'THEN'WRITE(DEVT,"LABEL")'ELSE'
WRITE(DEVT,TYPE);
'IF' EXTRA 'THEN' WRITE(DEVT," EXTRA");
'IF' LIST 'THEN' SKIP(DEVT);
'END';
'END' STORE IDENT IN LIST;
'PROCEDURE' DARR(BYTES); 'VALUE' BYTES; 'INTEGER' BYTES;
'BEGIN''INTEGER' FIRST,DFIRST,COUNT,STYP,SUBS;
STYP:=TYPE;
DAR1: FIRST:=NADR; DFIRST:=NODEC+1; SUBS:=1; COUNT:=1;
DAR2: IDENT; TYPE:=STYP; NEWADR; SID;
'IF' BS=44 'THEN''BEGIN' COUNT:=COUNT+1;
ABS; 'GOTO' DAR2 'END';
CHFAIL(27,18); 'COMMENT' CHECK [;
NSUB: GET INTEGER; CHFAIL(58,18); GET INTEGER;
'IF' BS=29 'THEN' ABS 'ELSE'
'BEGIN' CHFAIL(44,18); SUBS:=SUBS+1; 'GOTO' NSUB
'END';
CODE(1); CODE(ADEPTH); CODE(COUNT); CODE(FIRST);
CODE(BYTES); CODE(SUBS);
'FOR' DECL:=DFIRST 'STEP' 1 'UNTIL' NODEC 'DO'
VADR[DECL]:=VADR[DECL]+BSIZE*SUBS;
'IF' BS=44 'THEN''BEGIN' ABS; 'GOTO' DAR1 'END';
SEMI(61); 'END' DECLARE ARRAY;
'PROCEDURE' DTV;
'BEGIN''INTEGER' STYP;
STYP:=TYPE;
DTV1: IDENT; TYPE:=STYP; NEWADR;
SID; 'IF' BS=44 'THEN''BEGIN' ABS; 'GOTO' DTV1 'END'
'ELSE''IF' BS=59 'THEN' SEMI(0);
'END' DECLARE VARIABLE LIST;
'INTEGER''PROCEDURE' DTYPE;
'BEGIN''INTEGER' I;
BYTES:=0;
I:='IF' BS=725 'THEN' 1
'ELSE''IF' BS=374 'THEN' 2
'ELSE''IF' BS=95 'THEN' 3
'ELSE''IF' BS=780 'THEN' 4
'ELSE''IF' BS=122 'THEN' 5
'ELSE' 'IF' BS=105 'THEN' 6
'ELSE''IF' BS=783 'THEN' 8
'ELSE''IF' BS=881 'THEN' 9
'ELSE''IF' BS=658 'THEN' 10
'ELSE''IF' BS=481 'THEN' 14 'ELSE' 0;
'IF' I=6 'THEN'
'BEGIN' ABS; CHFAIL(122,48); BYTES:=1;
'END' BYTE ARRAY
'ELSE''IF' I>0 'THEN'
'BEGIN' ABS;
'IF' BS=122 'THEN'
'BEGIN' I:=I+4; ABS;
'END' REAL, INTEGER OR BOOLEAN ARRAY
'ELSE''IF' BS=658 'THEN'
'BEGIN' I:=I+10; ABS;
'END' REAL, INTEGER OR BOOLEAN PROCEDURE;
'END' SOME SORT OF DECLARATION EXCEPT BYTE ARRAY;
'IF' BYTES=0 'THEN'
'BEGIN' BYTES:=
'IF' I=5 'THEN' 4 'ELSE' 'IF' I=6 'THEN' 2 'ELSE'
'IF' I=7 'THEN' 65 'ELSE' 0;
'END' SET BYTE COUNT IF NOT ALREADY DONE;
'IF' BYTES#0 'AND' BS=224 'THEN'
'BEGIN' ABS; BYTES:=BYTES+32;
'END' ADD EXTRA MEMORY BIT;
DTYPE:=I;
'END' READ TYPE OF DECLARATION;
'BOOLEAN''PROCEDURE' CHKFR(INDEX);
'VALUE' INDEX; 'INTEGER' INDEX;
'BEGIN''INTEGER' I,J;
CHKFR:='FALSE'; J:=FRNP[INDEX];
'FOR' I:=0 'STEP' 1 'UNTIL' 100 'DO'
'BEGIN' 'IF' IDN[I] # FRN[J+I] 'THEN''GOTO' NO;
'IF' IDN[I]=0 'THEN'
'BEGIN''IF' DEPTH=FLBD[INDEX] 'THEN' CHKFR:='TRUE';
'GOTO' NO;
'END' FOUND;
'END' CHARACTER LOOP;
NO:
'END' CHECK IF REFERENCE SATISFIED;
'PROCEDURE' GET INTEGER;
'IF' AE 'THEN' CODE(43);
'PROCEDURE' SFR;
'BEGIN'
'IF' 'NOT' FOUND 'OR' FOUND 'AND''NOT'
(DEPTH=VDEP[DECL] 'OR' DEPTH=-VDEP[DECL]) 'THEN'
'BEGIN''INTEGER' I;
'IF' LDPT#0 'THEN'
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
'IF' CHKFR(I) 'THEN'
'BEGIN' ADDR:=FRLN[I];
'IF' FLVT[I]#TYPE 'THEN' WARN(50);
'GOTO' ESFR;
'END' CHECK FOR PRE-EXISTING SAME FORWARD REFERENCE;
'IF' LDPT>=MAXLAB-1 'OR' FRFP>=MAXLAB*6 'THEN'
'BEGIN' WARN(30); 'GOTO' ESFR;
'END''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;
'END' END OF NAME;
'END';
SFR1:
FLVT[LDPT]:=TYPE; FLBD[LDPT]:=DEPTH; FLINE[LDPT]:=TLIN;
ADDR:=NEWLAB; FRLN[LDPT]:=ADDR;
'END' UNDECLARED PROCEDURE OR LABEL;
ESFR:
'END' RETURN PROCEDURE LABEL IF DECLARED, ELSE SET FORWARD REF;
'PROCEDURE' DLAB(EXTR); 'VALUE' EXTR; 'BOOLEAN' EXTR;
'BEGIN''INTEGER' I,SDEV;
'IF' EXTR 'THEN'
'BEGIN''IF' BITSTR 'THEN'
'BEGIN' IOC(21); BITQ(NLAB,2); BS2(2); IOC(22);
'END'
'ELSE' 'BEGIN' SKIP(DEV); WRITE(DEV,"L",NLAB,"='");
'END';
SDEV:=DEVT; DEVT:=DEV;
IDOUT; DEVT:=SDEV; WRITE(DEV,"'");
'IF''NOT' BITSTR 'THEN''BEGIN'
WRITE(DEV,","); ITEM:=0;
'END';
'END' EXTERNAL REFERENCE
'ELSE' LDEC(NLAB);
ADDR:=NEWLAB; SID;
'IF' LDPT#0 'THEN'
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
'IF' CHKFR(I) 'THEN'
'BEGIN' DEFINE(FRLN[I],ADDR);
'IF' FLVT[I]#TYPE 'THEN' WARN(50);
D2ELETE(I); I:=I-1
'END' DELETE SATISFIED FORWARD REFS;
'END' PUT LABEL OR PROCEDURE DECLARATION IN LIST;
'PROCEDURE' D2ELETE(ITEM); 'INTEGER' ITEM; 'VALUE' 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 DOWM;
LDPT:=LDPT-1;
'END' DELETE INTERNAL ITEM FROM LABEL/PROCEDURE LISTS;
'PROCEDURE' CSTR;
'BEGIN'
L: STCH;
'IF'CHAR=34'THEN'CODE(0)'ELSE'
'BEGIN' 'IF' CHAR=-1 'THEN' 'BEGIN' CODE(13); CODE(10) 'END' 'ELSE'
'IF' CHAR=-2 'THEN' CODE(34) 'ELSE'CODE(CHAR);'GOTO'L
'END';
ABS
'END';
'PROCEDURE' STCH;
'BEGIN'
L: INCH; 'IF' CHAR<32 'THEN' 'GOTO' L;
'IF' CHAR=42 'THEN'
'BEGIN' INCH;
'IF' CHAR=78 'THEN' CHAR:=-1 'ELSE'
'IF' CHAR=34 'THEN' CHAR:=-2 'ELSE'
'IF' CHAR=76 'THEN' CHAR:=10 'ELSE'
'IF' CHAR=84 'THEN' CHAR:=9 'ELSE'
'IF' CHAR=80 'THEN' CHAR:=12 'ELSE'
'IF' CHAR=67 'THEN' CHAR:=13 'ELSE'
'IF' CHAR=83 'THEN' CHAR:=32 'ELSE'
'IF' CHAR<32 'THEN' 'GOTO' L
'END' 'ELSE'
'IF' CHAR=94 'THEN'
'BEGIN' INCH; CHAR:=CHAR-(CHAR%32)*32;
'IF' CHAR=0 'THEN' 'GOTO' L
'END'
'END';
'PROCEDURE' PCALL;
'BEGIN''INTEGER' STYP;
'IF' FOUND 'AND' DECL<ND1 'THEN'
'BEGIN''INTEGER' SDEC; SDEC:=DECL;
'IF' DECL=11 'OR' DECL=12 'THEN'
'BEGIN' CODE(VADR[SDEC]); 'IF' BS=40 'THEN' WARN(36);
STYP:=ILVT[SDEC]; 'GOTO' ECL2;
'END' INPUT AND OUTPUT;
CHFAIL(40,32);
'IF' DECL=10 'OR' DECL>ND2 'THEN'
'BEGIN' GETINTEGER; 'GOTO' NREAD;
'END' DELETE OR EXTRA FUNCTION;
'IF' DECL<10 'THEN'
'BEGIN'
'IF' DECL=5 'OR' DECL=3 'THEN' GET INTEGER
'ELSE' 'IF' 'NOT' (BS=41 'OR' BS=44) 'THEN' GET INTEGER
'ELSE' CODE(84);
'IF' SDEC>=7 'THEN'
'BEGIN' CHFAIL(44,42);
'IF' SDEC#7 'THEN'
'BEGIN' GETINTEGER;
'IF' SDEC=8 'THEN'
'BEGIN' 'IF' BS=41 'THEN' CODE(29) 'ELSE'
'BEGIN' CHFAIL(44,42); GETINTEGER;
'END';
'END' WRITE;
CODE(VADR[SDEC]);
'END' WRITE OR CHOUT
'ELSE'
'BEGIN' 'IF''NOT' AE 'THEN' CODE(44);
'IF' BS=41'THEN'
'BEGIN' CODE(29); CODE(29) 'END'
'ELSE'
'BEGIN' CHFAIL(44,42); GETINTEGER;
CHFAIL(44,42); GET INTEGER;
'END' FORMATTED PRINT;
CODE(2);
'END' REAL WRITE
'END' NUMBER/CHAR OUTPUT
'ELSE''IF' SDEC=6 'THEN'
'BEGIN' CHFAIL(44,42);
'IF' BS=34 'THEN'
'BEGIN' CODE(5); CSTR
'END' NORMAL CALL
'ELSE' 'BEGIN' IDENT;
'IF''NOT' FOUND 'OR' TYPE#4 'THEN' WARN(42);
GETOUT; CODE(60)
'END' PRINT FORMAL STRING
'END' TEXT
'ELSE''IF' SDEC=4 'THEN'
'BEGIN' 'IF' BS#44 'THEN''GOTO' NREAD 'ELSE'
'BEGIN' ABS; DBE(14); CODE(72);
'END' READ WITH LABEL PARAMETER
'END' READ
'ELSE'
NREAD: CODE(VADR[SDEC]);
'END' INPUT/OUTPUT CALLS SDEC<10
'ELSE''IF' SDEC<=ND2 'THEN'
'BEGIN' 'IF''NOT' AE 'THEN' CODE(44);
CODE(27); CODE(SDEC-11);
'END' STANDARD FUNCTION CALL;
STYP:=ILVT[SDEC];
'END' CALL OF BUILT IN ROUTINES
'ELSE'
'BEGIN' 'INTEGER' COUNT,PRAD,PTYPE;
'BOOLEAN' FORMAL;
FORMAL:=FOUND 'AND' TYPE>14;
'IF' FORMAL 'THEN'
'BEGIN' PRAD:=DECL; STYP:=TYPE-5
'END' 'ELSE'
'BEGIN' SFR; STYP:=TYPE; PRAD:=ADDR
'END' SET TYPE OF NORMAL PROCEDURE CALL;
'IF' BS#40 'THEN'
'BEGIN' 'IF' FORMAL 'THEN'
'BEGIN' GETOUT; CODE(58);
'END' PARAMETERLESS FORMAL
'ELSE' 'BEGIN' CODE(11); LABEL(ADDR)
'END';
'GOTO' ECL2
'END' CALL OF PARAMETERLESS PROCEDURE;
COUNT:=0; ABS;
NPAR: PTYPE:=DTYPE;
'IF' PTYPE#0 'THEN'
'BEGIN' 'IF' PTYPE<10 'THEN' WARN(19); DBE(PTYPE);
'END' LABEL/PROCEDURE PARAMETER
'ELSE'
'BEGIN' 'IF' 'NOT' LETTER 'THEN'
'BEGIN''IF' BS=34 'THEN'
'BEGIN''INTEGER' L1; CODE(47); LABEL(NEWLAB);
L1:=JMPNEW; LDEC(L1-1); CSTR; LDEC(L1); TYPE:=4;
'END' STRING PARAMETER
'ELSE' 'BEGIN' TYPE:='IF' BS=575 'OR' BS=818 'OR'
BS=241 'THEN' 3 'ELSE' 1; 'GOTO' VEXP;
'END' NON-STRING NON-LETTER PARAMETER
'END' NON-LETTER PARAMETER
'ELSE' 'BEGIN' IDENT;
'IF''NOT' FOUND 'THEN' WARN(34);
'IF' BS=44 'OR' BS=41 'THEN'
'BEGIN''IF' TYPE>20 'OR' TYPE=4 'OR' ATYPE 'OR'
TYPE=8 'THEN' GETOUT
'ELSE''IF' TYPE<4 'THEN'
'BEGIN' TYPE:=TYPE+20; SVAD(DECL);
'END' 'ELSE' 'GOTO' VPAR;
'END' PARAMETER BY NAME
'ELSE'
VPAR: 'BEGIN' FRED:='TRUE';
VEXP: EXPRESSION; 'IF' TYPE<3 'AND'
(BS=35 'OR' BS=38 'OR' BS=60 'OR' BS=61
'OR' BS=62 'OR' BS=63) 'THEN'
'BEGIN' AEREAD:='TRUE'; SBE; TYPE:=3;
'END' RELATIONAL EXPRESSION
'END' NUMERICAL/BOOLEAN
'END' VARIABLE/ARRAY PARAMETER
'END' PARAMS NOT STARTING WITH DECLARATION;
SIXBIT(TYPE);
COUNT:=COUNT+1; 'IF' BS=44 'THEN'
'BEGIN' ABS; 'GOTO' NPAR
'END';
'IF' FORMAL 'THEN'
'BEGIN' DECL:=PRAD; GETOUT; CODE(59); CODE(COUNT);
'END'
'ELSE' 'BEGIN' CODE(36); CODE(COUNT); LABEL(PRAD)
'END';
'END' USER DECLARED PROCEDURE CALL;
CHFAIL(41,21);
ECL2: TYPE:=STYP;
'END' PROCEDURE CALL;
'PROCEDURE' SVAD(DECL); 'VALUE' DECL; 'INTEGER' DECL;
'BEGIN''INTEGER' LEVEL;
LEVEL:=ILBD[DECL];
'IF' LEVEL=0 'THEN'
'BEGIN' CODE(67); CODE(LOWER(VADR[DECL])) 'END'
'ELSE''IF' LEVEL=PDEPTH 'THEN'
'BEGIN' CODE(66); CODE(LOWER(VADR[DECL])) 'END'
'ELSE''BEGIN' CODE(39); VINFO(DECL) 'END';
'END' SET ADDRESS OF VARIABLE ON STACK;
'PROCEDURE' CURLY;
'BEGIN'
LOOP: INCH;
'IF' CHAR=125 'THEN' 'GOTO' FIN
'ELSE'
'IF' CHAR=123 'THEN' CURLY;
'GOTO' LOOP;
FIN:
'END';
'PROCEDURE' COMMENT;
'BEGIN'
COM: 'IF' CHAR=123 'THEN'
'BEGIN' CURLY; ABS; 'GOTO' COM;
'END';
'IF' BS=135 'THEN'
'BEGIN'
CL: INCH; 'IF' CHAR#59 'THEN''GOTO' CL 'ELSE'
'BEGIN' ABS; 'GOTO' COM
'END'
'END';
'IF' BS=169 'THEN'
'BEGIN''INTEGER' I;
I:=1;
CL1: ABS; DIG[I]:=BS; I:=I+1;
'IF' BS#59 'THEN''GOTO' CL1;
ABS; RDIR; 'GOTO' COM;
'END' DIRECTIVE;
'END' CHECK FOR COMMENT OR DIRECTIVE;
'PROCEDURE' RDIR;
'BEGIN''BOOLEAN' YES; 'INTEGER' P,C;
P:=1; YES:='TRUE';
DL: C:=DIG[P]; P:=P+1;
'IF' C=45 'THEN' YES:='FALSE'
'ELSE''IF' C=43 'THEN' YES:='TRUE'
'ELSE''IF' C=16 'THEN' PRECOM:=YES
'ELSE''IF' C=2 'THEN' BITSTR:=YES
'ELSE''IF' C=12 'THEN' LIST:=YES
'ELSE''IF' C=20 'THEN' IDTAB:=YES
'ELSE''IF' C=4 'THEN' DIAGNOSTICS:=YES
'ELSE''IF' C=19 'THEN' LTAB:=YES;
'IF' C#59 'THEN''GOTO' DL;
'END' DIRECTIVE;
'PROCEDURE' SEMI(FNO); 'VALUE' FNO; 'INTEGER' FNO;
'BEGIN' CHFAIL(59,FNO); COMMENT 'END';
'PROCEDURE' STATEMENT;
'BEGIN'
ST: 'IF' LIST 'THEN' WRITE(DEVT,"<",SIZE-2,">");
'IF' LETTER 'THEN'
'BEGIN' IDENT;
'IF' BS=58 'THEN'
'BEGIN' TYPE:=14; DLAB('FALSE'); CODE(61);
CODE(PDEPTH); CODE(ADEPTH); ABS;
'GOTO' ST;
'END' LABEL
'ELSE''IF' BS=27 'OR' BS=7000 'THEN' ASSIGNMENT(0,'FALSE',0,0)
'ELSE' 'BEGIN'
'IF' 'NOT' FOUND 'THEN' TYPE:=10
'ELSE''IF' TYPE#10 'AND' TYPE#15 'THEN' WARN(35);
PCALL
'END'
'END' UNCONDITIONAL NON-GOTO
'ELSE''IF' BS=366 'THEN'
'BEGIN''INTEGER' L1,L2;
L1:=IFCLAUSE; 'IF' BS=366 'THEN' WARN(33);
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; DBE(14); CODE(57);
'END' GOTO STATEMENT
'ELSE''IF' BS=928 'THEN'
'BEGIN''INTEGER' L1,L2;
L1:=NEWLAB; L2:=NEWLAB; LDEC(L1);
ABS; DBE(3); CHFAIL(175,56); CODE(28); LABEL(L2);
STATEMENT; JMP(L1); LDEC(L2);
'END' WHILE STATEMENT
'ELSE''IF' BS=726 'THEN'
'BEGIN''INTEGER' L1; L1:=NEWLAB;
LDEC(L1); ABS;
NREP: STATEMENT;
'IF' BS=59 'THEN''BEGIN' ABS; COMMENT; 'GOTO' NREP;
'END';
CHFAIL(854,57);
DBE(3); CODE(28); LABEL(L1);
'END' REPEAT STATEMENT
'ELSE''IF' BS=121 'THEN'
'BEGIN''INTEGER' L1,L2; 'BOOLEAN' FIRST;
L1:=NEWLAB; ABS; GET INTEGER; CHFAIL(606,58);
CODE(37); CODE(1);
'IF' DIGIT 'THEN'
'BEGIN' FIRST:='TRUE';
NEXC: GET INTEGER; CHFAIL(58,58);
CODE(38); CODE(1); CODE(41); CODE(22);
'IF' FIRST 'THEN' FIRST:='FALSE' 'ELSE' CODE(32);
'IF' DIGIT 'THEN''GOTO' NEXC;
L2:=NEWLAB; CODE(28); LABEL(L2);
STATEMENT; JMP(L1); LDEC(L2);
'IF' BS=59 'THEN'
'BEGIN' ABS; FIRST:='TRUE';
'IF' DIGIT 'THEN''GOTO' NEXC 'ELSE' WARN(58);
'END' ANOTHER CASE;
'END' DIGIT LABEL FOUND;
'IF' BS=212 'THEN'
'BEGIN' ABS; STATEMENT;
'END' ELSE PART
'ELSE''BEGIN' CHFAIL(214,58);
ECC: 'IF''NOT' TERM 'THEN'
'BEGIN' ABS; 'GOTO' ECC;
'END' END COMMENT;
'END' CASE TERMINATED BY END;
LDEC(L1);
'END' CASE STATEMENT
'ELSE' 'IF' BS=255 'THEN'
'BEGIN''INTEGER' SDECL,STYP,LVAR,STLAB,L1,L2,L3;
ABS; IDENT;
'IF''NOT'(FOUND'AND'(TYPE<3'OR' TYPE>20'AND'TYPE<23))
'THEN' WARN(13);
STYP:=TYPE; SDECL:=DECL; CHFAIL(7000,24);
NEWADR; LVAR:=ADDR; FSCHK;
STLAB:=NEWLAB; L3:=NEWLAB;
ELEMENT: L1:=L3; L2:=NEWLAB; L3:=NEWLAB; LDEC(L1);
'IF' STYP>20 'THEN'
'BEGIN' DECL:=SDECL;GETOUT; RHS(STYP-20);
CODE(55);
'END' CONTROLLED VARIABLE NAME PARAMETER
'ELSE' 'BEGIN' RHS(STYP); DECL:=SDECL; PUTOUT;
'END' VARIABLE IS NOT NAME PARAMETER;
CODE(64); CODE(LVAR);
LABEL('IF' BS=928 'THEN' L1 'ELSE''IF' BS=780
'THEN' L2 'ELSE' L3);
'COMMENT' SET ADDRESS FOR RETURN;
'IF' BS=928 'THEN'
'BEGIN' ABS; DBE(3); 'GOTO' FOR1
'END' WHILE ELEMENT
'ELSE''IF' BS#780 'THEN''GOTO' FOR2;
'BEGIN''INTEGER' L4; L4:=NEWLAB;
ABS; CODE(29); JMP(L4);
'COMMENT' SET ZERO FOR NO INCREMENT;
LDEC(L2); CODE(84); LDEC(L4);
'COMMENT' -1 TO INCREMENT;
RHS(TYPE); CHFAIL(854,31);
RHS(TYPE); 'IF' STYP>20 'THEN'
'BEGIN' DECL:=SDECL; GETOUT 'END'
'ELSE' SVAD(SDECL) ;
CODE(34);
CODE('IF' STYP=2 'OR' STYP=22 'THEN' 2 'ELSE' 0);
LABEL(L3); 'GOTO' FOR2;
'COMMENT' PARAMETERS FOR STEP TESTER;
'END' STEP ELEMENT;
FOR1: CODE(28); LABEL(L3);
FOR2: 'IF' BS=44 'THEN'
'BEGIN' ABS; JMP(STLAB); 'GOTO' ELEMENT
'END';
CHFAIL(175,22); LDEC(STLAB);
STATEMENT;
CODE(65); CODE(LVAR); LDEC(L3);
NADR:=NADR-1;
'END' FOR STATEMENT
'ELSE' 'IF' BS=85 'THEN'
'BEGIN''INTEGER' SDBASE,SNADR,SILFP,JPPL;
'BOOLEAN' PLS,ABM,BLOCK;
ABS; COMMENT;
PLS:='FALSE'; ABM:='FALSE'; BLOCK:='FALSE';
NDEC: TYPE:=DTYPE;
'IF' TYPE#0 'THEN'
'BEGIN''IF''NOT' BLOCK 'THEN'
'BEGIN' BLOCK:='TRUE'; DEPTH:=DEPTH+1;
SDBASE:=DBASE; DBASE:=NODEC; SNADR:=NADR;
SILFP:=ILFP;
'END';
'IF' LIST 'THEN' WRITE(DEVT,"<",SIZE-2,">");
'IF' TYPE<4 'THEN' DTV
'ELSE''IF' TYPE<10 'THEN'
'BEGIN''IF' PLS 'THEN'
'BEGIN' LDEC(JPPL); PLS:='FALSE''END';
'IF' TYPE=8 'THEN'
'BEGIN''INTEGER' NOS,NOSL;
DTV; CHFAIL(7000,45); CODE(47); LABEL(NEWLAB);
DECL:=NODEC; PUTOUT;
JPPL:=NLAB; JMP(NEWLAB);
LDEC(JPPL-1); NOSL:=NLAB;
LABEL(NEWLAB);NOS:=0;
PLS:='TRUE';
SEL: NOS:=NOS+1; IDENT; TYPE:=14; SFR; LABEL(ADDR);
'IF' BS=44 'THEN'
'BEGIN' ABS; 'GOTO' SEL 'END';
SEMI(46);
'IF' BITSTR 'THEN''BEGIN'
IOC(21); BITQ(NOSL,2); BS2(1); BITQ(NOS,0);
'END''ELSE''BEGIN' SKIP(DEV); ITEM:=0;
WRITE(DEV,"L",NOSL,"=",NOS); SKIP(DEV);
'END';
'END' DECLARE SWITCH TYPE=8
'ELSE''BEGIN'
'IF''NOT' ABM 'THEN'
'BEGIN' ABM:='TRUE'; ADEPTH:=ADEPTH+1 'END';
DARR(BYTES);
'END' DECLARE ARRAY T<10 BUT NOT 8
'END' DECLARE ARRAY OR SWITCH TYPE<10
'ELSE''BEGIN''IF''NOT' PLS 'THEN'
'BEGIN' JPPL:=JMPNEW; PLS:='TRUE'
'END';
DPROC;
'END' TYPE>=10;
'GOTO' NDEC;
'END' DECLARATIONS TYPE#0;
'IF' PLS 'THEN' LDEC(JPPL);
TAIL: STATEMENT;
'IF' BS=59 'THEN''BEGIN' ABS; COMMENT; 'GOTO' TAIL
'END'
'ELSE''IF' BS#214 'THEN'
'BEGIN' FAIL(16); 'GOTO' TAIL 'END';
ECOM: ABS; 'IF''NOT' TERM 'THEN''GOTO' ECOM;
'IF' BLOCK 'THEN'
'BEGIN'
'IF' ABM 'THEN''BEGIN' CODE(61); ADEPTH:=ADEPTH-1;
CODE(PDEPTH); CODE(ADEPTH) 'END';
NODEC:=DBASE; DBASE:=SDBASE; NADR:=SNADR;
ILFP:=SILFP;
EBLOCK;
'END' BLOCK
'END' BLOCK OR COMPOUND;
'END' STATEMENT;
'PROCEDURE' EBLOCK;
'BEGIN''INTEGER' I,J,K,L,M;
DEPTH:=DEPTH-1;
'IF' LDPT#0 'THEN'
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
'IF' FLBD[I]>DEPTH 'THEN'
'BEGIN' FLBD[I]:=DEPTH;
'FOR' J:=NODEC 'STEP' -1 'UNTIL' ND1 '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'(VDEP[J]=DEPTH 'OR' VDEP[J]=-DEPTH) 'THEN'
'BEGIN'
DEFINE(FRLN[I],VADR[J]); D2ELETE(I); I:=I-1;
'GOTO' EXLOOP;
'END' DECLARATION FOUND AT RIGHT DEPTH;
'END' NAMES MATCH;
'END' LOOK AT CHARACTERS OF NAME;
NO: 'END' DECLARED IDENTIFIER LIST LOOP;
EXLOOP: 'END' FORWARD LABEL SATISFACTION DEPTH CHANGE;
'END' DEAL WITH LABEL LIST AT BLOCK END;
'INTEGER''PROCEDURE' STAK;
STAK:=FIXSP*2+2;
'PROCEDURE' DPROC;
'BEGIN''INTEGER' SLTYP;
SLTYP:=TYPE; IDENT; TYPE:=SLTYP;
'IF' BS=224 'THEN'
'BEGIN' ABS; DLAB('TRUE');
'END' EXTERNAL REFERENCE
'ELSE'
'BEGIN''INTEGER' SNADR,SDBASE,SNODEC,SFIXSP,PINL,
SILFP,SDEV,SADEP,SPDEP;
SPDEP:=PDEPTH; PDEPTH:=NPN; NPN:=NPN+1;
'IF' PDEPTH>=BSIZE 'THEN' WARN(23);
DLAB('FALSE');
'IF' TYPE>10 'THEN' VDEP[NODEC]:=-VDEP[NODEC];
'IF' PRECOM 'OR' BS=214 'THEN'
'BEGIN' 'IF' BS=214 'THEN' ABS;
SDEV:=DEVT; DEVT:=DEV;
'IF' BITSTR 'THEN'
'BEGIN' IOC(21); BS2(3); BS2(3); BS2(1);
IOC(22);
'END'
'ELSE' 'BEGIN' SKIP(DEV); WRITE(DEV,"'");
'END';
IDOUT; WRITE(DEV,"'"); DEVT:=SDEV;
'IF' BITSTR 'THEN'
'BEGIN' IOC(21); BITQ(NLAB-1,1);
'END'
'ELSE' WRITE(DEV,"=L",NLAB-1,",");
'END' PRCOMPILER ENTRY DEFINITION;
SADEP:=ADEPTH; SDBASE:=DBASE; ADEPTH:=0; DEPTH:=DEPTH+1;
SNODEC:=NODEC; DBASE:=NODEC; SFIXSP:=FIXSP; SNADR:=NADR;
SILFP:=ILFP;
'COMMENT' MAKE BODY BEHAVE LIKE A BLOCK;
FIXSP:=3; NADR:=4; PINL:=NEWLAB; LABEL(PINL); CODE(PDEPTH);
'IF' BS=40 'THEN'
'BEGIN''INTEGER' SPTYP;
TYPE:=0; ABS; DTV; CHFAIL(41,21); SEMI(28);
'IF' FIXSP>103 'THEN' WARN(54);
'FOR' DECL:=1 'STEP' 1 'UNTIL' 100 'DO' DIG[DECL]:=0;
VALUE: SPTYP:=DTYPE;
'IF' SPTYP=9 'THEN'
'BEGIN'
LOOP: IDENT;
'IF''NOT' FOUND 'OR' DECL<=SNODEC 'THEN'
WARN(39) 'ELSE' DIG[DECL-SNODEC]:=1;
'IF' BS=44 'THEN'
'BEGIN' ABS; 'GOTO' LOOP 'END'
'ELSE''BEGIN' SEMI(29); 'GOTO' VALUE
'END'
'END' VALUE SPECIFICATION;
'GOTO' TSP1;
TSPEC: SPTYP:=DTYPE;
TSP1: 'IF' SPTYP#0 'THEN'
'BEGIN''IF' SPTYP=9 'THEN' WARN(26);
LOP: IDENT; 'IF''NOT' FOUND 'OR' TYPE#0 'THEN' WARN(29)
'ELSE' 'BEGIN' ILVT[DECL]:=SPTYP; ILBD[DECL]:=PDEPTH;
'END';
'IF' BS=44 'THEN'
'BEGIN' ABS; 'GOTO' LOP;
'END'
'ELSE' 'BEGIN' SEMI(29); 'GOTO' TSPEC;
'END'
'END' TYPE SPECIFICATION;
CODE(FIXSP-3); 'COMMENT' NUMBER OF PARAMETERS;
'FOR' DECL:=NODEC 'STEP' -1 'UNTIL' NODEC-FIXSP+4 'DO'
'BEGIN' TYPE:=ILVT[DECL];
'IF' TYPE>9 'THEN' ILVT[DECL]:=ILVT[DECL]+5
'ELSE''IF' ATYPE 'THEN'
'BEGIN''IF' DIG[DECL-SNODEC]#0 'THEN' WARN(41);
'END' FORMAL ARRAY
'ELSE''IF' TYPE<4 'AND' TYPE>0 'THEN'
'BEGIN''IF' DIG[DECL-SNODEC]=0 'THEN'
'BEGIN' TYPE:=TYPE+20;
ILVT[DECL]:=ILVT[DECL]+20;
'END' NAME PARAMETER
'END' UNSUBSCRIPTED VARIABLE
'ELSE' 'IF' TYPE=0 'THEN' WARN(40);
CODE(TYPE);
'END' CHECK TYPES OF PARAMETERS;
'END' PARAMETER SPECIFICATION
'ELSE'
'BEGIN' SEMI(29); CODE(0)
'END' NO PARAMETER CASE;
STATEMENT;
'IF' SLTYP>10 'THEN'
'BEGIN' CODE(195); 'END';
CODE(10);
'IF' BITSTR 'THEN'
'BEGIN'
IOC(21); BITQ(PINL,2); BS2(1); BITQ(STAK,0);
'END'
'ELSE' 'BEGIN' SKIP(DEV); ITEM:=0;
WRITE(DEV,"L",PINL,"=",STAK); SKIP(DEV);
'END';
NADR:=SNADR; DBASE:=SDBASE; NODEC:=SNODEC;
FIXSP:=SFIXSP; ILFP:=SILFP;
'IF' VDEP[NODEC]<0 'THEN' VDEP[NODEC]:=-VDEP[NODEC];
ADEPTH:=SADEP; PDEPTH:=SPDEP; EBLOCK;
'END' NOT EXTERNAL REFERENCE;
SEMI(23);
'END' DECLARE PROCEDURE;
'INTEGER''PROCEDURE' SUBSCRIPT;
'BEGIN''INTEGER' STYPE,NOS,SDEC;
STYPE:=TYPE-4; SDEC:=DECL; CHFAIL(27,3); NOS:=1;
NSUB: GET INTEGER;
'IF' BS=29 'THEN' ABS 'ELSE'
'BEGIN' CHFAIL(44,4); NOS:=NOS+1; 'GOTO' NSUB
'END';
SUBSCRIPT:=NOS; DECL:=SDEC;
'IF' NOS#VADR[DECL]%BSIZE 'AND' VADR[DECL]%BSIZE#0 'THEN'
WARN(20);
TYPE:=STYPE 'END';
'PROCEDURE' FETCH;
'BEGIN'
'IF' FRED 'THEN' FRED:='FALSE' 'ELSE' IDENT;
'IF''NOT' FOUND 'THEN' TYPE:=TYPE+10;
'COMMENT' ASSUME UNDECLARED FUNCTION OF CURRENT TYPE;
'IF' TYPE>20 'THEN'
'BEGIN' TYPE:=TYPE-20; GETOUT; CODE(62);
'END' NAME PARAMETER
'ELSE''IF' TYPE>10 'THEN'
'BEGIN' PCALL; TYPE:=TYPE-10
'END'
'ELSE' 'IF' TYPE>4 'THEN'
'BEGIN''INTEGER' N;
N:=SUBSCRIPT; ARIN(68,69,14,DECL); CODE(N);
'END'
'ELSE' GETOUT;
'END' FETCH VARIABLE;
'PROCEDURE' EXPRESSION;
'BEGIN''IF' FRED 'THEN'
'BEGIN' FETCH; FFET:='TRUE'; 'END';
'IF' BTYPE 'THEN' DBE(3)
'ELSE' 'BEGIN' TYPE:='IF' AE 'THEN' 1 'ELSE' 2;
'IF' BS=35 'OR' BS=38 'OR' BS=60 'OR' BS=61
'OR' BS=62 'OR' BS=63 'THEN'
'BEGIN' RE; FFET:='TRUE'; SBE;
TYPE:=3;
'END' CONVERT ARITH TO BOOLEAN;
'END' EXPRESSION STARTS WITH ARITH ITEM;
'END' EXPRESSION;
'PROCEDURE' RHS(T); 'VALUE' T; 'INTEGER' T;
'BEGIN'
EXPRESSION;
'IF' T=1 'THEN'
'BEGIN''IF' TYPE=2 'THEN' CODE(44)
'ELSE''IF' TYPE=3 'THEN' WARN(59)
'END' REAL REQUIRED
'ELSE''IF' T=2 'THEN'
'BEGIN''IF' TYPE=1 'THEN' CODE(43)
'ELSE''IF' TYPE=3 'THEN' WARN(59)
'END' INTEGER REQUIRED
'ELSE''IF' TYPE#3 'THEN' WARN(60);
TYPE:=T
'END' ASSIGNMENT RIGHT HAND SIDE;
'PROCEDURE' ASSIGNMENT(RTYP,RECU,D,S); 'VALUE' RTYPE,RECU,D,S;
'INTEGER' RTYP,D,S; 'BOOLEAN' RECU;
'BEGIN''INTEGER' SS;
'IF' 'NOT' RECU 'THEN'
'BEGIN''IF' 'NOT' FOUND 'THEN' WARN(17);
D:=DECL; 'IF' ATYPE 'THEN' S:=SUBSCRIPT; RTYP:=TYPE;
'IF' RTYP>20 'THEN'
'BEGIN' RTYP:=RTYP-20; GETOUT;
'END' LEFT PART IS PARAM BY NAME
'ELSE''IF' RTYP>10 'THEN'
'BEGIN' RTYP:=RTYP-10;
'IF' VDEP[D]>0 'THEN' WARN(17);
'END' ASSIGN TO FUNCTION;
'END' SETUP FOR NON-RECURSIVE ENTRIES;
CHFAIL(7000,24);
'IF' LETTER 'THEN'
'BEGIN' IDENT;
'IF' BS#7000 'THEN'
'BEGIN''IF' ATYPE 'THEN'
'BEGIN' SS:=SUBSCRIPT;
'IF' BS=7000 'THEN''GOTO' MASG
'ELSE' 'BEGIN' ARIN(68,69,14,DECL);
CODE(SS); FFET:='TRUE';
'GOTO' NLHS;
'END' ARRAY PART OF RHS;
'END' ARRAY AFTER :=
'ELSE' 'BEGIN' FRED:='TRUE'; 'GOTO' NLHS;
'END' IDENT NOT ARRAY OF FOLLOWED BY :=
'END' IDENT NOT FOLLOWED BY :=
'ELSE' 'BEGIN''IF' 'NOT' FOUND 'THEN' WARN(17);
'IF' TYPE>20 'THEN'
'BEGIN' TYPE:=TYPE-20; GETOUT;
'END' MULTIPLE ASSIGN TO NAME PARAM
'ELSE''IF' TYPE>10 'THEN'
'BEGIN' TYPE:=TYPE-10;
'IF' VDEP[DECL]>0 'THEN' WARN(17);
'END' ASSIGN TO FUNCTION;
MASG: 'IF' TYPE#RTYP 'THEN' WARN(43);
ASSIGNMENT(RTYP,'TRUE',DECL,SS);
'GOTO' GV1;
'END' ANOTHER LEFT PART FOUND
'END' LETTER AFTER :=
'ELSE' 'BEGIN'
NLHS: RHS(RTYP);
'IF' RECU 'THEN'
'BEGIN' CODE(241);
GV1: CODE(209);
'END' STORE IN V1 FOR MULTIPLES;
TYPE:=ILVT[D];
'IF' TYPE>=11 'AND' TYPE<=13 'THEN' TYPE:=TYPE-10;
'IF' TYPE>20 'THEN' CODE(55)
'ELSE''IF' ATYPE 'THEN'
'BEGIN' ARIN(70,71,15,D); CODE(S);
'END' ASSIGN TO AN ARRAY ELEMENT
'ELSE''IF' TYPE<4 'THEN'
'BEGIN' DECL:=D; PUTOUT;
'END' ASSIGN TO SCALAR OR FUNCTION
'ELSE' WARN(17);
TYPE:=RTYP;
'END' DO ACTUAL ASSIGNMENT;
'END' ASSIGNMENT;
'PROCEDURE' ARIN(LOC,GLO,ANY,DEC);
'VALUE' LOC,GLO,ANY,DEC;
'INTEGER' LOC,GLO,ANY,DEC;
'BEGIN''INTEGER' LEVEL;
LEVEL:=ILBD[DEC];
'IF' LEVEL=0 'THEN'
'BEGIN' CODE(GLO); CODE(LOWER(VADR[DEC])) 'END'
'ELSE''IF' LEVEL=PDEPTH 'THEN'
'BEGIN' CODE(LOC); CODE(LOWER(VADR[DEC])) 'END'
'ELSE''BEGIN' CODE(ANY); VINFO(DEC) 'END';
'END' ARRAY ELEMENT INFORMATION;
'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); 'INTEGER' X; 'VALUE' X;
'BEGIN''INTEGER' I; SKIP(DEVT);
DELETE(DEV); DEV:=0; CHOUT(DEV,0); IOC(17);
WRITE(DEVT,"FAIL ",X," LINE ",LINE," IDENT ");
IDOUT; WRITE(DEVT," SYMBOL ",BS," ");
WRITE(DEVT," IN "); SNAM;
SKIP(DEVT); BUGS:='TRUE';
'IF' X#2 'THEN'
'BEGIN'
'FOR' I:=1 'STEP' 1 'UNTIL' 100 'DO'
'BEGIN' LBP:=LBP+1; 'IF' LBP=101 'THEN' LBP:=1;
'IF' LBUF[LBP]#0 'THEN' CHOUT(DEVT,LBUF[LBP]);
LBUF[LBP]:=0;
'END' PRINT RING BUFFER CONTENTS;
'IF' LIST 'THEN''BEGIN' SKIP(DEVT); WRITE(DEVT,"============");
'END';
'END' PRINT ERROR CONTEXT;
CHOUT(0);
'END' FAILURE WARNING;
'PROCEDURE' FAIL(X); 'INTEGER' X; 'VALUE' X;
'BEGIN' WARN(X);
'IF' TERM 'THEN' ABS;
NEXT: 'IF''NOT' TERM 'THEN''BEGIN' ABS; 'GOTO' NEXT 'END';
'END' FAILURE OUTPUT;
'PROCEDURE' CHFAIL(SYM,FNO); 'INTEGER' SYM,FNO; 'VALUE' SYM, FNO;
'BEGIN''IF' BS#SYM 'THEN' WARN(FNO); ABS 'END';
'PROCEDURE' SAVE;
'BEGIN' DECL:=DECL+1; DIG[DECL]:=EXPAND(BS); ABS 'END';
'PROCEDURE' RDIG;
L: 'IF' DIGIT 'THEN'
'BEGIN' SAVE; 'GOTO' L 'END';
'PROCEDURE' MAKREAL(R1,R2);
'VALUE' R1,R2; 'BOOLEAN' R1,R2;
'BEGIN' 'IF''NOT' R2 'THEN' CODE(44);
'IF''NOT' R1 'THEN' CODE(51);
'END' MAKE BOTH OPERANDS REAL;
'BOOLEAN''PROCEDURE' APRIME;
'BEGIN''BOOLEAN' PREAL;
'IF' FFET 'THEN'
'BEGIN' FFET:='FALSE'; APRIME:=TYPE=1; 'GOTO' EAPR;
'END' FIRST OPERAND FETCHED;
'IF' BS=40 'THEN'
'BEGIN' ABS; PREAL:=AE; CHFAIL(41,12)
'END'
'ELSE''IF' LETTER 'THEN'
'BEGIN' 'IF' TYPE>2 'THEN' TYPE:=2;
FETCH; 'IF''NOT' (TYPE=1 'OR' TYPE=2) 'THEN' WARN(38);
PREAL:=TYPE=1
'END'
'ELSE' 'BEGIN''INTEGER' I,J,K,L;
PREAL:='FALSE'; DECL:=0;
'IF' BS=38 'THEN'
'BEGIN' STCH;
K:=CHAR; L:=0;ABS; 'GOTO' INTOUT;
'END' CHARACTER LITERAL
'ELSE''BEGIN'
'IF' BS=46 'THEN''GOTO' RFRAC
'ELSE''IF''NOT' DIGIT 'THEN' FAIL(10)
'ELSE''BEGIN' RDIG;
'IF' BS=5 'THEN''GOTO' REXP
'ELSE''IF' BS#46 'THEN''GOTO' LITOUT;
RFRAC: SAVE; PREAL:='TRUE'; RDIG;
'IF' BS#5 'THEN''GOTO' LITOUT;
REXP: SAVE; PREAL:='TRUE';
'IF' BS=43 'OR' BS=45 'THEN' SAVE;
RDIG;
'END' NUMERIC NOT STARTING WITH SIGN OR POINT
'END' NUMERIC LITERAL;
LITOUT: 'IF' PREAL 'THEN'
'BEGIN' CODE(45);
'IF' BITSTR 'THEN''BEGIN'
IOC(21); BS2(3); BS2(3); BS2(0); IOC(22);
BS8(32); BS8(32);
'FOR' J:=1 'STEP' 1 'UNTIL' DECL 'DO'
BS8(DIG[J]);
BS8(13);
'END''ELSE''BEGIN'
SKIP(DEV); WRITE(DEV,"FL ");
'FOR' J:=1 'STEP' 1 'UNTIL' DECL 'DO'
CHOUT(DEV,DIG[J]);
SKIP(DEV); ITEM:=0;
'END';
SIZE:=SIZE+4;
'END' FLOATING POINT LITERAL
'ELSE''BEGIN' K:=0; L:=0;
'FOR' J:=1 'STEP' 1 'UNTIL' DECL 'DO'
'BEGIN' K:=10*K+DIG[J]-48; L:=L*10;
'IF' K>=BSIZE 'THEN'
'BEGIN' L:=L+K%BSIZE; K:=LOWER(K);
'END';
'IF' L>=BSIZE%2 'THEN' WARN(44);
'END' NUMERIC LITERAL CONVERSION;
INTOUT: 'IF' K=0 'AND' L=0 'THEN' CODE(29)
'ELSE' 'IF' L=0 'THEN' SIXBIT(K)
'ELSE''BEGIN' CODE(16); CODE(K); CODE(L) 'END'
'END';
'END';
APRIME:=PREAL;
TYPE:='IF' PREAL 'THEN' 1 'ELSE' 2;
EAPR: 'END' ARITHMETIC PRIMARY;
'BOOLEAN''PROCEDURE' AFAC;
'BEGIN''BOOLEAN' FREAL,SREAL,NEG;
'IF' FRED 'OR' FFET 'THEN' NEG:='FALSE' 'ELSE'
'BEGIN' NEG:=BS=45;
'IF' BS=43 'OR' BS=45 'THEN' ABS;
'END';
FREAL:=APRIME;
AFA1: 'IF' BS=30 'THEN'
'BEGIN''IF' 'NOT' FREAL 'THEN'
'BEGIN' CODE(44); FREAL:='TRUE'
'END';
ABS; CODE('IF' APRIME 'THEN' 49 'ELSE' 18);
'GOTO' AFA1
'END';
'IF' NEG 'THEN' CODE('IF' FREAL 'THEN' 46 'ELSE' 17);
AFAC:=FREAL;
TYPE:='IF' FREAL 'THEN' 1 'ELSE' 2;
'END' ARITHMETIC FACTOR;
'BOOLEAN''PROCEDURE' ATERM;
'BEGIN''BOOLEAN' FREAL,SREAL;
FREAL:=AFAC;
ATE1: 'IF' BS=42 'THEN'
'BEGIN' ABS; SREAL:=AFAC;
'IF' 'NOT' FREAL 'AND''NOT' SREAL 'THEN' CODE(19)
'ELSE''BEGIN'
MAKREAL(FREAL,SREAL); CODE(50); FREAL:='TRUE'
'END' REAL MULTIPLY;
'GOTO' ATE1
'END' MULTIPLY CASE
'ELSE''IF' BS=47 'THEN'
'BEGIN' ABS; SREAL:=AFAC;
MAKREAL(FREAL,SREAL);
CODE(52); FREAL:='TRUE'; 'GOTO' ATE1
'END' REAL DIVISION CASE
'ELSE''IF' BS=37 'THEN'
'BEGIN' ABS; SREAL:=AFAC;
'IF' FREAL 'OR' SREAL 'THEN' WARN(11);
CODE(20); 'GOTO' ATE1
'END' INTEGER DIVISION CASE
'ELSE' 'IF' BS=535 'THEN'
'BEGIN' ABS; SREAL:=AFAC;
'IF' FREAL 'OR' SREAL 'THEN' WARN(11);
CODE(76); 'GOTO' ATE1;
'END' MOD OPERATOR;
ATERM:=FREAL;
TYPE:='IF' FREAL 'THEN' 1 'ELSE' 2;
'END' ARITHMETIC TERM;
'BOOLEAN''PROCEDURE' SAE;
'BEGIN''BOOLEAN' FREAL,SREAL;
FREAL:=ATERM;
SAE1: 'IF' BS=43 'OR' BS=45 'OR' BS=33 'OR' BS=521 'OR' BS=169 'THEN'
'BEGIN''INTEGER' ADDOP;
ADDOP:=BS; ABS; SREAL:=ATERM;
'IF' 'NOT' FREAL 'AND''NOT' SREAL 'THEN'
'BEGIN'
CODE('IF' ADDOP=43 'THEN' 13
'ELSE''IF'ADDOP=33 'THEN' 73
'ELSE''IF'ADDOP=521'THEN' 74
'ELSE''IF'ADDOP=169'THEN' 75 'ELSE' 21)
'END'
'ELSE''BEGIN'
'IF' ADDOP=33 'OR' ADDOP=521 'OR' ADDOP=169 'THEN' WARN(11);
MAKREAL(FREAL,SREAL);
CODE('IF' ADDOP=43 'THEN' 53 'ELSE' 54);
FREAL:='TRUE';
'END' REAL ADDITION/SUBTRACTION;
'GOTO' SAE1
'END';
SAE:=FREAL;
TYPE:='IF' FREAL 'THEN' 1 'ELSE' 2;
'END' SIMPLE ARITHMETIC EXPRESSION;
'BOOLEAN''PROCEDURE' AE;
'IF' BS=366 'THEN'
'BEGIN''BOOLEAN' FREAL,SREAL; 'INTEGER' L1,L2;
L1:=IFCLAUSE; FREAL:=SAE; CHFAIL(212,7);
L2:=JMPNEW; LDEC(L1);
SREAL:=AE;
'IF' FREAL 'AND' SREAL 'OR''NOT' FREAL 'AND''NOT' SREAL 'THEN' LDEC(L2)
'ELSE''IF' FREAL 'THEN'
'BEGIN' CODE(44); LDEC(L2)
'END'
'ELSE' 'BEGIN' L1:=JMPNEW; LDEC(L2); CODE(44);
FREAL:='TRUE'; LDEC(L1)
'END';
AE:=FREAL;
TYPE:='IF' FREAL 'THEN' 1 'ELSE' 2;
'END'
'ELSE' AE:=SAE;
'PROCEDURE' SETI(I); 'VALUE' I; 'INTEGER' I; IOC(11);
'PROCEDURE' SETO(I); 'VALUE' I;
'INTEGER' I; IOC(12);
'INTEGER' 'PROCEDURE' SWLIST; IOC(16);
'PROCEDURE' RE;
'BEGIN''INTEGER' SBS; 'BOOLEAN' FREAL,SREAL;
FREAL:=TYPE=1; SBS:=BS; ABS; SREAL:=AE;
'IF''NOT' FREAL 'AND''NOT' SREAL 'THEN' CODE(41)
'ELSE''BEGIN' MAKREAL(FREAL,SREAL); CODE(56);
'END';
'IF' SBS=61 'THEN' CODE(22)
'ELSE''IF' SBS=35 'THEN' 'BEGIN' CODE(22); CODE(30) 'END'
'ELSE''IF' SBS=60 'THEN' CODE(24)
'ELSE''IF' SBS=62 'THEN' CODE(23)
'ELSE''IF' SBS=63 'THEN' 'BEGIN' CODE(23); CODE(30) 'END'
'ELSE''IF' SBS=38 'THEN' 'BEGIN' CODE(24); CODE(30) 'END'
'ELSE' FAIL(9);
TYPE:=3;
'END' RELATIONAL BOOLEAN;
'PROCEDURE' PUTOUT;
'BEGIN''INTEGER' LEVEL, SLOT;
LEVEL:=ILBD[DECL];
SLOT:='IF' VDEP[DECL]<0 'THEN' 3
'ELSE' LOWER(VADR[DECL]);
'IF' LEVEL=0 'THEN'
'BEGIN''IF' SLOT>15 'THEN'
'BEGIN' CODE(37); CODE(SLOT); 'END'
'ELSE' CODE(240+SLOT);
'END'
'ELSE''IF' LEVEL=PDEPTH 'THEN'
'BEGIN''IF' SLOT>15 'THEN'
'BEGIN' CODE(4); CODE(SLOT); 'END'
'ELSE' CODE(224+SLOT);
'END'
'ELSE'
'BEGIN' CODE(26); CODE(LEVEL); CODE(SLOT); 'END';
'END' STORE VARIABLE;
'PROCEDURE' GETOUT;
'BEGIN''INTEGER' LEVEL, SLOT;
LEVEL:=ILBD[DECL];
SLOT:='IF' VDEP[DECL]<0 'THEN' 3
'ELSE' LOWER(VADR[DECL]);
'IF' LEVEL=0 'THEN'
'BEGIN''IF' SLOT>15 'THEN'
'BEGIN' CODE(38); CODE(SLOT); 'END'
'ELSE' CODE(208+SLOT);
'END'
'ELSE''IF' LEVEL=PDEPTH 'THEN'
'BEGIN''IF' SLOT>15 'THEN'
'BEGIN' CODE(12); CODE(SLOT); 'END'
'ELSE' CODE(192+SLOT);
'END'
'ELSE'
'BEGIN' CODE(25); CODE(LEVEL); CODE(SLOT); 'END';
'END' FETCH VARIABLE;
'INTEGER''PROCEDURE' IFCLAUSE;
'BEGIN' ABS; DBE(3); CHFAIL(808,25);
CODE(28); LABEL(NLAB); IFCLAUSE:=NEWLAB 'END' IFCLAUSE;
'PROCEDURE' BPRIM;
'BEGIN' 'BOOLEAN' NOT;
'IF' FFET 'THEN'
'BEGIN' FFET:='FALSE'; 'GOTO' EBPRIM;
'END' BOOLEAN OPERAND FETCHED;
'IF' BS=575 'THEN''BEGIN' NOT:='TRUE'; ABS 'END'
'ELSE' NOT:='FALSE';
'IF' BS=818 'THEN'
'BEGIN' ABS; CODE(84) 'END'
'ELSE''IF' BS=241 'THEN'
'BEGIN' ABS; CODE(29) 'END'
'ELSE''IF' LETTER 'THEN'
'BEGIN' TYPE:=3; FETCH;
'IF''NOT' BTYPE 'THEN'
'BEGIN' FFET:='TRUE'; 'GOTO' RELAT;
'END' IDENTIFIER NOT BOOLEAN;
'END' EXPRESSION STARTS WITH IDENTIFIER
'ELSE''IF' BS=40 'THEN'
'BEGIN' ABS; DBE(3); CHFAIL(41,14) 'END'
'ELSE' 'BEGIN' TYPE:=2;
RELAT: TYPE:='IF' AE 'THEN' 1 'ELSE' 2; RE;
'END' RELATIONAL PRIMARY;
'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' SBE2;
'BEGIN' BTERM;
SBE1: 'IF' BS=618 'THEN'
'BEGIN' ABS; BTERM; CODE(32); 'GOTO' SBE1 'END';
'END' SBE WITHOUT EQUIV;
'PROCEDURE' SBEQ;
'BEGIN' SBE2;
SBQ2: 'IF' BS=373 'THEN'
'BEGIN' CODE(30); ABS; SBE2; CODE(32); 'GOTO' SBQ2 'END';
'END' IMPLIES;
'PROCEDURE' SBE;
'BEGIN' SBEQ;
SBE3: 'IF' BS=217 'THEN'
'BEGIN' ABS; SBEQ; CODE(33); 'GOTO' SBE3 'END';
'END' SIMPLE BOOLEAN EXPRESSION;
'PROCEDURE' SDBE(DBTYP); 'VALUE' DBTYP; 'INTEGER' DBTYP;
'BEGIN'
'IF' DBTYP=3 'THEN' SBE
'ELSE''IF' BS=40 'THEN'
'BEGIN' ABS; DBE(DBTYP); CHFAIL(41,14)
'END'
'ELSE' 'BEGIN' IDENT;
'IF' FOUND 'THEN'
'BEGIN' 'IF' TYPE=DBTYP+5 'THEN' GETOUT
'ELSE''IF' TYPE=8 'THEN'
'BEGIN''IF' SUBSCRIPT#1 'THEN' WARN(47);
GETOUT; CODE(48);
'END' EVALUATE SWITCH
'ELSE''GOTO' SANF
'END' ACTION WHEN DECLARED
'ELSE' SANF: 'BEGIN' TYPE:=DBTYP; SFR;
CODE(47); LABEL(ADDR);
'END' SET ADDRESS OF NON-FORMAL
'END' SET ADDRESS OF LABEL OR PROCEDURE
'END' SIMPLE DESIGNATIONAL OR BOOLEAN EXPRESSION;
'PROCEDURE' DBE(DBTYP); 'VALUE' DBTYP; 'INTEGER' DBTYP;
'BEGIN'
'IF' BS#366 'THEN' SDBE(DBTYP)
'ELSE' 'BEGIN''INTEGER' L1,L2;
L1:=IFCLAUSE; SDBE(DBTYP); CHFAIL(212,8);
L2:=JMPNEW; LDEC(L1);
DBE(DBTYP); LDEC(L2);
'END' CONDITIONAL;
TYPE:=DBTYP;
'END' DESIGNATIONAL OR BOOLEAN EXPRESSION;
'PROCEDURE' STID(LEN,SADR,TYPE);
'VALUE' LEN,SADR,TYPE;
'INTEGER' LEN,SADR,TYPE;
'BEGIN' DECL:=DECL+1; NODEC:=DECL; ND1:=NODEC+1;
MXV:=NODEC; ILNP[DECL]:=ILFP;
IL[ILFP+LEN]:=0; ILFP:=ILFP+LEN+1;
SETO(IL] + ILFP);
VADR[DECL]:=SADR; ILVT[DECL]:=TYPE; ILBD[DECL]:=0;
'END' STORE STANDARD IDENTIFIER;
ITEM:=0; BSIZE:=256; RSIZE:=2; ILEP:=1;
NAPT:=1; LNAM[1]:=0;
LIST:='FALSE'; BITSTR:='TRUE'; PRECOM:='FALSE';
LTAB:='FALSE'; IDTAB:='FALSE';
'FOR' DECL:=1 'STEP' 1 'UNTIL' 100 'DO' LBUF[DECL]:=0;
HOL1:='FALSE'; STRING:='FALSE';
TLIN:=1; RERUN:='FALSE'; BUGS:='FALSE';
PDEPTH:=0; NPN:=1; LDPT:=0; FIXSP:=0; DEPTH:=0;
ADEPTH:=0; SIZE:=4; DOLL:='FALSE'; LINE:=1; LBP:=0;
ILFP:=0; FRFP:=0;
NLAB:=1; MAX:=0; NADR:=2; FRED:='FALSE'; FFET:='FALSE';
AEREAD:='FALSE'; SECOND:='FALSE'; DIAGNOSTICS:='FALSE';
IOC(8); IOC(3); SETO(SWLIST+13);
WRITE(10,"ALG"); 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); RERUN:='TRUE';
SETO(SWLIST+13); WRITE(10,"ALG"); INPUT(INDEV);
'IF' INDEV<1 'THEN' 'GOTO' IOCH;
IOK: SETO(SWLIST+13); WRITE(10,"OBJ"); OUTPUT(DEV);
SETI(SWLIST); DECL:=1;
GD: CHIN(10,DEVT);
'IF' DEVT#0 'THEN'
'BEGIN' DEVT:='IF' DEVT>95 'THEN' DEVT-96
'ELSE''IF' DEVT>64 'THEN' DEVT-64
'ELSE' DEVT;
DIG[DECL]:=DEVT; DECL:=DECL+1;
'GOTO' GD;
'END';
DIG[DECL]:=59; RDIR;
SETO(SWLIST+13); WRITE(10,"MON");
OUTPUT(DEVT);
'IF' DEVT>0 'THEN' IDTAB:='TRUE' 'ELSE' DEVT:=1;
SETO(SWLIST+13); WRITE(10,"ALG"); IOC(7);
IOC(1);
'IF' IDTAB 'THEN'
'BEGIN' SKIP(DEVT);
WRITE(DEVT,"IDENTIFIER TABLE SIZE=",MAXNID);
SKIP(DEVT);
WRITE(DEVT,"FORWARD REFERENCE TABLE SIZE=",MAXLAB);
SKIP(DEVT);
'END';
DECL:=0; SETO(IL]);
WRITE(10,"SKIP"); STID(4,40,10);
WRITE(10,"CHIN"); STID(4,7,12);
WRITE(10,"CLOSE"); STID(5,77,10);
WRITE(10,"READ"); STID(4,3,11);
WRITE(10,"IOC"); STID(3,35,10);
WRITE(10,"TEXT"); STID(4,5,10);
WRITE(10,"RWRITE"); STID(6,48,10);
WRITE(10,"WRITE"); STID(5,6,10);
WRITE(10,"CHOUT"); STID(5,8,10);
WRITE(10,"DELETE"); STID(6,78,10);
WRITE(10,"INPUT"); STID(5,79,12);
WRITE(10,"OUTPUT"); STID(6,80,12);
WRITE(10,"SQRT"); STID(4,0,11);
WRITE(10,"SIN"); STID(3,0,11);
WRITE(10,"COS"); STID(3,0,11);
WRITE(10,"ARCTAN"); STID(6,0,11);
WRITE(10,"EXP"); STID(3,0,11);
WRITE(10,"LN"); STID(2,0,11);
WRITE(10,"SIGN"); STID(4,0,12);
WRITE(10,"ENTIER"); STID(6,0,12);
WRITE(10,"ABS"); STID(3,0,11);
ND2:=NODEC;
WRITE(10,"OPSYSIDCODE"); STID(11,81,12);
WRITE(10,"SELECTINPUT"); STID(11,82,10);
WRITE(10,"SELECTOUTPUT"); STID(12,83,10);
CHIN(INDEV); CHOUT(DEV);
LXX: INCH; 'IF'CHAR=39'THEN'FULL:='FALSE''ELSE'
'IF'CHAR>64'AND'CHAR<91'THEN'FULL:='TRUE'
'ELSE''GOTO'LXX;
HOL1:='TRUE';
ABS; COMMENT;
'IF' BITSTR 'THEN''BEGIN'
WRITE(DEV,"B"); IOC(17);
BITQ(0,1);
'END''ELSE''BEGIN' SKIP(DEV); WRITE(DEV,"ORG 0"); SKIP(DEV);
WRITE(DEV,"#L0"); SKIP(DEV);
'END';
STATEMENT;
'IF' 'NOT' DOLL 'THEN' WARN(6); CODE(63);
'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';
'IF' BITSTR 'THEN''BEGIN'
IOC(21); BITQ(0,2); BS2(0);
BS2(3); BS2(0); BS16(STAK);
BS2(3); BS2(3); BS2(3); BS16(0);
IOC(22);
'END''ELSE''BEGIN'
SKIP(DEV); WRITE(DEV,"L0:#",STAK); SKIP(DEV);
WRITE(DEV,"END 0"); SKIP(DEV);
'END';
'IF' IDTAB 'THEN'
'BEGIN' SKIP(DEVT);
WRITE(DEVT,"MAXIMUM IDENTIFIERS IN SCOPE=",MXV);
SKIP(DEVT);
WRITE(DEVT,"MAXIMUM FORWARD REFERNECES=",MAX);
SKIP(DEVT);
'END';
EPROG: CLOSE(DEV); CLOSE(INDEV); CLOSE(DEVT);
SKIP(1);
'IF' BUGS 'THEN'
WRITE(1,"PROGRAM FAILS")
'ELSE' WRITE(1,"COMPILES OK");
SKIP(1); WRITE(1,"SIZE ",SIZE);
CHOUT(1,7); SKIP(1); SKIP(1);
'IF' RERUN 'THEN' IOC(9);
'END'
'END' OF RML ALGOL COMPILER
$$$$$