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

 PDP 11/45 SEQUENTIAL PASCAL
 COMPILER PASS 3: SCOPE 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;            CONST_ID1=2;        CONST_DEF1=3;       TYPE_ID1=4;
TYPE_DEF1=5;       VAR_ID1=6;          VAR_LIST1=7;        PROC_ID1=8;
PROC_DEF1=9;       LBL_END1=10;        FORWARD1=11;        FUNC_ID1=12;
FUNC_DEF1=13;      POINTER1=14;        FUNC_TYPE1=15;      PROG_ID1=16;
PROG_DEF1=17;      VARNT_END1=18;      TYPE1=19;           ENUM1=20;
ENUM_ID1=21;       ENUM_DEF1=22;       SUBR_DEF1=23;       SET_DEF1=24;
ARRAY_DEF1=25;     REC1=26;            FIELD_ID1=27;       FIELDLIST1=28;
REC_DEF1=29;       VARNT1=30;          PARM_ID1=31;        PARM_TYPE1=32;
UNIV_TYPE1=33;     CPARMLIST1=34;      VPARMLIST1=35;      BODY1=36;
BODY_END1=37;      ANAME1=38;          STORE1=39;          CALL_NAME1=40;
CALL1=41;          ARG_LIST1=42;       ARG1=43;            FALSEJUMP1=44;
DEF_LABEL1=45;     JUMP_DEF1=46;       DEF_CASE1=47;       CASE1=48;
JUMP1=49;          END_CASE1=50;       ADDRESS1=51;        FOR_STORE1=52;
FOR_LIM1=53;       FOR_UP1=54;         FOR_DOWN1=55;       WITH_VAR1=56;
WITH_TEMP1=57;     WITH1=58;           VALUE1=59;          LT1=60;
EQ1=61;            GT1=62;             LE1=63;             NE1=64;
GE1=65;            IN1=66;             UPLUS1=67;          UMINUS1=68;
PLUS1=69;          MINUS1=70;          OR1=71;             STAR1=72;
SLASH1=73;         DIV1=74;            MOD1=75;            AND1=76;
FNAME1=77;         NOT1=78;            EMPTY_SET1=79;      INCLUDE1=80;
FUNCTION1=81;      CALL_FUNC1=82;      NAME1=83;           COMP1=84;
SUB1=85;           ARROW1=86;          CONSTANT1=87;       REAL1=88;
FREAL1=89;         INTEGER1=90;        FINTEGER1=91;       CHAR1=92;
FCHAR1=93;         STRING1=94;         FSTRING1=95;        NEW_LINE1=96;
LCONST1=97;        MESSAGE1=98;        TAG_ID1=99;         TAG_TYPE1=100;
PART_END1=101;     TAG_DEF1=102;       LABEL1=103;         CASE_JUMP1=104;

"OUTPUT OPERATORS"

EOM2=1;            PROG_DEF2=2;        TYPE_DEF2=3;        TYPE2=4;
ENUM_DEF2=5;       SUBR_DEF2=6;        SET_DEF2=7;         ARRAY_DEF2=8;
POINTER2=9;        REC2=10;            REC_DEF2=11;        NEW_NOUN2=12;
FIELDLIST2=13;     TAG_DEF2=14;        PART_END2=15;       CASE_JUMP2=16;
VARNT_END2=17;     VAR_LIST2=18;       FORWARD2=19;        PROC_DEF2=20;
PROCF_DEF2=21;     LCONST2=22;         FUNC_DEF2=23;       FUNCF_DEF2=24;
PARM_TYPE2=25;     UNIV_TYPE2=26;      CPARMLIST2=27;      VPARMLIST2=28;
BODY2=29;          BODY_END2=30;       ADDRESS2=31;        RESULT2=32;
STORE2=33;         CALL_PROC2=34;      PARM2=35;           FALSEJUMP2=36;
DEF_LABEL2=37;     JUMP_DEF2=38;       JUMP2=39;           CHK_TYPE2=40;
CASE_LIST2=41;     FOR_STORE2=42;      FOR_LIM2=43;        FOR_UP2=44;
FOR_DOWN2=45;      WITH_VAR2=46;       WITH_TEMP2=47;      WITH2=48;
VALUE2=49;         LT2=50;             EQ2=51;             GT2=52;
LE2=53;            NE2=54;             GE2=55;             IN2=56;
UPLUS2=57;         UMINUS2=58;         PLUS2=59;           MINUS2=60;
OR2=61;            STAR2=62;           SLASH2=63;          DIV2=64;
MOD2=65;           AND2=66;            NOT2=67;            EMPTY_SET2=68;
INCLUDE2=69;       FUNCTION2=70;       CALL_FUNC2=71;      ROUTINE2=72;
VAR2=73;           ARROW2=74;          VCOMP2=75;          SUB2=76;
INDEX2=77;         REAL2=78;           STRING2=79;         NEW_LINE2=80;
MESSAGE2=81;       CALL_NEW2=82;       UNDEF2=83;          VARIANT2=84;
MODE2=85;

"OTHER CONSTANTS"

MIN_CASE=0;        MAX_CASE=127;       THIS_PASS=3;        SPELLING_MAX=700;
TEXT_LENGTH = 18;
INFILE = 1;        OUTFILE = 2;
NOUN_MAX=700;
OPERAND_MAX=150;   UPDATE_MAX=100;     UPDATE_MAX1=101;    MAX_LEVEL=15;
MAX_TAG=15;        MIN_TAG=0;          TAG_STACK_MAX=5;

"MODES"

PROC_MODE=1;       FUNC_MODE=2;        PROGRAM_MODE=3;

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

"ERRORS"

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;
LBLRANGE_ERROR=9;  LBLTYPE_ERROR=10;   AMBILBL_ERROR=11;   WITH_ERROR=12;
ARROW_ERROR=20;    PROC_USE_ERROR=14;  NAME_ERROR=15;      COMP_ERROR=16;
SUB_ERROR=17;      CALL_NAME_ERROR=19; RESOLVE_ERROR=21;

"MISCELANEOUS"

NOT_POSSIBLY_FORWARD=FALSE;            POSSIBLY_FORWARD=TRUE;
OUTPUT=TRUE;       RETAIN=FALSE;       PROC_TYPE=NIL;      STD_LEVEL=0;
PREFIX_LEVEL=1;    GLOBAL_LEVEL=2;

TYPE

  ENTRY_KIND=(INDEX_CONST,REAL_CONST,STRING_CONST,VARIABLE,
    PARAMETER,FIELD,SCALAR_KIND,ROUTINE_KIND,SET_KIND,
    POINTER_KIND,ARRAY_KIND,RECORD_KIND,WITH_KIND,UNDEF_KIND);

  OPERAND_CLASS=(VAR_CLASS,ROUTINE_CLASS,ICONST_CLASS,RCONST_CLASS,SCONST_CLASS,
    DEF_CLASS,UNDEF_CLASS,FCONST_CLASS,CASE_LABEL);

  ERROR_NOTE=(YES,NO,SUPPRESS);

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

  TAG_SET=SET OF MIN_TAG..MAX_TAG;

  TAG_INDEX=0..TAG_STACK_MAX;

  UNIV_SET = ARRAY (.1..8.) OF INTEGER;

  SPELLING_INDEX=0..SPELLING_MAX;

  NOUN_INDEX= 0..NOUN_MAX;

  STACK_INDEX=0..OPERAND_MAX;

  UPDATE_INDEX=0..UPDATE_MAX;

  NAME_PTR=@NAME_REC;

  VARIANT_PTR=@VARIANT_REC;

  ENTRY_PTR=@ENTRY_REC;

  ENTRY_REC=
    RECORD
      NOUN:NOUN_INDEX;
      CASE KIND:ENTRY_KIND OF
        INDEX_CONST:(CONST_TYPE:NOUN_INDEX; CONST_VAL:INTEGER);
        REAL_CONST:(REAL_DISP:INTEGER);
        STRING_CONST:(STRING_LENGTH,STRING_DISP:INTEGER);
        VARIABLE:(VAR_TYPE:ENTRY_PTR);
        PARAMETER:(PARM_TYPE:ENTRY_PTR);
        FIELD:(FIELD_TYPE:ENTRY_PTR; VARIANT:VARIANT_PTR);
        SCALAR_KIND:(RANGE_TYPE:NOUN_INDEX);
        ROUTINE_KIND:(ROUT_PARM: NAME_PTR; ROUT_TYPE:ENTRY_PTR);
        POINTER_KIND:(OBJECT_TYPE,NEXT_FWD:ENTRY_PTR);
        ARRAY_KIND:(INDEX_TYPE:NOUN_INDEX; EL_TYPE:ENTRY_PTR);
        WITH_KIND:(WITH_TYPE:NOUN_INDEX);
        RECORD_KIND:(FIELD_NAME:NAME_PTR)
    END;

  OPERAND=
    RECORD
      CASE CLASS:OPERAND_CLASS OF
        VAR_CLASS:(VTYPE:ENTRY_PTR);
        ROUTINE_CLASS:(ROUT:ENTRY_PTR; PARM:NAME_PTR);
        ICONST_CLASS:(ICONST_TYPE:NOUN_INDEX; ICONST_VAL:INTEGER);
        RCONST_CLASS:(RCONST_DISP:INTEGER);
        SCONST_CLASS:(SCONST_LENGTH,SCONST_DISP:INTEGER);
        CASE_LABEL:(LABEL,INDEX:INTEGER);
        DEF_CLASS:(DEF_ENTRY:ENTRY_PTR; DEF_SPIX:SPELLING_INDEX)
    END;

  NAME_ACCESS=(GENERAL,INCOMPLETE,
    UNRES_TYPE,UNRES_ROUTINE,QUALIFIED,UNDEFINED);

  LEVEL_INDEX=0..MAX_LEVEL;

  SPELLING_ENTRY=
    RECORD
      ENTRY:ENTRY_PTR;
      LEVEL:LEVEL_INDEX;
      ACCESS:NAME_ACCESS
    END;

  DISPLAY_REC=
    RECORD
      BASE:0..UPDATE_MAX1;
      LEVEL_ENTRY:ENTRY_PTR;
      PREV_HEAD,PREV_TAIL: NAME_PTR
    END;

  UPDATE_REC=
    RECORD
      UPDATE_SPIX:SPELLING_INDEX;
      OLD_ENTRY:SPELLING_ENTRY
    END;

  PACKED_SET=INTEGER;

  VARIANT_REC=
    RECORD
      TAG_NOUN:NOUN_INDEX;
      LABEL_SET:PACKED_SET;
      PARENT_VARIANT:VARIANT_PTR
    END;

  NAME_REC=
    RECORD
      NAME_SPIX:SPELLING_INDEX;
      NAME_ENTRY:ENTRY_PTR;
      NEXT_NAME:NAME_PTR
    END;

VAR

  INTER_PASS_PTR: PASSPTR;

  CONSTANTS: SET OF OPERAND_CLASS;

  TYPES,CONST_KINDS: SET OF ENTRY_KIND;

  NAME_HEAD,NAME_TAIL: NAME_PTR;

  HALT,TEST,RESOLUTION,FUNC_TYPE_SW,UPDATE_SW,PREFIX_SW: BOOLEAN;

  OPS:ARRAY (.STACK_INDEX.) OF OPERAND;

  UENTRY,THIS_FUNCTION:ENTRY_PTR;

  INACCESSIBLE,OP_ACCESS: SET OF NAME_ACCESS;

  LABELS: ARRAY (.MIN_CASE..MAX_CASE.) OF INTEGER;

  THIS_UPDATE: UPDATE_INDEX;

  T:STACK_INDEX;

  ENUM_VAL,THIS_LABEL,SY,UNRESOLVED,TAG_TOP,RESET_POINT,CONST_DISP:
    INTEGER;

  ENUM_TYPE,THIS_NOUN,NEW_TYPE,LABEL_TYPE,TAG_FIELD,NEW_TAG_FIELD,
  RESET_NOUN: NOUN_INDEX;

  THIS_VARIANT:VARIANT_PTR;

  VARIANT_LABELS,TAG_LABELS: TAG_SET;

  TAG_STACK: ARRAY (.TAG_INDEX.) OF
    RECORD
      PREV_LABELS:TAG_SET;
      PREV_TAG,PREV_TYPE:NOUN_INDEX
    END;

  UPDATES:ARRAY (.UPDATE_INDEX.) OF UPDATE_REC;

  DISPLAY:ARRAY (.LEVEL_INDEX.) OF DISPLAY_REC;

  THIS_LEVEL,BODY_LEVEL: LEVEL_INDEX;

  SPELLING_TABLE:ARRAY (.SPELLING_INDEX.) OF SPELLING_ENTRY;

"############################"
"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 3: 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 PACK(LONG_SET: UNIV UNIV_SET; VAR SHORT_SET: PACKED_SET);
  BEGIN
    SHORT_SET:= LONG_SET(.1.)
  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('3'); 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;


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

"#############"
"PASS ROUTINES"
"#############"

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

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

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

  PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER);
  BEGIN
    WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2);
    IF TEST 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
    PUT3(OP,ARG1,ARG2,ARG3); PUT_ARG(ARG4)
  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;

  PROCEDURE IGNORE3(OP:INTEGER);
  VAR ARG1,ARG2,ARG3:INTEGER;
  BEGIN
    READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3);
    PUT3(OP,ARG1,ARG2,ARG3)
  END;

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

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

  PROCEDURE ABORT;
  BEGIN
    ERROR(ABORT_ERROR); HALT:=TRUE
  END;

"##############"
"INITIALIZATION"
"##############"

  PROCEDURE STD_ID(VAR STD_ENTRY:ENTRY_PTR; INDEX:SPELLING_INDEX);
  BEGIN
    NEW(STD_ENTRY); STD_ENTRY@.NOUN:=INDEX;
    WITH SPELLING_TABLE(.INDEX.) DO BEGIN
      ENTRY:=STD_ENTRY;
      LEVEL:=STD_LEVEL;
      ACCESS:=GENERAL
    END
  END;

  PROCEDURE STD_CONST(CONST_INDEX,TYPE_INDEX:SPELLING_INDEX;
    CONST_VALUE:INTEGER);
  VAR CONST_ENTRY:ENTRY_PTR;
  BEGIN
    STD_ID(CONST_ENTRY,CONST_INDEX);
    WITH CONST_ENTRY@ DO BEGIN
      KIND:=INDEX_CONST;
      CONST_TYPE:=TYPE_INDEX;
      CONST_VAL:=CONST_VALUE
    END
  END;

  PROCEDURE STD_PARM(VAR PARM_ENTRY: NAME_PTR; PARMTYPE:ENTRY_PTR;
    PARM_INDEX:NOUN_INDEX);
  BEGIN
    NEW(PARM_ENTRY);
    WITH PARM_ENTRY@ DO BEGIN
      NAME_SPIX:=XUNDEF;
      NEW(NAME_ENTRY);
      WITH NAME_ENTRY@ DO BEGIN
        NOUN:=PARM_INDEX;
        KIND:=PARAMETER;
        PARM_TYPE:=PARMTYPE
      END;
      NEXT_NAME:=NIL
    END
  END;

  PROCEDURE STD_ENTRY(VAR E:ENTRY_PTR; INDEX:NOUN_INDEX);
  BEGIN
    NEW(E);
    WITH E@ DO BEGIN
      NOUN:=INDEX;
      KIND:=UNDEF_KIND
    END
  END;

  PROCEDURE STD_ROUT (ROUT_INDEX: NOUN_INDEX; ROUTTYPE: ENTRY_PTR;
    FIRST_PARM: NAME_PTR);
  VAR ROUT_ENTRY:ENTRY_PTR;
  BEGIN
    STD_ID(ROUT_ENTRY,ROUT_INDEX);
    WITH ROUT_ENTRY@ DO BEGIN
      KIND:=ROUTINE_KIND;
      ROUT_PARM:=FIRST_PARM;
      ROUT_TYPE:=ROUTTYPE
    END
  END;

  PROCEDURE STD_SCALAR(VAR SCALAR_ENTRY:ENTRY_PTR; SCALAR_INDEX:SPELLING_INDEX);
  BEGIN
    STD_ID(SCALAR_ENTRY,SCALAR_INDEX);
    WITH SCALAR_ENTRY@ DO BEGIN
      KIND:=SCALAR_KIND;
      RANGE_TYPE:=SCALAR_INDEX
    END
  END;

  PROCEDURE INITIALIZE;
  VAR I:INTEGER; INT_TYPE,REAL_TYPE,BOOL_TYPE,CHAR_TYPE,POINTER_TYPE,
    INDEX_TYPE,ARITH_TYPE,PASSIVE_TYPE: ENTRY_PTR;
    ARITH_SPARM,INT_CPARM,PTR_VPARM,CHAR_CPARM,INDEX_CPARM,REAL_CPARM,
    INDEX_SPARM:  NAME_PTR;
  BEGIN
    INIT_PASS(INTER_PASS_PTR);
    WITH INTER_PASS_PTR@ DO BEGIN
      TEST:=TESTOPTION IN OPTIONS
    END;
    IF TEST THEN PRINTFF;
    THIS_NOUN:=ZWITH;   NEW_TYPE:=XUNDEF;
    HALT:=FALSE; RESOLUTION:=FALSE; FUNC_TYPE_SW:=FALSE;
    PREFIX_SW:=TRUE; THIS_FUNCTION:=NIL;
    CONST_DISP:=0;
    UNRESOLVED:=0 "UNRESOLVED IDENTIFIERS";
    CONSTANTS:=(.ICONST_CLASS,RCONST_CLASS,SCONST_CLASS.);
    TYPES:=(.SCALAR_KIND,ARRAY_KIND,RECORD_KIND,POINTER_KIND,SET_KIND,
      UNDEF_KIND.);
    OP_ACCESS:=(.GENERAL,UNRES_ROUTINE,QUALIFIED.);
    CONST_KINDS:=(.INDEX_CONST,REAL_CONST,STRING_CONST.);
    INACCESSIBLE:=(.UNDEFINED,INCOMPLETE,UNRES_TYPE.);
    THIS_UPDATE:= -1; T:= -1; THIS_LEVEL:= PREFIX_LEVEL;
    FOR I:=0 TO SPELLING_MAX DO
      SPELLING_TABLE(.I.).ACCESS:=UNDEFINED;
    "STANDARD ENTRYS"
    STD_CONST(XFALSE,XBOOLEAN,0);
    STD_CONST(XTRUE,XBOOLEAN,1);
    STD_CONST(XNIL,ZPOINTER,0);
    STD_ENTRY(UENTRY,XUNDEF);
    STD_ENTRY(INDEX_TYPE,ZINDEX);
    STD_ENTRY(ARITH_TYPE,ZARITHMETIC);
    STD_ENTRY(PASSIVE_TYPE,ZPASSIVE);
    STD_ENTRY(POINTER_TYPE,ZPOINTER);
    STD_SCALAR(INT_TYPE,XINTEGER);
    STD_SCALAR(REAL_TYPE,XREAL);
    STD_SCALAR(BOOL_TYPE,XBOOLEAN);
    STD_SCALAR(CHAR_TYPE,XCHAR);
    STD_PARM(ARITH_SPARM,ARITH_TYPE,ZSPARM);
    STD_PARM(INT_CPARM,INT_TYPE,ZCPARM);
    STD_PARM(CHAR_CPARM,CHAR_TYPE,ZCPARM);
    STD_PARM(INDEX_CPARM,INDEX_TYPE,ZCPARM);
    STD_PARM(INDEX_SPARM,INDEX_TYPE,ZSPARM);
    STD_PARM(REAL_CPARM,REAL_TYPE,ZCPARM);
    STD_PARM(PTR_VPARM,POINTER_TYPE,ZNPARM);
    STD_ROUT(XABS, ARITH_TYPE, ARITH_SPARM);
    STD_ROUT(XATTRIBUTE, INT_TYPE, INT_CPARM);
    STD_ROUT(XCHR, CHAR_TYPE, INT_CPARM);
    STD_ROUT(XCONV, REAL_TYPE, INT_CPARM);
    STD_ROUT(XORD, INT_TYPE, CHAR_CPARM);
    STD_ROUT(XPRED, INDEX_TYPE, INDEX_SPARM);
    STD_ROUT(XSUCC, INDEX_TYPE, INDEX_SPARM);
    STD_ROUT(XTRUNC, INT_TYPE, REAL_CPARM);
    STD_ROUT(XNEW, PROC_TYPE, PTR_VPARM);
  END;

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

  PROCEDURE UPDATE_CHECK;
  BEGIN
    UPDATE_SW:= (THIS_LEVEL > GLOBAL_LEVEL) OR (THIS_LEVEL = GLOBAL_LEVEL)
      AND PREFIX_SW;
  END;

  PROCEDURE PUSH_LEVEL(E:ENTRY_PTR);
  BEGIN
    IF THIS_LEVEL>=MAX_LEVEL THEN ABORT ELSE THIS_LEVEL:=THIS_LEVEL+1;
    UPDATE_CHECK;
    WITH DISPLAY(.THIS_LEVEL.) DO BEGIN
      BASE:=THIS_UPDATE+1;
      LEVEL_ENTRY:=E;
      PREV_HEAD:=NAME_HEAD; PREV_TAIL:=NAME_TAIL; NAME_HEAD:=NIL
    END
  END;

  PROCEDURE POP_LEVEL;
  VAR U:UPDATE_INDEX;
  BEGIN
    WITH DISPLAY (.THIS_LEVEL.) DO BEGIN
      NAME_HEAD:=PREV_HEAD; NAME_TAIL:=PREV_TAIL;
      FOR U:=THIS_UPDATE DOWNTO BASE DO
        WITH UPDATES(.U.) DO BEGIN
          SPELLING_TABLE(.UPDATE_SPIX.):=OLD_ENTRY
        END;
      THIS_UPDATE:=BASE-1
    END;
    THIS_LEVEL:= THIS_LEVEL - 1;
    UPDATE_CHECK
  END;

"#############"
"NAME HANDLING"
"#############"

  PROCEDURE PUSH;
  BEGIN
    IF T>= OPERAND_MAX THEN ABORT ELSE
    T:=T+1
  END;

  PROCEDURE NEW_ENTRY(VAR E:ENTRY_PTR);
  BEGIN
    IF THIS_NOUN>=NOUN_MAX THEN ABORT ELSE
    THIS_NOUN:=THIS_NOUN+1;
    NEW(E);
    WITH E@ DO BEGIN
      NOUN:=THIS_NOUN; KIND:=UNDEF_KIND
    END
  END;

  PROCEDURE PUSH_NEW_ENTRY(VAR E:ENTRY_PTR);
  BEGIN
    PUSH; NEW_ENTRY(E);
    WITH OPS(.T.) DO BEGIN
      CLASS:=DEF_CLASS;
      DEF_ENTRY:=E; DEF_SPIX:=XUNDEF
    END
  END;

  PROCEDURE UPDATE(SPIX:SPELLING_INDEX; E:ENTRY_PTR; A:NAME_ACCESS);
  BEGIN
    IF UPDATE_SW THEN BEGIN
      "SAVE OLD ENTRY"
      IF THIS_UPDATE>=UPDATE_MAX THEN ABORT ELSE
      THIS_UPDATE:=THIS_UPDATE+1;
      WITH UPDATES(.THIS_UPDATE.) DO BEGIN
        UPDATE_SPIX:=SPIX;
        OLD_ENTRY:=SPELLING_TABLE(.SPIX.)
      END
    END;
    WITH SPELLING_TABLE(.SPIX.) DO BEGIN
      ENTRY:=E; LEVEL:=THIS_LEVEL; ACCESS:=A
    END
  END;

  PROCEDURE PUSH_NEW_NAME(RESOLVE,OUTPUT:BOOLEAN; A:NAME_ACCESS);
  VAR SPIX:SPELLING_INDEX; E:ENTRY_PTR;
  BEGIN
    READ_IFL(SPIX);
    IF SPIX<>XUNDEF THEN
      WITH SPELLING_TABLE(.SPIX.) DO
        IF (ACCESS<>UNDEFINED) AND (LEVEL=THIS_LEVEL) THEN
          IF RESOLVE AND (ACCESS=UNRES_ROUTINE) THEN BEGIN
            E:=ENTRY; ACCESS:=GENERAL;
            RESOLUTION:=TRUE; UNRESOLVED:=UNRESOLVED-1
          END ELSE BEGIN
            ERROR(AMBIGUITY_ERROR); SPIX:=XUNDEF;
          END
        ELSE BEGIN
          NEW_ENTRY(E);
          UPDATE(SPIX,E,A)
        END;
    PUSH;
    WITH OPS(.T.) DO
      IF SPIX=XUNDEF THEN BEGIN
        CLASS:=UNDEF_CLASS;
        IF OUTPUT THEN PUT1(NEW_NOUN2,XUNDEF)
      END ELSE BEGIN
        CLASS:=DEF_CLASS; DEF_ENTRY:=E; DEF_SPIX:=SPIX;
        IF OUTPUT THEN PUT1(NEW_NOUN2,E@.NOUN)
      END
  END;

  PROCEDURE PUSH_OLD_NAME;
  VAR SPIX:SPELLING_INDEX;
  BEGIN
    PUSH; READ_IFL(SPIX);
    WITH OPS(.T.),SPELLING_TABLE(.SPIX.) DO
      IF ACCESS IN INACCESSIBLE THEN BEGIN
        ERROR(NAME_ERROR);
        CLASS:=UNDEF_CLASS
      END ELSE BEGIN
        CLASS:=DEF_CLASS;
        DEF_ENTRY:=ENTRY; DEF_SPIX:=SPIX
      END
  END;

  PROCEDURE FIND_NAME(LIST:NAME_PTR; SPIX:SPELLING_INDEX; VAR E:ENTRY_PTR);
  VAR NAME:NAME_PTR;
  BEGIN
    E:=NIL; NAME:=LIST;
    WHILE NAME<>NIL DO
      WITH NAME@ DO
        IF NAME_SPIX=SPIX THEN BEGIN
          E:=NAME_ENTRY; NAME:=NIL
        END ELSE NAME:=NEXT_NAME;
    IF E=NIL THEN BEGIN
      ERROR(NAME_ERROR);
      E:=UENTRY
    END
  END;

  PROCEDURE CHAIN_NAME(E:ENTRY_PTR; SPIX:SPELLING_INDEX);
  VAR N:NAME_PTR;
  BEGIN
    NEW(N);
    WITH N@ DO BEGIN
      NAME_SPIX:=SPIX;
      NAME_ENTRY:=E;
      NEXT_NAME:=NIL;
      IF NAME_HEAD=NIL THEN BEGIN NAME_HEAD:=N; NAME_TAIL:=N END
      ELSE BEGIN NAME_TAIL@.NEXT_NAME:=N; NAME_TAIL:=N END
    END
  END;

  PROCEDURE SET_ACCESS(SPIX:SPELLING_INDEX; A:NAME_ACCESS);
  BEGIN
    SPELLING_TABLE(.SPIX.).ACCESS:=A;
    T:=T-1
  END;

  PROCEDURE ENTER_NAMES(LIST:NAME_PTR; ACCESS:NAME_ACCESS);
  VAR THIS_NAME:NAME_PTR;
  BEGIN
    THIS_NAME:=LIST;
    WHILE THIS_NAME<>NIL DO
      WITH THIS_NAME@ DO BEGIN
        UPDATE(NAME_SPIX,NAME_ENTRY,ACCESS);
        THIS_NAME:=NEXT_NAME
      END
  END;

  FUNCTION DEFINED:BOOLEAN;
  BEGIN
    DEFINED:=OPS(.T.).CLASS<>UNDEF_CLASS
  END;

  FUNCTION TOP:ENTRY_PTR;
  BEGIN
    TOP:=OPS(.T.).DEF_ENTRY
  END;

  PROCEDURE DEFINE (VAR E: ENTRY_PTR);
  BEGIN
    WITH OPS(.T.) DO
      IF CLASS = DEF_CLASS THEN E:= DEF_ENTRY ELSE E:= UENTRY
  END;

"#####################"
"CONSTANT DECLARATIONS"
"#####################"

  PROCEDURE CONST_ID;
  BEGIN
    PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,RETAIN,INCOMPLETE);
    IF DEFINED THEN THIS_NOUN:=THIS_NOUN-1 "CONST IDS DON'T HAVE NOUNS"
  END;

  PROCEDURE CONST_DEF;
  BEGIN
    WITH OPS(.T-1.) DO
      IF CLASS=DEF_CLASS THEN BEGIN
        WITH DEF_ENTRY@, OPS(.T.) DO
          IF CLASS IN CONSTANTS THEN
            CASE CLASS OF
              ICONST_CLASS: BEGIN
                KIND:=INDEX_CONST;
                CONST_TYPE:=ICONST_TYPE; CONST_VAL:=ICONST_VAL
              END;
              RCONST_CLASS: BEGIN
                KIND:=REAL_CONST; REAL_DISP:=RCONST_DISP
              END;
              SCONST_CLASS: BEGIN
                KIND:=STRING_CONST;
                STRING_LENGTH:=SCONST_LENGTH;
                STRING_DISP:=SCONST_DISP
              END
            END
          ELSE ERROR(CONSTID_ERROR);
        T:=T-1; SET_ACCESS(DEF_SPIX,GENERAL)
      END ELSE T:=T-2
  END;

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

  PROCEDURE TYPE_ID;
  VAR SPIX:SPELLING_INDEX; ERROR_SW:BOOLEAN;
  BEGIN
    READ_IFL(SPIX); ERROR_SW:=FALSE;
    IF SPIX<>XUNDEF THEN
      WITH SPELLING_TABLE(.SPIX.) DO
        CASE ACCESS OF
          GENERAL:
            IF LEVEL=THIS_LEVEL THEN ERROR_SW:=TRUE
            ELSE UPDATE(SPIX,NIL,INCOMPLETE);
          UNDEFINED:
            UPDATE(SPIX,NIL,INCOMPLETE);
          UNRES_TYPE:
            IF LEVEL<>THIS_LEVEL THEN ERROR_SW:=TRUE
            ELSE UNRESOLVED:=UNRESOLVED-1;
          UNRES_ROUTINE:
            ERROR_SW:=TRUE
        END
    ELSE ERROR_SW:=TRUE;
    IF ERROR_SW THEN ERROR(NAME_ERROR);
    PUSH;
    WITH OPS(.T.) DO
      IF ERROR_SW THEN CLASS:=UNDEF_CLASS
      ELSE BEGIN
        CLASS:=DEF_CLASS; DEF_SPIX:=SPIX
      END
  END;

  PROCEDURE TYPE_DEF;
  VAR TYP,FWD_REF:ENTRY_PTR;
  BEGIN
    WITH OPS(.T-1.) DO
      IF CLASS=DEF_CLASS THEN
        WITH SPELLING_TABLE(.DEF_SPIX.) DO BEGIN
          DEFINE(TYP);
          IF ACCESS=UNRES_TYPE THEN BEGIN "RESOLVE"
            FWD_REF:=ENTRY;
            REPEAT
              WITH FWD_REF@ DO BEGIN
                OBJECT_TYPE:=TYP;
                FWD_REF:=NEXT_FWD
              END
            UNTIL FWD_REF=NIL
          END;
          ENTRY:=TYP;
          ACCESS:=GENERAL
        END;
    T:=T-2; PUT0(TYPE_DEF2)
  END;

  PROCEDURE TYPE_(OUTPUT:BOOLEAN; OP:INTEGER);
  VAR TYP: ENTRY_PTR;
  BEGIN
    PUSH_OLD_NAME;
    IF DEFINED THEN
      IF NOT(TOP@.KIND IN TYPES) THEN BEGIN
        ERROR(NAME_ERROR); OPS(.T.).CLASS:=UNDEF_CLASS
      END;
    IF OUTPUT THEN BEGIN
      DEFINE(TYP);
      PUT1(OP, TYP@.NOUN)
    END
  END;

  PROCEDURE ENUM_ID;
  BEGIN
    PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,RETAIN,GENERAL);
    IF DEFINED THEN BEGIN
      THIS_NOUN:=THIS_NOUN-1; "CONST IDS DON'T HAVE NOUNS"
      WITH TOP@ DO BEGIN
          KIND:=INDEX_CONST;
          CONST_TYPE:=ENUM_TYPE;
          ENUM_VAL:=ENUM_VAL+1; CONST_VAL:=ENUM_VAL
      END
    END;
    T:=T-1
  END;

  PROCEDURE ENUM;
  VAR E:ENTRY_PTR;
  BEGIN
    PUSH_NEW_ENTRY(E);
    ENUM_VAL:=-1;
    WITH E@ DO BEGIN
      KIND:=SCALAR_KIND;
      RANGE_TYPE:=NOUN; ENUM_TYPE:=NOUN
    END
  END;

  PROCEDURE SUBR_DEF;
  VAR MIN,MAX:INTEGER; TYPE1:NOUN_INDEX; E:ENTRY_PTR;
  BEGIN
    MIN:=0; MAX:=1; TYPE1:=XUNDEF;
    WITH OPS(.T.) DO
      IF CLASS=ICONST_CLASS THEN BEGIN
        MAX:=ICONST_VAL; TYPE1:=ICONST_TYPE
      END ELSE ERROR(SUBR_ERROR);
    WITH OPS(.T-1.) DO
      IF CLASS=ICONST_CLASS THEN BEGIN
        MIN:=ICONST_VAL;
        IF (MIN>MAX) OR (ICONST_TYPE<>TYPE1) THEN ERROR(SUBR_ERROR)
      END ELSE ERROR(SUBR_ERROR);
    T:=T-2;
    PUSH_NEW_ENTRY(E);
    WITH E@ DO BEGIN
      KIND:=SCALAR_KIND;
      RANGE_TYPE:=TYPE1;
      PUT4(SUBR_DEF2,NOUN,TYPE1,MIN,MAX)
    END
  END;

  PROCEDURE SET_DEF;
  VAR E:ENTRY_PTR;
  BEGIN
    T:=T-1;
    PUSH_NEW_ENTRY(E); E@.KIND:=SET_KIND;
    PUT1(SET_DEF2,E@.NOUN)
  END;

  PROCEDURE ARRAY_DEF;
  VAR INDEX:NOUN_INDEX; E,EL:ENTRY_PTR;
  BEGIN
    DEFINE(EL);
    T:=T-1;
    IF DEFINED THEN INDEX:=TOP@.NOUN ELSE INDEX:=XUNDEF;
    T:=T-1;
    PUSH_NEW_ENTRY(E);
    WITH E@ DO BEGIN
      KIND:=ARRAY_KIND;
      INDEX_TYPE:=INDEX;
      EL_TYPE:=EL;
      PUT1(ARRAY_DEF2,NOUN)
    END
  END;

  PROCEDURE REC;
  VAR E:ENTRY_PTR;
  BEGIN
    PUT0(REC2);
    PUSH_NEW_ENTRY(E);
    PUSH_LEVEL(E)
  END;

  PROCEDURE FIELD_DEF(NUMBER:INTEGER; VAR TYP:ENTRY_PTR);
  VAR I:INTEGER;
  BEGIN
    IF DEFINED THEN TYP:=TOP ELSE TYP:=UENTRY;
    T:=T-1;
    FOR I:=1 TO NUMBER DO
      IF DEFINED THEN
        WITH OPS(.T.) DO BEGIN
          WITH DEF_ENTRY@ DO BEGIN
            KIND:=FIELD;
            FIELD_TYPE:=TYP;
            VARIANT:=THIS_VARIANT
          END;
          CHAIN_NAME(DEF_ENTRY,DEF_SPIX);
          SET_ACCESS(DEF_SPIX,GENERAL)
        END ELSE T:=T-1;
  END;

  PROCEDURE FIELD_LIST;
  VAR NUMBER:INTEGER; TYP:ENTRY_PTR;
  BEGIN
    READ_IFL(NUMBER);
    FIELD_DEF(NUMBER,TYP);
    PUT1(FIELDLIST2,NUMBER)
  END;

  PROCEDURE TAG_DEF;
  VAR TYP:ENTRY_PTR;
  BEGIN
    FIELD_DEF(1,TYP);
    IF TAG_TOP>TAG_STACK_MAX THEN ABORT
    ELSE WITH TAG_STACK(.TAG_TOP.) DO BEGIN
      PREV_LABELS:=TAG_LABELS;
      TAG_LABELS:=(..);
      PREV_TAG:=TAG_FIELD;
      TAG_FIELD:=NEW_TAG_FIELD;
      PREV_TYPE:=LABEL_TYPE;
      WITH TYP@ DO
        IF KIND=SCALAR_KIND THEN LABEL_TYPE:=RANGE_TYPE
        ELSE LABEL_TYPE:=XUNDEF
    END;
    TAG_TOP:=TAG_TOP+1
  END;

  PROCEDURE VARNT;
  VAR VARNT_PTR:VARIANT_PTR;
  BEGIN
    VARIANT_LABELS:=(..);
    NEW(VARNT_PTR);
    WITH VARNT_PTR@ DO BEGIN
      TAG_NOUN:=TAG_FIELD;
      PARENT_VARIANT:=THIS_VARIANT;
      THIS_VARIANT:=VARNT_PTR
    END
  END;

  PROCEDURE TAG_ID;
  BEGIN
    PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,OUTPUT,INCOMPLETE);
    IF DEFINED THEN NEW_TAG_FIELD:=OPS(.T.).DEF_ENTRY@.NOUN
    ELSE NEW_TAG_FIELD:=XUNDEF
  END;

  PROCEDURE LBL_END;
  BEGIN
    IF VARIANT_LABELS AND TAG_LABELS <> (..) THEN ERROR(AMBILBL_ERROR);
    TAG_LABELS:=TAG_LABELS OR VARIANT_LABELS;
    WITH THIS_VARIANT@ DO
      PACK(VARIANT_LABELS,LABEL_SET);
  END;

  PROCEDURE VARNT_END;
  BEGIN
    THIS_VARIANT:=THIS_VARIANT@.PARENT_VARIANT;
    PUT0(VARNT_END2)
  END;

  PROCEDURE PART_END;
  BEGIN
    PUT0(PART_END2);
    TAG_TOP:=TAG_TOP-1;
    IF TAG_TOP<=TAG_STACK_MAX THEN
      WITH TAG_STACK(.TAG_TOP.) DO BEGIN
        TAG_LABELS:=PREV_LABELS;
        TAG_FIELD:=PREV_TAG;
        LABEL_TYPE:=PREV_TYPE
      END
  END;

  PROCEDURE LABEL;
  BEGIN
    IF DEFINED THEN WITH OPS(.T.) DO
      IF CLASS=ICONST_CLASS THEN BEGIN
        IF (ICONST_VAL<MIN_TAG) OR (ICONST_VAL>MAX_TAG)
          THEN ERROR(LBLRANGE_ERROR)
        ELSE VARIANT_LABELS:=VARIANT_LABELS OR (.ICONST_VAL.);
        IF ICONST_TYPE<>LABEL_TYPE THEN ERROR(LBLTYPE_ERROR)
      END ELSE ERROR(LBLTYPE_ERROR);
    T:=T-1
  END;

  PROCEDURE REC_DEF;
  VAR E:ENTRY_PTR;
  BEGIN
    WITH TOP@ DO BEGIN
      KIND:=RECORD_KIND;
      FIELD_NAME:=NAME_HEAD;
      PUT1(REC_DEF2,NOUN)
    END;
    POP_LEVEL
  END;

  PROCEDURE POINTER;
  VAR SPIX:SPELLING_INDEX; OBJ_TYP,PTR_TYP,FWD_REF:ENTRY_PTR;
  BEGIN
    READ_IFL(SPIX); OBJ_TYP:=UENTRY; PUSH_NEW_ENTRY(PTR_TYP);
    IF SPIX<>XUNDEF THEN
      WITH SPELLING_TABLE(.SPIX.) DO
        CASE ACCESS OF
          GENERAL:
            IF ENTRY@.KIND IN TYPES THEN OBJ_TYP:=ENTRY
            ELSE ERROR(NAME_ERROR);
          UNDEFINED:
            BEGIN
              UPDATE(SPIX,PTR_TYP,UNRES_TYPE);
              UNRESOLVED:=UNRESOLVED+1
            END;
          INCOMPLETE,UNRES_ROUTINE:
            ERROR(NAME_ERROR);
          UNRES_TYPE:
            IF LEVEL=THIS_LEVEL THEN BEGIN
              FWD_REF:=ENTRY;
              WHILE FWD_REF@.NEXT_FWD<>NIL DO
                FWD_REF:=FWD_REF@.NEXT_FWD;
              FWD_REF@.NEXT_FWD:=PTR_TYP
            END ELSE ERROR(NAME_ERROR)
        END;
    WITH PTR_TYP@ DO BEGIN
      KIND:=POINTER_KIND;
      OBJECT_TYPE:=OBJ_TYP;
      NEXT_FWD:=NIL;
      PUT1(POINTER2,NOUN)
    END
  END;

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

  PROCEDURE VAR_LIST;
  VAR I,NUMBER:INTEGER; TYP:ENTRY_PTR;
  BEGIN
    READ_IFL(NUMBER); PUT1(VAR_LIST2,NUMBER);
    DEFINE(TYP);
    T:=T-1;
    FOR I:=1 TO NUMBER DO
      WITH OPS(.T.) DO
       IF DEFINED THEN BEGIN
        WITH DEF_ENTRY@ DO BEGIN
          KIND:=VARIABLE;
          VAR_TYPE:=TYP
        END;
        SET_ACCESS(DEF_SPIX,GENERAL)
       END ELSE T:=T-1
  END;

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

  PROCEDURE ROUTINE_ID(ACCESS:NAME_ACCESS; MODE:INTEGER);
  BEGIN
    PUSH_NEW_NAME(POSSIBLY_FORWARD,RETAIN,ACCESS);
    PUT1(MODE2,MODE);
    PUSH_LEVEL(UENTRY);
  END;

  PROCEDURE PROC_DEF(OP:INTEGER);
  BEGIN
    MARK(RESET_POINT);
    RESET_NOUN:=THIS_NOUN;
    IF DEFINED THEN
      WITH TOP@ DO
        IF RESOLUTION THEN BEGIN
          RESOLUTION:=FALSE; PUT1(PROCF_DEF2,NOUN);
          ENTER_NAMES(ROUT_PARM,GENERAL)
        END ELSE BEGIN
          KIND:=ROUTINE_KIND; ROUT_PARM:=NAME_HEAD;
          ROUT_TYPE:=PROC_TYPE; PUT1(OP,NOUN)
        END
      ELSE PUT1(OP,XUNDEF);
    IF PREFIX_SW THEN BEGIN POP_LEVEL; T:=T-1 END
  END;

  PROCEDURE FUNC_TYPE;
  BEGIN
    TYPE_(RETAIN,0);
    FUNC_TYPE_SW:=TRUE
  END;

  PROCEDURE FUNC_DEF;
  VAR TYP: ENTRY_PTR;
  BEGIN
    MARK(RESET_POINT);
    RESET_NOUN:=THIS_NOUN;
    IF FUNC_TYPE_SW THEN BEGIN
      DEFINE(TYP);
      T:=T-1
    END ELSE TYP:= UENTRY;
    IF DEFINED THEN BEGIN
      THIS_FUNCTION:=TOP;
      WITH THIS_FUNCTION@ DO
        IF RESOLUTION THEN BEGIN
          IF FUNC_TYPE_SW THEN ERROR(RESOLVE_ERROR);
          RESOLUTION:=FALSE; PUT1(FUNCF_DEF2,NOUN);
          ENTER_NAMES(ROUT_PARM,GENERAL)
        END ELSE BEGIN
          KIND:=ROUTINE_KIND; ROUT_PARM:=NAME_HEAD;
          ROUT_TYPE:= TYP;  PUT2(FUNC_DEF2, TYP@.NOUN, NOUN)
        END
    END ELSE PUT2(FUNC_DEF2,XUNDEF,XUNDEF);
    FUNC_TYPE_SW:=FALSE;
    IF PREFIX_SW THEN BEGIN POP_LEVEL; T:=T-1 END
  END;

  PROCEDURE PARMLIST(OP:INTEGER);
  VAR I,NUMBER:INTEGER; PTYPE:ENTRY_PTR;
  BEGIN
    DEFINE(PTYPE);
    READ_IFL(NUMBER);
    PUT1(OP,NUMBER);
    FOR I:=NUMBER DOWNTO 1 DO
      WITH OPS(.T-I.) DO
       IF CLASS=DEF_CLASS THEN BEGIN
        WITH DEF_ENTRY@ DO BEGIN
          KIND:=PARAMETER;
          PARM_TYPE:=PTYPE;
        END;
        CHAIN_NAME(DEF_ENTRY,DEF_SPIX);
        SPELLING_TABLE(.DEF_SPIX.).ACCESS:=GENERAL
       END;
    T:=T-NUMBER-1
  END;

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

  PROCEDURE BODY;
  BEGIN
    BODY_LEVEL:=THIS_LEVEL;
    PUT0(BODY2)
  END;

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

  PROCEDURE FORWARD_;
  BEGIN
    PUT0(FORWARD2);
    IF DEFINED THEN BEGIN
      SET_ACCESS(OPS(.T.).DEF_SPIX,UNRES_ROUTINE);
      UNRESOLVED:=UNRESOLVED+1
    END ELSE T:=T-1;
    POP_LEVEL
  END;

  PROCEDURE ANAME;
  BEGIN
    WITH OPS(.T.) DO
      IF CLASS=ROUTINE_CLASS THEN
        IF ROUT = THIS_FUNCTION THEN
          PUT1(RESULT2, THIS_FUNCTION@.ROUT_TYPE@.NOUN)
        ELSE PUT0(ADDRESS2)
      ELSE PUT0(ADDRESS2)
  END;

  PROCEDURE CALL_NAME;
  VAR ERR:BOOLEAN;
  BEGIN
    ERR:=FALSE;
    WITH OPS(.T.) DO BEGIN
      IF CLASS=ROUTINE_CLASS THEN
        IF ROUT@.ROUT_TYPE<>PROC_TYPE THEN ERR:=TRUE ELSE "OK"
      ELSE ERR:=TRUE;
      IF ERR THEN BEGIN
        ERROR(CALL_NAME_ERROR);
        CLASS:=UNDEF_CLASS
      END
    END
  END;

  PROCEDURE CALL(OP:INTEGER);
  BEGIN
    WITH OPS(.T.) DO
      IF CLASS=ROUTINE_CLASS THEN BEGIN
        IF PARM<>NIL THEN ERROR(FEW_ARGS_ERROR);
        WITH ROUT@ DO
          IF OP = CALL_FUNC2 THEN BEGIN
            PUT0(CALL_FUNC2);
            CLASS:= VAR_CLASS;  VTYPE:= ROUT_TYPE
          END
          ELSE IF NOUN=XNEW THEN PUT1(CALL_NEW2,NEW_TYPE)
          ELSE PUT0(OP)
      END ELSE PUT0(OP);
    IF OP<>CALL_FUNC2 THEN T:=T-1
  END;

  PROCEDURE ARG_LIST;
  BEGIN
    WITH OPS(.T.) DO
      IF CLASS<>ROUTINE_CLASS THEN BEGIN
        ERROR(ARG_LIST_ERROR);
        CLASS:=UNDEF_CLASS
      END
  END;

  PROCEDURE ARG;
  VAR THIS_PARM:ENTRY_PTR; ERR:ERROR_NOTE;
  BEGIN
    ERR:=NO;
    WITH OPS(.T-1.) DO
      IF CLASS=ROUTINE_CLASS THEN BEGIN
        IF PARM=NIL THEN ERR:=YES ELSE
          WITH PARM@ DO BEGIN
            THIS_PARM:=NAME_ENTRY;
            PARM:=NEXT_NAME
          END
      END ELSE ERR:=SUPPRESS;
    IF ERR<>NO THEN BEGIN
      IF ERR=YES THEN ERROR(MANY_ARGS_ERROR);
      PUT2(PARM2,XUNDEF,XUNDEF)
    END ELSE
      WITH THIS_PARM@ DO BEGIN
        PUT2(PARM2,NOUN,PARM_TYPE@.NOUN);
        IF NOUN=ZNPARM THEN
          WITH OPS(.T.) DO
            IF CLASS=VAR_CLASS THEN
              WITH VTYPE@ DO
                IF KIND=POINTER_KIND THEN NEW_TYPE:=OBJECT_TYPE@.NOUN
      END;
    T:=T-1 "POP ARGUMENT"
  END;

  PROCEDURE DEF_CASE;
  BEGIN
    READ_IFL(THIS_LABEL);
    PUT1(DEF_LABEL2,THIS_LABEL)
  END;

  PROCEDURE CASE_;
  VAR VAL:INTEGER;
  BEGIN
    WITH OPS(.T.) DO
      IF CLASS=ICONST_CLASS THEN BEGIN
        PUT1(CHK_TYPE2,ICONST_TYPE);
        VAL:=ICONST_VAL;
        CLASS:=CASE_LABEL;
        LABEL:=THIS_LABEL;
        IF (VAL>=MIN_CASE) AND (VAL<=MAX_CASE) THEN
          INDEX:=VAL ELSE BEGIN
            ERROR(LBLRANGE_ERROR);
            T:=T-1
          END
      END ELSE BEGIN
        T:=T-1;
        ERROR(LBLTYPE_ERROR)
      END
  END;

  PROCEDURE END_CASE;
  VAR L0,LN,MIN,MAX,I:INTEGER;
  BEGIN
    READ_IFL(L0); READ_IFL(LN);
    FOR I:=MIN_CASE TO MAX_CASE DO LABELS(.I.):=LN;
    IF OPS(.T.).CLASS=CASE_LABEL THEN BEGIN
     MIN:=OPS(.T.).INDEX; MAX:=MIN;
    END ELSE BEGIN MIN:=0; MAX:=0 END;
    WHILE OPS(.T.).CLASS=CASE_LABEL DO BEGIN
        WITH OPS(.T.) DO BEGIN
          IF LABELS(.INDEX.)=LN THEN
            LABELS(.INDEX.):=LABEL
          ELSE ERROR(AMBILBL_ERROR);
          IF INDEX>MAX THEN MAX:=INDEX ELSE
            IF INDEX<MIN THEN MIN:=INDEX
        END;
        T:=T-1
    END;
      T:=T-1;
      PUT3(CASE_LIST2,L0,MIN,MAX);
      FOR I:=MIN TO MAX DO PUT_ARG(LABELS(.I.));
      PUT_ARG(LN)
  END;

  PROCEDURE WITH_TEMP;
  VAR TEMP:ENTRY_PTR; ERR:BOOLEAN;
  BEGIN
    ERR:=FALSE;
    WITH OPS(.T.) DO
      IF CLASS=VAR_CLASS THEN
        WITH VTYPE@ DO
          IF KIND=RECORD_KIND THEN BEGIN
            NEW_ENTRY(TEMP);
            WITH TEMP@ DO BEGIN
              PUT1(WITH_TEMP2,NOUN);
              KIND:=WITH_KIND;
              WITH_TYPE:=VTYPE@.NOUN
            END;
            PUSH_LEVEL(TEMP);
            ENTER_NAMES(FIELD_NAME,QUALIFIED)
          END ELSE ERR:=TRUE
      ELSE ERR:=TRUE;
    IF ERR THEN BEGIN
      ERROR(WITH_ERROR);
      PUSH_LEVEL(UENTRY); PUT1(WITH_TEMP2,XUNDEF)
    END;
    T:=T-1
  END;

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

  PROCEDURE FNAME;
  VAR TYP: ENTRY_PTR;
  BEGIN
    WITH OPS(.T.) DO
      IF CLASS=ROUTINE_CLASS THEN
        WITH ROUT@ DO BEGIN
          IF ROUT_TYPE=PROC_TYPE THEN BEGIN
            ERROR(PROC_USE_ERROR);
            TYP:= UENTRY
          END ELSE TYP:=ROUT_TYPE;
          PUT1(FUNCTION2, TYP@.NOUN);
          IF PARM<>NIL THEN ERROR(FEW_ARGS_ERROR);
          PUT0(CALL_FUNC2);
          CLASS:= VAR_CLASS;  VTYPE:= TYP
        END
  END;

  PROCEDURE FUNCTION_ERROR(ERROR_NUM:INTEGER);
  BEGIN
    ERROR(ERROR_NUM);
    OPS(.T.).CLASS:=UNDEF_CLASS
  END;

  PROCEDURE FUNCTION_;
  VAR FUNC_TYPE: NOUN_INDEX;
  BEGIN
    FUNC_TYPE:= XUNDEF;
    WITH OPS(.T.) DO
      IF CLASS = ROUTINE_CLASS THEN
        WITH ROUT@ DO
          IF ROUT_TYPE = PROC_TYPE THEN
            FUNCTION_ERROR(PROC_USE_ERROR)
          ELSE FUNC_TYPE:= ROUT_TYPE@.NOUN
      ELSE FUNCTION_ERROR(NAME_ERROR);
    PUT1(FUNCTION2, FUNC_TYPE)
  END;

  PROCEDURE BINARY(OP:INTEGER);
  BEGIN
    PUT0(OP);
    T:=T-1
  END;

  PROCEDURE POP2(OP:INTEGER);
  BEGIN
    PUT0(OP);
    T:=T-2
  END;

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

  PROCEDURE PUSH_OPERAND(OP_ENTRY:ENTRY_PTR; COMP:BOOLEAN);
  VAR OP:INTEGER; VARNT_PTR:VARIANT_PTR;
  BEGIN
    IF NOT COMP THEN PUSH;
    WITH OPS(.T.) , OP_ENTRY@ DO
      CASE KIND OF
        INDEX_CONST: BEGIN
          CLASS:=FCONST_CLASS;
          PUT2(INDEX2,CONST_VAL,CONST_TYPE)
        END;
        REAL_CONST: BEGIN
          CLASS:=FCONST_CLASS;
          PUT1(REAL2,REAL_DISP)
        END;
        STRING_CONST: BEGIN
          CLASS:=FCONST_CLASS;
          PUT2(STRING2,STRING_LENGTH,STRING_DISP)
        END;
        VARIABLE,FIELD,PARAMETER: BEGIN
          CLASS:=VAR_CLASS;
          CASE KIND OF
            VARIABLE:VTYPE:=VAR_TYPE;
            FIELD: VTYPE:=FIELD_TYPE;
            PARAMETER: VTYPE:=PARM_TYPE
          END;
          IF COMP THEN BEGIN
            OP:=VCOMP2;
            VARNT_PTR:=VARIANT;
            WHILE VARNT_PTR<>NIL DO
              WITH VARNT_PTR@ DO BEGIN
                PUT2(VARIANT2,LABEL_SET,TAG_NOUN);
                VARNT_PTR:=PARENT_VARIANT
              END
          END ELSE OP:=VAR2;
          PUT2(OP,NOUN,VTYPE@.NOUN)
        END;
        ROUTINE_KIND: BEGIN
          CLASS:=ROUTINE_CLASS;
          ROUT:=OP_ENTRY;
          PARM:=ROUT_PARM;
          PUT1(ROUTINE2,NOUN)
        END;
        SCALAR_KIND,POINTER_KIND,ARRAY_KIND,RECORD_KIND,SET_KIND,
        UNDEF_KIND: BEGIN
          ERROR(NAME_ERROR);
          CLASS:=UNDEF_CLASS;
          IF NOT COMP THEN PUT0(UNDEF2)
        END
      END
  END;

  PROCEDURE NAME;
  VAR SPIX:SPELLING_INDEX; COMP,ERR:BOOLEAN; NAME_ENTRY:ENTRY_PTR;
  BEGIN
    READ_IFL(SPIX); ERR:=FALSE; COMP:=FALSE;
    WITH SPELLING_TABLE(.SPIX.) DO
      IF ACCESS IN OP_ACCESS THEN BEGIN
        NAME_ENTRY:=ENTRY;
        CASE ACCESS OF
          GENERAL,UNRES_ROUTINE: ;
          QUALIFIED: BEGIN
            COMP:=TRUE; PUSH "WITH TEMP";
            WITH DISPLAY(.LEVEL.).LEVEL_ENTRY@ DO BEGIN
              PUT2(VAR2,NOUN,ZWITH);
              PUT1(ARROW2,WITH_TYPE)
            END
          END
        END
      END ELSE ERR:=TRUE;
    IF ERR THEN BEGIN
      ERROR(NAME_ERROR);
      NAME_ENTRY:=UENTRY
    END;
    PUSH_OPERAND(NAME_ENTRY,COMP)
  END;

  PROCEDURE COMP;
  CONST QUALIFIED=TRUE;
  VAR SPIX:SPELLING_INDEX; COMPONENT:ENTRY_PTR; NAME_LIST:NAME_PTR;
    ERR:BOOLEAN;
  BEGIN
    READ_IFL(SPIX); ERR:=FALSE;
    WITH OPS(.T.) DO
      IF CLASS=VAR_CLASS THEN BEGIN
        WITH VTYPE@ DO
          IF KIND=RECORD_KIND THEN NAME_LIST:=FIELD_NAME
          ELSE BEGIN ERR:=TRUE; NAME_LIST:=NIL END;
        FIND_NAME(NAME_LIST,SPIX,COMPONENT)
      END ELSE ERR:=TRUE;
    IF ERR THEN ERROR(COMP_ERROR)
    ELSE PUSH_OPERAND(COMPONENT,QUALIFIED)
  END;

  PROCEDURE SUB_ERR;
  BEGIN
    ERROR(SUB_ERROR);
    PUT2(SUB2,XUNDEF,XUNDEF)
  END;

  PROCEDURE SUB;
  BEGIN
    T:=T-1;
    WITH OPS(.T.) DO
      IF CLASS=VAR_CLASS THEN
        WITH VTYPE@ DO
          IF KIND=ARRAY_KIND THEN BEGIN
            PUT2(SUB2,INDEX_TYPE,EL_TYPE@.NOUN);
            VTYPE:=EL_TYPE
          END ELSE SUB_ERR
      ELSE SUB_ERR
  END;

  PROCEDURE ARROW_ERR;
  BEGIN
    ERROR(ARROW_ERROR);
    PUT1(ARROW2,XUNDEF)
  END;

  PROCEDURE ARROW;
  BEGIN
    FNAME "CALL PARAMETERLESS POINTER-VALUED FUNCTION, IF ANY" ;
    WITH OPS(.T.) DO
      IF CLASS=VAR_CLASS THEN
        WITH VTYPE@ DO
          IF KIND=POINTER_KIND THEN BEGIN
            VTYPE:=OBJECT_TYPE;
            PUT1(ARROW2,VTYPE@.NOUN)
          END ELSE ARROW_ERR
      ELSE ARROW_ERR
  END;

"########"
"CONSTANT"
"########"

  PROCEDURE CONSTANT;
  BEGIN
    PUSH_OLD_NAME;
    IF DEFINED THEN
      WITH OPS(.T.), DEF_ENTRY@ DO
          IF KIND IN CONST_KINDS THEN
            CASE KIND OF
              INDEX_CONST: BEGIN
                CLASS:=ICONST_CLASS;
                ICONST_TYPE:=CONST_TYPE;
                ICONST_VAL:=CONST_VAL
              END;
              REAL_CONST: BEGIN
                CLASS:=RCONST_CLASS; RCONST_DISP:=REAL_DISP
              END;
              STRING_CONST:BEGIN
                CLASS:=SCONST_CLASS;
                SCONST_LENGTH:=STRING_LENGTH;
                SCONST_DISP:=STRING_DISP
              END
            END
          ELSE BEGIN CLASS:=UNDEF_CLASS; ERROR(CONSTID_ERROR) END
  END;

  PROCEDURE REAL_;
  BEGIN
    PUSH;
    WITH OPS(.T.) DO BEGIN
      CLASS:=RCONST_CLASS; RCONST_DISP:=CONST_DISP
    END
  END;

  PROCEDURE FREAL;
  BEGIN
    PUSH; OPS(.T.).CLASS:=FCONST_CLASS;
    PUT1(REAL2,CONST_DISP)
  END;

  PROCEDURE INDEX(TYP:NOUN_INDEX);
  BEGIN
    PUSH;
    WITH OPS(.T.) DO BEGIN
      CLASS:=ICONST_CLASS;
      ICONST_TYPE:=TYP;
      READ_IFL(ICONST_VAL)
    END
  END;

  PROCEDURE FINDEX(TYP:NOUN_INDEX);
  VAR VALUE:INTEGER;
  BEGIN
    PUSH; OPS(.T.).CLASS:=FCONST_CLASS;
    READ_IFL(VALUE);
    PUT2(INDEX2,VALUE,TYP)
  END;

  PROCEDURE STRING;
  BEGIN
    PUSH;
    WITH OPS(.T.) DO BEGIN
      CLASS:=SCONST_CLASS;
      READ_IFL(SCONST_LENGTH);
      SCONST_DISP:=CONST_DISP
    END
  END;

  PROCEDURE FSTRING;
  VAR LENGTH:INTEGER;
  BEGIN
    PUSH; OPS(.T.).CLASS:=FCONST_CLASS;
    READ_IFL(LENGTH); PUT2(STRING2,LENGTH,CONST_DISP)
  END;

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

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

 ADDRESS1: PUT0(ADDRESS2);
 ANAME1: ANAME;
 AND1: BINARY(AND2);
 ARG_LIST1: ARG_LIST;
 ARG1: ARG;
 ARRAY_DEF1: ARRAY_DEF;
 ARROW1: ARROW;
 BODY_END1: BODY_END;
 BODY1: BODY;
 CALL_FUNC1: CALL(CALL_FUNC2);
 CALL_NAME1: CALL_NAME;
 CALL1: CALL(CALL_PROC2);
 CASE1: CASE_;
 CASE_JUMP1: IGNORE1(CASE_JUMP2);
 CHAR1: INDEX(XCHAR);
 COMP1: COMP;
 CONST_DEF1: CONST_DEF;
 CONST_ID1: CONST_ID;
 CONSTANT1: CONSTANT;
 CPARMLIST1: PARMLIST(CPARMLIST2);
 DEF_CASE1: DEF_CASE;
 DEF_LABEL1: IGNORE1(DEF_LABEL2);
 DIV1: BINARY(DIV2);
 EMPTY_SET1: BEGIN PUSH; PUT0(EMPTY_SET2) END;
 END_CASE1: END_CASE;
 ENUM_DEF1: PUT2(ENUM_DEF2,ENUM_TYPE,ENUM_VAL);
 ENUM_ID1: ENUM_ID;
 ENUM1: ENUM;
 EOM1: HALT:=TRUE;
 EQ1: BINARY(EQ2);
 FALSEJUMP1: BEGIN IGNORE1(FALSEJUMP2); T:=T-1 END;
 FCHAR1: FINDEX(XCHAR);
 FIELD_ID1,PARM_ID1, VAR_ID1: PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,
    OUTPUT,INCOMPLETE);
 FIELDLIST1: FIELD_LIST;
 FINTEGER1: FINDEX(XINTEGER);
 FNAME1: FNAME;
 FOR_DOWN1: IGNORE2(FOR_DOWN2);
 FOR_LIM1: BEGIN IGNORE3(FOR_LIM2); T:=T-1 END;
 FOR_STORE1: POP2(FOR_STORE2);
 FOR_UP1: IGNORE2(FOR_UP2);
 FORWARD1: FORWARD_;
 FREAL1: FREAL;
 FSTRING1: FSTRING;
 FUNC_DEF1: FUNC_DEF;
 FUNC_ID1: ROUTINE_ID(GENERAL,FUNC_MODE);
 FUNC_TYPE1: FUNC_TYPE;
 FUNCTION1: FUNCTION_;
 GE1: BINARY(GE2);
 GT1: BINARY(GT2);
 INCLUDE1: BINARY(INCLUDE2);
 INTEGER1: INDEX(XINTEGER);
 IN1: BINARY(IN2);
 JUMP_DEF1: IGNORE2(JUMP_DEF2);
 JUMP1: IGNORE1(JUMP2);
 LABEL1: LABEL;
 LBL_END1: LBL_END;
 LCONST1: LCONST;
 LE1: BINARY(LE2);
 LT1: BINARY(LT2);
 MESSAGE1: IGNORE2(MESSAGE2);
 MINUS1: BINARY(MINUS2);
 MOD1: BINARY(MOD2);
 NAME1: NAME;
 NEW_LINE1: IGNORE1(NEW_LINE2);
 NE1: BINARY(NE2);
 NOT1: PUT0(NOT2);
 OR1: BINARY(OR2);
 PARM_TYPE1: TYPE_(OUTPUT,PARM_TYPE2);
 PART_END1: PART_END;
 PLUS1: BINARY(PLUS2);
 POINTER1: POINTER;
 PROC_DEF1: PROC_DEF(PROC_DEF2);
 PROC_ID1: ROUTINE_ID(GENERAL,PROC_MODE);
 PROG_DEF1: PROC_DEF(PROG_DEF2);
 PROG_ID1: BEGIN PREFIX_SW:= FALSE; ROUTINE_ID(INCOMPLETE, PROGRAM_MODE) END;
 REAL1: REAL_;
 REC_DEF1: REC_DEF;
 REC1: REC;
 SET_DEF1: SET_DEF;
 SLASH1: BINARY(SLASH2);
 STAR1: BINARY(STAR2);
 STORE1: POP2(STORE2);
 STRING1: STRING;
 SUBR_DEF1: SUBR_DEF;
 SUB1: SUB;
 TAG_DEF1: TAG_DEF;
 TAG_ID1: TAG_ID;
 TAG_TYPE1: TYPE_(OUTPUT,TAG_DEF2);
 TYPE_DEF1: TYPE_DEF;
 TYPE_ID1: TYPE_ID;
 TYPE1: TYPE_(OUTPUT,TYPE2);
 UMINUS1: PUT0(UMINUS2);
 UNIV_TYPE1: TYPE_(OUTPUT,UNIV_TYPE2);
 UPLUS1: PUT0(UPLUS2);
 VALUE1: PUT0(VALUE2);
 VAR_LIST1: VAR_LIST;
 VARNT_END1: VARNT_END;
 VARNT1: VARNT;
 VPARMLIST1: PARMLIST(VPARMLIST2);
 WITH_TEMP1: WITH_TEMP;
 WITH_VAR1: PUT0(WITH_VAR2);
 WITH1: BEGIN POP_LEVEL; PUT0(WITH2) END
 END

  UNTIL HALT;
  IF UNRESOLVED > 0 THEN ERROR(UNRES_ERROR);
  PUT0(EOM2);
  WITH INTER_PASS_PTR@ DO BEGIN
    RELEASE(RESETPOINT);  CONSTANTS:=CONST_DISP
  END;
  NEXT_PASS(INTER_PASS_PTR)
END.