'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
$$$$$$$$