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

 PDP-11/45 CONCURRENT/SEQUENTIAL PASCAL
 COMPILER PASS 7: CODE ASSEMBLY

 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";
TEXT_LENGTH = 18;
INFILE = 1;        OUTFILE = 2;
LISTOPTION = 0;    SUMMARYOPTION = 1;  TESTOPTION = 2;     CHECKOPTION = 3;
CODEOPTION = 4;    NUMBEROPTION = 5;
MAXWORD = 100;

TYPE FILE = 1..2;
  TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR;

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

TYPE   POINTER = @ INTEGER;
OPTION = LISTOPTION..NUMBEROPTION;
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;
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;
TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE;

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"


CONSTADDR1 = 0;    LOCALADDR1 = 1;     GLOBADDR1 = 2;      PUSHCONST1 = 3;
PUSHLOCAL1 = 4;    PUSHGLOB1 = 5;      PUSHIND1 = 6;       PUSHBYTE1 = 7;
PUSHREAL1 = 8;     PUSHSET1 = 9;       FIELD1 = 10;        INDEX1 = 11;
POINTER1 = 12;     VARIANT1 = 13;      RANGE1 = 14;        COPYBYTE1 = 15;
COPYWORD1 = 16;    COPYREAL1 = 17;     COPYSET1 = 18;      COPYTAG1 = 19;
COPYSTRUC1 = 20;   NEW1 = 21;          NEWINIT1 = 22;      NOT1 = 23;
ANDWORD1 = 24;     ANDSET1 = 25;       ORWORD1 = 26;       ORSET1 = 27;
NEGWORD1 = 28;     NEGREAL1 = 29;      ADDWORD1 = 30;      ADDREAL1 = 31;
SUBWORD1 = 32;     SUBREAL1 = 33;      SUBSET1 = 34;       MULWORD1 = 35;
MULREAL1 = 36;     DIVWORD1 = 37;      DIVREAL1 = 38;      MODWORD1 = 39;
BUILDSET1 = 40;    INSET1 = 41;        LSWORD1 = 42;       EQWORD1 = 43;
GRWORD1 = 44;      NLWORD1 = 45;       NEWORD1 = 46;       NGWORD1 = 47;
LSREAL1 = 48;      EQREAL1 = 49;       GRREAL1 = 50;       NLREAL1 = 51;
NEREAL1 = 52;      NGREAL1 = 53;       EQSET1 = 54;        NLSET1 = 55;
NESET1 = 56;       NGSET1 = 57;        LSSTRUCT1 = 58;     EQSTRUCT1 = 59;
GRSTRUCT1 = 60;    NLSTRUCT1 = 61;     NESTRUCT1 = 62;     NGSTRUCT1 = 63;
FUNCVALUE1 = 64;   JUMP1 = 65;         FALSEJUMP1 = 66;    CASEJUMP1 = 67;
INITVAR1 = 68;     CALL1 = 69;         CALLSYS1 = 70;      ENTER1 = 71;
EXIT1 = 72;        ENTERPROG1 = 73;    EXITPROG1 = 74;     BEGINCLAS1 = 75;
ENDCLASS1 = 76;    ENTERCLAS1 = 77;    EXITCLASS1 = 78;    BEGINMON1 = 79;
ENDMON1 = 80;      ENTERMON1 = 81;     EXITMON1 = 82;      BEGINPROC1 = 83;
ENDPROC1 = 84;     ENTERPROC1 = 85;    EXITPROC1 = 86;     POP1 = 87;
NEWLINE1 = 88;     INCRWORD1 = 89;     DECRWORD1 = 90;     INITCLASS1 = 91;
INITMON1 = 92;     INITPROC1 = 93;     PUSHLABEL1 = 94;    CALLPROG1 = 95;
TRUNCREAL1 = 96;   ABSWORD1 = 97;      ABSREAL1 = 98;      SUCCWORD1 = 99;
PREDWORD1 = 100;   CONVWORD1 = 101;    EMPTY1 = 102;       ATTRIBUTE1 = 103;
REALTIME1 = 104;   DELAY1 = 105;       CONTINUE1 = 106;    IO1 = 107;
START1 = 108;      STOP1 = 109;        SETHEAP1 = 110;     WAIT1 = 111;
MESSAGE1=112;      EOM1=113;

"OUTPUT OPERATORS"

CONSTADDR2 = 2;    LOCALADDR2 = 4;     GLOBADDR2 = 6;      PUSHCONST2 = 8;
PUSHLOCAL2 = 10;   PUSHGLOB2 = 12;      PUSHIND2 = 14;     PUSHBYTE2 = 16;
PUSHREAL2 = 18;    PUSHSET2 = 20;       FIELD2 = 22;        INDEX2 = 24;
POINTER2 = 26;     VARIANT2 = 28;      RANGE2 = 30;        COPYBYTE2 = 32;
COPYWORD2 = 34;    COPYREAL2 = 36;     COPYSET2 = 38;      COPYTAG2 = 40;
COPYSTRUC2 = 42;    NEW2 = 44;          NEWINIT2 = 46;     NOT2 = 48;
ANDWORD2 = 50;      ANDSET2 = 52;       ORWORD2 = 54;      ORSET2 = 56;
NEGWORD2 = 58;     NEGREAL2 = 60;      ADDWORD2 = 62;      ADDREAL2 = 64;
SUBWORD2 = 66;     SUBREAL2 = 68;      SUBSET2 = 70;       MULWORD2 = 72;
MULREAL2 = 74;      DIVWORD2 = 76;     DIVREAL2 = 78;      MODWORD2 = 80;
BUILDSET2 = 82;     INSET2 = 84;       LSWORD2 = 86;       EQWORD2 = 88;
GRWORD2 = 90;       NLWORD2 = 92;       NEWORD2 = 94;       NGWORD2 = 96;
LSREAL2 = 98;      EQREAL2 = 100;      GRREAL2 = 102;      NLREAL2 = 104;
NEREAL2 = 106;     NGREAL2 = 108;      EQSET2 = 110;       NLSET2 = 112;
NESET2 = 114;       NGSET2 = 116;       LSSTRUCT2 = 118;   EQSTRUCT2 = 120;
GRSTRUCT2 = 122;   NLSTRUCT2 = 124;    NESTRUCT2 = 126;     NGSTRUCT2 = 128;
FUNCVALUE2 = 130;  JUMP2 = 132;        FALSEJUMP2 = 134;   CASEJUMP2 = 136;
INITVAR2 = 138;     CALL2 = 140;       CALLSYS2 = 142;     ENTER2 = 144;
EXIT2 = 146;        ENTERPROG2 = 148;   EXITPROG2 = 150;   BEGINCLAS2 = 152;
ENDCLASS2 = 154;   ENTERCLAS2 = 156;   EXITCLASS2 = 158;   BEGINMON2 = 160;
ENDMON2 = 162;     ENTERMON2 = 164;     EXITMON2 = 166;     BEGINPROC2 = 168;
ENDPROC2 = 170;    ENTERPROC2 = 172;   EXITPROC2 = 174;    POP2 = 176;
NEWLINE2 = 178;     INCRWORD2 = 180;   DECRWORD2 = 182;    INITCLASS2 = 184;
INITMON2 = 186;     INITPROC2 = 188;    PUSHLABEL2 = 190;   CALLPROG2 = 192;
TRUNCREAL2 = 194;  ABSWORD2 = 196;     ABSREAL2 = 198;      SUCCWORD2 = 200;
PREDWORD2 = 202;   CONVWORD2 = 204;    EMPTY2 = 206;        ATTRIBUTE2 = 208;
REALTIME2 = 210;   DELAY2 = 212;       CONTINUE2 = 214;    IO2 = 216;
START2 = 218;       STOP2 = 220;       SETHEAP2 = 222;     WAIT2 = 224;

"OTHER CONSTANTS"

STACKMARGIN = 20 "BYTES EXTRA PER PROCEDURE CALL";
PDP11 = TRUE;
CONCURRENT = TRUE;
INITIALBLOCK = 1;

TYPE

SHORTTEXT = ARRAY (.1..8.) OF CHAR;
MEDTEXT = ARRAY (.1..16.) OF CHAR;
LONGTEXT = ARRAY (.1..24.) OF CHAR;

VAR

LINK: PASSPTR;

SUMMARY, TEST, GENERATE: BOOLEAN;

JUMPTABLE, BLOCKTABLE, STACKTABLE, CONSTTABLE: TABLEPTR;
CONSTANTS: INTEGER;

PROGLENGTH, CODELENGTH, STACKLENGTH, VARLENGTH: INTEGER;

BLOCK: INTEGER;

DONE: BOOLEAN;

"############################"
"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 7: 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(.3.) DO BEGIN
    TAG:= INTTYPE;
    IF GENERATE  THEN INT:= PROGLENGTH ELSE INT:= 0
  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('7'); 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/OUTPUT PROCEDURES"
"#######################"

PROCEDURE WRITEOP(OP: INTEGER);
BEGIN
  IF GENERATE THEN WRITE_IFL(OP) ELSE
  IF TEST THEN PRINTOP(OP);
END;

PROCEDURE WRITEARG(ARG: INTEGER);
BEGIN
  IF GENERATE THEN WRITE_IFL(ARG) ELSE
  IF TEST THEN PRINTARG(ARG);
END;

PROCEDURE COPYARG;
VAR ARG: INTEGER;
BEGIN
  READ_IFL(ARG);
  IF GENERATE THEN WRITE_IFL(ARG) ELSE
  IF TEST THEN PRINTARG(ARG);
END;

PROCEDURE COPY1(OP: INTEGER);
VAR ARG: INTEGER;
BEGIN
  READ_IFL(ARG);
  IF GENERATE THEN
  BEGIN WRITE_IFL(OP); WRITE_IFL(ARG) END
  ELSE IF TEST THEN
  BEGIN PRINTOP(OP); PRINTARG(ARG) END;
END;

PROCEDURE COPY2(OP: INTEGER);
VAR ARG1, ARG2: INTEGER;
BEGIN
  READ_IFL(ARG1); READ_IFL(ARG2);
  IF GENERATE THEN
  BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2);
  END ELSE
  IF TEST THEN
  BEGIN PRINTOP(OP);
    PRINTARG(ARG1); PRINTARG(ARG2);
  END;
END;

PROCEDURE COPY3(OP: INTEGER);
VAR ARG1, ARG2, ARG3: INTEGER;
BEGIN
  READ_IFL(ARG1);
  READ_IFL(ARG2); READ_IFL(ARG3);
  IF GENERATE THEN
  BEGIN
    WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3);
  END ELSE
  IF TEST THEN
  BEGIN
    PRINTOP(OP); PRINTARG(ARG1);
    PRINTARG(ARG2); PRINTARG(ARG3);
  END;
END;

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

FUNCTION ENTRY(T: TABLEPTR; I: INTEGER): INTEGER;
VAR PORTION: TABLEPTR; J: INTEGER;
BEGIN
 IF I=0 THEN ENTRY:=0 "REFERENCE TO UNDEFINED ROUTINE" ELSE BEGIN
  PORTION:= T; J:= I;
  WHILE J > MAXWORD DO
  BEGIN
    PORTION:= PORTION@.NEXTPORTION;
    J:= J - MAXWORD;
  END;
  ENTRY:= PORTION@.CONTENTS(.J.);
 END
END;

"########################"
"JUMP AND CALL PROCEDURES"
"########################"

PROCEDURE WRITEJUMP(OP: INTEGER);
VAR LOCATION, JUMPLABEL: INTEGER;
BEGIN
  WRITEOP(OP);
  READ_IFL(LOCATION); READ_IFL(JUMPLABEL);
  WRITEARG(ENTRY(JUMPTABLE, JUMPLABEL) - LOCATION);
END;

PROCEDURE WRITECASE(OP: INTEGER);
VAR DIFF, LOCATION, CASELABEL, I: INTEGER;
BEGIN
  WRITEOP(OP);
  COPYARG;
  READ_IFL(DIFF); WRITEARG(DIFF);
  READ_IFL(LOCATION);
  FOR I:= 0 TO DIFF DO
  BEGIN
    READ_IFL(CASELABEL);
    WRITEARG(ENTRY(JUMPTABLE, CASELABEL) - LOCATION);
    LOCATION:= LOCATION + WORDLENGTH;
  END;
END;

PROCEDURE WRITECALL(OP: INTEGER);
VAR LOCATION, BLOCK: INTEGER;
BEGIN
  WRITEOP(OP);
  READ_IFL(LOCATION); READ_IFL(BLOCK);
  WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION);
END;

"###############################"
"NEW, ENTER, AND EXIT PROCEDURES"
"##############################"

PROCEDURE WRITENEW(OP: INTEGER);
VAR BLOCK, LENGTH: INTEGER;
BEGIN
  WRITEOP(OP);
  READ_IFL(BLOCK); READ_IFL(LENGTH);
  WRITEARG(STACKLENGTH + LENGTH);
  WRITEARG(LENGTH);
END;

PROCEDURE COPYBLOCK;
BEGIN
  READ_IFL(BLOCK);
  STACKLENGTH:= ENTRY(STACKTABLE, BLOCK) + STACKMARGIN;
  WRITEARG(STACKLENGTH);
END;

PROCEDURE WRITEENTER(OP: INTEGER);
BEGIN
  WRITEOP(OP); COPYBLOCK;
  COPYARG; COPYARG;
  COPYARG;
END;

PROCEDURE WRITEEXIT(OP: INTEGER);
BEGIN
  WRITEOP(OP);
END;

PROCEDURE WRITEPROG(OP: INTEGER);
BEGIN
  WRITEOP(OP);
  COPYARG; COPYARG;
  COPYBLOCK; COPYARG;
END;

"###############"
"INIT PROCEDURES"
"###############"

PROCEDURE WRITEINIT(OP: INTEGER);
VAR LOCATION, BLOCK: INTEGER;
BEGIN
  WRITEOP(OP); COPYARG;
  READ_IFL(LOCATION); READ_IFL(BLOCK);
  WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION);
END;

PROCEDURE WRITEPROC(OP: INTEGER);
VAR LOCATION, BLOCK: INTEGER;
BEGIN WRITEOP(OP); COPYARG;
  COPYARG; COPYBLOCK;
  READ_IFL(LOCATION); READ_IFL(BLOCK);
  WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION);
END;


"########################"
"HEAD AND TAIL PROCEDURES"
"########################"

PROCEDURE WRITEHEAD;
BEGIN
  IF TEST THEN
  BEGIN PRINTFF;
    WRITE('('); WRITE('#'); WRITE(EOL);
  END;
  WRITEARG(PROGLENGTH); WRITEARG(CODELENGTH);
  WRITEARG(STACKLENGTH); WRITEARG(VARLENGTH);
END;

PROCEDURE WRITETAIL;
VAR I: INTEGER;
BEGIN
  FOR I:= 1 TO CONSTANTS DIV WORDLENGTH DO
    WRITEARG(ENTRY(CONSTTABLE, I));
    IF TEST THEN
    BEGIN
      WRITE(EOL); WRITE('#'); WRITE(')');
    END;
END;

"###################"
"PRINTING PROCEDURES"
"###################"

PROCEDURE PRINTSHORT(T: SHORTTEXT);
VAR I: INTEGER; C: CHAR;
BEGIN
  I:= 1; C:= T(.I.);
  WHILE C <> '.' DO
  BEGIN WRITE(C); I:= I + 1; C:= T(.I.) END;
END;

PROCEDURE PRINTMED(T: MEDTEXT);
VAR I: INTEGER; C: CHAR;
BEGIN
  I:= 1; C:= T(.I.);
  WHILE C <> '.' DO
  BEGIN WRITE(C); I:= I + 1; C:= T(.I.) END;
END;

PROCEDURE PRINTLONG(T: LONGTEXT);
VAR I: INTEGER; C: CHAR;
BEGIN
  I:= 1; C:= T(.I.);
  WHILE C <> '.' DO
  BEGIN WRITE(C); I:= I + 1; C:= T(.I.) END;
END;

"################"
"ERROR PROCEDURES"
"################"

PROCEDURE PRINTHEAD(PASS, LINE: INTEGER);
VAR M: MEDTEXT; S: SHORTTEXT;
BEGIN
  PRINTEOL;
  M:= '****** PASS .   '; PRINTMED(M);
  PRINTABS(PASS);
  S:= ' LINE . '; PRINTSHORT(S);
  PRINTABS(LINE);
 WRITE(' ');
END;

PROCEDURE PASS1ERROR(NO, LINE: INTEGER);
CONST
COMMENT_ERROR=1;   NUMBER_ERROR=2;     INSERT_ERROR=3;     STRING_ERROR=4;
CHAR_ERROR=5;
BEGIN
  PRINTHEAD(1, LINE);
  CASE NO OF
    COMMENT_ERROR: PRINTMED('ENDLESS COMMENT.');
    NUMBER_ERROR:  PRINTMED('INVALID NUMBER. ');
    INSERT_ERROR:  PRINTMED('TABLE OVERFLOW. ');
    STRING_ERROR:  PRINTMED('INVALID STRING. ');
    CHAR_ERROR:    PRINTMED('BAD CHARACTER.  ')
  END;
  PRINTEOL;
END;

PROCEDURE PASS2ERROR(NO, LINE: INTEGER);
CONST
PROG_ERROR=1;      DEC_ERROR=2;        CONSTDEF_ERROR=3;   TYPEDEF_ERROR=4;
TYPE_ERROR=5;      ENUM_ERROR=6;       SUBR_ERROR=7;       SET_ERROR=8;
ARRAY_ERROR=9;     RECORD_ERROR=10;    STACK_ERROR=11;     VAR_ERROR=12;
ROUTINE_ERROR=13;  PROC_ERROR=14;      FUNC_ERROR=15;      WITH_ERROR=16;
PARM_ERROR=17;     BODY_ERROR=18;      STATS_ERROR=19;     STAT_ERROR=20;
IDSTAT_ERROR=21;   ARG_ERROR=22;       COMP_ERROR=23;      IF_ERROR=24;
CASE_ERROR=25;     LABEL_ERROR=26;     WHILE_ERROR=27;     REPEAT_ERROR=28;
FOR_ERROR=29;      CYCLE_ERROR=30;     EXPR_ERROR=31;      VARIABLE_ERROR=32;
CONSTANT_ERROR=33; INIT_ERROR=34;      MPROG_ERROR=35;     POINTER_ERROR=36;
PREFIX_ERROR=37;   INTERFACE_ERROR=38;
BEGIN
  PRINTHEAD(2, LINE);
  CASE NO OF
    PROG_ERROR:        PRINTMED('SEQL PROGRAM.   ');
    DEC_ERROR:         PRINTMED('DECLARATION.    ');
    CONSTDEF_ERROR:    PRINTMED('CONSTANT DFN.   ');
    TYPEDEF_ERROR:     PRINTMED('TYPE DFN.       ');
    TYPE_ERROR:        PRINTMED('TYPE.           ');
    ENUM_ERROR:        PRINTMED('ENUMERATION TYP.');
    SUBR_ERROR:        PRINTMED('SUBRANGE TYPE.  ');
    SET_ERROR:         PRINTMED('SET TYPE.       ');
    ARRAY_ERROR:       PRINTMED('ARRAY TYPE.     ');
    RECORD_ERROR:      PRINTMED('RECORD TYPE.    ');
    STACK_ERROR:       PRINTMED('STACK LENGTH.   ');
    VAR_ERROR:         PRINTMED('VAR DECLARATION.');
    ROUTINE_ERROR:     PRINTMED('ROUTINE.        ');
    PROC_ERROR:        PRINTMED('PROCEDURE.      ');
    FUNC_ERROR:        PRINTMED('FUNCTION.       ');
    WITH_ERROR:        PRINTMED('WITH STMT.      ');
    PARM_ERROR:        PRINTMED('PARAMETER.      ');
    BODY_ERROR:        PRINTMED('BODY.           ');
    STATS_ERROR:       PRINTMED('STMT LIST.      ');
    STAT_ERROR:        PRINTMED('STATEMENT.      ');
    IDSTAT_ERROR:      PRINTMED('ID STMT.        ');
    ARG_ERROR:         PRINTMED('ARGUMENT.       ');
    COMP_ERROR:        PRINTMED('COMPOUND STMT.  ');
    IF_ERROR:          PRINTMED('IF STMT.        ');
    CASE_ERROR:        PRINTMED('CASE STMT.      ');
    LABEL_ERROR:       PRINTMED('LABEL LIST.     ');
    WHILE_ERROR:       PRINTMED('WHILE STMT.     ');
    REPEAT_ERROR:      PRINTMED('REPEAT STMT.    ');
    FOR_ERROR:         PRINTMED('FOR STMT.       ');
    CYCLE_ERROR:       PRINTMED('CYCLE STMT.     ');
    EXPR_ERROR:        PRINTMED('EXPRESSION.     ');
    VARIABLE_ERROR:    PRINTMED('VARIABLE.       ');
    CONSTANT_ERROR:    PRINTMED('CONSTANT.       ');
    INIT_ERROR:        PRINTMED('INIT STMT.      ');
    MPROG_ERROR:       PRINTMED('TERMINATION.    ');
    PREFIX_ERROR:      PRINTMED('PREFIX.         ');
    INTERFACE_ERROR:   PRINTMED('INTERFACE.      ');
    POINTER_ERROR:     PRINTMED('POINTER TYPE.   ')
  END;
  PRINTSHORT(' SYNTAX.');
  PRINTEOL;
END;

PROCEDURE PASS3ERROR(NO, LINE: INTEGER);
CONST
UNRES_ERROR=1;     AMBIGUITY_ERROR=2;  ABORT_ERROR=3;      CONSTID_ERROR=4;
SUBR_ERROR=5;      FEW_ARGS_ERROR=6;   ARG_LIST_ERROR=7;   MANY_ARGS_ERROR=8;
CASERANGE_ERROR=9; CASETYPE_ERROR=10;  AMBICASE_ERROR=11;  WITH_ERROR=12;
INIT_ERROR=13;     PROC_USE_ERROR=14;  NAME_ERROR=15;      COMP_ERROR=16;
SUB_ERROR=17;      INTERFACE_ERROR=18; CALL_NAME_ERROR=19; ARROW_ERROR=20;
RESOLVE_ERROR=21;
BEGIN
  PRINTHEAD(3, LINE);
  CASE NO OF
    UNRES_ERROR:       PRINTLONG ('UNRESOLVED ROUTINE.     ');
    AMBIGUITY_ERROR:   PRINTLONG ('AMBIGUOUS IDENTIFIER.   ');
    ABORT_ERROR:       PRINTLONG ('COMPILER ABORT.         ');
    CONSTID_ERROR:     PRINTLONG ('INVALID CONSTANT.       ');
    SUBR_ERROR:        PRINTLONG ('INVALID SUBRANGE.       ');
    FEW_ARGS_ERROR:    PRINTLONG ('MISSING ARGUMENT.       ');
    ARG_LIST_ERROR:    PRINTLONG ('NOT A ROUTINE.          ');
    MANY_ARGS_ERROR:   PRINTLONG ('TOO MANY ARGUMENTS.     ');
    CASERANGE_ERROR:   PRINTLONG ('LABEL VALUE TOO LARGE.  ');
    CASETYPE_ERROR:    PRINTLONG ('INVALID LABEL.          ');
    AMBICASE_ERROR:    PRINTLONG ('AMBIGUOUS LABEL.        ');
    WITH_ERROR:        PRINTLONG ('INVALID WITH VARIABLE.  ');
    INIT_ERROR:        PRINTLONG ('INVALID INITIALIZATION. ');
    PROC_USE_ERROR:    PRINTLONG ('NOT A FUNCTION.         ');
    NAME_ERROR:        PRINTLONG ('INVALID NAME USAGE.     ');
    COMP_ERROR:        PRINTLONG ('INVALID SELECTION.      ');
    SUB_ERROR:         PRINTLONG ('INVALID SUBSCRIPTING.   ');
    INTERFACE_ERROR:   PRINTLONG ('INVALID INTERFACE.      ');
    CALL_NAME_ERROR:   PRINTLONG ('INVALID CALL.           ');
    ARROW_ERROR:       PRINTLONG ('INVALID POINTING.       ');
    RESOLVE_ERROR:     PRINTLONG ('INVALID RESOLUTION.     ')
  END;
  PRINTEOL;
END;

PROCEDURE PASS4ERROR(NO, LINE: INTEGER);
CONST
NESTING_ERROR=1;   ADDRESS_ERROR=2;    ACTIVE_ERROR=3;     QUEUE_ERROR=4;
PROCESS_ERROR=5;   ENTRY_ERROR=6;      FUNCTYPE_ERROR=7;   TYPEID_ERROR=8;
ENUM1_ERROR=9;     ENUM2_ERROR=10;     INDEX_ERROR=11;     MEMBER_ERROR=12;
STACK_ERROR=13;    PARM1_ERROR=14;     PARM2_ERROR=15;     PARM3_ERROR=16;
PARM4_ERROR=17;    PARM5_ERROR=18;     PARM6_ERROR=19;     PARM7_ERROR=20;
COMPILER_ERROR=21; STRING_ERROR=22;    RESOLVE_ERROR=23;   TAG_ERROR=24;
POINTER_ERROR=25;
BEGIN
  PRINTHEAD(4, LINE);
  CASE NO OF
    NESTING_ERROR:     PRINTLONG ('INVALID NESTING.        ');
    ADDRESS_ERROR:     PRINTLONG ('ADDRESS OVERFLOW.       ');
    ACTIVE_ERROR:      PRINTLONG ('ACTIVE VARIABLE.        ');
    QUEUE_ERROR:       PRINTLONG ('QUEUE VARIABLE.         ');
    PROCESS_ERROR:     PRINTLONG ('NESTED PROCESS.         ');
    ENTRY_ERROR:       PRINTLONG ('INVALID ENTRY VARIABLE. ');
    FUNCTYPE_ERROR:    PRINTLONG ('INVALID FUNCTION TYPE.  ');
    TYPEID_ERROR: ;
    ENUM1_ERROR:       PRINTLONG ('RECORD ENUMERATION.     ');
    ENUM2_ERROR:       PRINTLONG ('LONG ENUMERATION.       ');
    INDEX_ERROR:       PRINTLONG ('INVALID INDEX TYPE.     ');
    MEMBER_ERROR:      PRINTLONG ('INVALID MEMBER TYPE.    ');
    STACK_ERROR:       PRINTLONG ('PROCESS STACK USAGE.    ');
    PARM1_ERROR,PARM2_ERROR,PARM3_ERROR,PARM4_ERROR,
    PARM5_ERROR,PARM6_ERROR,
    PARM7_ERROR:       PRINTLONG ('INVALID PARAMETER.      ');
    COMPILER_ERROR:    PRINTLONG ('COMPILER ABORT.         ');
    STRING_ERROR:      PRINTLONG ('ODD LENGTH STRING TYPE. ');
    RESOLVE_ERROR:     PRINTLONG ('INVALID RESOLUTION.     ');
    TAG_ERROR:         PRINTLONG ('INVALID TAG TYPE.       ');
    POINTER_ERROR:     PRINTLONG ('RECORD POINTER TYPE.    ')
  END;
  PRINTEOL;
END;

PROCEDURE PASS5ERROR(NO, LINE: INTEGER);
CONST
COMPILER_ERROR=1;  TYPE_ERROR=2;       ADDRESS_ERROR=3;    ASSIGN_ERROR=4;
INIT_ERROR = 5;
BEGIN
  PRINTHEAD(5, LINE);
  CASE NO OF
    COMPILER_ERROR:    PRINTMED('COMPILER ABORT. ');
    TYPE_ERROR:        PRINTMED('OPERAND TYPE.   ');
    ADDRESS_ERROR:     PRINTMED('NOT A VARIABLE. ');
    ASSIGN_ERROR:      PRINTMED('NOT ASSIGNABLE. ');
    INIT_ERROR:        PRINTLONG ('INVALID INITIALIZATION. ')
  END;
  PRINTEOL;
END;

PROCEDURE PASS6ERROR(NO, LINE: INTEGER);
CONST STACK_ERROR = 1;  CODE_ERROR = 2;
BEGIN
  PRINTHEAD(6, LINE);
  CASE NO OF
    STACK_ERROR: PRINTMED('TOO MUCH STACK. ');
    CODE_ERROR: PRINTMED('TOO MUCH CODE.  ')
  END;
  PRINTEOL;
END;

PROCEDURE PRINTMESSAGE;
VAR PASS, ERROR, LINE: INTEGER;
BEGIN
  OK:= TEST;
  READ_IFL(PASS); READ_IFL(ERROR);
  READ_IFL(LINE);
  CASE PASS OF
    1:  PASS1ERROR(ERROR, LINE);
    2:  PASS2ERROR(ERROR, LINE);
    3:  PASS3ERROR(ERROR, LINE);
    4:  PASS4ERROR(ERROR, LINE);
    5:  PASS5ERROR(ERROR, LINE);
    6:  PASS6ERROR(ERROR, LINE)
  END;
END;

"##################"
"SUMMARY PROCEDURES"
"##################"

PROCEDURE PRINTSUMMARY;
BEGIN
  WRITE(EOL);
  PRINTLONG('PROCEDURE PRINTSUMMARY .');
  PRINTSHORT('CALLED. ')
END;

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

PROCEDURE BEGINPASS;
BEGIN
  INIT_PASS(LINK);
  WITH LINK@ DO
  BEGIN
    SUMMARY:= SUMMARYOPTION IN OPTIONS;
    TEST:= TESTOPTION IN OPTIONS;
    GENERATE:= CODEOPTION IN OPTIONS;
    IF PDP11
      THEN GENERATE:= GENERATE & NOT TEST
      ELSE BEGIN
             TEST:= TEST OR GENERATE;
             GENERATE:= FALSE;
           END;
    PROGLENGTH:= TABLES@.PROGLENGTH;
    CODELENGTH:= TABLES@.CODELENGTH;
    STACKLENGTH:= TABLES@.STACKLENGTH + STACKMARGIN;
    VARLENGTH:= TABLES@.VARLENGTH;
    JUMPTABLE:= TABLES@.JUMPTABLE;
    BLOCKTABLE:= TABLES@.BLOCKTABLE;
    STACKTABLE:= TABLES@.STACKTABLE;
    CONSTTABLE:= TABLES@.CONSTTABLE;
  END;
  CONSTANTS:= LINK@.CONSTANTS;
  WRITEHEAD;
END;

PROCEDURE ENDPASS;
BEGIN
  WRITETAIL;
  IF SUMMARY THEN PRINTSUMMARY;
  RELEASE(LINK@.RESETPOINT);
END;

"#################"
"OPERATOR SCANNING"
"#################"

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

CONSTADDR1"(DISPL)":
  COPY1(CONSTADDR2);

LOCALADDR1"(DISPL)":
  COPY1(LOCALADDR2);

GLOBADDR1"(DISPL)":
  COPY1(GLOBADDR2);

PUSHCONST1"(VALUE)":

  COPY1(PUSHCONST2);

PUSHLOCAL1"(DISPL)":
  COPY1(PUSHLOCAL2);

PUSHGLOB1"(DISPL)":
  COPY1(PUSHGLOB2);

PUSHIND1:
  WRITEOP(PUSHIND2);

PUSHBYTE1:
  WRITEOP(PUSHBYTE2);

PUSHREAL1:
  WRITEOP(PUSHREAL2);

PUSHSET1:
  WRITEOP(PUSHSET2);

FIELD1"(DISPL)":
  COPY1(FIELD2);

INDEX1"(MIN, MAX-MIN, LENGTH)":
  COPY3(INDEX2);

POINTER1:
  WRITEOP(POINTER2);

VARIANT1"(DISPL, TAGSET)":
  COPY2(VARIANT2);

RANGE1"(MIN, MAX)":
  COPY2(RANGE2);

COPYBYTE1:
  WRITEOP(COPYBYTE2);

COPYWORD1:
  WRITEOP(COPYWORD2);

COPYREAL1:
  WRITEOP(COPYREAL2);

COPYSET1:
  WRITEOP(COPYSET2);

COPYTAG1"(LENGTH DIV WORDLENGTH)":
  COPY1(COPYTAG2);

COPYSTRUC1"(LENGTH DIV WORDLENGTH)":
  COPY1(COPYSTRUC2);

NEW1"(BLOCK, LENGTH)":
  WRITENEW(NEW2);

NEWINIT1"(BLOCK, LENGTH)":
  WRITENEW(NEWINIT2);

NOT1:
  WRITEOP(NOT2);

ANDWORD1:
  WRITEOP(ANDWORD2);

ANDSET1:
  WRITEOP(ANDSET2);

ORWORD1:
  WRITEOP(ORWORD2);

ORSET1:
  WRITEOP(ORSET2);

NEGWORD1:
  WRITEOP(NEGWORD2);

NEGREAL1:
  WRITEOP(NEGREAL2);

ADDWORD1:
  WRITEOP(ADDWORD2);

ADDREAL1:
  WRITEOP(ADDREAL2);

SUBWORD1:
  WRITEOP(SUBWORD2);

SUBREAL1:
  WRITEOP(SUBREAL2);

SUBSET1:
  WRITEOP(SUBSET2);

MULWORD1:
  WRITEOP(MULWORD2);

MULREAL1:
  WRITEOP(MULREAL2);

DIVWORD1:
  WRITEOP(DIVWORD2);

DIVREAL1:
  WRITEOP(DIVREAL2);

MODWORD1:
  WRITEOP(MODWORD2);

BUILDSET1:
  WRITEOP(BUILDSET2);

INSET1:
  WRITEOP(INSET2);

LSWORD1:
  WRITEOP(LSWORD2);

EQWORD1:
  WRITEOP(EQWORD2);

GRWORD1:
  WRITEOP(GRWORD2);

NLWORD1:
  WRITEOP(NLWORD2);

NEWORD1:
  WRITEOP(NEWORD2);

NGWORD1:
  WRITEOP(NGWORD2);

LSREAL1:
  WRITEOP(LSREAL2);

EQREAL1:
  WRITEOP(EQREAL2);

GRREAL1:
  WRITEOP(GRREAL2);

NLREAL1:
  WRITEOP(NLREAL2);

NEREAL1:
  WRITEOP(NEREAL2);

NGREAL1:
  WRITEOP(NGREAL2);

EQSET1:
  WRITEOP(EQSET2);

NLSET1:
  WRITEOP(NLSET2);

NESET1:
  WRITEOP(NESET2);

NGSET1:
  WRITEOP(NGSET2);

LSSTRUCT1"(LENGTH DIV WORDLENGTH)":
  COPY1(LSSTRUCT2);

EQSTRUCT1"(LENGTH DIV WORDLENGTH)":
  COPY1(EQSTRUCT2);

GRSTRUCT1"(LENGTH DIV WORDLENGTH)":
  COPY1(GRSTRUCT2);

NLSTRUCT1"(LENGTH DIV WORDLENGTH)":
  COPY1(NLSTRUCT2);

NESTRUCT1"(LENGTH DIV WORDLENGTH)":
  COPY1(NESTRUCT2);

NGSTRUCT1"(LENGTH DIV WORDLENGTH)":
  COPY1(NGSTRUCT2);

FUNCVALUE1"(KIND)":
  COPY1(FUNCVALUE2);

JUMP1"(LOCATION, LABEL)":
  WRITEJUMP(JUMP2);

FALSEJUMP1"(LOCATION, LABEL)":
  WRITEJUMP(FALSEJUMP2);

CASEJUMP1"(MIN, MAX-MIN, LOCATION, LABELS)":
  WRITECASE(CASEJUMP2);

INITVAR1"(LENGTH DIV WORDLENGTH)":
  COPY1(INITVAR2);

CALL1"(LOCATION, BLOCK)":
  WRITECALL(CALL2);

CALLSYS1"(ENTRY * WORDLENGTH)":
  COPY1(CALLSYS2);

ENTER1"(BLOCK, POPLENGTH, LINE, VARLENGTH)":
  WRITEENTER(ENTER2);

EXIT1:
  WRITEEXIT(EXIT2);

ENTERPROG1"(POPLENGTH, LINE, BLOCK, VARLENGTH)":
  WRITEPROG(ENTERPROG2);

EXITPROG1:
  WRITEEXIT(EXITPROG2);

BEGINCLAS1"(BLOCK, POPLENGTH, LINE, VARLENGTH)":
  WRITEENTER(BEGINCLAS2);

ENDCLASS1:
  WRITEEXIT(ENDCLASS2);

ENTERCLAS1"(BLOCK, POPLENGTH, LINE, VARLENGTH)":
  WRITEENTER(ENTERCLAS2);

EXITCLASS1:
  WRITEEXIT(EXITCLASS2);

BEGINMON1"(BLOCK, POPLENGTH, LINE, VARLENGTH)":
  WRITEENTER(BEGINMON2);

ENDMON1:
  WRITEEXIT(ENDMON2);

ENTERMON1"(BLOCK, POPLENGTH, LINE, VARLENGTH)":
  WRITEENTER(ENTERMON2);

EXITMON1:
  WRITEEXIT(EXITMON2);

BEGINPROC1"(LINE)":
  COPY1(BEGINPROC2);

ENDPROC1:
  WRITEEXIT(ENDPROC2);

ENTERPROC1"(BLOCK, POPLENGTH, LINE, VARLENGTH)":
  WRITEENTER(ENTERPROC2);

EXITPROC1:
  WRITEEXIT(EXITPROC2);

POP1"(LENGTH)":
  COPY1(POP2);

NEWLINE1"(NUMBER)":
  COPY1(NEWLINE2);

INCRWORD1:
  WRITEOP(INCRWORD2);

DECRWORD1:
  WRITEOP(DECRWORD2);

INITCLASS1"(PARAMLENGTH, LOCATION, BLOCK)":
  WRITEINIT(INITCLASS2);

INITMON1"(PARAMLENGTH, LOCATION, BLOCK)":
  WRITEINIT(INITMON2);

INITPROC1"(PARAMLENGTH, VARLENGTH, BLOCK, LOCATION, BLOCK)":
  WRITEPROC(INITPROC2);

PUSHLABEL1"(LOCATION, BLOCK)":
  WRITECALL(PUSHLABEL2);

CALLPROG1:
  WRITEOP(CALLPROG2);

TRUNCREAL1:
  WRITEOP(TRUNCREAL2);

ABSWORD1:
  WRITEOP(ABSWORD2);

ABSREAL1:
  WRITEOP(ABSREAL2);

SUCCWORD1:
  WRITEOP(SUCCWORD2);

PREDWORD1:
  WRITEOP(PREDWORD2);

CONVWORD1:
  WRITEOP(CONVWORD2);

EMPTY1:
  WRITEOP(EMPTY2);

ATTRIBUTE1:
  WRITEOP(ATTRIBUTE2);

REALTIME1:
  WRITEOP(REALTIME2);

DELAY1:
  WRITEOP(DELAY2);

CONTINUE1:
  WRITEOP(CONTINUE2);

IO1:
  WRITEOP(IO2);

START1:
  WRITEOP(START2);

STOP1:
  WRITEOP(STOP2);

SETHEAP1:
  WRITEOP(SETHEAP2);

WAIT1:
  WRITEOP(WAIT2);

MESSAGE1"(PASS, ERROR, LINE)":
  PRINTMESSAGE;

EOM1: DONE:=TRUE

END
UNTIL DONE;
END "OF SCAN";

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