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

 PDP 11/45 SEQUENTIAL PASCAL
 COMPILER PASS 4: DECLARATION ANALYSIS

 JANUARY 1975"
(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;            PROG_DEF1=2;        TYPE_DEF1=3;        TYPE1=4;
ENUM_DEF1=5;       SUBR_DEF1=6;        SET_DEF1=7;         ARRAY_DEF1=8;
POINTER1=9;        REC1=10;            REC_DEF1=11;        NEW_NOUN1=12;
FIELDLIST1=13;     TAG_DEF1=14;        PART_END1=15;       CASE_JUMP1=16;
VARNT_END1=17;     VAR_LIST1=18;       FORWARD1=19;        PROC_DEF1=20;
PROCF_DEF1=21;     LCONST1=22;         FUNC_DEF1=23;       FUNCF_DEF1=24;
PARM_TYPE1=25;     UNIV_TYPE1=26;      CPARMLIST1=27;      VPARMLIST1=28;
BODY1=29;          BODY_END1=30;       ADDRESS1=31;        RESULT1=32;
STORE1=33;         CALL_PROC1=34;      PARM1=35;           FALSEJUMP1=36;
DEF_LABEL1=37;     JUMP_DEF1=38;       JUMP1=39;           CHK_TYPE1=40;
CASE_LIST1=41;     FOR_STORE1=42;      FOR_LIM1=43;        FOR_UP1=44;
FOR_DOWN1=45;      WITH_VAR1=46;       WITH_TEMP1=47;      WITH1=48;
VALUE1=49;         LT1=50;             EQ1=51;             GT1=52;
LE1=53;            NE1=54;             GE1=55;             IN1=56;
UPLUS1=57;         UMINUS1=58;         PLUS1=59;           MINUS1=60;
OR1=61;            STAR1=62;           SLASH1=63;          DIV1=64;
MOD1=65;           AND1=66;            NOT1=67;            EMPTY_SET1=68;
INCLUDE1=69;       FUNCTION1=70;       CALL_FUNC1=71;      ROUTINE1=72;
VAR1=73;           ARROW1=74;          VCOMP1=75;          SUB1=76;
INDEX1=77;         REAL1=78;           STRING1=79;         NEW_LINE1=80;
MESSAGE1=81;       CALL_NEW1=82;       UNDEF1=83;          VARIANT1=84;
MODE1=85;

"OUTPUT OPERATORS"

EOM2=1;            BODY2=2;            BODY_END2=3;        ADDRESS2=4;
RESULT2=5;         TAG_STORE2=6;       STORE2=7;           CALL_PROC2=8;
CALL_NEW2=9;       CONSTPARM2=10;      VARPARM2=11;        SAVEPARM2=12;
FALSEJUMP2=13;     JUMP2=14;           JUMP_DEF2=15;       DEF_LABEL2=16;
CHK_TYPE2=17;      CASE_LIST2=18;      FOR_STORE2=19;      FOR_LIM2=20;
FOR_UP2=21;        FOR_DOWN2=22;       WITH2=23;           VALUE2=24;
LT2=25;            EQ2=26;             GT2=27;             LE2=28;
NE2=29;            GE2=30;             IN2=31;             UPLUS2=32;
UMINUS2=33;        PLUS2=34;           MINUS2=35;          OR2=36;
STAR2=37;          SLASH2=38;          DIV2=39;            MOD2=40;
AND2=41;           NOT2=42;            EMPTY_SET2=43;      INCLUDE2=44;
FUNCTION2=45;      CALL_FUNC2=46;      CALL_GEN2=47;       ROUTINE2=48;
VAR2=49;           ARROW2=50;          VCOMP2=51;          VARIANT2=52;
SUB2=53;           NEW_LINE2=54;       MESSAGE2=55;        LCONST2=56;
INITVAR2=57;       UNDEF2=58;          RANGE2=59;          CASE_JUMP2=60;

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

"ERRORS"

NESTING_ERROR=1;   ADDRESS_ERROR=2;    RESOLVE_ERROR=23;   TAG_ERROR=24;
POINTER_ERROR=25;  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;

"INPUT_MODES"

PROC1_MODE=1;      FUNC1_MODE=2;       PROGRAM1_MODE=3;    RECORD_MODE=4;
VARIANT_MODE=5;

"OUTPUT_MODES"

SCONST2_MODE=11;   LCONST2_MODE=0;     PROC2_MODE=1;       PROGRAM2_MODE=2;
PE2_MODE=3;        CE2_MODE=4;         ME2_MODE=5;         PROCESS2_MODE=6;
CLASS2_MODE=7;     MONITOR2_MODE=8;    STD2_MODE=9;        UNDEF2_MODE=10;

"MISCELANEOUS"

MAX_INT=32667;     SET_MIN=0;          SET_MAX=127;        THIS_PASS=4;
STACK_MAX=100;     NOUN_MAX=700;       MAX_LEVEL=15;
TAG_MIN=0;         TAG_MAX=15;
INITIAL_LEVEL=0;   RESOLVE=TRUE;       DONT_RESOLVE=FALSE;
INITIALBLOCK = 1;  BYTELENGTH = 1;
TEXT_LENGTH = 18;
INFILE = 2;        OUTFILE = 1;

TYPE

  INPUT_MODE = PROC1_MODE..VARIANT_MODE;

  DISPLACEMENT=INTEGER;

  OUTPUT_MODE=LCONST2_MODE..SCONST2_MODE;

  STACK_INDEX=0..STACK_MAX;

  NOUN_INDEX=0..NOUN_MAX;

  TYPE_KIND=INT_KIND..ROUTINE_KIND;

  TYPE_KINDS=SET OF TYPE_KIND;

  CONTEXT_KIND=FUNC_RESULT..WITH_VAR;

  CONTEXTS=SET OF CONTEXT_KIND;

  PACKED_SET=0..15;

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

  ENTRY_CLASS=(UNDEFINED,VALUE,ROUTINE,TEMPLATE);

  ENTRY_PTR=@ENTRY;

  ENTRY=
    RECORD
      CASE CLASS:ENTRY_CLASS OF
        VALUE:(
          VMODE:OUTPUT_MODE; VDISP,CLEAR_SIZE:DISPLACEMENT;
          CONTEXT:CONTEXT_KIND);
        ROUTINE:(
          RMODE:OUTPUT_MODE; RDISP:DISPLACEMENT;
          PARM_SIZE,VAR_SIZE:DISPLACEMENT);
        TEMPLATE:(
          NOUN:NOUN_INDEX; SIZE:DISPLACEMENT;
          CASE KIND:TYPE_KIND OF
            INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND:(
              MIN,MAX:INTEGER))
    END;

  DISPLAY_INDEX=0..MAX_LEVEL;

  DISPLAY_REC=
    RECORD
      LAST_MODE: OUTPUT_MODE;
      LAST_ADDRESS:DISPLACEMENT;
      LAST_INITIALIZE:BOOLEAN
    END;

VAR

  SY,PARM_NUMBER,RESET_POINT:INTEGER;

  INTER_PASS_PTR: PASSPTR;

  WITH_CONTEXT:CONTEXT_KIND;

  N:NOUN_INDEX;

  DEBUG,DONE,UNIVERSAL,SAVE_CONTEXT,GENERIC_FUNCTION,PREFIX_SW,INITIALIZE,
  NO_FORWARD: BOOLEAN;

  NOUN_TABLE:ARRAY (.NOUN_INDEX.) OF ENTRY_PTR;

  STACK:ARRAY (.STACK_INDEX.) OF ENTRY_PTR;

  THIS_LEVEL, T: INTEGER;

  DISPLAY: ARRAY (.DISPLAY_INDEX.) OF DISPLAY_REC;

  CURRENT_DISP,CURRENT_LABEL: DISPLACEMENT;

  CHK_MODE:INPUT_MODE;

  MODE: OUTPUT_MODE;

  PASS_BY_REFERENCE, ASSIGNABLE: CONTEXTS;

  UENTRY,NEW_ENTRY,OLD_ENTRY,UTYPE: ENTRY_PTR;

  SMALLS,LISTS,NONLISTS,FUNC_TYPES,INDEXS,LARGES: TYPE_KINDS;

"############################"
"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 4: 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('4'); 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
    WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3);
    IF DEBUG THEN BEGIN
      PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3)
    END
  END;

  PROCEDURE PUT3_ARG(ARG1,ARG2,ARG3:INTEGER);
  BEGIN
    WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3);
    IF DEBUG THEN BEGIN
      PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3)
    END
  END;

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

  PROCEDURE PUT5(OP,ARG1,ARG2,ARG3,ARG4,ARG5:INTEGER);
  BEGIN
    PUT3(OP,ARG1,ARG2,ARG3);
    PUT_ARG(ARG4); PUT_ARG(ARG5)
  END;

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

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

  PROCEDURE STD_INDEX(N:NOUN_INDEX; K:TYPE_KIND; L,U:INTEGER);
  VAR E:ENTRY_PTR;
  BEGIN
    NEW(E); NOUN_TABLE(.N.):=E;
    WITH E@ DO BEGIN
      CLASS:=TEMPLATE; NOUN:=N;
      SIZE:=WORDLENGTH;
      KIND:=K; MIN:=L; MAX:=U
    END
  END;

  PROCEDURE STD_PARM(N:NOUN_INDEX; C:CONTEXT_KIND);
  VAR E:ENTRY_PTR;
  BEGIN
    NEW(E); NOUN_TABLE(.N.):=E;
    WITH E@ DO BEGIN
      CLASS:=VALUE; VMODE:=UNDEF2_MODE;
      VDISP:= 0;
      CONTEXT:=C
    END
  END;

  PROCEDURE STD_ROUTINE(N:NOUN_INDEX; NO:INTEGER);
  VAR E:ENTRY_PTR;
  BEGIN
    NEW(E); NOUN_TABLE(.N.):=E;
    WITH E@ DO BEGIN
      CLASS:=ROUTINE; RMODE:=STD2_MODE; RDISP:=NO;
      PARM_SIZE:= 0; VAR_SIZE:= 0;
    END
  END;

  PROCEDURE STD_NONINDEX(N:NOUN_INDEX; K:TYPE_KIND; S:DISPLACEMENT);
  VAR E:ENTRY_PTR;
  BEGIN
    NEW(E); NOUN_TABLE(.N.):=E;
    WITH E@ DO BEGIN
      CLASS:=TEMPLATE;
      NOUN:=N; SIZE:=S; KIND:=K
    END
  END;

  PROCEDURE INITIALIZE_;
  VAR I:INTEGER;
  BEGIN
    INIT_PASS(INTER_PASS_PTR);
    WITH INTER_PASS_PTR@ DO BEGIN
      DEBUG:=TESTOPTION IN OPTIONS;
      IF DEBUG THEN PRINTFF
    END;
    GENERIC_FUNCTION:=FALSE;
    CURRENT_DISP:=0;
    PREFIX_SW:=TRUE;
    T:=-1; DONE:=FALSE;
    THIS_LEVEL:=-1;
    SAVE_CONTEXT:=FALSE;
    NO_FORWARD:= FALSE;
    MODE:=PROGRAM2_MODE;
    ASSIGNABLE:= (.FUNC_RESULT, VARIABLE, VAR_PARM, UNIV_VAR, WITH_VAR.);
    NONLISTS:=(.INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND,
      SET_KIND,STRING_KIND,NONLIST_KIND,UNDEF_KIND.);
    LISTS:=(.POINTER_KIND,LIST_KIND.);
    CURRENT_LABEL:=INITIALBLOCK;
    NEW(UTYPE);
    WITH UTYPE@ DO BEGIN
      CLASS:=TEMPLATE;
      NOUN:=XUNDEF; SIZE:=1;
      KIND:=UNDEF_KIND
    END;
    INDEXS:=(.INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND.);
    PASS_BY_REFERENCE:=(.VAR_PARM,UNIV_VAR.);
    LARGES:=(.STRING_KIND,LIST_KIND,NONLIST_KIND.);
    SMALLS:=(.INT_KIND,REAL_KIND,CHAR_KIND,BOOL_KIND,ENUM_KIND,SET_KIND.);
    FUNC_TYPES:= (.INT_KIND, CHAR_KIND, BOOL_KIND, ENUM_KIND,
      POINTER_KIND, REAL_KIND.);
    NEW(UENTRY); UENTRY@.CLASS:=UNDEFINED; NOUN_TABLE(.XUNDEF.):=UENTRY;
    STD_INDEX(XINTEGER,INT_KIND,-32767,32767);
    STD_NONINDEX(XREAL,REAL_KIND,REALLENGTH);
    STD_INDEX(XBOOLEAN,BOOL_KIND,0,1);
    STD_INDEX(XCHAR,CHAR_KIND,0,127);
    STD_NONINDEX(ZWITH,POINTER_KIND,WORDLENGTH);
    STD_NONINDEX(ZARITHMETIC,GENERIC_KIND,0);
    STD_NONINDEX(ZINDEX,GENERIC_KIND,0);
    STD_NONINDEX(ZPOINTER,POINTER_KIND,WORDLENGTH);
    NOUN_TABLE(.ZPOINTER.)@.NOUN:=XUNDEF "GENERIC POINTERS HAVE UNDEF NOUN";
    STD_PARM(ZVPARM,VAR_PARM);
    STD_PARM(ZCPARM,CONST_PARM);
    STD_PARM(ZSPARM,SAVE_PARM);
    STD_PARM(ZNPARM,NEW_PARM);
    STD_ROUTINE( XNEW,-1);
    STD_ROUTINE( XTRUNC,0);
    STD_ROUTINE( XABS,1);
    STD_ROUTINE( XSUCC,2);
    STD_ROUTINE( XPRED,3);
    STD_ROUTINE( XCONV,4);
    STD_ROUTINE( XATTRIBUTE,6);
    STD_ROUTINE( XORD,8);
    STD_ROUTINE( XCHR,9);
  END;

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

  PROCEDURE ERROR(NUMBER:INTEGER);
  BEGIN
    PUT2(MESSAGE2,THIS_PASS,NUMBER)
  END;

  PROCEDURE EOM;
  BEGIN
    WITH INTER_PASS_PTR@ DO BEGIN
      RELEASE(RESETPOINT);
      BLOCKS:=CURRENT_LABEL;
    END;
    PUT1(EOM2,0);
    DONE:=TRUE
  END;

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

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

  PROCEDURE CASE_LIST;
  VAR I,ARG,MIN,MAX:INTEGER;
  BEGIN
    T:=T-1;
    READ_IFL(ARG); READ_IFL(MIN); READ_IFL(MAX);
    PUT3(CASE_LIST2,ARG,MIN,MAX);
    FOR I:=MIN TO MAX+1 DO BEGIN
      READ_IFL(ARG); PUT_ARG(ARG)
    END
  END;

  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 ARG1:INTEGER;
  BEGIN
    READ_IFL(ARG1); PUT1(OP,ARG1)
  END;

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

"#############"
"NOUN HANDLING"
"#############"

  PROCEDURE PUSH;
  BEGIN
    IF T>=STACK_MAX THEN ABORT ELSE T:=T+1;
    STACK(.T.):=UENTRY "***** TEMPORARY *****"
  END;

  PROCEDURE PUSH_NEW_ENTRY(VAR E:ENTRY_PTR);
  BEGIN
    READ_IFL(N); NEW(E);
    IF N<>XUNDEF THEN NOUN_TABLE(.N.):=E;
    IF T>=STACK_MAX THEN ABORT ELSE T:=T+1;
    STACK(.T.):=E
  END;

  PROCEDURE PUSH_OLD_ENTRY(VAR E:ENTRY_PTR);
  BEGIN
    READ_IFL(N); E:=NOUN_TABLE(.N.);
    IF T>=STACK_MAX THEN ABORT ELSE T:=T+1;
    STACK(.T.):=E
  END;

"#######"
"NESTING"
"#######"

  PROCEDURE PUSH_LEVEL(M:INPUT_MODE);
  BEGIN
    IF THIS_LEVEL>=MAX_LEVEL THEN ABORT ELSE THIS_LEVEL:=THIS_LEVEL+1;
    WITH DISPLAY(.THIS_LEVEL.) DO BEGIN
      LAST_MODE:=MODE;
      LAST_ADDRESS:=CURRENT_DISP;
      IF M<>VARIANT_MODE THEN CURRENT_DISP:=0;
      IF MODE<>PROGRAM2_MODE THEN
        IF M< RECORD_MODE THEN ERROR(NESTING_ERROR);
      CASE M OF
        PROC1_MODE,FUNC1_MODE: MODE:=PROC2_MODE;
        PROGRAM1_MODE: MODE:=PROGRAM2_MODE;
        VARIANT_MODE,RECORD_MODE: MODE:=UNDEF2_MODE
      END;
      LAST_INITIALIZE:=INITIALIZE; INITIALIZE:=FALSE
    END
  END;

  PROCEDURE POP_LEVEL;
  BEGIN
    WITH DISPLAY(.THIS_LEVEL.) DO BEGIN
      MODE:=LAST_MODE;
      CURRENT_DISP:=LAST_ADDRESS;
      INITIALIZE:=LAST_INITIALIZE
    END;
    THIS_LEVEL:=THIS_LEVEL-1
  END;

"###################"
"ADDRESS COMPUTATION"
"###################"

  FUNCTION ADD(A,B:INTEGER):INTEGER;
  BEGIN
  "ASSERT (A>=0) AND (B>=0);"
    IF MAX_INT-A>=B THEN ADD:=A+B
    ELSE BEGIN
      ERROR(ADDRESS_ERROR);
      ADD:=A
    END
  END;

  FUNCTION MULTIPLY(A,B:INTEGER):INTEGER;
  BEGIN
    "ASSERT (A>=0) AND (B>=0);"
    IF A<=MAX_INT DIV B THEN MULTIPLY:=A*B
    ELSE BEGIN
      MULTIPLY:=A;
      ERROR(ADDRESS_ERROR)
    END
  END;

  FUNCTION SUBTRACT(A,B:INTEGER):INTEGER;
  BEGIN
    "ASSERT A>=B;"
    IF (A>=0) AND (B>=0) THEN SUBTRACT:=A-B
    ELSE IF (A<0) AND (B<0) THEN SUBTRACT:=A-B
    ELSE SUBTRACT:=ADD(A,-B)
  END;

"#################"
"TYPE DECLARATIONS"
"#################"

  PROCEDURE TYPE_;
  VAR TYP:ENTRY_PTR;
  BEGIN
    PUSH_OLD_ENTRY(TYP);
    IF TYP=UENTRY THEN STACK(.T.):=UTYPE;
  END;

  PROCEDURE ENUM_DEF;
  VAR ENUM_ENTRY:ENTRY_PTR;
  BEGIN
    PUSH_NEW_ENTRY(ENUM_ENTRY);
    WITH ENUM_ENTRY@ DO BEGIN
      CLASS:=TEMPLATE;
      NOUN:=N; SIZE:=WORDLENGTH;
      KIND:=ENUM_KIND;
      MIN:=0; READ_IFL(MAX);
      IF MAX>SET_MAX THEN ERROR(ENUM2_ERROR)
    END;
    IF MODE=UNDEF2_MODE THEN ERROR(ENUM1_ERROR)
  END;

  PROCEDURE SUBR_DEF;
  VAR SUBR_ENTRY:ENTRY_PTR;
  BEGIN
    PUSH_NEW_ENTRY(SUBR_ENTRY);
    WITH SUBR_ENTRY@ DO BEGIN
      CLASS:=TEMPLATE;
      READ_IFL(NOUN); SIZE:=WORDLENGTH;
      IF NOUN=XUNDEF THEN KIND:=ENUM_KIND
        ELSE KIND:=NOUN_TABLE(.NOUN.)@.KIND;
      READ_IFL(MIN); READ_IFL(MAX)
    END
  END;

  PROCEDURE MEMBER_CHECK;
  BEGIN
    WITH STACK(.T.)@ DO
      IF KIND IN INDEXS THEN
        IF (MIN<SET_MIN) OR (MAX>SET_MAX) THEN ERROR(MEMBER_ERROR)
        ELSE "OK"
      ELSE ERROR(MEMBER_ERROR)
  END;

  PROCEDURE SET_DEF;
  VAR SET_NOUN:NOUN_INDEX; SET_ENTRY:ENTRY_PTR;
  BEGIN
    MEMBER_CHECK;
    SET_NOUN:=STACK(.T.)@.NOUN;
    T:=T-1 "POP MEMBER TYPE";
    PUSH_NEW_ENTRY(SET_ENTRY);
    WITH SET_ENTRY@ DO BEGIN
      CLASS:=TEMPLATE;
      NOUN:=SET_NOUN;
      SIZE:=SETLENGTH;
      KIND:=SET_KIND
    END
  END;

  PROCEDURE ARRAY_DEF;
  VAR SPAN,ARRAY_SIZE:DISPLACEMENT; ARRAY_KIND:TYPE_KIND;
    ARRAY_ENTRY:ENTRY_PTR;
  BEGIN
    WITH STACK(.T-1.)@ DO
      IF KIND IN INDEXS THEN SPAN:=ADD(SUBTRACT(MAX,MIN),1)
      ELSE BEGIN
        SPAN:=1; ERROR(INDEX_ERROR)
      END;
    WITH STACK(.T.)@ DO BEGIN
      IF KIND=CHAR_KIND THEN BEGIN
        IF SPAN MOD WORDLENGTH <>0 THEN BEGIN
          ERROR(STRING_ERROR);
          SPAN:=WORDLENGTH
        END;
        ARRAY_KIND:=STRING_KIND;
        ARRAY_SIZE:=SPAN
      END ELSE BEGIN
        IF KIND IN LISTS THEN ARRAY_KIND:=LIST_KIND
        ELSE ARRAY_KIND:=NONLIST_KIND;
        ARRAY_SIZE:=MULTIPLY(SPAN,SIZE)
      END;
    END;
    T:=T-2 "POP INDEX AND ELEMENT TYPES";
    PUSH_NEW_ENTRY(ARRAY_ENTRY);
    WITH ARRAY_ENTRY@ DO BEGIN
      CLASS:=TEMPLATE;
      NOUN:=N; SIZE:=ARRAY_SIZE;
      KIND:=ARRAY_KIND
    END
  END;

  PROCEDURE POINTER;
  VAR PTR_ENTRY:ENTRY_PTR;
  BEGIN
    IF MODE=UNDEF2_MODE "IN RECORD" THEN ERROR(POINTER_ERROR);
    PUSH_NEW_ENTRY(PTR_ENTRY);
    WITH PTR_ENTRY@ DO BEGIN
      CLASS:=TEMPLATE; NOUN:=N;
      SIZE:=WORDLENGTH; KIND:=POINTER_KIND
    END
  END;

  PROCEDURE FIELDLIST;
  VAR THIS_SIZE:DISPLACEMENT; NUMBER,I:INTEGER;
  BEGIN
    WITH STACK(.T.)@ DO BEGIN
      INITIALIZE:=INITIALIZE OR (KIND IN LISTS);
      THIS_SIZE:=SIZE
    END;
    READ_IFL(NUMBER);
    FOR I:=NUMBER DOWNTO 1 DO "ASSIGN ADDRESSES IN FORWARD DIRECTION"
      WITH STACK(.T-I.)@ DO BEGIN
        CLASS:=VALUE; VMODE:=MODE; CONTEXT:=FIELD;
        VDISP:=CURRENT_DISP; CURRENT_DISP:=ADD(CURRENT_DISP,THIS_SIZE)
      END;
    T:=T-NUMBER-1 "POP DECLARATION LIST"
  END;

  PROCEDURE TAG_DEF;
  VAR THIS_SIZE:DISPLACEMENT;
  BEGIN
    "TAG" TYPE_;
    WITH STACK(.T.)@ DO BEGIN
      IF KIND IN INDEXS THEN
       BEGIN
        IF (MIN<TAG_MIN) OR (MAX>TAG_MAX) THEN ERROR(TAG_ERROR)
       END
      ELSE ERROR(TAG_ERROR);
      THIS_SIZE:=SIZE; INITIALIZE:=INITIALIZE OR (KIND IN LISTS)
    END;
    T:=T-1;
    WITH STACK(.T.)@ DO BEGIN
      CLASS:=VALUE; VMODE:=MODE;
      CONTEXT:=TAG_FIELD; CLEAR_SIZE:=0;
      VDISP:=CURRENT_DISP; CURRENT_DISP:=ADD(CURRENT_DISP,THIS_SIZE)
    END;
    PUSH_LEVEL(VARIANT_MODE)
  END;

  PROCEDURE PART_END;
  VAR VARNT_SIZE:DISPLACEMENT;
  BEGIN
    WITH STACK(.T.)@ "TAG FIELD", DISPLAY(.THIS_LEVEL.) DO BEGIN
      VARNT_SIZE:=CLEAR_SIZE;
      IF INITIALIZE THEN LAST_INITIALIZE:=TRUE ELSE CLEAR_SIZE:=0;
      LAST_ADDRESS:=ADD(CURRENT_DISP,VARNT_SIZE)
    END;
    T:=T-1; POP_LEVEL
  END;

  PROCEDURE VARNT_END;
  VAR VARNT_SIZE:DISPLACEMENT;
  BEGIN
    WITH STACK(.T.)@ "TAG_FIELD", DISPLAY(.THIS_LEVEL.) DO BEGIN
      VARNT_SIZE:=CURRENT_DISP-LAST_ADDRESS;
      IF VARNT_SIZE>CLEAR_SIZE THEN CLEAR_SIZE:=VARNT_SIZE;
      CURRENT_DISP:=LAST_ADDRESS
    END
  END;

  PROCEDURE REC_DEF;
  VAR REC_ENTRY:ENTRY_PTR;
  BEGIN
    PUSH_NEW_ENTRY(REC_ENTRY);
    WITH REC_ENTRY@ DO BEGIN
      CLASS:=TEMPLATE;
      NOUN:=N; SIZE:=CURRENT_DISP;
      IF INITIALIZE THEN KIND:=LIST_KIND ELSE KIND:=NONLIST_KIND
    END;
    POP_LEVEL
  END;

"#####################"
"VARIABLE DECLARATIONS"
"#####################"

  PROCEDURE VAR_LIST;
  VAR NUMBER,I:INTEGER; THIS_SIZE:DISPLACEMENT;
  BEGIN
    WITH STACK(.T.)@ "TYPE" DO BEGIN
      THIS_SIZE:=SIZE;
      INITIALIZE:=INITIALIZE OR (KIND IN LISTS)
    END;
    READ_IFL(NUMBER);
    FOR I:=NUMBER DOWNTO 1 DO "ASSIGN ADDRESSES IN FORWARD DIRECTION"
      WITH STACK(.T-I.)@ DO BEGIN
        CLASS:=VALUE; VMODE:=MODE; CONTEXT:=VARIABLE;
        CURRENT_DISP:=ADD(CURRENT_DISP,THIS_SIZE); VDISP:=-CURRENT_DISP
      END;
    T:=T-NUMBER-1 "POP DECLARATION LIST"
  END;

"####################"
"ROUTINE DECLARATIONS"
"####################"

  PROCEDURE PEND;
  VAR VSIZE:DISPLACEMENT; I:INTEGER;
  BEGIN
    CURRENT_DISP:=WORDLENGTH; "LEAVE A WORD FOR LINE NUMBER"
    FOR I:=0 TO PARM_NUMBER-1 DO "ASSIGN ADDRESSES IN REVERSE ORDER"
      WITH STACK(.T-I.)@ DO BEGIN
        VSIZE:=VDISP; VDISP:=CURRENT_DISP;
        CURRENT_DISP:=ADD(CURRENT_DISP,VSIZE);
        VMODE:=MODE
      END;
    CURRENT_DISP:=CURRENT_DISP-WORDLENGTH "CENTER";
    T:=T-PARM_NUMBER "POP PARMS";
  END;

  PROCEDURE ROUTINE_DEF(RESOLVE:BOOLEAN);
  VAR ROUTINE_ENTRY:ENTRY_PTR;
  BEGIN
    IF RESOLVE THEN BEGIN
      IF PARM_NUMBER>0 THEN BEGIN
        ERROR(RESOLVE_ERROR); PEND
      END;
      NO_FORWARD:= TRUE;
      PUSH_OLD_ENTRY(ROUTINE_ENTRY);
    END ELSE BEGIN
      PEND;
      PUSH_NEW_ENTRY(ROUTINE_ENTRY);
      WITH ROUTINE_ENTRY@ DO BEGIN
        CLASS:=ROUTINE;
        PARM_SIZE:=CURRENT_DISP;
        VAR_SIZE:= 0;
        IF PREFIX_SW THEN RMODE:=PE2_MODE ELSE RMODE:=MODE;
        CURRENT_LABEL:=CURRENT_LABEL+1; RDISP:=CURRENT_LABEL
      END
    END;
    CURRENT_DISP:=0; MARK(RESET_POINT);
    IF PREFIX_SW THEN BEGIN
      T:=T-1; POP_LEVEL
    END
  END;

  PROCEDURE FORWARD_;
  BEGIN
    IF NO_FORWARD THEN BEGIN
      ERROR(RESOLVE_ERROR);
      NO_FORWARD:= FALSE
    END;
    T:= T- 1;  POP_LEVEL
  END;

  PROCEDURE PROG_DEF;
  VAR SAVE_LABEL:INTEGER;
  BEGIN
    PREFIX_SW:=FALSE;
    SAVE_LABEL:=CURRENT_LABEL; CURRENT_LABEL:=0;
    ROUTINE_DEF(DONT_RESOLVE);
    CURRENT_LABEL:=SAVE_LABEL
  END;

  PROCEDURE FUNC_DEF(RESOLVE:BOOLEAN);
  VAR FUNC_TYPE:ENTRY_PTR;
  BEGIN
    IF NOT RESOLVE THEN BEGIN
      TYPE_;
      IF NOT(STACK(.T.)@.KIND IN FUNC_TYPES) THEN ERROR(FUNCTYPE_ERROR);
      T:=T-1
    END;
    ROUTINE_DEF(RESOLVE)
  END;

  PROCEDURE MODE_;
  BEGIN
    READ_IFL(CHK_MODE); PUSH_LEVEL(CHK_MODE);
    PARM_NUMBER:=0
  END;

  PROCEDURE UNIV_TYPE;
  BEGIN
    TYPE_;
    IF STACK(.T.)@.KIND IN LISTS THEN ERROR(PARM6_ERROR);
    UNIVERSAL:=TRUE;
  END;

  PROCEDURE PARMLIST(C:CONTEXT_KIND);
  VAR I,NUMBER:INTEGER; THIS_SIZE:DISPLACEMENT;
  BEGIN
    READ_IFL(NUMBER); PARM_NUMBER:=PARM_NUMBER+NUMBER;
    WITH STACK(.T.)@ DO
      IF (C IN PASS_BY_REFERENCE) OR (KIND IN LARGES)
        THEN THIS_SIZE:=WORDLENGTH ELSE THIS_SIZE:=SIZE;
    FOR I:=1 TO NUMBER DO
      WITH STACK(.T-I.)@ DO BEGIN
        CLASS:=VALUE; VDISP:=THIS_SIZE;
        CONTEXT:=C
      END;
    T:=T-1 "POP TYPE"
  END;

  PROCEDURE CPARM_LIST;
  VAR C:CONTEXT_KIND;
  BEGIN
    IF UNIVERSAL THEN BEGIN
      C:=UNIV_CONST; UNIVERSAL:=FALSE
    END ELSE C:=CONST_PARM;
    PARMLIST(C)
  END;

  PROCEDURE VPARMLIST;
  VAR C:CONTEXT_KIND;
  BEGIN
    IF CHK_MODE=FUNC1_MODE THEN ERROR(PARM7_ERROR);
    IF UNIVERSAL THEN BEGIN
      C:=UNIV_VAR; UNIVERSAL:=FALSE
    END ELSE C:=VAR_PARM;
    PARMLIST(C)
  END;


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

  PROCEDURE BODY;
  BEGIN
    WITH STACK(.T.)@ DO BEGIN
      VAR_SIZE:=CURRENT_DISP;
      PUT4(BODY2,RMODE,RDISP,PARM_SIZE,VAR_SIZE);
      IF INITIALIZE THEN PUT1(INITVAR2,CURRENT_DISP)
    END;
    NO_FORWARD:= FALSE;
  END;

  PROCEDURE BODY_END;
  BEGIN
    PUT0(BODY_END2);
    T:=T-1;
    RELEASE(RESET_POINT);
    POP_LEVEL
  END;

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

  PROCEDURE PUT_TYPE;
  VAR N:NOUN_INDEX;
  BEGIN
    READ_IFL(N);
    WITH NOUN_TABLE(.N.)@ DO
      IF CLASS=TEMPLATE THEN PUT3_ARG(KIND,NOUN,SIZE)
      ELSE PUT3_ARG(UNDEF_KIND,XUNDEF,1)
  END;

  PROCEDURE RESULT;
  BEGIN
    PUT1(RESULT2, STACK(.T.)@.PARM_SIZE + WORDLENGTH "CENTER");
    PUT_TYPE
  END;

  PROCEDURE STORE;
  BEGIN
    WITH STACK(.T-1.)@ DO
      IF CLASS=VALUE THEN
        IF CONTEXT=TAG_FIELD THEN PUT1(TAG_STORE2,CLEAR_SIZE)
        ELSE PUT0(STORE2)
      ELSE PUT0(STORE2);
    T:=T-2
  END;

  PROCEDURE PARM;
  VAR PARM_NOUN:NOUN_INDEX; OP:INTEGER;  PARM_CONTEXT:CONTEXT_KIND;
  BEGIN
    READ_IFL(PARM_NOUN);
    IF PARM_NOUN<>XUNDEF THEN
    WITH NOUN_TABLE(.PARM_NOUN.)@ DO BEGIN
      PARM_CONTEXT:= CONTEXT;
      CASE PARM_CONTEXT OF
        VAR_PARM,UNIV_VAR,NEW_PARM: OP:=VARPARM2;
        CONST_PARM,UNIV_CONST: OP:=CONSTPARM2;
        SAVE_PARM: BEGIN GENERIC_FUNCTION:=TRUE; OP:=SAVEPARM2 END
      END;
      PUT3(OP,VMODE,VDISP,CONTEXT)
    END
   ELSE PUT3(CONSTPARM2,UNDEF2_MODE,0,CONST_PARM);
    TYPE_;
    WITH STACK(.T.)@ DO BEGIN
      PUT3_ARG(KIND,NOUN,SIZE);
      IF PARM_CONTEXT = CONST_PARM THEN
        IF KIND IN INDEXS THEN
          IF N "TYPE NOUN" <> XINTEGER THEN PUT2(RANGE2,MIN,MAX)
    END;
    T:=T-2
  END;

  PROCEDURE CALL_NEW;
  VAR INITIALIZE:0..1;
  BEGIN
    TYPE_;
    WITH STACK(.T.)@ DO BEGIN
      IF KIND IN LISTS THEN INITIALIZE:=1 ELSE INITIALIZE:=0;
      PUT2(CALL_NEW2,SIZE,INITIALIZE)
    END;
    T:=T-2
  END;

  PROCEDURE FOR_LIM;
  VAR ARG1,ARG2,ARG4:INTEGER;
  BEGIN
    READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG4);
    CURRENT_DISP:=ADD(CURRENT_DISP,WORDLENGTH);
    PUT4(FOR_LIM2,ARG1,-CURRENT_DISP,ARG2,ARG4);
    T:=T-3
  END;

  PROCEDURE FOR_LOOP(OP:INTEGER);
  BEGIN
    CURRENT_DISP:=CURRENT_DISP-WORDLENGTH;
    IGNORE2(OP)
  END;

  PROCEDURE WITH_TEMP;
  VAR WITH_ENTRY:ENTRY_PTR;
  BEGIN
    PUSH_NEW_ENTRY(WITH_ENTRY);
    WITH WITH_ENTRY@ DO BEGIN
      CLASS:=VALUE; VMODE:=PROC2_MODE "ALL TEMPS HAVE PROCEDURE MODE";
      CURRENT_DISP:=ADD(CURRENT_DISP,WORDLENGTH);
      VDISP:=-CURRENT_DISP;
      IF WITH_CONTEXT IN ASSIGNABLE THEN CONTEXT:= WITH_VAR
        ELSE CONTEXT:= WITH_CONST
    END;
    T:=T-2;
    PUT0(ADDRESS2)
  END;

  PROCEDURE WITH_;
  BEGIN
    CURRENT_DISP:=CURRENT_DISP-WORDLENGTH;
    PUT0(WITH2)
  END;

"##########"
"EXPRESSION"
"##########"
  
  PROCEDURE CALL_FUNC;
  BEGIN
    IF GENERIC_FUNCTION THEN BEGIN
      PUT0(CALL_GEN2);
      GENERIC_FUNCTION:= FALSE
    END ELSE PUT0(CALL_FUNC2)
  END;
  
  PROCEDURE FUNCTION_;
  BEGIN
    PUT0(FUNCTION2);
    PUT_TYPE
  END;
  
  PROCEDURE BINARY(OP:INTEGER);
  BEGIN
    T:=T-1; STACK(.T.):=UENTRY;
    PUT0(OP)
  END;

"################"
"VALUE OR ROUTINE"
"################"

  PROCEDURE INDEX;
  VAR VALUE:INTEGER;
  BEGIN
    PUSH;
    READ_IFL(VALUE);
    PUT3(VAR2,SCONST2_MODE,VALUE,CONSTANT);
    PUT_TYPE
  END;

  PROCEDURE REAL_;
  VAR DISP:DISPLACEMENT;
  BEGIN
    PUSH;
    READ_IFL(DISP);
    PUT3(VAR2,LCONST2_MODE,DISP,CONSTANT);
    PUT3_ARG(REAL_KIND,XREAL,REALLENGTH)
  END;

  PROCEDURE STRING;
  VAR LENGTH:INTEGER;  DISP:DISPLACEMENT;
  BEGIN
    PUSH;
    READ_IFL(LENGTH);  READ_IFL(DISP);
    PUT3(VAR2,LCONST2_MODE,DISP,CONSTANT);
    PUT3_ARG(STRING_KIND,LENGTH,LENGTH)
  END;

  PROCEDURE VARIANT;
  VAR TAGSET:INTEGER; TAGFIELD:ENTRY_PTR;
  BEGIN
    READ_IFL(TAGSET);
    PUSH_OLD_ENTRY(TAGFIELD); T:=T-1;
    WITH TAGFIELD@ DO
      IF CLASS=VALUE THEN PUT2(VARIANT2,TAGSET,VDISP)
  END;

  PROCEDURE VCOMP(OP:INTEGER);
  VAR N:NOUN_INDEX;  VAR_ENTRY:ENTRY_PTR;
  BEGIN
    IF OP=VCOMP2 THEN T:=T-1 "POP RECORD";
    PUSH_OLD_ENTRY(VAR_ENTRY);
    WITH VAR_ENTRY@ DO BEGIN
      PUT3(OP,VMODE,VDISP,CONTEXT); PUT_TYPE;
      IF SAVE_CONTEXT THEN BEGIN
        WITH_CONTEXT:=CONTEXT; SAVE_CONTEXT:=FALSE
      END
    END
  END;

  PROCEDURE ARROW;
  BEGIN
    PUT0(ARROW2); PUT_TYPE;
    STACK(.T.):=UENTRY
  END;

  PROCEDURE SUB;
  VAR N:NOUN_INDEX; INDEX,ELEMENT:ENTRY_PTR;
    LENGTH:DISPLACEMENT;
  BEGIN
    "INDEX" TYPE_; INDEX:=STACK(.T.); T:=T-1;
    "ELEMENT" TYPE_; ELEMENT:=STACK(.T.); T:=T-1;
    WITH ELEMENT@ DO
      IF KIND=CHAR_KIND THEN LENGTH:=BYTELENGTH ELSE LENGTH:=SIZE;
    WITH INDEX@ DO BEGIN
      IF KIND IN INDEXS THEN PUT3(SUB2,MIN,MAX,LENGTH) ELSE PUT3(SUB2,0,0,1);
      PUT3_ARG(KIND,NOUN,SIZE)
    END;
    WITH ELEMENT@ DO PUT3_ARG(KIND,NOUN,LENGTH);
    T:=T-1; STACK(.T.):=ELEMENT
  END;

  PROCEDURE ROUTINE_;
  VAR ROUT:ENTRY_PTR;
  BEGIN
    PUSH_OLD_ENTRY(ROUT);
    WITH ROUT@ DO
      IF CLASS=ROUTINE THEN
        PUT4(ROUTINE2,RMODE,RDISP,PARM_SIZE,VAR_SIZE)
      ELSE PUT0(UNDEF2)
  END;

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

BEGIN
 INITIALIZE_;
 REPEAT READ_IFL(SY); CASE SY OF

 ADDRESS1: PUT0(ADDRESS2);
 AND1: BINARY(AND2);
 ARRAY_DEF1: ARRAY_DEF;
 ARROW1: ARROW;
 BODY_END1: BODY_END;
 BODY1: BODY;
 CALL_FUNC1: CALL_FUNC;
 CALL_NEW1: CALL_NEW;
 CALL_PROC1: BEGIN PUT0(CALL_PROC2); T:=T-1 END;
 CASE_JUMP1: IGNORE1(CASE_JUMP2);
 CASE_LIST1: CASE_LIST;
 CHK_TYPE1: BEGIN PUT0(CHK_TYPE2); PUT_TYPE END;
 CPARMLIST1: CPARM_LIST;
 DEF_LABEL1: IGNORE1(DEF_LABEL2);
 DIV1: BINARY(DIV2);
 EMPTY_SET1: BEGIN PUSH; PUT0(EMPTY_SET2) END;
 EOM1: EOM;
 ENUM_DEF1: ENUM_DEF;
 EQ1: BINARY(EQ2);
 FALSEJUMP1: BEGIN IGNORE1(FALSEJUMP2); T:=T-1 END;
 FIELDLIST1: FIELDLIST;
 FOR_DOWN1: FOR_LOOP(FOR_DOWN2);
 FOR_LIM1: FOR_LIM;
 FOR_STORE1: PUT0(FOR_STORE2);
 FOR_UP1: FOR_LOOP(FOR_UP2);
 FORWARD1: FORWARD_;
 FUNC_DEF1: FUNC_DEF(DONT_RESOLVE);
 FUNCF_DEF1: FUNC_DEF(RESOLVE);
 FUNCTION1: FUNCTION_;
 GE1: BINARY(GE2);
 GT1: BINARY(GT2);
 INCLUDE1: BINARY(INCLUDE2);
 INDEX1: INDEX;
 IN1: BINARY(IN2);
 JUMP_DEF1: IGNORE2(JUMP_DEF2);
 JUMP1: IGNORE1(JUMP2);
 LCONST1: LCONST;
 LE1: BINARY(LE2);
 LT1: BINARY(LT2);
 MESSAGE1: IGNORE2(MESSAGE2);
 MINUS1: BINARY(MINUS2);
 MODE1: MODE_;
 MOD1: BINARY(MOD2);
 NEW_LINE1: IGNORE1(NEW_LINE2);
 NEW_NOUN1: PUSH_NEW_ENTRY(NEW_ENTRY);
 NE1: BINARY(NE2);
 NOT1: PUT0(NOT2);
 OR1: BINARY(OR2);
 PARM_TYPE1: TYPE_;
 PARM1: PARM;
 PART_END1: PART_END;
 PLUS1: BINARY(PLUS2);
 POINTER1: POINTER;
 PROC_DEF1: ROUTINE_DEF(DONT_RESOLVE);
 PROCF_DEF1: ROUTINE_DEF(RESOLVE);
 PROG_DEF1: PROG_DEF;
 REAL1: REAL_;
 REC_DEF1: REC_DEF;
 REC1: PUSH_LEVEL(RECORD_MODE);
 RESULT1: RESULT;
 ROUTINE1: ROUTINE_;
 SET_DEF1: SET_DEF;
 SLASH1: BINARY(SLASH2);
 STAR1: BINARY(STAR2);
 STORE1:STORE;
 STRING1: STRING;
 SUBR_DEF1: SUBR_DEF;
 SUB1: SUB;
 TAG_DEF1: TAG_DEF;
 TYPE_DEF1: T:=T-1;
 TYPE1: TYPE_;
 UMINUS1: PUT0(UMINUS2);
 UNDEF1: BEGIN PUSH; PUT0(UNDEF2) END;
 UNIV_TYPE1: UNIV_TYPE;
 UPLUS1: PUT0(UPLUS2);
 VALUE1: PUT0(VALUE2);
 VAR_LIST1: VAR_LIST;
 VARIANT1: VARIANT;
 VARNT_END1: VARNT_END;
 VAR1: VCOMP(VAR2);
 VCOMP1: VCOMP(VCOMP2);
 VPARMLIST1: VPARMLIST;
 WITH_TEMP1: WITH_TEMP;
 WITH_VAR1: SAVE_CONTEXT:=TRUE;
 WITH1: WITH_
 END

 UNTIL DONE;
 NEXT_PASS(INTER_PASS_PTR)
END.