"AL HARTMANN
 INFORMATION SCIENCE
 CALIFORNIA INSTITUTE OF TECHNOLOGY
 PASADENA, CALIFORNIA 91125

 PDP 11/45 SEQUENTIAL PASCAL
 COMPILER PASS 5: BODY SEMANTIC ANALYSIS

 DECEMBER 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;

TYPE FILE = 1..2;

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

TYPE   POINTER = @ INTEGER;
OPTION = LISTOPTION..NUMBEROPTION;
PASSPTR = @PASSLINK;
PASSLINK =
  RECORD
    OPTIONS: SET OF OPTION;
    LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER;
    TABLES: POINTER
  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"

EOM1=1;            BODY1=2;            BODY_END1=3;        ADDRESS1=4;
RESULT1=5;         TAG_STORE1=6;       STORE1=7;           CALL_PROC1=8;
CALL_NEW1=9;       CONSTPARM1=10;      VARPARM1=11;        SAVEPARM1=12;
FALSEJUMP1=13;     JUMP1=14;           JUMP_DEF1=15;       DEF_LABEL1=16;
CHK_TYPE1=17;      CASE_LIST1=18;      FOR_STORE1=19;      FOR_LIM1=20;
FOR_UP1=21;        FOR_DOWN1=22;       WITH1=23;           VALUE1=24;
LT1=25;            EQ1=26;             GT1=27;             LE1=28;
NE1=29;            GE1=30;             IN1=31;             UPLUS1=32;
UMINUS1=33;        PLUS1=34;           MINUS1=35;          OR1=36;
STAR1=37;          SLASH1=38;          DIV1=39;            MOD1=40;
AND1=41;           NOT1=42;            EMPTY_SET1=43;      INCLUDE1=44;
FUNCTION1=45;      CALL_FUNC1=46;      CALL_GEN1=47;       ROUTINE1=48;
VAR1=49;           ARROW1=50;          VCOMP1=51;          VARIANT1=52;
SUB1=53;           NEW_LINE1=54;       MESSAGE1=55;        LCONST1=56;
INITVAR1=57;       UNDEF1=58;          RANGE1=59;          CASE_JUMP1=60;

"OUTPUT OPERATORS"

PUSHCONST2=0;      PUSHVAR2=1;         PUSHIND2=2;         PUSHADDR2=3;
FIELD2=4;          INDEX2=5;           POINTER2=6;         VARIANT2=7;
RANGE2=8;          ASSIGN2=9;          ASSIGNTAG2=10;      COPY2=11;
NEW2=12;           NOT2=13;            AND2=14;            OR2=15;
NEG2=16;           ADD2=17;            SUB2=18;            MUL2=19;
DIV2=20;           MOD2=21;            "NOT USED"          "NOT USED"
FUNCTION2=24;      BUILDSET2=25;       COMPARE2=26;        COMPSTRCT2=27;
FUNCVALUE2=28;     DEFLABEL2=29;       JUMP2=30;           FALSEJUMP2=31;
CASEJUMP2=32;      INITVAR2=33;        CALL2=34;           ENTER2=35;
RETURN2=36;        POP2=37;            NEWLINE2=38;        ERR2=39;
LCONST2=40;        MESSAGE2=41;        INCREMENT2=42;      DECREMENT2=43;
PROCEDURE2=44;     INIT2=45;           PUSHLABEL2=46;      CALLPROG2=47;
EOM2=48;

"STANDARD SPELLING/NOUN INDICES"

XUNDEF=0;          XFALSE=1;           XTRUE=2;            XINTEGER=3;
XBOOLEAN=4;        XCHAR=5;            XNIL=6;             XABS=7;
XATTRIBUTE=8;      XCHR=9;             XCONV=10;           XORD=11;
XPRED=12;          XSUCC=13;           XTRUNC=14;          XNEW=15;
XREAL=16;

"STANDARD NOUN INDICES"

ZARITHMETIC=17;    ZINDEX=18;          ZPASSIVE=19;        ZPOINTER=20;
ZVPARM=21;         ZCPARM=22;          ZSPARM=23;          ZNPARM=24;
ZWITH=25;

"CONTEXT"

FUNC_RESULT=1;     ENTRY_VAR=2;        VARIABLE=3;         VAR_PARM=4;
UNIV_VAR=5;        CONST_PARM=6;       UNIV_CONST=7;       FIELD=8;
EXPR=10;           CONSTANT=11;        SAVE_PARM=12;       NEW_PARM=13;
TAG_FIELD=14;      WITH_CONST = 15;    WITH_VAR = 16;

"TYPE KIND"

INT_KIND=0;        REAL_KIND=1;        BOOL_KIND=2;        CHAR_KIND=3;
ENUM_KIND=4;       SET_KIND=5;         STRING_KIND=6;      NONLIST_KIND=7;
POINTER_KIND=8;    LIST_KIND=9;        GENERIC_KIND=10;    UNDEF_KIND=11;
ROUTINE_KIND=12;

"DATA TYPS"

BYTE_TYP=0;        WORD_TYP=1;         REAL_TYP=2;         SET_TYP=3;
STRUCT_TYP=4;

"ADDRESS MODES"

SCONST_MODE=11;    LCONST_MODE=0;      PROC_MODE=1;        PROG_MODE=2;
PE_MODE=3;         CE_MODE=4;          ME_MODE=5;          PROCESS_MODE=6;
CLASS_MODE=7;      MONITOR_MODE=8;     STD_MODE=9;         UNDEF_MODE=10;
TEMP_MODE=PROC_MODE;

"COMPARISONS"

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

"ERRORS"

COMPILER_ERROR=1;  TYPE_ERROR=2;       ADDRESS_ERROR=3;    ASSIGN_ERROR=4;

THIS_PASS=5;       BYTELENGTH = 1;
TEXT_LENGTH = 18;
INFILE = 1;        OUTFILE = 2;

TYPE

  TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR;

  DISPLACEMENT=INTEGER;

  ADDR_STATE=(DIRECT,INDIRECT,ADDR,EXPRESSION);

  ADDR_MODE= LCONST_MODE..SCONST_MODE;

  ADDR_MODES=SET OF ADDR_MODE;

  TYPE_KIND=INT_KIND..ROUTINE_KIND;

  STORE_CLASS=(STORE_FOR,STORE_TAG,STORE_USUAL);

  TYPE_KINDS=SET OF TYPE_KIND;

  CONTEXT_KIND=FUNC_RESULT..WITH_VAR;

  CONTEXTS=SET OF CONTEXT_KIND;

  OPERAND_CLASS=(UNDEFINED,VALUE,ROUTINE);

  OPERAND=
    RECORD
      KIND:TYPE_KIND; NOUN:INTEGER;
      MODE:ADDR_MODE; DISP:DISPLACEMENT; LENGTH:DISPLACEMENT;
      CASE CLASS:OPERAND_CLASS OF
        VALUE:(CONTEXT:CONTEXT_KIND; STATE:ADDR_STATE);
        ROUTINE:(PARM_SIZE,VAR_SIZE:DISPLACEMENT)
    END;

  OPERAND_PTR=@OPERAND;

  STACK_LINK=@STACK_ENTRY;

  STACK_ENTRY=RECORD
                OPND:OPERAND_PTR;
                RESET_POINT:INTEGER;
                NEXT_ENTRY:STACK_LINK
              END;

VAR

  INT_EXPR,REAL_EXPR,BOOL_EXPR,SET_EXPR,UNDEF_EXPR: OPERAND;

  SY: INTEGER;

  S,T: OPERAND_PTR;

  INTER_PASS_PTR: PASSPTR;

  CURRENT_MODE: ADDR_MODE;

  ROUTINE_MODES: ADDR_MODES;

  TOP_STACK,THIS_STACK,EMPTY_STACK:STACK_LINK;

  DEBUG,DONE: BOOLEAN;

  NONLISTS,INDEXS,LARGES,ARITHMETIC,INDIRECTS,SMALLS,POINTERS: TYPE_KINDS;

  UNIVERSAL,ASSIGNS,VAR_PARMS,CNST_PARMS, WITHED: CONTEXTS;

"############################"
"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 5: 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('5'); 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;

  PROCEDURE PUT_ARG(ARG:INTEGER);
  BEGIN
    WRITE_IFL(ARG);
    IF DEBUG THEN PRINTARG(ARG)
  END;

  PROCEDURE PUT0(OP:INTEGER);
  BEGIN
    WRITE_IFL(OP);
    IF DEBUG THEN PRINTOP(OP)
  END;

  PROCEDURE PUT1(OP,ARG1:INTEGER);
  BEGIN
    WRITE_IFL(OP); WRITE_IFL(ARG1);
    IF DEBUG THEN BEGIN
      PRINTOP(OP); PRINTARG(ARG1)
    END
  END;

  PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER);
  BEGIN
    WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2);
    IF DEBUG THEN BEGIN
      PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2)
    END
  END;

  PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER);
  BEGIN
    PUT2(OP,ARG1,ARG2);
    PUT_ARG(ARG3)
  END;

  PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER);
  BEGIN
    WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3);
    WRITE_IFL(ARG4);
    IF DEBUG THEN BEGIN
      PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2);
      PRINTARG(ARG3); PRINTARG(ARG4)
    END
  END;

  PROCEDURE PUT5(OP,ARG1,ARG2,ARG3,ARG4,ARG5:INTEGER);
  BEGIN
    WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3);
    WRITE_IFL(ARG4); WRITE_IFL(ARG5);
    IF DEBUG THEN BEGIN
      PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2);
      PRINTARG(ARG3); PRINTARG(ARG4); PRINTARG(ARG5)
    END
  END;

"NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START WITH PRINTFF"

"##########################"
"OPERAND STACK MANIPULATION"
"##########################"

  PROCEDURE POP;
  BEGIN
    T:=S; TOP_STACK:=TOP_STACK@.NEXT_ENTRY;
    RELEASE(TOP_STACK@.RESET_POINT);
    IF TOP_STACK=EMPTY_STACK THEN S:=NIL ELSE S:=TOP_STACK@.NEXT_ENTRY@.OPND;
  END;

  PROCEDURE PUSH;
  BEGIN
    S:=T; NEW(THIS_STACK);
    WITH THIS_STACK@ DO BEGIN
      NEW(OPND); T:=OPND;
      NEXT_ENTRY:=TOP_STACK; MARK(RESET_POINT)
    END;
    TOP_STACK:=THIS_STACK
  END;

"##########"
"INITIALIZE"
"##########"

  PROCEDURE INITIALIZE;
  BEGIN
    DONE:=FALSE;
    INIT_PASS(INTER_PASS_PTR);
    WITH INTER_PASS_PTR@ DO BEGIN
      DEBUG:=TESTOPTION IN OPTIONS;
      IF DEBUG THEN PRINTFF
    END;
    ARITHMETIC:=(.INT_KIND,REAL_KIND.);
    INDEXS:=(.INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND.);
    SMALLS:=INDEXS OR (.REAL_KIND,SET_KIND,POINTER_KIND.);
    NONLISTS:=INDEXS OR (.REAL_KIND,SET_KIND,STRING_KIND,NONLIST_KIND.);
    LARGES:=(.STRING_KIND,NONLIST_KIND,LIST_KIND.);
    INDIRECTS:=LARGES;
    ROUTINE_MODES:= (.PROC_MODE,PE_MODE,CE_MODE,ME_MODE.);
    UNIVERSAL:=(.UNIV_VAR,UNIV_CONST.);
    ASSIGNS:=(.FUNC_RESULT,VARIABLE,VAR_PARM,UNIV_VAR, WITH_VAR.);
    POINTERS:=(.POINTER_KIND,UNDEF_KIND.);
    WITHED:= (.WITH_CONST, WITH_VAR.);
    CNST_PARMS:=(.CONST_PARM,UNIV_CONST.);
    VAR_PARMS:=(.VAR_PARM,UNIV_VAR,NEW_PARM.);
    S:=NIL; T:=NIL; NEW(EMPTY_STACK); TOP_STACK:=EMPTY_STACK;
    WITH EMPTY_STACK@ DO BEGIN
      NEXT_ENTRY:=NIL; OPND:=NIL; MARK(RESET_POINT)
    END;
    WITH INT_EXPR DO BEGIN
      KIND:=INT_KIND; NOUN:=XINTEGER; LENGTH:=WORDLENGTH;
      MODE:=UNDEF_MODE;
      CLASS:=VALUE; CONTEXT:=EXPR; STATE:=EXPRESSION
    END;
    REAL_EXPR:=INT_EXPR;
    WITH REAL_EXPR DO BEGIN
      KIND:=REAL_KIND; NOUN:=XREAL;     LENGTH:=REALLENGTH
    END;
    BOOL_EXPR:=INT_EXPR;
    WITH BOOL_EXPR DO BEGIN
      KIND:=BOOL_KIND; NOUN:=XBOOLEAN
    END;
    SET_EXPR:=INT_EXPR;
    WITH SET_EXPR DO BEGIN
      KIND:=SET_KIND; NOUN:=XUNDEF;     LENGTH:=SETLENGTH
    END;
    UNDEF_EXPR:=INT_EXPR;
    WITH UNDEF_EXPR DO BEGIN
      KIND:=UNDEF_KIND; NOUN:=XUNDEF
    END;
    PUT1(JUMP2,1) "JUMP TO BLOCK LABEL 1, THE INITIAL PROCESS"
  END;

"######"
"ERRORS"
"######"

  PROCEDURE ERROR1(ERROR: INTEGER);
  BEGIN
    WITH T@ DO
      IF KIND=UNDEF_KIND THEN "SUPPRESS MESSAGE"
      ELSE PUT2(MESSAGE2,THIS_PASS,ERROR);
    T@:=UNDEF_EXPR
  END;

  PROCEDURE ERROR2(ERROR:INTEGER);
  BEGIN
    IF (T@.KIND=UNDEF_KIND) OR (S@.KIND=UNDEF_KIND) THEN "SUPPRESS MESSAGE"
    ELSE PUT2(MESSAGE2,THIS_PASS,ERROR);
    S@:=UNDEF_EXPR
  END;

  PROCEDURE ERROR2P(ERROR:INTEGER);
  BEGIN
    ERROR2(ERROR); POP
  END;

  PROCEDURE EOM;
  VAR VAR_LENGTH:DISPLACEMENT;
  BEGIN
    WITH INTER_PASS_PTR@ DO
      RELEASE(RESETPOINT);
    READ_IFL(VAR_LENGTH); PUT1(EOM2,VAR_LENGTH);
    DONE:=TRUE
  END;

  PROCEDURE ABORT;
  BEGIN
    PUT2(MESSAGE2,THIS_PASS,COMPILER_ERROR);
    EOM
  END;

"#############"
"TYPE CHECKING"
"#############"

  FUNCTION TTYP:INTEGER "TYPE CODE";
  BEGIN
    WITH T@ DO
      CASE KIND OF
        INT_KIND,BOOL_KIND,ENUM_KIND,POINTER_KIND,
        UNDEF_KIND: TTYP:=WORD_TYP;
        REAL_KIND: TTYP:=REAL_TYP;
        CHAR_KIND: IF LENGTH=WORDLENGTH THEN TTYP:=WORD_TYP
          ELSE TTYP:=BYTE_TYP;
        SET_KIND: TTYP:=SET_TYP;
        STRING_KIND,NONLIST_KIND,LIST_KIND: TTYP:=STRUCT_TYP;
        GENERIC_KIND,ROUTINE_KIND: BEGIN
          ERROR1(TYPE_ERROR); TTYP:=WORD_TYP END
      END
  END;

  FUNCTION COMPATIBLE:BOOLEAN;
  VAR RESULT:BOOLEAN;
  BEGIN
    IF (T@.CLASS <> VALUE) OR (S@.CLASS <> VALUE) THEN RESULT:= FALSE ELSE
    IF T@.CONTEXT IN UNIVERSAL THEN
      RESULT:=(S@.KIND IN NONLISTS) AND (T@.LENGTH=S@.LENGTH)
    ELSE
    IF T@.KIND=S@.KIND THEN
      CASE T@.KIND OF
        INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,
        ENUM_KIND,NONLIST_KIND,LIST_KIND: RESULT:=T@.NOUN=S@.NOUN;
        STRING_KIND:
          RESULT:=(T@.LENGTH=S@.LENGTH) OR (T@.CONTEXT IN CNST_PARMS);
        SET_KIND,POINTER_KIND:
          RESULT:=(T@.NOUN=S@.NOUN) OR (T@.NOUN=XUNDEF)
            OR (S@.NOUN=XUNDEF);
        UNDEF_KIND,ROUTINE_KIND: RESULT:=FALSE
      END
    ELSE IF T@.KIND=GENERIC_KIND THEN
      CASE T@.NOUN OF
        ZARITHMETIC: RESULT:=S@.KIND IN ARITHMETIC;
        ZINDEX: RESULT:=S@.KIND IN INDEXS
      END
    ELSE RESULT:=FALSE;
    IF NOT RESULT THEN ERROR2(TYPE_ERROR);
    COMPATIBLE:=RESULT
  END;

"######"
"IGNORE"
"######"

  PROCEDURE LCONST;
  VAR LENGTH,I,ARG:INTEGER;
  BEGIN
    READ_IFL(LENGTH); PUT1(LCONST2,LENGTH);
    FOR I:=1 TO LENGTH DIV WORDLENGTH DO BEGIN
      READ_IFL(ARG); PUT_ARG(ARG)
    END
  END;

  PROCEDURE IGNORE1(OP:INTEGER);
  VAR ARG:INTEGER;
  BEGIN
    READ_IFL(ARG); PUT1(OP,ARG)
  END;

  PROCEDURE IGNORE2(OP:INTEGER);
  VAR ARG1,ARG2:INTEGER;
  BEGIN
    READ_IFL(ARG1); READ_IFL(ARG2);
    PUT2(OP,ARG1,ARG2)
  END;

"####"
"BODY"
"####"

  PROCEDURE ROUTINE_;
  BEGIN
    PUSH;
    WITH T@ DO BEGIN
      READ_IFL(MODE); READ_IFL(DISP);
      CLASS:=ROUTINE;
      READ_IFL(PARM_SIZE); READ_IFL(VAR_SIZE);
    END
  END;

  PROCEDURE BODY;
  BEGIN
    ROUTINE_;
    WITH T@ DO BEGIN
      PUT5(ENTER2,MODE,DISP,PARM_SIZE,VAR_SIZE,0);
      CURRENT_MODE:=MODE
    END
  END;

  PROCEDURE BODY_END;
  BEGIN
    PUT1(RETURN2,CURRENT_MODE);
    POP
  END;

"#######"
"LOADING"
"#######"

  PROCEDURE ADDR_ERROR;
  BEGIN
    ERROR1(ADDRESS_ERROR);
    PUT1(PUSHCONST2,0)
  END;

  PROCEDURE ADDRESS;
  BEGIN
    WITH T@ DO
      IF CLASS=VALUE THEN BEGIN
        CASE STATE OF
          DIRECT:
            IF MODE=SCONST_MODE THEN ADDR_ERROR
            ELSE PUT2(PUSHADDR2,MODE,DISP);
          INDIRECT: PUT3(PUSHVAR2,WORD_TYP,MODE,DISP);
          ADDR: ;
          EXPRESSION: ADDR_ERROR
        END;
        STATE:=ADDR
      END ELSE ADDR_ERROR
  END;

  PROCEDURE TYPE_;
  BEGIN
    WITH T@ DO BEGIN
      READ_IFL(KIND); READ_IFL(NOUN); READ_IFL(LENGTH)
    END
  END;

  PROCEDURE RESULT;
  BEGIN
    WITH T@ DO BEGIN
      CLASS:=VALUE;
      READ_IFL(DISP);
      PUT2(PUSHADDR2,MODE,DISP);
      CONTEXT:=FUNC_RESULT; STATE:=ADDR;
      "RESULT" TYPE_
    END
  END;

  PROCEDURE VALUE_;
  BEGIN
    WITH T@ DO BEGIN
      IF KIND IN SMALLS THEN BEGIN "LOAD VALUE"
        CASE STATE OF
          DIRECT: IF MODE=SCONST_MODE THEN PUT1(PUSHCONST2,DISP) ELSE
            PUT3(PUSHVAR2,TTYP,MODE,DISP);
          INDIRECT: BEGIN
            PUT3(PUSHVAR2,WORD_TYP,MODE,DISP);
            PUT1(PUSHIND2,TTYP)
          END;
          ADDR: PUT1(PUSHIND2,TTYP);
          EXPRESSION:
        END;
        IF LENGTH=BYTELENGTH THEN LENGTH:=WORDLENGTH;
        STATE:=EXPRESSION
      END ELSE IF KIND IN INDIRECTS THEN ADDRESS
      ELSE "ERROR" PUT1(PUSHCONST2,0);
      CONTEXT:=EXPR
    END
  END;

  PROCEDURE STORE(STORE_WHAT:STORE_CLASS);
  VAR TYP:INTEGER; SIMILAR:BOOLEAN; CLEAR_LENGTH:DISPLACEMENT;
  BEGIN
    IF STORE_WHAT=STORE_TAG THEN READ_IFL(CLEAR_LENGTH);
    "EXPRESSION" VALUE_;
    SIMILAR:=COMPATIBLE;
    POP "EXPRESSION";
    IF SIMILAR THEN WITH T@ DO
      IF CONTEXT IN ASSIGNS THEN BEGIN
        TYP:=TTYP;
        IF STORE_WHAT<>STORE_TAG THEN
        IF TYP=STRUCT_TYP THEN PUT1(COPY2,LENGTH)
        ELSE PUT1(ASSIGN2,TYP)
        ELSE PUT1(ASSIGNTAG2,CLEAR_LENGTH)
      END ELSE ERROR1(ASSIGN_ERROR);
    IF STORE_WHAT<>STORE_FOR THEN POP "VARIABLE"
  END;

"##########"
"STATEMENTS"
"##########"

  PROCEDURE VAR_REF;
  BEGIN
    WITH T@ DO BEGIN
      CLASS:=VALUE;
      READ_IFL(MODE); READ_IFL(DISP); READ_IFL(CONTEXT)
    END
  END;

  PROCEDURE VAR_;
  BEGIN
    PUSH; VAR_REF; "VAR" TYPE_;
    WITH T@ DO
      IF(CONTEXT IN VAR_PARMS) OR
        (CONTEXT IN CNST_PARMS) AND (KIND IN LARGES)
        THEN STATE:=INDIRECT ELSE STATE:=DIRECT
  END;

  PROCEDURE CALL_PROC;
  BEGIN
    WITH T@ DO
      IF CLASS=ROUTINE THEN
        IF MODE=STD_MODE THEN PUT1(PROCEDURE2,DISP)
        ELSE PUT3(CALL2,MODE,DISP,PARM_SIZE);
    POP
  END;

  PROCEDURE CALL_NEW;
  BEGIN
    IGNORE2(NEW2);
    POP
  END;

  PROCEDURE CONSTPARM (GENERIC: BOOLEAN);
  BEGIN
    "PARAMETER" VAR_;
    IF COMPATIBLE THEN IF T@.CONTEXT = UNIV_CONST THEN S@.KIND:= T@.KIND;
    POP "PARAMETER";
    "ARGUMENT" VALUE_;
    IF GENERIC THEN S@ "FUNCTION RESULT" :=
      T@ "ACTUAL ARGUMENT";
    POP "ARGUMENT"
  END;

  PROCEDURE VARPARM;
  BEGIN
    "ARGUMENT" ADDRESS;
    "PARAMETER" VAR_;
    IF COMPATIBLE THEN
      IF NOT (S@.CONTEXT IN ASSIGNS) THEN ERROR2(ASSIGN_ERROR);
    POP "PARAMETER";
    POP "ARGUMENT"
  END;

  PROCEDURE FALSE_JUMP;
  VAR L:DISPLACEMENT;
  BEGIN
    "BOOLEAN" VALUE_;
    IF T@.KIND<>BOOL_KIND THEN ERROR1(TYPE_ERROR);
    READ_IFL(L); PUT1(FALSEJUMP2,L);
    POP
  END;

  PROCEDURE CASE_JUMP;
  VAR L:DISPLACEMENT;
  BEGIN
    "SELECTOR" VALUE_;
    READ_IFL(L); PUT1(JUMP2,L)
  END;

  PROCEDURE DEF_LABEL;
  VAR L:DISPLACEMENT;
  BEGIN
    READ_IFL(L); PUT1(DEFLABEL2,L)
  END;

  PROCEDURE JUMP;
  VAR L:DISPLACEMENT;
  BEGIN
    READ_IFL(L); PUT1(JUMP2,L)
  END;

  PROCEDURE JUMP_DEF;
  BEGIN
    JUMP; DEF_LABEL
  END;

  PROCEDURE CHK_TYPE;
  BEGIN
    PUSH; T@:=INT_EXPR; TYPE_;
    IF COMPATIBLE THEN "OK";
    POP
  END;

  PROCEDURE CASE_LIST;
  VAR I,MIN,MAX:INTEGER; L:DISPLACEMENT;
  BEGIN
    POP "SELECTOR";
    DEF_LABEL;
    READ_IFL(MIN); READ_IFL(MAX); PUT2(CASEJUMP2,MIN,MAX);
    FOR I:=MIN TO MAX DO BEGIN
      READ_IFL(L); PUT_ARG(L)
    END;
    DEF_LABEL
  END;

  PROCEDURE POP_TEMP;
  BEGIN
    POP;
    PUT1(POP2,WORDLENGTH)
  END;

  PROCEDURE FOR_STORE;
  BEGIN
    "INITIAL" VALUE_; STORE(STORE_FOR); T@.STATE:=DIRECT
  END;

  PROCEDURE FOR_LIM;
  VAR OP:INTEGER; LIMIT_DISP:DISPLACEMENT; LABEL:DISPLACEMENT;
  BEGIN
    "FINAL" VALUE_; DEF_LABEL;
    POP "LIMIT";
    "CONTROL VAR" VALUE_;
    T@.STATE:=DIRECT; READ_IFL(LIMIT_DISP);
    PUT3(PUSHVAR2,WORD_TYP,TEMP_MODE,LIMIT_DISP);
    READ_IFL("COMPARISON"OP);
    PUT2(COMPARE2,OP,WORD_TYP);
    READ_IFL(LABEL); PUT1(FALSEJUMP2,LABEL)
  END;

  PROCEDURE FOR_LOOP(OP:INTEGER);
  BEGIN
    "CONTROL VAR" ADDRESS;
    PUT0(OP);
    JUMP_DEF;
    POP_TEMP
  END;

"##########"
"EXPRESSION"
"##########"

  PROCEDURE EQUALITY(OP:INTEGER);
  BEGIN
    "RIGHT OPERAND" VALUE_;
    IF COMPATIBLE THEN
      CASE T@.KIND OF
        CHAR_KIND,INT_KIND,BOOL_KIND,  ENUM_KIND,POINTER_KIND,
        REAL_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP);
        STRING_KIND,NONLIST_KIND,LIST_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH);
        GENERIC_KIND,UNDEF_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR)
      END;
    POP; T@:=BOOL_EXPR
  END;

  PROCEDURE INEQUALITY(OP:INTEGER);
  BEGIN
    "RIGHT OPERAND" VALUE_;
    IF COMPATIBLE THEN
      CASE T@.KIND OF
        INT_KIND,REAL_KIND,CHAR_KIND,BOOL_KIND,ENUM_KIND,SET_KIND:
          PUT2(COMPARE2,OP,TTYP);
        STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH);
        POINTER_KIND,GENERIC_KIND,LIST_KIND,NONLIST_KIND,
        UNDEF_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR)
      END;
    POP; T@:=BOOL_EXPR
  END;

  PROCEDURE STRICT_INEQUALITY(OP:INTEGER);
  BEGIN
    "RIGHT OPERAND" VALUE_;
    IF COMPATIBLE THEN
      CASE T@.KIND OF
        INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND:
          PUT2(COMPARE2,OP,TTYP);
        STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH);
        SET_KIND,POINTER_KIND,LIST_KIND,NONLIST_KIND,
        ROUTINE_KIND,UNDEF_KIND: ERROR2(TYPE_ERROR)
      END;
    POP; T@:=BOOL_EXPR
  END;

  PROCEDURE INCLUSION;
  BEGIN
    "RIGHT OPERAND" VALUE_;
    IF (T@.KIND=SET_KIND) AND (S@.KIND IN INDEXS)
      AND (S@.NOUN=T@.NOUN) THEN PUT2(COMPARE2,INSET,SET_TYP)
    ELSE ERROR2(TYPE_ERROR);
    POP; T@:=BOOL_EXPR
  END;

  PROCEDURE UMINUS;
  BEGIN
    "OPERAND" VALUE_;
    IF T@.KIND IN ARITHMETIC THEN PUT1(NEG2,TTYP) ELSE ERROR1(TYPE_ERROR)
  END;

  PROCEDURE UPLUS;
  BEGIN
    "OPERAND" VALUE_;
    IF T@.KIND IN ARITHMETIC THEN "OK" ELSE ERROR1(TYPE_ERROR)
  END;

  PROCEDURE PLUS_MINUS_STAR(OP:INTEGER);
  VAR TNOUN:INTEGER;
  BEGIN
    "RIGHT OPERAND" VALUE_;
    IF T@.KIND=S@.KIND THEN
      IF T@.KIND=INT_KIND THEN BEGIN
        PUT1(OP,WORD_TYP);
        POP; T@:=INT_EXPR
      END ELSE IF T@.KIND=REAL_KIND THEN BEGIN
        PUT1(OP,REAL_TYP);
        POP; T@:=REAL_EXPR
      END ELSE IF (T@.KIND=SET_KIND) AND (OP=SUB2)
        AND COMPATIBLE THEN BEGIN
        PUT1(SUB2,SET_TYP); TNOUN:=T@.NOUN;
        POP; T@:=SET_EXPR; T@.NOUN:=TNOUN
      END ELSE ERROR2P(TYPE_ERROR)
    ELSE ERROR2P(TYPE_ERROR)
  END;

  PROCEDURE SLASH;
  BEGIN
    "RIGHT OPERAND" VALUE_;
    IF (T@.KIND=REAL_KIND) AND (S@.KIND=REAL_KIND) THEN
      PUT1(DIV2,REAL_TYP)
    ELSE ERROR2(TYPE_ERROR);
    POP; T@:=REAL_EXPR
  END;

  PROCEDURE DIV_MOD(OP:INTEGER);
  BEGIN
    "RIGHT OPERAND" VALUE_;
    IF (T@.KIND=INT_KIND) AND (S@.KIND=INT_KIND) THEN
      PUT1(OP,WORD_TYP)
    ELSE ERROR2(TYPE_ERROR);
    POP; T@:=INT_EXPR
  END;

  PROCEDURE OR_AND(OP:INTEGER);
  VAR TNOUN:INTEGER;
  BEGIN
    "RIGHT OPERAND" VALUE_;
    IF T@.KIND=S@.KIND THEN
      IF T@.KIND=BOOL_KIND THEN BEGIN
        PUT1(OP,WORD_TYP);
        POP; T@:=BOOL_EXPR
      END ELSE IF (T@.KIND=SET_KIND)
        AND COMPATIBLE THEN BEGIN
        PUT1(OP,SET_TYP); TNOUN:=T@.NOUN;
        POP; T@:=SET_EXPR; T@.NOUN:=TNOUN
      END ELSE ERROR2P(TYPE_ERROR)
    ELSE ERROR2P(TYPE_ERROR)
  END;

  PROCEDURE NOT_;
  BEGIN
    "OPERAND" VALUE_;
    IF T@.KIND<>BOOL_KIND THEN ERROR1(TYPE_ERROR);
    T@:=BOOL_EXPR;
    PUT0(NOT2)
  END;

  PROCEDURE EMPTY_SET;
  BEGIN
    PUSH; T@:=SET_EXPR;
    PUT3(PUSHVAR2,SET_TYP,LCONST_MODE,0)
  END;

  PROCEDURE INCLUDE;
  BEGIN
    "SET MEMBER" VALUE_;
    IF T@.KIND IN INDEXS THEN BEGIN
      IF S@.NOUN=XUNDEF     THEN S@.NOUN:=T@.NOUN
      ELSE IF S@.NOUN<>T@.NOUN THEN ERROR2(TYPE_ERROR);
      PUT0(BUILDSET2)
    END ELSE ERROR2(TYPE_ERROR);
    POP
  END;

  PROCEDURE FUNCTION_;
  BEGIN
    PUSH; T@:= UNDEF_EXPR; T@.CONTEXT:= FUNC_RESULT;
    "FUNC" TYPE_;
    WITH S@ DO 
      IF (CLASS = ROUTINE) AND (MODE <> STD_MODE)
        THEN PUT2(FUNCVALUE2, MODE, TTYP);
  END;

  PROCEDURE CALL_FUNC;
  BEGIN
    WITH S@ DO
     IF CLASS = ROUTINE THEN
      IF MODE=STD_MODE THEN PUT2(FUNCTION2, DISP, TTYP)
      ELSE PUT3(CALL2, MODE, DISP, PARM_SIZE);
    S@:=T@; POP
  END;

  PROCEDURE CALL_GEN;
  BEGIN
    WITH S@ DO PUT2(FUNCTION2,DISP,TTYP);
    T@.CONTEXT:= FUNC_RESULT; S@:= T@;
    POP "ARG"
  END;

"########"
"VARIABLE"
"########"

  PROCEDURE UNDEF;
  BEGIN
    PUSH; T@:=UNDEF_EXPR;
    PUT1(PUSHCONST2,0)
  END;

  PROCEDURE VCOMP;
  VAR SAVE_CONTEXT:INTEGER;
  BEGIN
    SAVE_CONTEXT:= T@.CONTEXT;
    VAR_REF; TYPE_;
    WITH T@ DO BEGIN
      PUT1(FIELD2,DISP);
      STATE:=ADDR;
      IF CONTEXT=VARIABLE THEN CONTEXT:=ENTRY_VAR
      ELSE CONTEXT:=SAVE_CONTEXT;
    END
  END;

  PROCEDURE SUB;
  VAR MIN,MAX,SIZE: INTEGER;
  BEGIN
    "SUBSCRIPT" VALUE_;
    READ_IFL(MIN); READ_IFL(MAX); READ_IFL(SIZE);
    PUT3(INDEX2,MIN,MAX,SIZE);
    PUSH; T@:=UNDEF_EXPR; "INDEX" TYPE_;
    IF COMPATIBLE THEN "OK";
    POP; POP;
    "ELEMENT" TYPE_;
  END;

  PROCEDURE ARROW;
  VAR SAVE_CONTEXT:CONTEXT_KIND;
  BEGIN
    WITH T@ DO
      IF KIND=POINTER_KIND THEN BEGIN
        SAVE_CONTEXT:=CONTEXT;
        "POINTER" VALUE_; CONTEXT:=SAVE_CONTEXT;
        IF NOT (CONTEXT IN WITHED) THEN PUT0(POINTER2);
        STATE:=ADDR
      END ELSE ERROR1(TYPE_ERROR);
    "OBJECT" TYPE_
  END;

"#########"
"MAIN LOOP"
"#########"

BEGIN "MAIN PROGRAM"
INITIALIZE;
REPEAT "MAIN LOOP"
 READ_IFL(SY);
 CASE SY OF

 ADDRESS1: ADDRESS;
 AND1: OR_AND(AND2);
 ARROW1: ARROW;
 BODY_END1: BODY_END;
 BODY1: BODY;
 CALL_FUNC1: CALL_FUNC;
 CALL_GEN1: CALL_GEN;
 CALL_NEW1: CALL_NEW;
 CALL_PROC1: CALL_PROC;
 CASE_JUMP1: CASE_JUMP;
 CASE_LIST1: CASE_LIST;
 CHK_TYPE1: CHK_TYPE;
 CONSTPARM1: CONSTPARM(FALSE);
 DEF_LABEL1: DEF_LABEL;
 DIV1: DIV_MOD(DIV2);
 EMPTY_SET1: EMPTY_SET;
 EOM1: EOM;
 EQ1: EQUALITY(EQUAL);
 FALSEJUMP1: FALSE_JUMP;
 FOR_DOWN1: FOR_LOOP(DECREMENT2);
 FOR_LIM1: FOR_LIM;
 FOR_STORE1: FOR_STORE;
 FOR_UP1: FOR_LOOP(INCREMENT2);
 FUNCTION1: FUNCTION_;
 GE1: INEQUALITY(NOTLESS);
 GT1: STRICT_INEQUALITY(GREATER);
 INCLUDE1: INCLUDE;
 INITVAR1: IGNORE1(INITVAR2);
 IN1: INCLUSION;
 JUMP_DEF1: JUMP_DEF;
 JUMP1: JUMP;
 LCONST1: LCONST;
 LE1: INEQUALITY(NOTGREATER);
 LT1: STRICT_INEQUALITY(LESS);
 MESSAGE1: IGNORE2(MESSAGE2);
 MINUS1: PLUS_MINUS_STAR(SUB2);
 MOD1: DIV_MOD(MOD2);
 NEW_LINE1: IGNORE1(NEWLINE2);
 NE1: EQUALITY(NOTEQUAL);
 NOT1: NOT_;
 OR1: OR_AND(OR2);
 PLUS1: PLUS_MINUS_STAR(ADD2);
 RANGE1: IGNORE2(RANGE2);
 RESULT1: RESULT;
 ROUTINE1: ROUTINE_;
 SAVEPARM1: CONSTPARM(TRUE);
 SLASH1: SLASH;
 STAR1: PLUS_MINUS_STAR(MUL2);
 STORE1: STORE(STORE_USUAL);
 SUB1: SUB;
 TAG_STORE1: STORE(STORE_TAG);
 UMINUS1: UMINUS;
 UNDEF1: UNDEF;
 UPLUS1: UPLUS;
 VALUE1: VALUE_;
 VARIANT1: IGNORE2(VARIANT2);
 VARPARM1: VARPARM;
 VAR1: VAR_;
 VCOMP1: VCOMP;
 WITH1: POP_TEMP
 END

 UNTIL DONE;
 NEXT_PASS(INTER_PASS_PTR)
END.