"PER BRINCH HANSEN
 INFORMATION SCIENCE
 CALIFORNIA INSTITUTE OF TECHNOLOGY
 PASADENA, CALIFORNIA 91125

 PDP 11/45 CONCURRENT/SEQUENTIAL PASCAL
 COMPILER PASS 6: CODE SELECTION

 9 SEPTEMBER 1974"
(NUMBER)

"###########
#  PREFIX  #
###########"

CONST              EOL = '(:10:)';     FF = '(:12:)';      EOM = '(:25:)';
PRINTLIMIT = 18;   MAXDIGIT = 6;
WORDLENGTH = 2 "BYTES";
REALLENGTH = 8 "BYTES";
SETLENGTH = 16 "BYTES";
LISTOPTION = 0;    SUMMARYOPTION = 1;  TESTOPTION = 2;     CHECKOPTION = 3;
CODEOPTION = 4;    NUMBEROPTION = 5;
MAXWORD = 100;

TYPE FILE = 1..2;

CONST IDLENGTH = 12;
TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR;

TYPE   POINTER = @ INTEGER;
TABLEPTR = @TABLE;
TABLE = RECORD
          NEXTPORTION: TABLEPTR;
          CONTENTS: ARRAY (.1..MAXWORD.) OF INTEGER
        END;
TABLEPART = RECORD
              PROGLENGTH, CODELENGTH, STACKLENGTH,
                VARLENGTH: INTEGER;
              JUMPTABLE, BLOCKTABLE, STACKTABLE,
                CONSTTABLE: TABLEPTR
            END;
TABLESPTR = @TABLEPART;
OPTION = LISTOPTION..NUMBEROPTION;
PASSPTR = @PASSLINK;
PASSLINK =
  RECORD
    OPTIONS: SET OF OPTION;
    LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER;
    TABLES: TABLESPTR
  END;

TYPE ARGTAG =
  (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE);

TYPE ARGTYPE = RECORD
                 CASE TAG: ARGTAG OF
                   NILTYPE, BOOLTYPE: (BOOL: BOOLEAN);
                   INTTYPE: (INT: INTEGER);
                   IDTYPE: (ID: IDENTIFIER);
                   PTRTYPE: (PTR: PASSPTR)
               END;

CONST MAXARG = 10;
TEXT_LENGTH = 18;
TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE;
  TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR;

CONST PAGELENGTH = 256;
TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER;

PROCEDURE READ(VAR C: CHAR);
PROCEDURE WRITE(C: CHAR);
PROCEDURE NOTUSED1;
PROCEDURE NOTUSED2;
PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE);
PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE);
FUNCTION FILE_LENGTH(F:FILE): INTEGER;
PROCEDURE MARK(VAR TOP: INTEGER);
PROCEDURE RELEASE(TOP: INTEGER);

PROGRAM MAIN(VAR PARAM: ARGLIST);

"#############################################
#  PASS(VAR OK: BOOLEAN; VAR LINK: POINTER)  #
#############################################"

CONST

"INPUT OPERATORS"

PUSHCONST1 = 0;    PUSHVAR1 = 1;       PUSHIND1 = 2;       PUSHADDR1 = 3;
FIELD1 = 4;        INDEX1 = 5;         POINTER1 = 6;       VARIANT1 = 7;
RANGE1 = 8;        ASSIGN1 = 9;        ASSIGNTAG1 = 10;    COPY1 = 11;
NEW1 = 12;         NOT1 = 13;          AND1 = 14;          OR1 = 15;
NEG1 = 16;         ADD1 = 17;          SUB1 = 18;          MUL1 = 19;
DIV1 = 20;         MOD1 = 21;          "NOT USED"          "NOT USED"
FUNCTION1 = 24;    BUILDSET1 = 25;     COMPARE1 = 26;      COMPSTRUC1 = 27;
FUNCVALUE1 = 28;   DEFLABEL1 = 29;     JUMP1 = 30;         FALSEJUMP1 = 31;
CASEJUMP1 = 32;    INITVAR1 = 33;      CALL1 = 34;         ENTER1 = 35;
RETURN1 = 36;      POP1 = 37;          NEWLINE1 = 38;      ERROR1 = 39;
CONSTANT1 = 40;    MESSAGE1 = 41;      INCREMENT1 = 42;    DECREMENT1 = 43;
PROCEDURE1 = 44;   INIT1 = 45;         PUSHLABEL1 = 46;    CALLPROG1 = 47;
EOM1=48;

"VIRTUAL DATA TYPES"

BYTETYPE = 0;      WORDTYPE = 1;       REALTYPE = 2;       SETTYPE = 3;

"VIRTUAL ADDRESSING MODES"

MODE0 = 0 "CONSTANT";
MODE1 = 1 "PROCEDURE";
MODE2 = 2 "PROGRAM";
MODE3 = 3 "PROCESS ENTRY";
MODE4 = 4 "CLASS ENTRY";
MODE5 = 5 "MONITOR ENTRY";
MODE6 = 6 "PROCESS";
MODE7 = 7 "CLASS";
MODE8 = 8 "MONITOR";
MODE9 = 9 "STANDARD";
MODE10=10 "UNDEFINED";

"COMPARISON OPERATORS"

LESS = 0;          EQUAL = 1;          GREATER = 2;        NOTLESS = 3;
NOTEQUAL = 4;      NOTGREATER = 5;     INSET = 6;

"STANDARD FUNCTIONS"

TRUNC1 = 0;        ABS1 = 1;           SUCC1 = 2;          PRED1 = 3;
CONV1 = 4;         EMPTY1 = 5;         ATTRIBUTE1 = 6;     REALTIME1 = 7;
MIN_FUNC = 0;      MAX_FUNC = 7;

"STANDARD PROCEDURES"

DELAY1 = 0;        CONTINUE1 = 1;      IO1 = 2;            START1 = 3;
STOP1 = 4;         SETHEAP1 = 5;       WAIT1 = 6;
MIN_PROC = 0;      MAX_PROC = 6;

"OUTPUT OPERATORS"

CONSTADDR2 = 0;    LOCALADDR2 = 1;     GLOBADDR2 = 2;      PUSHCONST2 = 3;
PUSHLOCAL2 = 4;    PUSHGLOB2 = 5;      PUSHIND2 = 6;       PUSHBYTE2 = 7;
PUSHREAL2 = 8;     PUSHSET2 = 9;       FIELD2 = 10;        INDEX2 = 11;
POINTER2 = 12;     VARIANT2 = 13;      RANGE2 = 14;        COPYBYTE2 = 15;
COPYWORD2 = 16;    COPYREAL2 = 17;     COPYSET2 = 18;      COPYTAG2 = 19;
COPYSTRUC2 = 20;   NEW2 = 21;          NEWINIT2 = 22;      NOT2 = 23;
ANDWORD2 = 24;     ANDSET2 = 25;       ORWORD2 = 26;       ORSET2 = 27;
NEGWORD2 = 28;     NEGREAL2 = 29;      ADDWORD2 = 30;      ADDREAL2 = 31;
SUBWORD2 = 32;     SUBREAL2 = 33;      SUBSET2 = 34;       MULWORD2 = 35;
MULREAL2 = 36;     DIVWORD2 = 37;      DIVREAL2 = 38;      MODWORD2 = 39;
BUILDSET2 = 40;    INSET2 = 41;        LSWORD2 = 42;       EQWORD2 = 43;
GRWORD2 = 44;      NLWORD2 = 45;       NEWORD2 = 46;       NGWORD2 = 47;
LSREAL2 = 48;      EQREAL2 = 49;       GRREAL2 = 50;       NLREAL2 = 51;
NEREAL2 = 52;      NGREAL2 = 53;       EQSET2 = 54;        NLSET2 = 55;
NESET2 = 56;       NGSET2 = 57;        LSSTRUCT2 = 58;     EQSTRUCT2 = 59;
GRSTRUCT2 = 60;    NLSTRUCT2 = 61;     NESTRUCT2 = 62;     NGSTRUCT2 = 63;
FUNCVALUE2 = 64;   JUMP2 = 65;         FALSEJUMP2 = 66;    CASEJUMP2 = 67;
INITVAR2 = 68;     CALL2 = 69;         CALLSYS2 = 70;      ENTER2 = 71;
EXIT2 = 72;        ENTERPROG2 = 73;    EXITPROG2 = 74;     BEGINCLAS2 = 75;
ENDCLASS2 = 76;    ENTERCLAS2 = 77;    EXITCLASS2 = 78;    BEGINMON2 = 79;
ENDMON2 = 80;      ENTERMON2 = 81;     EXITMON2 = 82;      BEGINPROC2 = 83;
ENDPROC2 = 84;     ENTERPROC2 = 85;    EXITPROC2 = 86;     POP2 = 87;
NEWLINE2 = 88;     INCRWORD2 = 89;     DECRWORD2 = 90;     INITCLASS2 = 91;
INITMON2 = 92;     INITPROC2 = 93;     PUSHLABEL2 = 94;    CALLPROG2 = 95;
TRUNCREAL2 = 96;   ABSWORD2 = 97;      ABSREAL2 = 98;      SUCCWORD2 = 99;
PREDWORD2 = 100;   CONVWORD2 = 101;    EMPTY2 = 102;       ATTRIBUTE2 = 103;
REALTIME2 = 104;   DELAY2 = 105;       CONTINUE2 = 106;    IO2 = 107;
START2 = 108;      STOP2 = 109;        SETHEAP2 = 110;     WAIT2 = 111;
MESSAGE2 = 112;    EOM2=113;

"OTHER CONSTANTS"

PDP11 = TRUE;
CONCURRENT=FALSE;
INITIALBLOCK = 1;
SPLITLENGTH = 4 "WORDS PER REAL";
TWOWORDS = 4;      THREEWORDS = 6;     FOURWORDS = 8;      FIVEWORDS = 10;
STACK_LIMIT = 32667 "GREATEST INTEGER - 100";              CODE_LIMIT = 32667;
THIS_PASS = 6;
INFILE = 2;        OUTFILE = 1;
STACK_ERROR = 1;   CODE_ERROR = 2;

VAR

LINK: PASSPTR;

SUMMARY, TEST, CHECK, GENERATE, NUMBER, AFTERBEGIN, AFTERERROR, DONE: BOOLEAN;

JUMPTABLE, BLOCKTABLE, STACKTABLE, CONSTTABLE: TABLEPTR;

CONSTANTS, STACKLENGTH, VARLENGTH, PARAMLENGTH, POPLENGTH, TEMP,
MAXTEMP, BLOCK, LOCATION, LINE, OP, ARG1, ARG2, ARG3, ARG4, ARG5: INTEGER;

"############################"
"COMMON TEST OUTPUT MECHANISM"
"############################"

PRINTED: INTEGER;

OK: BOOLEAN;
  "PASS1 TO 6:  OK = NOT DISK OVERFLOW
   PASS7:       OK = NOT DISK OVERFLOW & PROGRAM CORRECT"

PAGE_IN: PAGE;  PAGES_IN, WORDS_IN: INTEGER;
PAGE_OUT: PAGE;  PAGES_OUT, WORDS_OUT: INTEGER;

PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE);
VAR I: INTEGER;
BEGIN
  WRITE(EOL);
  FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.));
  WRITE(EOL)
END;

PROCEDURE FILE_LIMIT;
BEGIN
  PRINT_TEXT('PASS 6: FILE_LIMIT');
  OK:= FALSE
END;

PROCEDURE INIT_PASS (VAR LINK: PASSPTR);
BEGIN
  LINK:= PARAM(.2.).PTR;
  OK:= TRUE;
  PAGES_IN:= 1; WORDS_IN:= PAGELENGTH;
  PAGES_OUT:= 1; WORDS_OUT:= 0
END;

PROCEDURE NEXT_PASS (LINK: PASSPTR);
BEGIN
  IF WORDS_OUT > 0 THEN
    IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT
      ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT);
  WITH PARAM(.1.) DO BEGIN
    TAG:= BOOLTYPE; BOOL:=OK END;
  WITH PARAM(.2.) DO BEGIN
    TAG:= PTRTYPE; PTR:= LINK END;
  WITH PARAM(.4.) DO BEGIN
    TAG:= INTTYPE;  INT:= PAGES_OUT  END;
END;

PROCEDURE READ_IFL (VAR I: INTEGER);
BEGIN
  IF WORDS_IN = PAGELENGTH THEN BEGIN
    IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT
    ELSE BEGIN
      GET(INFILE, PAGES_IN, PAGE_IN);
      PAGES_IN:= SUCC(PAGES_IN)
    END;
    WORDS_IN:= 0
  END;
  WORDS_IN:= SUCC(WORDS_IN);
  I:= PAGE_IN(.WORDS_IN.)
END;

PROCEDURE WRITE_IFL (I: INTEGER);
BEGIN
  WORDS_OUT:= SUCC(WORDS_OUT);
  PAGE_OUT(.WORDS_OUT.):= I;
  IF WORDS_OUT = PAGELENGTH THEN BEGIN
    IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT
    ELSE BEGIN
      PUT(OUTFILE, PAGES_OUT, PAGE_OUT);
      PAGES_OUT:= SUCC(PAGES_OUT)
    END;
    WORDS_OUT:= 0
  END
END;

PROCEDURE PRINTABS(ARG: INTEGER);
VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER;
BEGIN
  REM:= ARG; DIGIT:= 0;
  REPEAT
    DIGIT:= DIGIT + 1;
    T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0'));
    REM:= REM DIV 10;
  UNTIL REM = 0;
  FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.));
  FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' ');
END;

PROCEDURE PRINTEOL;
BEGIN WRITE(EOL); PRINTED:= 0 END;

PROCEDURE PRINTFF;
VAR I:INTEGER;
BEGIN
  PRINTEOL; FOR I:=1 TO 130 DO WRITE('6'); PRINTEOL
END;

PROCEDURE PRINTOP(OP: INTEGER);
BEGIN
  IF PRINTED = PRINTLIMIT THEN PRINTEOL;
  WRITE('C'); PRINTABS(OP);
  PRINTED:= PRINTED + 1;
END;

PROCEDURE PRINTARG(ARG: INTEGER);
BEGIN
  IF PRINTED = PRINTLIMIT THEN PRINTEOL;
  IF ARG < 0 THEN WRITE('-') ELSE WRITE(' ');
  PRINTABS(ARG);
  PRINTED:= PRINTED + 1;
END;

"################"
"INPUT PROCEDURES"
"################"

PROCEDURE READ1ARG;
BEGIN READ_IFL(ARG1) END;

PROCEDURE READ2ARG;
BEGIN READ_IFL(ARG1); READ_IFL(ARG2) END;

PROCEDURE READ3ARG;
BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3) END;

PROCEDURE READ4ARG;
BEGIN
  READ_IFL(ARG1); READ_IFL(ARG2);
  READ_IFL(ARG3); READ_IFL(ARG4);
END;

PROCEDURE READ5ARG;
BEGIN
  READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3);
  READ_IFL(ARG4); READ_IFL(ARG5)
END;

"#################"
"OUTPUT PROCEDURES"
"#################"

PROCEDURE ERROR (PASS, NUMBER: INTEGER); FORWARD;

PROCEDURE WRITE1(OP: INTEGER);
BEGIN
  IF TEST THEN PRINTOP(OP);
  WRITE_IFL(OP);
  IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + WORDLENGTH
    ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END;
END;

PROCEDURE WRITE2(OP, ARG: INTEGER);
BEGIN
  IF TEST THEN
  BEGIN PRINTOP(OP); PRINTARG(ARG) END;
  WRITE_IFL(OP); WRITE_IFL(ARG);
  IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + TWOWORDS
    ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END;
END;

PROCEDURE WRITE3(OP, ARG1, ARG2: INTEGER);
BEGIN
  IF TEST THEN
  BEGIN PRINTOP(OP);
    PRINTARG(ARG1); PRINTARG(ARG2);
  END;
  WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2);
  IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + THREEWORDS
    ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END;
END;

PROCEDURE WRITE4(OP, ARG1, ARG2, ARG3: INTEGER);
BEGIN
  IF TEST THEN
  BEGIN
    PRINTOP(OP); PRINTARG(ARG1);
    PRINTARG(ARG2); PRINTARG(ARG3);
  END;
  WRITE_IFL(OP); WRITE_IFL(ARG1);
  WRITE_IFL(ARG2); WRITE_IFL(ARG3);
  IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + FOURWORDS
    ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END;
END;

PROCEDURE WRITE5(OP, ARG1, ARG2, ARG3, ARG4: INTEGER);
BEGIN
  IF TEST THEN
  BEGIN PRINTOP(OP);
    PRINTARG(ARG1); PRINTARG(ARG2);
    PRINTARG(ARG3); PRINTARG(ARG4);
  END;
  WRITE_IFL(OP);
  WRITE_IFL(ARG1); WRITE_IFL(ARG2);
  WRITE_IFL(ARG3); WRITE_IFL(ARG4);
  IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + FIVEWORDS
    ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END;
END;

PROCEDURE WRITEARG(ARG: INTEGER);
BEGIN
  IF TEST THEN PRINTARG(ARG);
  WRITE_IFL(ARG);
  IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + WORDLENGTH
    ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END;
END;

PROCEDURE WRITELOCATION;
BEGIN
  IF TEST THEN PRINTARG(LOCATION);
  WRITE_IFL(LOCATION);
END;

PROCEDURE COMMENT(LENGTH: INTEGER);
BEGIN LOCATION:= LOCATION - LENGTH END;
  
PROCEDURE ERROR;
BEGIN
  IF NOT AFTERERROR THEN BEGIN
    AFTERERROR:= TRUE;
    COMMENT(FOURWORDS);
    WRITE4(MESSAGE2, PASS, NUMBER, LINE);
    GENERATE:= FALSE
  END
END;
  
"################"
"STACK PROCEDURES"
"################"


PROCEDURE PUSHWORD;
BEGIN
  IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + WORDLENGTH
    ELSE ERROR(THIS_PASS, STACK_ERROR);
  IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP;
END;

PROCEDURE POPWORD;
BEGIN TEMP:= TEMP - WORDLENGTH END;

PROCEDURE PUSHREAL;
BEGIN
  IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + REALLENGTH
    ELSE ERROR(THIS_PASS, STACK_ERROR);
  IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP;
END;

PROCEDURE POPREAL;
BEGIN TEMP:= TEMP - REALLENGTH END;

PROCEDURE PUSHSET;
BEGIN
  IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + SETLENGTH
    ELSE ERROR(THIS_PASS, STACK_ERROR);
  IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP;
END;

PROCEDURE POPSET;
BEGIN TEMP:= TEMP - SETLENGTH END;

PROCEDURE PUSH(LENGTH: INTEGER);
BEGIN
  IF TEMP < STACK_LIMIT - LENGTH THEN TEMP:= TEMP + LENGTH
    ELSE ERROR(THIS_PASS, STACK_ERROR);
  IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP;
END;

PROCEDURE POP(LENGTH: INTEGER);
BEGIN TEMP:= TEMP - LENGTH END;

"###################"
"VARIABLE PROCEDURES"
"###################"

FUNCTION DISPL(ARG: INTEGER): INTEGER;
BEGIN
  IF ARG < 0 THEN DISPL:= ARG
             ELSE DISPL:= ARG + FOURWORDS;
END;

PROCEDURE PUSHVALUE(MODE, ARG: INTEGER);
VAR ADDR: INTEGER;
BEGIN
  CASE MODE OF
    MODE1, MODE3, MODE4, MODE5:
      WRITE2(PUSHLOCAL2, DISPL(ARG));
    MODE2:
      BEGIN
        ADDR:= DISPL(ARG);
        IF ADDR > 0 THEN ADDR:= ADDR + WORDLENGTH;
        WRITE2(PUSHGLOB2, ADDR)
      END;
    MODE6, MODE7, MODE8:
      WRITE2(PUSHGLOB2, ARG);
    MODE10:
  END;
  PUSHWORD;
END;

PROCEDURE PUSHADDRESS(MODE, ARG: INTEGER);
VAR ADDR: INTEGER;
BEGIN
  CASE MODE OF
    MODE0:
      WRITE2(CONSTADDR2, ARG);
    MODE1, MODE3, MODE4, MODE5:
      WRITE2(LOCALADDR2, DISPL(ARG));
    MODE2:
      BEGIN
        ADDR:= DISPL(ARG);
        IF ADDR > 0 THEN ADDR:= ADDR + WORDLENGTH;
        WRITE2(GLOBADDR2, ADDR)
      END;
    MODE6, MODE7, MODE8:
      WRITE2(GLOBADDR2, ARG);
    MODE10:
  END;
  PUSHWORD;
END;

PROCEDURE PUSHINDIRECT(VARTYPE: INTEGER);
BEGIN
  CASE VARTYPE OF
    BYTETYPE:
      WRITE1(PUSHBYTE2);
    WORDTYPE:
      WRITE1(PUSHIND2);
    REALTYPE:
      BEGIN WRITE1(PUSHREAL2);
        POPWORD; PUSHREAL;
      END;
    SETTYPE:
      BEGIN WRITE1(PUSHSET2);
        POPWORD; PUSHSET;
      END
  END;
END;


"#####################"
"COMPARISON PROCEDURES"
"#####################"

PROCEDURE COMPAREWORD(ARG: INTEGER);
BEGIN
  CASE ARG OF
    LESS:        WRITE1(LSWORD2);
    EQUAL:       WRITE1(EQWORD2);
    GREATER:     WRITE1(GRWORD2);
    NOTLESS:     WRITE1(NLWORD2);
    NOTEQUAL:    WRITE1(NEWORD2);
    NOTGREATER:  WRITE1(NGWORD2)
  END;
  POPWORD;
END;

PROCEDURE COMPAREREAL(ARG: INTEGER);
BEGIN
  CASE ARG OF
    LESS:        WRITE1(LSREAL2);
    EQUAL:       WRITE1(EQREAL2);
    GREATER:     WRITE1(GRREAL2);
    NOTLESS:     WRITE1(NLREAL2);
    NOTEQUAL:    WRITE1(NEREAL2);
    NOTGREATER:  WRITE1(NGREAL2)
  END;
  POPREAL; POPREAL; PUSHWORD;
END;

PROCEDURE COMPARESET(ARG: INTEGER);
BEGIN
  CASE ARG OF
    EQUAL:       WRITE1(EQSET2);
    NOTLESS:     WRITE1(NLSET2);
    NOTEQUAL:    WRITE1(NESET2);
    NOTGREATER:  WRITE1(NGSET2);
    INSET:       WRITE1(INSET2)
  END;
  POPSET;
  IF ARG <> INSET THEN
  BEGIN POPSET; PUSHWORD END;
END;

PROCEDURE COMPARESTRUCT(ARG1, ARG2: INTEGER);
BEGIN
  CASE ARG1 OF
    LESS:        WRITE1(LSSTRUCT2);
    EQUAL:       WRITE1(EQSTRUCT2);
    GREATER:     WRITE1(GRSTRUCT2);
    NOTLESS:     WRITE1(NLSTRUCT2);
    NOTEQUAL:    WRITE1(NESTRUCT2);
    NOTGREATER:  WRITE1(NGSTRUCT2)
  END;
  WRITEARG(ARG2 DIV WORDLENGTH);
  POPWORD;
END;

"################"
"TABLE PROCEDURES"
"################"

PROCEDURE ALLOCATE(VAR T: TABLEPTR; ENTRIES: INTEGER);
VAR PORTION: TABLEPTR; I: INTEGER;
BEGIN
  NEW(T); PORTION:= T;
  I:= ENTRIES - MAXWORD;
  WHILE I > 0 DO
  WITH PORTION@ DO
  BEGIN
    NEW(NEXTPORTION); PORTION:= NEXTPORTION;
    I:= I - MAXWORD;
  END;
END;

PROCEDURE ENTER(T: TABLEPTR; I, J: INTEGER);
VAR PORTION: TABLEPTR; K: INTEGER;
BEGIN
  PORTION:= T; K:= I;
  WHILE K > MAXWORD DO
  BEGIN
    PORTION:= PORTION@.NEXTPORTION;
    K:= K - MAXWORD;
  END;
  PORTION@.CONTENTS(.K.):= J;
END;

FUNCTION ENTRY(T: TABLEPTR; I: INTEGER): INTEGER;
VAR PORTION: TABLEPTR; J: INTEGER;
BEGIN
  PORTION:= T; J:= I;
  WHILE J > MAXWORD DO
  BEGIN
    PORTION:= PORTION@.NEXTPORTION;
    J:= J - MAXWORD;
  END;
  ENTRY:= PORTION@.CONTENTS(.J.);
END;

"###############"
"LINE PROCEDURES"
"###############"

PROCEDURE NEWLINE(ARG: INTEGER);
BEGIN
  LINE:= ARG;
  AFTERERROR:=FALSE;
  IF NUMBER AND AFTERBEGIN THEN WRITE2(NEWLINE2,LINE)
END;

PROCEDURE INITLINE;
BEGIN
  LINE:=0; AFTERBEGIN:=FALSE
END;

"################"
"BLOCK PROCEDURES"
"################"

PROCEDURE ENTERBLOCK(I, J, K, L: INTEGER);
BEGIN
  BLOCK:= I; PARAMLENGTH:= J; VARLENGTH:= K; STACKLENGTH:=L;
  POPLENGTH:= PARAMLENGTH + FOURWORDS;
  TEMP:= 0; MAXTEMP:= 0;
  IF BLOCK=INITIALBLOCK THEN ENTER(JUMPTABLE,BLOCK,LOCATION)
    ELSE ENTER(BLOCKTABLE,BLOCK,LOCATION);
  "THE INITIAL BLOCK IS ONLY REFERENCED BY THE FIRST JUMP INSTRUCTION
  IN A PROGRAM, BUT NOT BY ANY CALL OR INIT INSTRUCTION"
  AFTERBEGIN:=TRUE
END;

PROCEDURE EXITBLOCK;
BEGIN
  IF STACKLENGTH < STACK_LIMIT - MAXTEMP - VARLENGTH THEN
    STACKLENGTH:= STACKLENGTH + MAXTEMP + VARLENGTH + FIVEWORDS
  ELSE ERROR(THIS_PASS, STACK_ERROR);
  ENTER(STACKTABLE, BLOCK, STACKLENGTH);
  AFTERBEGIN:=FALSE
END;

"#########################################"
"INITIALIZATION AND TERMINATION PROCEDURES"
"#########################################"

PROCEDURE BEGINPASS;
BEGIN
  WITH LINK@ DO
  BEGIN
    SUMMARY:= SUMMARYOPTION IN OPTIONS;
    TEST:= TESTOPTION IN OPTIONS;
    CHECK:= CHECKOPTION IN OPTIONS;
    NUMBER:= NUMBEROPTION IN OPTIONS;
    GENERATE:= TRUE;
    MARK(RESETPOINT);
    ALLOCATE(JUMPTABLE, LABELS);
    ALLOCATE(BLOCKTABLE, BLOCKS);
    ALLOCATE(STACKTABLE, BLOCKS);
    ALLOCATE(CONSTTABLE, CONSTANTS DIV WORDLENGTH);
  END;
  LOCATION:= 0; CONSTANTS:= 0;
  INITLINE;
  IF TEST THEN PRINTFF;
END;

PROCEDURE ENDPASS;
BEGIN
  WITH LINK@ DO
  BEGIN
    IF GENERATE THEN OPTIONS:= OPTIONS OR (.CODEOPTION.);
    NEW(TABLES);
    TABLES@.PROGLENGTH:= FOURWORDS + LOCATION + CONSTANTS;
    TABLES@.CODELENGTH:= LOCATION;
    TABLES@.STACKLENGTH:= STACKLENGTH;
    TABLES@.VARLENGTH:= VARLENGTH;
    TABLES@.JUMPTABLE:=JUMPTABLE;
    TABLES@.BLOCKTABLE:=BLOCKTABLE;
    TABLES@.STACKTABLE:=STACKTABLE;
    TABLES@.CONSTTABLE:=CONSTTABLE;
  END;
END;

"#########"
"OPERATORS"
"#########"

PROCEDURE SCAN;
BEGIN
  DONE:=FALSE;
  REPEAT
    READ_IFL(OP);
    CASE OP OF

PUSHCONST1"(VALUE)":
  BEGIN READ1ARG;
    WRITE2(PUSHCONST2, ARG1); PUSHWORD;
  END;

PUSHVAR1"(TYPE, MODE, DISPL)":
  BEGIN READ3ARG;
    IF ARG1 = WORDTYPE
      THEN PUSHVALUE(ARG2, ARG3)
      ELSE BEGIN
             PUSHADDRESS(ARG2, ARG3);
             PUSHINDIRECT(ARG1);
           END;
  END;

PUSHIND1"(TYPE)":
  BEGIN READ1ARG; PUSHINDIRECT(ARG1) END;

PUSHADDR1"(MODE, DISPL)":
  BEGIN READ2ARG; PUSHADDRESS(ARG1, ARG2) END;

FIELD1"(DISPL)":
  BEGIN READ1ARG; IF ARG1<>0 THEN WRITE2(FIELD2,ARG1) END;

INDEX1"(MIN, MAX, LENGTH)":
  BEGIN READ3ARG;
    WRITE4(INDEX2, ARG1, ARG2 - ARG1, ARG3);
    POPWORD;
  END;

POINTER1:
  IF CHECK THEN WRITE1(POINTER2);

VARIANT1"(TAGSET, DISPL)":
  BEGIN READ2ARG;
    IF CHECK THEN WRITE3(VARIANT2, ARG2, ARG1);
  END;

RANGE1"(MIN, MAX)":
  BEGIN READ2ARG;
    IF CHECK THEN WRITE3(RANGE2, ARG1, ARG2);
  END;

ASSIGN1"(TYPE)":
  BEGIN READ1ARG;
    CASE ARG1 OF
      BYTETYPE:
        BEGIN WRITE1(COPYBYTE2); POPWORD END;
      WORDTYPE:
        BEGIN WRITE1(COPYWORD2); POPWORD END;
      REALTYPE:
        BEGIN WRITE1(COPYREAL2); POPREAL END;
      SETTYPE:
        BEGIN WRITE1(COPYSET2); POPSET END
    END;
    POPWORD;
  END;

ASSIGNTAG1"(LENGTH)":
  BEGIN  READ1ARG;
    IF ARG1 = 0 THEN WRITE1(COPYWORD2)
    ELSE WRITE2(COPYTAG2, ARG1 DIV WORDLENGTH);
    POPWORD; POPWORD;
  END;

COPY1"(LENGTH)":
  BEGIN READ1ARG; WRITE2(COPYSTRUC2, ARG1 DIV WORDLENGTH);
    POPWORD; POPWORD;
  END;

NEW1"(LENGTH, INITIALIZE)":
  BEGIN READ2ARG;
    IF (ARG2 = 1) & CHECK
      THEN WRITE3(NEWINIT2, BLOCK, ARG1)
      ELSE WRITE3(NEW2, BLOCK, ARG1);
    POPWORD;
  END;

NOT1:
  WRITE1(NOT2);

AND1"(TYPE)":
  BEGIN READ1ARG;
    IF ARG1 = WORDTYPE
      THEN BEGIN WRITE1(ANDWORD2); POPWORD END
      ELSE BEGIN WRITE1(ANDSET2); POPSET END;
  END;

OR1"(TYPE)":
  BEGIN READ1ARG;
    IF ARG1 = WORDTYPE
      THEN BEGIN WRITE1(ORWORD2); POPWORD END
      ELSE BEGIN WRITE1(ORSET2); POPSET END;
  END;

NEG1"(TYPE)":
  BEGIN READ1ARG;
    IF ARG1 = WORDTYPE THEN WRITE1(NEGWORD2)
                       ELSE WRITE1(NEGREAL2);
  END;

ADD1"(TYPE)":
  BEGIN READ1ARG;
    IF ARG1 = WORDTYPE
      THEN BEGIN WRITE1(ADDWORD2); POPWORD END
      ELSE BEGIN WRITE1(ADDREAL2); POPREAL END;
  END;

SUB1"(TYPE)":
  BEGIN READ1ARG;
    CASE ARG1 OF
      WORDTYPE:
        BEGIN WRITE1(SUBWORD2); POPWORD END;
      REALTYPE:
        BEGIN WRITE1(SUBREAL2); POPREAL END;
      SETTYPE:
        BEGIN WRITE1(SUBSET2); POPSET END
    END;
  END;

MUL1"(TYPE)":
  BEGIN READ1ARG;
    IF ARG1 = WORDTYPE
      THEN BEGIN WRITE1(MULWORD2); POPWORD END
      ELSE BEGIN WRITE1(MULREAL2); POPREAL END;
  END;

DIV1"(TYPE)":
  BEGIN READ1ARG;
    IF ARG1 = WORDTYPE
      THEN BEGIN WRITE1(DIVWORD2); POPWORD END
      ELSE BEGIN WRITE1(DIVREAL2); POPREAL END;
  END;

MOD1"(TYPE)":
  BEGIN READ1ARG; WRITE1(MODWORD2); POPWORD END;

"(NOT USED)"

"(NOT USED)"

FUNCTION1"(STANDARDFUNC, TYPE)":
  BEGIN READ2ARG;
    IF (ARG1 >= MIN_FUNC) AND (ARG1 <= MAX_FUNC) THEN
    CASE ARG1 OF
      TRUNC1:
        BEGIN WRITE1(TRUNCREAL2); POPREAL; PUSHWORD END;
      ABS1:
        IF ARG2 = WORDTYPE THEN WRITE1(ABSWORD2)
                           ELSE WRITE1(ABSREAL2);
      SUCC1:
        WRITE1(SUCCWORD2);
      PRED1:
        WRITE1(PREDWORD2);
      CONV1:
        BEGIN WRITE1(CONVWORD2); POPWORD; PUSHREAL END;
      EMPTY1:
        WRITE1(EMPTY2);
      ATTRIBUTE1:
        WRITE1(ATTRIBUTE2);
      REALTIME1:
        BEGIN WRITE1(REALTIME2); PUSHWORD END
    END;
  END;

BUILDSET1:
  BEGIN WRITE1(BUILDSET2); POPWORD END;

COMPARE1"(COMPARISON, TYPE)":
  BEGIN READ2ARG;
    CASE ARG2 OF
      WORDTYPE:
        COMPAREWORD(ARG1);
      REALTYPE:
        COMPAREREAL(ARG1);
      SETTYPE:
        COMPARESET(ARG1)
    END;
  END;

COMPSTRUC1"(COMPARISON, LENGTH)":
  BEGIN READ2ARG; COMPARESTRUCT(ARG1, ARG2) END;

FUNCVALUE1"(MODE)":
  BEGIN READ2ARG;
    CASE ARG1 OF
      MODE1, MODE3:
      IF ARG2 = WORDTYPE THEN BEGIN
        WRITE2(FUNCVALUE2, 0); PUSHWORD
      END ELSE BEGIN
        WRITE2(FUNCVALUE2, 8); PUSHREAL
      END;
      MODE4, MODE5:
      IF ARG2 = WORDTYPE THEN BEGIN
        WRITE2(FUNCVALUE2, 16); PUSHWORD
      END ELSE BEGIN
        WRITE2(FUNCVALUE2, 24); PUSHREAL
      END;
        MODE9, MODE10:
    END;
  END;

DEFLABEL1"(LABEL)":
  BEGIN READ1ARG;
    ENTER(JUMPTABLE, ARG1, LOCATION);
    IF NUMBER THEN WRITE2(NEWLINE2,LINE)
  END;

JUMP1"(LABEL)":
  BEGIN READ1ARG;
    WRITE1(JUMP2); WRITELOCATION; WRITEARG(ARG1);
  END;

FALSEJUMP1"(LABEL)":
  BEGIN READ1ARG;
    WRITE1(FALSEJUMP2); WRITELOCATION; WRITEARG(ARG1);
    POPWORD;
  END;

CASEJUMP1"(MIN, MAX, LABELS)":
  BEGIN READ2ARG; ARG2:=  ARG2 - ARG1;
    WRITE3(CASEJUMP2, ARG1, ARG2); WRITELOCATION;
    FOR ARG3:= 0 TO ARG2 DO
    BEGIN READ1ARG; WRITEARG(ARG1) END;
    POPWORD;
  END;

INITVAR1"(LENGTH)":
  BEGIN READ1ARG;
    IF CHECK THEN WRITE2(INITVAR2, ARG1 DIV WORDLENGTH);
  END;

CALL1"(MODE, LABEL, PARAMLENGTH)":
  BEGIN READ3ARG;
    IF ARG1 = MODE3 THEN
    BEGIN WRITE2(CALLSYS2, (ARG2 - 2) * WORDLENGTH);
      ARG1:= WORDLENGTH;
    END ELSE
    BEGIN
      WRITE1(CALL2); WRITELOCATION; WRITEARG(ARG2);
      IF ARG1<>MODE1 THEN ARG3:=ARG3+WORDLENGTH;
      "INCLUDES COMPONENT ADDRESS IN PARAMLENGTH"
      IF CONCURRENT
        THEN ARG1:= ENTRY(STACKTABLE, ARG2)
        ELSE ARG1:= WORDLENGTH;
    END;
    PUSH(ARG1); POP(ARG1 + ARG3);
  END;

ENTER1"(MODE, LABEL, PARAMLENGTH, VARLENGTH, TEMPLENGTH)":
  BEGIN READ5ARG;
    ENTERBLOCK(ARG2, ARG3, ARG4, ARG5);
    CASE ARG1 OF
      MODE1:
        WRITE5(ENTER2, BLOCK, POPLENGTH, LINE, VARLENGTH);
      MODE2:
        WRITE5(ENTERPROG2, POPLENGTH + WORDLENGTH, LINE, BLOCK, VARLENGTH);
      MODE3:
        WRITE5(ENTERPROC2, BLOCK, POPLENGTH, LINE, VARLENGTH);
      MODE4:
        WRITE5(ENTERCLAS2, BLOCK, POPLENGTH + WORDLENGTH, LINE, VARLENGTH);
      MODE5:
        WRITE5(ENTERMON2, BLOCK, POPLENGTH + WORDLENGTH, LINE, VARLENGTH);
      MODE6:
        WRITE2(BEGINPROC2, LINE);
      MODE7:
        WRITE5(BEGINCLAS2, BLOCK, FIVEWORDS, LINE, 0);
      MODE8:
        WRITE5(BEGINMON2, BLOCK, FIVEWORDS, LINE, 0);
      MODE10:
    END;
  END;

RETURN1"(MODE)":
  BEGIN READ1ARG;
    CASE ARG1 OF
      MODE1:  WRITE1(EXIT2);
      MODE2:  WRITE1(EXITPROG2);
      MODE3:  WRITE1(EXITPROC2);
      MODE4:  WRITE1(EXITCLASS2);
      MODE5:  WRITE1(EXITMON2);
      MODE6:  WRITE1(ENDPROC2);
      MODE7:  WRITE1(ENDCLASS2);
      MODE8:  WRITE1(ENDMON2);
      MODE10:
    END;
    EXITBLOCK;
  END;

POP1"(LENGTH)":
  BEGIN READ1ARG;
    WRITE2(POP2, ARG1); POP(ARG1);
  END;

NEWLINE1"(NUMBER)":
  BEGIN READ1ARG; NEWLINE(ARG1) END;

ERROR1:
  GENERATE:= FALSE;

CONSTANT1 "(LENGTH, VALUE)":
  BEGIN READ1ARG;
    FOR ARG3:= 1 TO ARG1 DIV WORDLENGTH DO
    BEGIN CONSTANTS:= CONSTANTS + 1;
      READ1ARG; ENTER(CONSTTABLE, CONSTANTS, ARG1);
    END;
  END;

MESSAGE1"(PASS, ERROR)":
  BEGIN READ2ARG;
    ERROR(ARG1, ARG2)
  END;

INCREMENT1:
  BEGIN WRITE1(INCRWORD2); POPWORD END;

DECREMENT1:
  BEGIN WRITE1(DECRWORD2); POPWORD END;

PROCEDURE1"(STANDARDPROCEDURE)":
  BEGIN READ1ARG;
    IF (ARG1 >= MIN_PROC) AND (ARG1 <= MAX_PROC) THEN
    CASE ARG1 OF
      DELAY1:
        BEGIN WRITE1(DELAY2); POPWORD END;
      CONTINUE1:
        BEGIN WRITE1(CONTINUE2); POPWORD END;
      IO1:
        BEGIN WRITE1(IO2); POP(THREEWORDS) END;
      START1:
        WRITE1(START2);
      STOP1:
        BEGIN WRITE1(STOP2); POP(TWOWORDS) END;
      SETHEAP1:
        BEGIN WRITE1(SETHEAP2); POPWORD END;
      WAIT1:
        WRITE1(WAIT2)
    END;
  END;

INIT1"(MODE, LABEL, PARAMLENGTH, VARLENGTH)":
  BEGIN READ4ARG;
    IF ARG1 = MODE6 THEN
    BEGIN WRITE4(INITPROC2, ARG3, ARG4, ARG2);
      PUSH(FOURWORDS); POP(ARG3 + FIVEWORDS);
    END ELSE
    BEGIN
      IF ARG1 = MODE7
        THEN WRITE2(INITCLASS2, ARG3)
        ELSE WRITE2(INITMON2, ARG3);
      ARG1:= ENTRY(STACKTABLE, ARG2);
      POP(ARG3); PUSH(ARG1); POP(ARG1 + WORDLENGTH);
    END;
    WRITELOCATION; WRITEARG(ARG2);
  END;

PUSHLABEL1"(LABEL)":
  BEGIN READ1ARG;
    WRITE1(PUSHLABEL2); WRITELOCATION; WRITEARG(ARG1);
    PUSHWORD;
  END;

CALLPROG1:
  BEGIN WRITE1(CALLPROG2); PUSHWORD END;

EOM1"(VARLENGTH)":
  BEGIN
    DONE:=TRUE;
    READ1ARG; VARLENGTH:=ARG1;
    COMMENT(WORDLENGTH); WRITE1(EOM2)
  END

    END
  UNTIL DONE
END;

BEGIN
  INIT_PASS(LINK);
  BEGINPASS;
  SCAN;
  ENDPASS;
  NEXT_PASS(LINK);
END.