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

 PDP 11/45 SEQUENTIAL PASCAL
 COMPILER PASS 2: SYNTAX ANALYSIS

 OCTOBER 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=0;            BEGIN1=1;           IF1=2;              CASE1=3;
WHILE1=4;          REPEAT1=5;          FOR1=6;             WITH1=7;
ID1=8;             REAL1=9;            STRING1=10;         INTEGER1=11;
CHAR1=12;          OPEN1=13;           NOT1=14;            SUB1=15;
SET1=16;           ARRAY1=17;          RECORD1=18;         ARROW1=19;
PERIOD1=20;        STAR1=21;           SLASH1=22;          DIV1=23;
MOD1=24;           AND1=25;            PLUS1=26;           MINUS1=27;
OR1=28;            EQ1=29;             NE1=30;             LE1=31;
GE1=32;            LT1=33;             GT1=34;             IN1=35;
CONST1=36;         TYPE1=37;           VAR1=38;            PROCEDURE1=39;
FUNCTION1=40;      PROGRAM1=41;        SEMICOLON1=42;      CLOSE1=43;
UP_TO1=44;         OF1=45;             COMMA1=46;          BUS1=47;
COLON1=48;         END1=49;            FORWARD1=50;        UNIV1=51;
BECOMES1=52;       THEN1=53;           ELSE1=54;           DO1=55;
UNTIL1=56;         TO1=57;             DOWNTO1=58;         LCONST1=59;
MESSAGE1=60;       NEW_LINE1=61;

"OUTPUT OPERATORS"

EOM2=1;            CONST_ID2=2;        CONST_DEF2=3;       TYPE_ID2=4;
TYPE_DEF2=5;       VAR_ID2=6;          VAR_LIST2=7;        PROC_ID2=8;
PROC_DEF2=9;       LBL_END2=10;        FORWARD2=11;        FUNC_ID2=12;
FUNC_DEF2=13;      POINTER2=14;        FUNC_TYPE2=15;      PROG_ID2=16;
PROG_DEF2=17;      VARNT_END2=18;      TYPE2=19;           ENUM2=20;
ENUM_ID2=21;       ENUM_DEF2=22;       SUBR_DEF2=23;       SET_DEF2=24;
ARRAY_DEF2=25;     REC2=26;            FIELD_ID2=27;       FIELDLIST2=28;
REC_DEF2=29;       VARNT2=30;          PARM_ID2=31;        PARM_TYPE2=32;
UNIV_TYPE2=33;     CPARMLIST2=34;      VPARMLIST2=35;      BODY2=36;
BODY_END2=37;      ANAME2=38;          STORE2=39;          CALL_NAME2=40;
CALL2=41;          ARG_LIST2=42;       ARG2=43;            FALSEJUMP2=44;
DEF_LABEL2=45;     JUMP_DEF2=46;       DEF_CASE2=47;       CASE2=48;
JUMP2=49;          END_CASE2=50;       ADDRESS2=51;        FOR_STORE2=52;
FOR_LIM2=53;       FOR_UP2=54;         FOR_DOWN2=55;       WITH_VAR2=56;
WITH_TEMP2=57;     WITH2=58;           VALUE2=59;          LT2=60;
EQ2=61;            GT2=62;             LE2=63;             NE2=64;
GE2=65;            IN2=66;             UPLUS2=67;          UMINUS2=68;
PLUS2=69;          MINUS2=70;          OR2=71;             STAR2=72;
SLASH2=73;         DIV2=74;            MOD2=75;            AND2=76;
FNAME2=77;         NOT2=78;            EMPTY_SET2=79;      INCLUDE2=80;
FUNCTION2=81;      CALL_FUNC2=82;      NAME2=83;           COMP2=84;
SUB2=85;           ARROW2=86;          CONSTANT2=87;       REAL2=88;
FREAL2=89;         INTEGER2=90;        FINTEGER2=91;       CHAR2=92;
FCHAR2=93;         STRING2=94;         FSTRING2=95;        NEW_LINE2=96;
LCONST2=97;        MESSAGE2=98;        TAG_ID2=99;         TAG_TYPE2=100;
PART_END2=101;     TAG_DEF2=102;       LABEL2=103;         CASE_JUMP2=104;

"OTHER CONSTANTS"

TEXT_LENGTH = 18;
INFILE = 2;        OUTFILE = 1;
THIS_PASS=2;       SPELLING_MAX=700;
COMP_BLOCK=TRUE;   ROUTINE_BLOCK=FALSE;

"MODES"

CLASS_MODE=1;      MONITOR_MODE=2;     PROCESS_MODE=3;     PROC_MODE=4;
PROCE_MODE=5;      FUNC_MODE=6;        FUNCE_MODE=7;       PROGRAM_MODE=8;

"ERRORS"

PROG_ERROR=1;      DEC_ERROR=2;        CONSTDEF_ERROR=3;   TYPEDEF_ERROR=4;
TYPE_ERROR=5;      ENUM_ERROR=6;       SUBR_ERROR=7;       SET_ERROR=8;
ARRAY_ERROR=9;     RECORD_ERROR=10;    STACK_ERROR=11;     VAR_ERROR=12;
ROUTINE_ERROR=13;  PROC_ERROR=14;      FUNC_ERROR=15;      WITH_ERROR=16;
PARM_ERROR=17;     BODY_ERROR=18;      STATS_ERROR=19;     STAT_ERROR=20;
IDSTAT_ERROR=21;   ARG_ERROR=22;       COMP_ERROR=23;      IF_ERROR=24;
CASE_ERROR=25;     POINTER_ERROR=36;   WHILE_ERROR=27;     REPEAT_ERROR=28;
FOR_ERROR=29;      PREFIX_ERROR=37;    EXPR_ERROR=31;      VARIABLE_ERROR=32;
CONSTANT_ERROR=33; INTERFACE_ERROR=38;

"STANDARD SPELLING/NOUN INDICES"

XUNDEF=0;          XFALSE=1;           XTRUE=2;            XINTEGER=3;
XBOOLEAN=4;        XCHAR=5;            XQUEUE=6;           XABS=7;
XATTRIBUTE=8;      XCHR=9;             XCONTINUE=10;       XCONV=11;
XDELAY=12;         XEMPTY=13;          XIO=14;             XORD=15;
XPRED=16;          XSTOP=17;           XREALTIME=18;       XSETHEAP=19;
XSUCC=20;          XTRUNC=21;          XSTART=22;          XWAIT=23;
XREAL=24;

TYPE

  SPELLING_INDEX=0..SPELLING_MAX;

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

  LABEL=INTEGER;

  SYMBOL=EOM1..NEW_LINE1;

  SETS=SET OF SYMBOL;

VAR

  INTER_PASS_PTR:PASSPTR;

  SY:SYMBOL;

  ARG:INTEGER;

  CURRENT_LABEL:LABEL;

  TEST:BOOLEAN;

"KEY SETS"

QIGNORE,           QOPEN,              QCLOSE,             QEOM,
QEND,              QSEMICOLON,         QBODY,              QID,
QDEFINITIONS,      QROUTINES,          QDECLARATIONS,      QDEF,
QDEC,              QCONSTANT,          QCONST_DEF,         QTYPE,
QTYPE_DEF,         QSUBR_LIMIT,        QDIMENSION,         QOF_TYPE,
QVAR_DEF,          QBLOCK,             QPARM_END,          QID_LIST,
QPROC_END,         QPROC_PARMS,        QFUNC_END,          QFUNC_TYPE,
QPROG_END,         QFBLOCK,            QPARM_LIST,         QSTAT,
QBODY_END,         QENTRY,             QSTAT_LIST,         QID_END,
QARGUMENT,         QARG_END,           QIF_END,            QTHEN_END,
QCASES,            QCASE_END,          QLABEL_LIST,        QDO_TAIL,
QUNARY,            QFACTOR,            QEXPR,              QUNTIL_TAIL,
QFOR_END,          QFORB_END,          QEXPR_OP,           QSEXPR_OP,
QTERM_OP,          QTERM_LIST,         QFACTOR_LIST,       QSET_EXPR,
QSELECT,           QSUB_END,           QARG,               QCOMMA,
QVARIANT_PART,     QTYPE_LIST,         QWITH_LIST,         QFIELD_LIST,
QTO_TAIL,          QFIELD_PACK,        QID_SEMI,           QVARIANT,
                   QPROGRAM,           QID_OPEN,           QID_CASE,
QSEMI_CASE,        QLABEL_TAIL:        SETS;

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

  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;

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

  "PARSING ROUTINES"

  PROCEDURE  PROGRAM_ ;    FORWARD;
  PROCEDURE  PREFIX(KEYS: SETS); FORWARD;
  PROCEDURE  INTERFACE (KEYS: SETS); FORWARD;
  PROCEDURE  PROG_HEADING (KEYS: SETS); FORWARD;
  PROCEDURE  BLOCK (KEYS: SETS); FORWARD;
  PROCEDURE  DECLARATIONS (KEYS: SETS); FORWARD;
  PROCEDURE  CONST_DEC (KEYS: SETS); FORWARD;
  PROCEDURE  TYPE_DEC (KEYS: SETS); FORWARD;
  PROCEDURE  TYPE_ (KEYS: SETS); FORWARD;
  PROCEDURE  ENUM_TYPE (KEYS: SETS);  FORWARD;
  PROCEDURE  SUBR_TYPE (KEYS: SETS); FORWARD;
  PROCEDURE  SET_TYPE  (KEYS: SETS); FORWARD;
  PROCEDURE  ARRAY_TYPE (KEYS: SETS); FORWARD;
  PROCEDURE  RECORD_TYPE (KEYS: SETS); FORWARD;
  PROCEDURE  FIELD_LIST (KEYS: SETS); FORWARD;
  PROCEDURE  VARIANT_PART (KEYS: SETS); FORWARD;
  PROCEDURE  VARIANT (KEYS: SETS); FORWARD;
  PROCEDURE  LABEL_LIST (KEYS: SETS; OP, ERROR_NUM: INTEGER); FORWARD;
  PROCEDURE  POINTER_TYPE (KEYS: SETS); FORWARD;
  PROCEDURE  VAR_DEC (KEYS: SETS); FORWARD;
  PROCEDURE  ID_LIST (KEYS: SETS; OP,ERROR_NUM: INTEGER; VAR ID_COUNT: INTEGER);
  FORWARD;
  PROCEDURE  IDENTIFIER (KEYS: SETS; OP, ERROR_NUM: INTEGER); FORWARD;
  PROCEDURE  ROUTINE_DEC (KEYS: SETS); FORWARD;
  PROCEDURE  PROC_DEC (KEYS: SETS); FORWARD;
  PROCEDURE  PROC_HEADING  (KEYS: SETS); FORWARD;
  PROCEDURE  FUNC_DEC  (KEYS: SETS); FORWARD;
  PROCEDURE  FUNC_HEADING  (KEYS: SETS); FORWARD;
  PROCEDURE  PARM_LIST (KEYS: SETS); FORWARD;
  PROCEDURE  BODY  (KEYS: SETS); FORWARD;
  PROCEDURE  STAT_LIST (KEYS: SETS); FORWARD;
  PROCEDURE  STAT  (KEYS: SETS); FORWARD;
  PROCEDURE  ID_STAT  (KEYS: SETS); FORWARD;
  PROCEDURE  ARG_LIST  (KEYS: SETS); FORWARD;
  PROCEDURE  COMPOUND_STAT (KEYS: SETS); FORWARD;
  PROCEDURE  IF_STAT  (KEYS: SETS); FORWARD;
  PROCEDURE  CASE_STAT (KEYS: SETS); FORWARD;
  PROCEDURE  WHILE_STAT (KEYS: SETS); FORWARD;
  PROCEDURE  REPEAT_STAT (KEYS: SETS); FORWARD;
  PROCEDURE  FOR_STAT  (KEYS: SETS); FORWARD;
  PROCEDURE  WITH_STAT (KEYS: SETS); FORWARD;
  PROCEDURE  EXPR  (KEYS: SETS); FORWARD;
  PROCEDURE  SEXPR  (KEYS: SETS); FORWARD;
  PROCEDURE  TERM  (KEYS: SETS); FORWARD;
  PROCEDURE  FACTOR  (KEYS: SETS); FORWARD;
  PROCEDURE  FACTOR_ID  (KEYS: SETS); FORWARD;
  PROCEDURE  VARIABLE  (KEYS: SETS); FORWARD;
  PROCEDURE  CONSTANT  (KEYS: SETS); FORWARD;

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

  PROCEDURE GET;
  VAR LENGTH,I,VAL,PASS_NO,MESSAGE_NO,LINE_NO:INTEGER;
    DONE:BOOLEAN;
  BEGIN
    DONE:=FALSE;
    REPEAT
      READ_IFL(SY);
      IF SY IN QIGNORE THEN
        CASE SY OF
          LCONST1: BEGIN
            READ_IFL(LENGTH); PUT1(LCONST2,LENGTH);
            FOR I:=1 TO LENGTH DIV 2 DO BEGIN
              READ_IFL(VAL); PUT_ARG(VAL)
            END
          END;
          MESSAGE1: BEGIN
            READ_IFL(PASS_NO); READ_IFL(MESSAGE_NO);
            PUT2(MESSAGE2,PASS_NO,MESSAGE_NO)
          END;
          NEW_LINE1: BEGIN
          READ_IFL(LINE_NO); PUT1(NEW_LINE2,LINE_NO)
          END
        END
      ELSE DONE:=TRUE
    UNTIL DONE;
    IF SY IN QARG THEN READ_IFL(ARG)
  END;

  PROCEDURE INITIALIZE;
  BEGIN
    CURRENT_LABEL:=1 "THE MAIN PROGRAM";
    INIT_PASS(INTER_PASS_PTR);
    WITH INTER_PASS_PTR@ DO BEGIN
      TEST:=TESTOPTION IN OPTIONS
    END;
    IF TEST THEN PRINTFF;
    QIGNORE:=(.LCONST1,MESSAGE1,NEW_LINE1.);
    QCOMMA:=(.COMMA1.);
    QOPEN:=(.OPEN1.); QCLOSE:=(.CLOSE1.);
    QEOM:=(.EOM1.); QEND:=(.END1.);
    QSEMICOLON:=(.SEMICOLON1.);
    QBODY:=(.BEGIN1.); QID:=(.ID1.);
    QDEFINITIONS:=(.CONST1,TYPE1.);
    QROUTINES:=(.PROCEDURE1,FUNCTION1.);
    QDECLARATIONS:=QDEFINITIONS OR (.VAR1.) OR QROUTINES;
    QDEF:=(.ID1,SEMICOLON1,EQ1.);
    QDEC:=(.ID1,SEMICOLON1,COLON1.);
    QCONSTANT:=(.ID1,INTEGER1,REAL1,CHAR1,STRING1.);
    QCONST_DEF:=QDEF OR QCONSTANT;
    QTYPE:=(.OPEN1,SET1,ARRAY1,RECORD1,ARROW1.) OR QCONSTANT;
    QTYPE_DEF:=QDEF OR QTYPE;
    QTYPE_LIST:=QTYPE OR QCOMMA;
    QSUBR_LIMIT:=(.UP_TO1.) OR QCONSTANT;
    QDIMENSION:=QTYPE OR (.COMMA1,BUS1,OF1.);
    QOF_TYPE:=QTYPE OR (.OF1.);
    QVAR_DEF:=QDEC OR QTYPE;
    QBLOCK:=QDECLARATIONS OR QBODY;
    QPARM_END:=QSEMICOLON OR QBLOCK;
    QID_LIST:=(.ID1,COMMA1.);
    QPROC_END := (.ID1, OPEN1.) OR QPARM_END;
    QARG:=(.ID1,INTEGER1,CHAR1,STRING1.);
    QPROC_PARMS:=QPROC_END-QID;
    QFUNC_END:=QPROC_END OR (.COLON1.);
    QFUNC_TYPE:=QPARM_END OR QID;
    QPROG_END:=QPROC_END-QBLOCK;
    QPARM_LIST:=QDEC OR (.UNIV1,VAR1.);
    QSTAT:=(.ID1,BEGIN1,IF1,CASE1,WHILE1,REPEAT1,FOR1,WITH1.);
    QBODY_END:=QSTAT OR QEND;
    QSTAT_LIST :=QSTAT OR QSEMICOLON;
    QID_END:=(.BECOMES1,OPEN1.);
    QIF_END:=(.THEN1,ELSE1.) OR QSTAT;
    QTHEN_END:=QIF_END-(.THEN1.);
    QCASES:=QCONSTANT OR QSTAT OR (.COLON1,COMMA1,SEMICOLON1.);
    QCASE_END:=QCASES OR (.OF1,END1.);
    QLABEL_LIST:=QCONSTANT OR QCOMMA;
    QLABEL_TAIL:=QLABEL_LIST OR (.COLON1.);
    QDO_TAIL:=QSTAT OR (.DO1.);
    QUNARY:=(.PLUS1,MINUS1.);
    QFACTOR:=QCONSTANT OR (.OPEN1,NOT1,SUB1.);
    QEXPR:=QUNARY OR QFACTOR;
    QARGUMENT:=QEXPR OR QCOMMA;
    QARG_END:=QARGUMENT OR QCLOSE;
    QUNTIL_TAIL:=QEXPR OR (.UNTIL1.);
    QFOR_END:=QEXPR OR QSTAT OR (.BECOMES1,TO1,DOWNTO1,DO1.);
    QFORB_END:=QFOR_END-(.BECOMES1.);
    QEXPR_OP:=(.EQ1,NE1,LE1,GE1,LT1,GT1,IN1.);
    QSEXPR_OP:=(.PLUS1,MINUS1,OR1.);
    QTERM_OP:=(.STAR1,SLASH1,DIV1,MOD1,AND1.);
    QTERM_LIST:=QFACTOR OR QSEXPR_OP;
    QFACTOR_LIST:=QFACTOR OR QTERM_OP;
    QSET_EXPR:=QARGUMENT OR (.BUS1.);
    QSELECT:=(.PERIOD1,SUB1,ARROW1.);
    QSUB_END:=QARGUMENT OR (.BUS1.);
    QWITH_LIST:=QDO_TAIL OR QCOMMA;
    QTO_TAIL:=QDO_TAIL OR QEXPR;
    QPROGRAM := (.PROGRAM1.);
    QID_SEMI := (.ID1, SEMICOLON1.);
    QID_OPEN := (.ID1, OPEN1.);
    QID_CASE := (.ID1, CASE1.);
    QSEMI_CASE := (.SEMICOLON1, CASE1.);
    QFIELD_LIST := QVAR_DEF OR QID_CASE;
    QVARIANT_PART := QCONSTANT OR (.COLON1, OF1, SEMICOLON1.);
    QVARIANT := QCONSTANT OR QSEMICOLON;
    QFIELD_PACK := QID_CASE OR (.OPEN1, CLOSE1.);
    QFBLOCK := QBLOCK OR (.FORWARD1.);
    GET
  END;

  PROCEDURE ERROR(NUMBER:INTEGER; KEYS:SETS);
  BEGIN
    PUT2(MESSAGE2,THIS_PASS,NUMBER);
    WHILE NOT (SY IN KEYS) DO GET
  END;

  PROCEDURE CHECK(NUMBER:INTEGER; KEYS:SETS);
  BEGIN
    IF NOT (SY IN KEYS) THEN ERROR(NUMBER,KEYS)
  END;

  PROCEDURE NEW_LABEL(VAR L:LABEL);
  BEGIN
    CURRENT_LABEL:=CURRENT_LABEL+1;
    L:=CURRENT_LABEL
  END;

"#######"
"PROGRAM"
"#######"

  PROCEDURE PROGRAM_;
  BEGIN
    PREFIX(QBLOCK OR QEOM);
    BLOCK(QEOM);
    IF SY=PERIOD1 THEN GET ELSE ERROR(PROG_ERROR,QEOM);
    IF SY<>EOM1 THEN ERROR(PROG_ERROR,QEOM);
    PUT0(EOM2)
  END;

  PROCEDURE PREFIX;
  VAR LKEYS1: SETS;
  BEGIN
    LKEYS1:=KEYS OR QDEFINITIONS OR QROUTINES OR QPROGRAM;
    CHECK(PREFIX_ERROR, LKEYS1);
    WHILE SY IN QDEFINITIONS DO BEGIN
      IF SY=CONST1 THEN CONST_DEC(LKEYS1) ELSE TYPE_DEC(LKEYS1);
      CHECK(PREFIX_ERROR, LKEYS1)
    END;
    INTERFACE(KEYS OR QPROGRAM);
    PROG_HEADING(KEYS)
  END;

  PROCEDURE INTERFACE;
  VAR LKEYS1: SETS;
  BEGIN
    LKEYS1:=KEYS OR QROUTINES;
    CHECK(INTERFACE_ERROR, LKEYS1);
    WHILE SY IN QROUTINES DO BEGIN
      IF SY=PROCEDURE1 THEN PROC_HEADING(LKEYS1) ELSE FUNC_HEADING (LKEYS1);
        CHECK(INTERFACE_ERROR, LKEYS1)
    END
  END;

  PROCEDURE PROG_HEADING;
  BEGIN
    IF SY=PROGRAM1 THEN GET
                   ELSE ERROR(PROG_ERROR, KEYS OR QID_OPEN OR QSEMICOLON);
    IDENTIFIER(KEYS OR QOPEN OR QSEMICOLON, PROG_ID2, PROG_ERROR);
    PARM_LIST(KEYS OR QSEMICOLON);
    PUT0(PROG_DEF2);
    IF SY=SEMICOLON1 THEN GET ELSE ERROR(PROG_ERROR, KEYS);
  END;

"#####"
"BLOCK"
"#####"

  PROCEDURE BLOCK;
  BEGIN
    DECLARATIONS(KEYS OR QBODY);
    BODY(KEYS)
  END;

"############"
"DECLARATIONS"
"############"

  PROCEDURE DECLARATIONS;
  VAR LKEYS1,LKEYS2:SETS;
  BEGIN
    LKEYS1:=KEYS OR QDECLARATIONS;
    LKEYS2:=KEYS OR QROUTINES;
    CHECK(DEC_ERROR,LKEYS1);
    WHILE SY IN QDEFINITIONS DO BEGIN
      IF SY=CONST1 THEN CONST_DEC(LKEYS1) ELSE TYPE_DEC(LKEYS1);
      CHECK(DEC_ERROR,LKEYS1)
    END;
    IF SY=VAR1 THEN VAR_DEC(LKEYS2);
    CHECK(DEC_ERROR,LKEYS2);
    IF SY IN QROUTINES THEN ROUTINE_DEC(KEYS)
  END;

  PROCEDURE CONST_DEC;
  VAR LKEYS1,LKEYS2:SETS;
  BEGIN
    LKEYS1:=KEYS OR QCONST_DEF;
    LKEYS2:=KEYS-QCONST_DEF;
    GET;
    REPEAT
      IDENTIFIER(LKEYS1,CONST_ID2,CONSTDEF_ERROR);
      IF SY=EQ1 THEN GET ELSE ERROR(CONSTDEF_ERROR,LKEYS1);
      CONSTANT(LKEYS1);
      PUT0(CONST_DEF2);
      IF SY=SEMICOLON1 THEN GET ELSE ERROR(CONSTDEF_ERROR,LKEYS1);
      CHECK(CONSTDEF_ERROR,LKEYS1)
    UNTIL SY IN LKEYS2
  END;

  PROCEDURE TYPE_DEC;
  VAR LKEYS1,LKEYS2:SETS;
  BEGIN
    LKEYS1:=KEYS OR QTYPE_DEF;
    LKEYS2:=KEYS-QTYPE_DEF;
    GET;
    REPEAT
      IDENTIFIER(LKEYS1,TYPE_ID2,TYPEDEF_ERROR);
      IF SY=EQ1 THEN GET ELSE ERROR(TYPEDEF_ERROR,LKEYS1);
      TYPE_(LKEYS1);
      PUT0(TYPE_DEF2);
      IF SY=SEMICOLON1 THEN GET ELSE ERROR(TYPEDEF_ERROR,LKEYS1);
      CHECK(TYPEDEF_ERROR,LKEYS1)
    UNTIL SY IN LKEYS2
  END;

"####"
"TYPE"
"####"

  PROCEDURE TYPE_;
  BEGIN
    CHECK(TYPE_ERROR,KEYS OR QTYPE);
    IF SY IN QTYPE THEN
      CASE SY OF
        OPEN1: ENUM_TYPE(KEYS);
        ID1,INTEGER1,REAL1,CHAR1,STRING1: SUBR_TYPE(KEYS);
        SET1: SET_TYPE(KEYS);
        ARRAY1: ARRAY_TYPE(KEYS);
        RECORD1: RECORD_TYPE(KEYS);
        ARROW1:  POINTER_TYPE(KEYS)
      END
    ELSE BEGIN
      ERROR(TYPE_ERROR,KEYS);
      PUT1(TYPE2,XUNDEF)
    END
  END;

  PROCEDURE ENUM_TYPE;
  VAR NUMBER:INTEGER;
  BEGIN
    PUT0(ENUM2); GET;
    ID_LIST(KEYS OR QCLOSE,ENUM_ID2,ENUM_ERROR,NUMBER);
    IF SY=CLOSE1 THEN GET ELSE ERROR(ENUM_ERROR,KEYS);
    PUT0(ENUM_DEF2)
  END;

  PROCEDURE SUBR_TYPE;
  VAR SPIX:SPELLING_INDEX;
  BEGIN
    IF SY=ID1 THEN BEGIN
      SPIX:=ARG; GET;
      CHECK(SUBR_ERROR,KEYS OR QSUBR_LIMIT);
      IF SY=UP_TO1 THEN BEGIN
        PUT1(CONSTANT2,SPIX);
        GET;
        CONSTANT(KEYS);
        PUT0(SUBR_DEF2)
      END ELSE PUT1(TYPE2,SPIX)
    END ELSE BEGIN
      CONSTANT(KEYS OR QSUBR_LIMIT);
      IF SY=UP_TO1 THEN GET ELSE ERROR(SUBR_ERROR,KEYS OR QCONSTANT);
      CONSTANT(KEYS);
      PUT0(SUBR_DEF2)
    END
  END;

  PROCEDURE SET_TYPE;
  BEGIN
    GET;
    IF SY=OF1 THEN GET ELSE ERROR(SET_ERROR,KEYS OR QTYPE);
    TYPE_(KEYS);
    PUT0(SET_DEF2)
  END;

  PROCEDURE ARRAY_TYPE;
  VAR LKEYS1:SETS; I,DIMENSIONS:INTEGER; DONE:BOOLEAN;
  BEGIN
    LKEYS1:=KEYS OR QDIMENSION;
    GET;
    IF SY=SUB1 THEN GET ELSE ERROR(ARRAY_ERROR,LKEYS1);
    DIMENSIONS:=0; DONE:=FALSE;
    REPEAT
      "INDEX"TYPE_(LKEYS1); DIMENSIONS:=DIMENSIONS+1;
      CHECK(ARRAY_ERROR,LKEYS1);
      IF SY IN QTYPE_LIST THEN
        IF SY=COMMA1 THEN GET ELSE ERROR(ARRAY_ERROR,LKEYS1)
      ELSE DONE:=TRUE
    UNTIL DONE;
    IF SY=BUS1 THEN GET ELSE ERROR(ARRAY_ERROR,KEYS OR QOF_TYPE);
    IF SY=OF1 THEN GET ELSE ERROR(ARRAY_ERROR,KEYS OR QTYPE);
    "ELEMENT"TYPE_(KEYS);
    FOR I:=1 TO DIMENSIONS DO PUT0(ARRAY_DEF2)
  END;

  PROCEDURE RECORD_TYPE;
  BEGIN
    PUT0(REC2); GET;
    FIELD_LIST(KEYS OR QEND);
    PUT0(REC_DEF2);
    IF SY=END1 THEN GET ELSE ERROR(RECORD_ERROR,KEYS);
  END;

  PROCEDURE FIELD_LIST;
  VAR LKEYS1: SETS; NUMBER: INTEGER; DONE: BOOLEAN;
  BEGIN
    LKEYS1 := KEYS OR QFIELD_LIST;
    DONE := FALSE;
    REPEAT
      CHECK(RECORD_ERROR, LKEYS1);
      IF SY<>CASE1 THEN BEGIN
        ID_LIST(LKEYS1, FIELD_ID2, RECORD_ERROR, NUMBER);
        IF SY=COLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1);
        TYPE_(LKEYS1);
        PUT1(FIELDLIST2, NUMBER);
        CHECK(RECORD_ERROR, LKEYS1);
        IF SY IN QFIELD_LIST THEN
          IF SY=SEMICOLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1)
        ELSE DONE := TRUE
      END ELSE DONE := TRUE
    UNTIL DONE;
    IF SY=CASE1 THEN VARIANT_PART(KEYS);
  END;

  PROCEDURE VARIANT_PART;
  VAR LKEYS1, LKEYS2: SETS; DONE: BOOLEAN;
  BEGIN
    LKEYS1 := KEYS OR QVARIANT_PART; LKEYS2 := KEYS OR QVARIANT;
    GET;
    IDENTIFIER(LKEYS1, TAG_ID2, RECORD_ERROR);
    IF SY=COLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1);
    IDENTIFIER(LKEYS1, TAG_TYPE2, RECORD_ERROR); PUT0(TAG_DEF2);
    IF SY=OF1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS2);
    DONE := FALSE;
    REPEAT
      VARIANT(LKEYS2);
      CHECK(RECORD_ERROR, LKEYS2);
      IF SY IN QVARIANT THEN
        IF SY=SEMICOLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS2)
      ELSE DONE := TRUE
    UNTIL DONE;
    PUT0(PART_END2)
  END;

  PROCEDURE VARIANT;
  BEGIN
    PUT0(VARNT2);
    LABEL_LIST(KEYS OR QFIELD_PACK, LABEL2, RECORD_ERROR);
    IF SY=OPEN1 THEN GET ELSE ERROR(RECORD_ERROR, KEYS OR QID_CASE OR QCLOSE);
    FIELD_LIST(KEYS OR QCLOSE);
    PUT0(VARNT_END2);
    IF SY=CLOSE1 THEN GET ELSE ERROR(RECORD_ERROR, KEYS);
  END;

  PROCEDURE LABEL_LIST;
  VAR LKEYS1: SETS; DONE: BOOLEAN;
  BEGIN
    LKEYS1 := KEYS OR QLABEL_TAIL; DONE := FALSE;
    REPEAT
      CONSTANT(LKEYS1);
      PUT0(OP);
      CHECK(ERROR_NUM, LKEYS1);
      IF SY IN QLABEL_LIST THEN
        IF SY=COMMA1 THEN GET ELSE ERROR(ERROR_NUM, LKEYS1)
      ELSE DONE := TRUE
    UNTIL DONE;
    IF OP=LABEL2 THEN PUT0(LBL_END2);
    IF SY=COLON1 THEN GET ELSE ERROR(ERROR_NUM, KEYS)
  END;

  PROCEDURE POINTER_TYPE;
  BEGIN
    GET;
    IDENTIFIER(KEYS, POINTER2, POINTER_ERROR)
  END;

"#########"
"VARIABLES"
"#########"

  PROCEDURE VAR_DEC;
  VAR    NUMBER:INTEGER; LKEYS1:SETS;
  BEGIN
    LKEYS1:=KEYS OR QVAR_DEF;
    GET;
    REPEAT
      ID_LIST(LKEYS1,VAR_ID2,VAR_ERROR,NUMBER);
      IF SY=COLON1 THEN GET ELSE ERROR(VAR_ERROR,LKEYS1);
      "VAR"TYPE_(LKEYS1);
      PUT1(VAR_LIST2, NUMBER);
      IF SY=SEMICOLON1 THEN GET ELSE ERROR(VAR_ERROR,LKEYS1);
      CHECK(VAR_ERROR,LKEYS1)
    UNTIL NOT(SY IN QVAR_DEF);
  END;

  PROCEDURE ID_LIST;
  VAR LKEYS1:SETS; DONE:BOOLEAN;
  BEGIN
    LKEYS1:=KEYS OR QID_LIST;
    ID_COUNT:=0; DONE:=FALSE;
    REPEAT
      IDENTIFIER(LKEYS1,OP,ERROR_NUM);
      ID_COUNT:=ID_COUNT+1;
      CHECK(ERROR_NUM,LKEYS1);
      IF SY IN QID_LIST THEN
        IF SY=COMMA1 THEN GET ELSE ERROR(ERROR_NUM,LKEYS1)
      ELSE DONE:=TRUE
    UNTIL DONE
  END;

  PROCEDURE IDENTIFIER;
  BEGIN
    IF SY=ID1 THEN BEGIN PUT1(OP,ARG); GET END
    ELSE BEGIN
      ERROR(ERROR_NUM,KEYS);
      PUT1(OP,XUNDEF)
    END
  END;

"########"
"ROUTINES"
"########"

  PROCEDURE ROUTINE_DEC;
  VAR LKEYS1:SETS;
  BEGIN
    LKEYS1:=KEYS OR QROUTINES;
    REPEAT
      CASE SY OF
        PROCEDURE1: PROC_DEC(LKEYS1);
        FUNCTION1: FUNC_DEC(LKEYS1)
      END;
      IF SY=SEMICOLON1 THEN GET ELSE ERROR(ROUTINE_ERROR, LKEYS1);
      CHECK(ROUTINE_ERROR,LKEYS1);
    UNTIL NOT(SY IN QROUTINES)
  END;

  PROCEDURE PROC_DEC;
  BEGIN
    PROC_HEADING(KEYS OR QFBLOCK);
    CHECK(PROC_ERROR, KEYS OR QFBLOCK);
    IF SY=FORWARD1 THEN BEGIN
      PUT0(FORWARD2); GET;
    END ELSE BLOCK(KEYS);
  END;

  PROCEDURE PROC_HEADING;
  BEGIN
    GET;
    IDENTIFIER(KEYS OR QDEC, PROC_ID2, PROC_ERROR);
    PARM_LIST(KEYS OR QSEMICOLON);
    PUT0(PROC_DEF2);
    IF SY=SEMICOLON1 THEN GET ELSE ERROR(PROC_ERROR, KEYS);
  END;

  PROCEDURE FUNC_DEC;
  BEGIN
    FUNC_HEADING(KEYS OR QFBLOCK);
    CHECK(FUNC_ERROR, KEYS OR QFBLOCK);
    IF SY=FORWARD1 THEN BEGIN
      PUT0(FORWARD2); GET
    END ELSE BLOCK(KEYS)
  END;

  PROCEDURE FUNC_HEADING;
  VAR LKEYS1: SETS;
  BEGIN
    LKEYS1 := KEYS OR QDEC OR QOPEN;
    GET;
    IDENTIFIER(LKEYS1, FUNC_ID2, FUNC_ERROR);
    CHECK(FUNC_ERROR, LKEYS1);
    IF SY<>SEMICOLON1 THEN BEGIN
      PARM_LIST(KEYS OR QDEC);
      IF SY=COLON1 THEN GET ELSE ERROR(FUNC_ERROR, KEYS OR QID_SEMI);
      IDENTIFIER(KEYS OR QSEMICOLON, FUNC_TYPE2, FUNC_ERROR)
    END;
    PUT0(FUNC_DEF2);
    IF SY=SEMICOLON1 THEN GET ELSE ERROR(FUNC_ERROR, KEYS);
  END;

  PROCEDURE PARM_LIST;
  VAR LIST_OP,TYPE_OP,NUMBER:INTEGER; DONE:BOOLEAN; LKEYS1:SETS;
  BEGIN
    LKEYS1:=KEYS OR QPARM_LIST OR QCLOSE;
    CHECK(PARM_ERROR,KEYS OR QOPEN);
    IF SY=OPEN1 THEN BEGIN
      GET; DONE:=FALSE;
      REPEAT
        CHECK(PARM_ERROR,LKEYS1);
        IF SY=VAR1 THEN BEGIN
          GET; LIST_OP:=VPARMLIST2
        END ELSE LIST_OP:=CPARMLIST2;
        ID_LIST(LKEYS1,PARM_ID2,PARM_ERROR,NUMBER);
        IF SY=COLON1 THEN GET ELSE ERROR(PARM_ERROR,LKEYS1);
        CHECK(PARM_ERROR,LKEYS1);
        IF SY=UNIV1 THEN BEGIN
          GET; TYPE_OP:=UNIV_TYPE2
        END ELSE TYPE_OP:=PARM_TYPE2;
        "TYPE"IDENTIFIER(LKEYS1,TYPE_OP,PARM_ERROR);
        PUT1(LIST_OP,NUMBER);
        CHECK(PARM_ERROR,LKEYS1);
        IF SY IN QPARM_LIST THEN
          IF SY=SEMICOLON1 THEN GET ELSE ERROR(PARM_ERROR,LKEYS1)
        ELSE DONE:=TRUE
      UNTIL DONE;
      IF SY=CLOSE1 THEN GET ELSE ERROR(PARM_ERROR,KEYS)
    END
  END;

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

  PROCEDURE BODY;
  BEGIN
    PUT0(BODY2);
    IF SY=BEGIN1 THEN GET ELSE ERROR(BODY_ERROR,KEYS OR QBODY_END);
    STAT_LIST (KEYS OR QEND);
    PUT0(BODY_END2);
    IF SY=END1 THEN GET ELSE ERROR(BODY_ERROR,KEYS)
  END;

  PROCEDURE STAT_LIST;
  VAR DONE:BOOLEAN; LKEYS1:SETS;
  BEGIN
    LKEYS1:=KEYS OR QSTAT_LIST;
    DONE:=FALSE;
    REPEAT
      STAT(LKEYS1);
      CHECK(STATS_ERROR,LKEYS1);
      IF SY IN QSTAT_LIST  THEN
        IF SY=SEMICOLON1 THEN GET ELSE ERROR(STATS_ERROR,LKEYS1)
      ELSE DONE:=TRUE
    UNTIL DONE
  END;

  PROCEDURE STAT;
  BEGIN
    CHECK(STAT_ERROR,KEYS OR QSTAT);
    IF SY IN QSTAT THEN
      CASE SY OF
        ID1: ID_STAT(KEYS);
        BEGIN1: COMPOUND_STAT(KEYS);
        IF1: IF_STAT(KEYS);
        CASE1: CASE_STAT(KEYS);
        WHILE1: WHILE_STAT(KEYS);
        REPEAT1: REPEAT_STAT(KEYS);
        FOR1: FOR_STAT(KEYS);
        WITH1: WITH_STAT(KEYS)
      END
  END;

  PROCEDURE ID_STAT;
  VAR LKEYS1: SETS;
  BEGIN
    LKEYS1:=KEYS OR QID_END;
    VARIABLE(LKEYS1);
    CHECK(IDSTAT_ERROR,LKEYS1);
    IF SY=BECOMES1 THEN BEGIN
      PUT0(ANAME2); GET;
      EXPR(KEYS); PUT0(STORE2)
    END ELSE BEGIN
      PUT0(CALL_NAME2);
      ARG_LIST(KEYS);
      PUT0(CALL2)
    END
  END;

  PROCEDURE ARG_LIST;
  VAR DONE:BOOLEAN; LKEYS1:SETS;
  BEGIN
    CHECK(ARG_ERROR,KEYS OR QOPEN);
    IF SY=OPEN1 THEN BEGIN
      PUT0(ARG_LIST2); GET; DONE:=FALSE; LKEYS1:=KEYS OR QARG_END;
      REPEAT
        EXPR(LKEYS1); PUT0(ARG2);
        CHECK(ARG_ERROR,LKEYS1);
        IF SY IN QARGUMENT THEN
          IF SY=COMMA1 THEN GET ELSE ERROR(ARG_ERROR,LKEYS1)
        ELSE DONE:=TRUE
      UNTIL DONE;
      IF SY=CLOSE1 THEN GET ELSE ERROR(ARG_ERROR,KEYS)
    END
  END;

  PROCEDURE COMPOUND_STAT;
  BEGIN
    GET;
    STAT_LIST (KEYS);
    IF SY=END1 THEN GET ELSE ERROR(COMP_ERROR,KEYS)
  END;

  PROCEDURE IF_STAT;
  VAR L1,L2:LABEL; LKEYS1:SETS;
  BEGIN
    LKEYS1:=KEYS OR QTHEN_END;
    GET;
    EXPR(KEYS OR QIF_END);
    NEW_LABEL(L1); PUT1(FALSEJUMP2,L1);
    IF SY=THEN1 THEN GET ELSE ERROR(IF_ERROR,LKEYS1);
    STAT(LKEYS1);
    CHECK(IF_ERROR,LKEYS1);
    IF SY=ELSE1 THEN BEGIN
      NEW_LABEL(L2); PUT2(JUMP_DEF2,L2,L1);
      GET;
      STAT(KEYS);
      PUT1(DEF_LABEL2,L2)
    END ELSE PUT1(DEF_LABEL2,L1)
  END;

  PROCEDURE CASE_STAT;
  VAR L0,LI,LN:LABEL; DONE:BOOLEAN; LKEYS1:SETS;
  BEGIN
    LKEYS1:=KEYS OR QCASES;
    GET; NEW_LABEL(L0); NEW_LABEL(LN);
    EXPR(KEYS OR QCASE_END);
    PUT1(CASE_JUMP2,L0); DONE:=FALSE;
    IF SY=OF1 THEN GET ELSE ERROR(CASE_ERROR,LKEYS1);
    REPEAT
      NEW_LABEL(LI); PUT1(DEF_CASE2,LI);
      LABEL_LIST(LKEYS1, CASE2, CASE_ERROR);
      STAT(LKEYS1); PUT1(JUMP2,LN);
      CHECK(CASE_ERROR,LKEYS1);
      IF SY IN QCASES THEN
        IF SY=SEMICOLON1 THEN GET ELSE ERROR(CASE_ERROR,LKEYS1)
      ELSE DONE:=TRUE
    UNTIL DONE;
    PUT2(END_CASE2,L0,LN);
    IF SY=END1 THEN GET ELSE ERROR(CASE_ERROR,KEYS);
  END;

  PROCEDURE WHILE_STAT;
  VAR L1,L2:LABEL;
  BEGIN
    NEW_LABEL(L1);  NEW_LABEL(L2);
    PUT1(DEF_LABEL2,L1);
    GET;
    EXPR(KEYS OR QDO_TAIL);
    PUT1(FALSEJUMP2,L2);
    IF SY=DO1 THEN GET ELSE ERROR(WHILE_ERROR,KEYS OR QSTAT);
    STAT(KEYS);
    PUT2(JUMP_DEF2,L1,L2)
  END;

  PROCEDURE REPEAT_STAT;
  VAR L:LABEL;
  BEGIN
    NEW_LABEL(L);
    PUT1(DEF_LABEL2,L);
    GET;
    STAT_LIST (KEYS OR QUNTIL_TAIL);
    IF SY=UNTIL1 THEN GET ELSE ERROR(REPEAT_ERROR,KEYS OR QEXPR);
    EXPR(KEYS);
    PUT1(FALSEJUMP2,L)
  END;

  PROCEDURE FOR_STAT;
  CONST UP=5; DOWN=3;
  VAR L1,L2:LABEL; LKEYS1:SETS; OP,DIRECTION:INTEGER;
  BEGIN
    LKEYS1:=KEYS OR QFORB_END;
    GET; NEW_LABEL(L1); NEW_LABEL(L2);
    IDENTIFIER(KEYS OR QFOR_END,NAME2,FOR_ERROR); PUT0(ADDRESS2);
    IF SY=BECOMES1 THEN GET ELSE ERROR(FOR_ERROR,LKEYS1);
    EXPR(LKEYS1); PUT0(FOR_STORE2);
    CHECK(FOR_ERROR,LKEYS1); DIRECTION:=UP; OP:=FOR_UP2;
    IF SY=TO1 THEN GET
    ELSE IF SY=DOWNTO1 THEN BEGIN
      GET; DIRECTION:=DOWN; OP:=FOR_DOWN2
    END ELSE ERROR(FOR_ERROR,QTO_TAIL);
    EXPR(KEYS OR QDO_TAIL);
    PUT3(FOR_LIM2,L1,DIRECTION,L2);
    IF SY=DO1 THEN GET ELSE ERROR(FOR_ERROR,KEYS);
    STAT(KEYS);
    PUT2(OP,L1,L2)
  END;

  PROCEDURE WITH_STAT;
  VAR WITH_COUNT,I:INTEGER; LKEYS1:SETS; DONE:BOOLEAN;
  BEGIN
    LKEYS1:=KEYS OR QWITH_LIST;
    WITH_COUNT:=0; GET; DONE:=FALSE;
    REPEAT
      PUT0(WITH_VAR2);
      VARIABLE(LKEYS1);
      PUT0(WITH_TEMP2);
      WITH_COUNT:=WITH_COUNT+1;
      CHECK(WITH_ERROR,LKEYS1);
      IF SY IN QID_LIST THEN
        IF SY=COMMA1 THEN GET ELSE ERROR(WITH_ERROR,LKEYS1)
      ELSE DONE:=TRUE
    UNTIL DONE;
    IF SY=DO1 THEN GET ELSE ERROR(WITH_ERROR,KEYS OR QSTAT);
    STAT(KEYS);
    FOR I:=1 TO WITH_COUNT DO PUT0(WITH2)
  END;

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

  PROCEDURE EXPR;
  VAR OP:INTEGER;
  BEGIN
    SEXPR(KEYS OR QEXPR_OP);
    CHECK(EXPR_ERROR,KEYS OR QEXPR_OP);
    IF SY IN QEXPR_OP THEN BEGIN
      CASE SY OF
        EQ1: OP:=EQ2;
        NE1: OP:=NE2;
        LE1: OP:=LE2;
        GE1: OP:=GE2;
        LT1: OP:=LT2;
        GT1: OP:=GT2;
        IN1: OP:=IN2
      END;
      PUT0(VALUE2); GET;
      SEXPR(KEYS);
      PUT0(OP)
    END
  END;

  PROCEDURE SEXPR;
  VAR UNARY:BOOLEAN; LKEYS1:SETS; OP:INTEGER;
  BEGIN
    LKEYS1:=KEYS OR QTERM_LIST;
    CHECK(EXPR_ERROR,LKEYS1);
    IF SY IN QUNARY THEN BEGIN
      UNARY:=TRUE;
      IF SY=PLUS1 THEN OP:=UPLUS2 ELSE OP:=UMINUS2;
      GET
    END ELSE UNARY:=FALSE;
    TERM(LKEYS1);
    IF UNARY THEN PUT0(OP);
    CHECK(EXPR_ERROR,LKEYS1);
    IF SY IN QTERM_LIST THEN BEGIN
      PUT0(VALUE2);
      REPEAT
        IF SY IN QSEXPR_OP THEN BEGIN
          CASE SY OF
            PLUS1: OP:=PLUS2;
            MINUS1: OP:=MINUS2;
            OR1: OP:=OR2
          END; GET
        END ELSE BEGIN
          ERROR(EXPR_ERROR,LKEYS1);
          OP:=PLUS2
        END;
        TERM(LKEYS1); PUT0(OP);
        CHECK(EXPR_ERROR,LKEYS1);
      UNTIL NOT(SY IN QTERM_LIST)
    END
  END;

  PROCEDURE TERM;
  VAR OP:INTEGER; LKEYS1:SETS;
  BEGIN
    LKEYS1:=KEYS OR QFACTOR_LIST;
    FACTOR(LKEYS1);
    CHECK(EXPR_ERROR,LKEYS1);
    IF SY IN QFACTOR_LIST THEN BEGIN
      PUT0(VALUE2);
      REPEAT
        IF SY IN QTERM_OP THEN BEGIN
          CASE SY OF
            STAR1: OP:=STAR2;
            SLASH1: OP:=SLASH2;
            DIV1: OP:=DIV2;
            MOD1: OP:=MOD2;
            AND1: OP:=AND2
          END;
          GET
        END ELSE BEGIN
          ERROR(EXPR_ERROR,LKEYS1);
          OP:=STAR2
        END;
        FACTOR(LKEYS1);
        PUT0(OP);
        CHECK(EXPR_ERROR,LKEYS1)
      UNTIL NOT(SY IN QFACTOR_LIST)
    END
  END;

  PROCEDURE FACTOR;
  VAR LKEYS1:SETS;
  BEGIN
    CHECK(EXPR_ERROR,KEYS OR QFACTOR);
    IF SY IN QFACTOR THEN
      CASE SY OF
        REAL1: BEGIN PUT0(FREAL2); GET END;
        STRING1: BEGIN PUT1(FSTRING2,ARG); GET END;
        INTEGER1: BEGIN PUT1(FINTEGER2,ARG); GET END;
        CHAR1: BEGIN PUT1(FCHAR2,ARG); GET END;
        ID1: FACTOR_ID(KEYS);
        OPEN1: BEGIN
          GET; EXPR(KEYS OR QCLOSE);
          IF SY=CLOSE1 THEN GET ELSE ERROR(EXPR_ERROR,KEYS)
        END;
        NOT1: BEGIN
          GET; FACTOR(KEYS); PUT0(NOT2)
        END;
        SUB1: BEGIN
          GET; PUT0(EMPTY_SET2);
          LKEYS1:=KEYS OR QSET_EXPR;
          CHECK(EXPR_ERROR,LKEYS1);
          WHILE SY IN QARGUMENT DO BEGIN
            EXPR(LKEYS1); PUT0(INCLUDE2);
            CHECK(EXPR_ERROR,LKEYS1);
            IF SY IN QARGUMENT THEN
              IF SY=COMMA1 THEN GET ELSE ERROR(EXPR_ERROR,LKEYS1);
            CHECK(EXPR_ERROR,LKEYS1)
          END;
          IF SY=BUS1 THEN GET ELSE ERROR(EXPR_ERROR,KEYS)
        END
      END
    ELSE PUT1(NAME2,XUNDEF)
  END;

  PROCEDURE FACTOR_ID;
  BEGIN
    VARIABLE(KEYS OR QOPEN);
    CHECK(EXPR_ERROR, KEYS OR QOPEN);
    IF SY=OPEN1 THEN BEGIN
      PUT0(FUNCTION2);
      ARG_LIST(KEYS);
      PUT0(CALL_FUNC2)
    END ELSE PUT0(FNAME2)
  END;

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

  PROCEDURE VARIABLE;
  VAR LKEYS1,LKEYS2:SETS; DONE:BOOLEAN;
  BEGIN
    LKEYS1:=KEYS OR QSELECT;
    IDENTIFIER(LKEYS1,NAME2,VARIABLE_ERROR);
    CHECK(VARIABLE_ERROR,LKEYS1);
    WHILE SY IN QSELECT DO BEGIN
      CASE SY OF
      PERIOD1:
        BEGIN
        PUT0(ADDRESS2);
        GET;
        IDENTIFIER(LKEYS1,COMP2,VARIABLE_ERROR)
        END;
      SUB1:
        BEGIN
        PUT0(ADDRESS2); GET;
        LKEYS2:=LKEYS1 OR QSUB_END; DONE:=FALSE;
        REPEAT
          EXPR(LKEYS2); PUT0(SUB2);
          CHECK(VARIABLE_ERROR,LKEYS2);
          IF SY IN QARGUMENT THEN
            IF SY=COMMA1 THEN GET ELSE ERROR(VARIABLE_ERROR,LKEYS2)
          ELSE DONE:=TRUE
        UNTIL DONE;
        IF SY=BUS1 THEN GET ELSE ERROR(VARIABLE_ERROR,LKEYS1)
        END;
      ARROW1:
        BEGIN
        PUT0(ARROW2); GET
        END
      END;
      CHECK(VARIABLE_ERROR,LKEYS1)
    END
  END;

  PROCEDURE CONSTANT;
  BEGIN
    CHECK(CONSTANT_ERROR,KEYS OR QCONSTANT);
    IF SY IN QCONSTANT THEN BEGIN
      CASE SY OF
        ID1: PUT1(CONSTANT2,ARG);
        INTEGER1: PUT1(INTEGER2,ARG);
        REAL1: PUT0(REAL2);
        CHAR1: PUT1(CHAR2,ARG);
        STRING1: PUT1(STRING2,ARG)
      END;
      GET
    END ELSE BEGIN
      ERROR(CONSTANT_ERROR,KEYS);
      PUT1(CONSTANT2,XUNDEF)
    END
  END;

"############"
"MAIN PROGRAM"
"############"

BEGIN
  INITIALIZE;
  PROGRAM_;
  INTER_PASS_PTR@.LABELS:= CURRENT_LABEL;
  NEXT_PASS(INTER_PASS_PTR)
END.