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

