Power-Programmierung/CD1.mdf/pascal/interpre/pl/parser.pas

Pascal/Delphi Source File | 1986-12-14 | 49.3 KB | 1,629 lines

PROGRAM PARSER;
{=============================================================================}
{  PROGRAM: PARSER V - PL PARSER WITH SYNTAX CHECKING, ERROR RECOVERY,        }
{                     SCOPE ANALYSIS, TYPE ANALYSIS, CODE GENERATION          }
{  AUTHOR: JAY MONFORT                     FOR: MATH 434 - COMPILER DESIGN    }
{  DATE: DECEMBER 4, 1986                                                     }
{=============================================================================}
{$K-,D-,V-,C-}
 { NO CTRL-C CHECK, NO STACK CHECK, NO VAR LENGTH CHECK, NO DEVICE CHECK }

CONST
     NO_NAME = 100;

     MAXLABEL = 1000;

TYPE
    SYMBOL_TYPE =
          (AND1,ARRAY1,ARROW1,BECOMES1,BEGIN1,{ 5 }BOOLEAN1,CALL1,COMMA1,CONST1,
           DIV1,{ 10 }DO1,END1,ENDTEXT1,EQUAL1,FALSE1,{ 15 }FI1,GREATER1,IF1,
           INTEGER1,LEFT_BRACKET1,{ 20 }LEFT_PAREN1,LESS1,MINUS1,MOD1,MULT1,
           { 25 }NAME1,NEWLINE1,NOT1,NUMERAL1,OD1,{ 30 }OR1,PAIRED_BRACKETS1,
           PERIOD1,PLUS1,PROC1,{ 35 }READ1,RIGHT_BRACKET1,RIGHT_PAREN1,
           SEMICOLON1,SKIP1,{ 40 }TRUE1,UNKNOWN1,WRITE1);


    RULE_TYPE =
        (PROGRAM2,BLOCK2,DEFINITION_PART2,DEFINITION2,CONSTANT_DEFINITION2,
         { 5 }VARIABLE_DEFINITION2,ARRAY_GROUP2,ARRAY_TAIL2,
         TYPE_SYMBOL2,VARIABLE_LIST2,PROCEDURE_DEFINITION2,
         STATEMENT_PART2,{ 12 }STATEMENT2,
         EMPTY_STATEMENT2,READ_STATEMENT2,VARIABLE_ACCESS_LIST2,
         WRITE_STATEMENT2,{ 17 }EXPRESSION_LIST2,ASSIGNMENT_STATEMENT2,
         PROCEDURE_STATEMENT2,IF_STATEMENT2,DO_STATEMENT2,
         { 22 }GUARDED_COMMAND_LIST2,GUARDED_COMMAND2,EXPRESSION2,
         PRIMARY_OPERATOR2,PRIMARY_EXPRESSION2,{ 27 }RELATIONAL_OPERATOR2,
         SIMPLE_EXPRESSION2,ADDING_OPERATOR2,TERM2,MULTIPLYING_OPERATOR2,
         { 32 }FACTOR2,VARIABLE_ACCESS2,INDEXED_SELECTOR2,CONSTANT2,NUMERAL2,
         { 37 }BOOLEAN_SYMBOL2,NAME2);


    CLASS = (ARRAY3,CONST3,PROC3,STANDARD_PROC3,STANDARD_TYPE3,UNDEFINED3,
             VAR3);


    ERRTYPE = (SYNTAX4,UNDEFINED4,AMBIGUOUS4,TYPE4,KIND4,UNEQUAL4,RANGE4);


    OPERATION_PART =
             (ADD5,AND5,ARROW5,ASSIGN5,BAR5,CALL5,CONSTANT5,DIVIDE5,END_PROC5,
              END_PROG5,EQUAL5,FI5,GREATER5,INDEX5,LESS5,MINUS5,MODULO5,
              MULTIPLY5,NOT5,OR5,PROC5,PROG5,READ5,SUBTRACT5,VALUE5,VARIABLE5,
              WRITE5);


    IF_DO_TYPE = (IF_,DO_);

    RANGE = 1..MAXLABEL;

    OBJECT_POINTER = ^OBJECT_RECORD;

    OBJECT_RECORD = RECORD
                      NAME: INTEGER;
                      PREVIOUS: OBJECT_POINTER;
                      CASE KIND: CLASS OF
                                ARRAY3: ( UPPER_BOUND,
                                          ARRAY_LEVEL,
                                          ARRAY_DISPLACEMENT: INTEGER;
                                          ELEMENT_TYPE,
                                          INDEX_TYPE:  OBJECT_POINTER );
                                CONST3: ( CONST_VALUE: INTEGER;
                                          CONST_TYPE: OBJECT_POINTER );
                                 PROC3: ( PROC_LEVEL: INTEGER;
                                          PROC_LABEL: RANGE );
                        STANDARD_PROC3: ();
                        STANDARD_TYPE3: ();
                            UNDEFINED3: ();
                                  VAR3: ( VAR_TYPE: OBJECT_POINTER;
                                          VAR_LEVEL,
                                          VAR_DISPLACEMENT: INTEGER );
                    END;

    BLOCK_POINTER = ^BLOCK_RECORD;

    BLOCK_RECORD = RECORD
                     PREVIOUS_BLOCK: BLOCK_POINTER;
                     LAST_OBJECT: OBJECT_POINTER
                   END;

    SYMBOLS = SET OF SYMBOL_TYPE;

    SYMBOL_SET_ARRAY = ARRAY[RULE_TYPE] OF SYMBOLS;

    OPERATIONS = SET OF OPERATION_PART;

    ASSEMBLY_TABLE = ARRAY[RANGE] OF INTEGER;

    TEMP_ARRAY = ARRAY[1..1667,1..3] OF INTEGER;

    WRKSTRING = STRING[80];

{-----------------------------------------------------------------------------}

CONST
    LONGSYMBOLS: SYMBOLS = [NUMERAL1,NAME1];

    ONE_OPERANDS: OPERATIONS = [ARROW5,ASSIGN5,BAR5,CONSTANT5,DIVIDE5,FI5,
                                MODULO5,READ5,WRITE5];

    TWO_OPERANDS: OPERATIONS = [CALL5,INDEX5,PROC5,PROG5,VARIABLE5];

{-----------------------------------------------------------------------------}

VAR
    FIRST: SYMBOL_SET_ARRAY;         { FIRST AND FOLLOW SYMBOLS FOR RULE_TYPES}

    SYMBOL: SYMBOL_TYPE;             { THE CURRENT SYMBOL }

    LABEL_NUMBER,                    { THE NEXT LABEL NUMBER IN ASSEMBLY TABLE}
    EXIT_LABEL: RANGE;               { USED TO EXIT IF AND DO LOOPS           }

    ADDRESS,                         { THE CURRENT ADDRESS FOR CODE GENERATION}
    ROW,                             { USED IN FILLING THE TEMP TABLE }
    BLOCK_NUM,                       { THE CURRENT BLOCK LEVEL NUMBER }
    ARGUMENT,                        { INTEGER WITH LONG SYMBOLS }
    LINENUM: INTEGER;                { INTEGER WITH NEWLINE1     }

    TABLE: ASSEMBLY_TABLE;           { USED FOR STORING LABEL ADDRESSES }

    TEMP: TEMP_ARRAY;                { CONTAINS THE FIRST PASS CODE }

    BLOCK_LEVEL: BLOCK_POINTER;      { POINTER TO CURRENT BLOCK }

    INTEGER_TYPE,                    { POINTERS TO STANDARD TYPES }
    BOOLEAN_TYPE,
    UNIVERSAL_TYPE: OBJECT_POINTER;

    TEMP1FILE,                       { TEMP1 FROM SCANNER, TEMP2 FROM PARSER }
    TEMP2FILE: TEXT[$2800];          { 10K BUFFERS FOR TEMP FILES }

    ERRFILE: TEXT[$800];             {  2K BUFFER FOR ERROR FILES }

    ERROPENED: BOOLEAN;              { TELLS IF THE ERROR FILE HAS BEEN USED }


{-----------------------------------------------------------------------------}
{----          FUNCTION EXIST - RETURNS TRUE IF A FILE IS ON DISK         ----}
{-----------------------------------------------------------------------------}
FUNCTION EXIST(FILENAME: WRKSTRING): BOOLEAN;
VAR
   FIL: FILE;
BEGIN
     ASSIGN(FIL,FILENAME);
     {$I-}
     RESET(FIL);
     {$I+}
     EXIST:= (IORESULT = 0);
     IF IORESULT = 0
        THEN CLOSE(FIL)
END;    { FUNCTION EXIST }
{-----------------------------------------------------------------------------}

{=============================================================================}
{====      THE FOLLOWING PROCEDURES OPEN THE INPUT AND OUTPUT FILES       ====}
{====                                                                     ====}
{-----------------------------------------------------------------------------}
{----        PROCEDURE OPEN_TEMP1 - OPENS THE TEMP1 CODE FILE             ----}
{-----------------------------------------------------------------------------}
PROCEDURE OPEN_TEMP1;
{ GLOBAL VARIABLE - TEMP1FILE: TEXT }
BEGIN
     IF EXIST('TEMP1.')
        THEN
            BEGIN
                 ASSIGN(TEMP1FILE,'TEMP1.');
                 RESET(TEMP1FILE);
                 LOWVIDEO;
                 GOTOXY(20,8);
                 WRITE('PARSING ');
                 NORMVIDEO;
                 WRITELN('TEMP1')
            END
        ELSE
            BEGIN
                 WRITELN;
                 WRITELN('UNKNOWN DISK ERROR OR TEMP1. NOT FOUND.');
                 HALT(100)      { USED FOR ERRORLEVEL IN BATCH FILE }
            END
END;    { PROCEDURE OPEN_TEMP1 }
{-----------------------------------------------------------------------------}

{-----------------------------------------------------------------------------}
{----         PROCEDURE OPEN_TEMP2 - OPENS THE CODE FILE FOR OUTPUT       ----}
{-----------------------------------------------------------------------------}
PROCEDURE OPEN_TEMP2;
{ GLOBAL VARIABLE - TEMP2FILE: TEXT }
BEGIN
     ASSIGN(TEMP2FILE,'TEMP2.');
     {$I-}
     REWRITE(TEMP2FILE);
     {$I+}
     IF IORESULT <> 0
       THEN
         BEGIN
           WRITELN;
           WRITELN('UNKNOWN DISK ERROR');
           HALT(100)      { PICKED UP AS ERRORLEVEL BY DOS }
         END
END;
{-----------------------------------------------------------------------------}
{====                 END OF FILE OPENING PROCEDURES                      ====}
{=============================================================================}


{=============================================================================}
{====         THE FOLLOWING ARE THE ERROR FILE PROCEDURES                 ====}
{                                                                             }
{----              PROCEDURE OPENERROR - OPENS THE ERROR FILE             ----}
{-----------------------------------------------------------------------------}
PROCEDURE OPENERROR(FILENAME: WRKSTRING);
{ GLOBAL VARIABLE - ERRFILE: TEXT }
BEGIN
     ASSIGN(ERRFILE,FILENAME);
     {$I-}
     REWRITE(ERRFILE);
     {$I+}
     IF IORESULT <> 0
        THEN
          BEGIN
             WRITELN('UNKNOWN DISK ERROR');
             HALT(100)
          END
END;    { PROCEDURE OPENERROR }
{-----------------------------------------------------------------------------}

{-----------------------------------------------------------------------------}
{----            PROCEDURE ERROR - HANDLES THE PARSER ERRORS              ----}
{-----------------------------------------------------------------------------}
PROCEDURE ERROR(KIND_OF_ERROR: ERRTYPE);
{ GLOBAL VARIABLE - ERRFILE: TEXT; LINENUM: INTEGER; ERROPENED: BOOLEAN }
BEGIN
   IF NOT ERROPENED
     THEN
       BEGIN
         ERROPENED:= TRUE;
         OPENERROR('ERROR2.');
       END;
   WRITE(ERRFILE,' LINE:',LINENUM:5);
   CASE KIND_OF_ERROR OF
        SYNTAX4: WRITELN(ERRFILE,' SYNTAX ERROR');
     UNDEFINED4: WRITELN(ERRFILE,' SEMANTIC ERROR - UNDEFINED NAME');
     AMBIGUOUS4: WRITELN(ERRFILE,' SEMANTIC ERROR - NAME ALREADY DEFINED');
          TYPE4: WRITELN(ERRFILE,' TYPE ERROR - INCOMPATIBLE TYPE(S)');
          KIND4: WRITELN(ERRFILE,' KIND ERROR - THIS TYPE NOT ACCEPTABLE HERE');
       UNEQUAL4: WRITELN(ERRFILE,' SYNTAX ERROR - UNEQUAL VARIABLES AND ASSIGNMENTS');
         RANGE4: WRITELN(ERRFILE,' SYNTAX ERROR - NEGATIVE VALUES NOT ALLOWED IN ARRAY INDICES')
   END   { CASE }
END;    { PROCEDURE ERROR }
{-----------------------------------------------------------------------------}
{====                END OF ERROR FILE PROCEDURES                         ====}
{=============================================================================}


{-----------------------------------------------------------------------------}
{        PROCEDURE MAKE_FIRSTS - MAKES THE FIRST SETS FOR RULE_TYPES          }
{-----------------------------------------------------------------------------}
PROCEDURE MAKE_FIRSTS;
{ GLOBAL VARIABLE - FIRST: SYMBOL_SET_ARRAY }
BEGIN
     FIRST[NAME2]:= [NAME1];
     FIRST[BOOLEAN_SYMBOL2]:= [FALSE1,TRUE1];
     FIRST[NUMERAL2]:= [NUMERAL1];
     FIRST[CONSTANT2]:= FIRST[NAME2] + FIRST[BOOLEAN_SYMBOL2] +
                        FIRST[NUMERAL2] + [MINUS1];
     FIRST[INDEXED_SELECTOR2]:= [LEFT_BRACKET1];
     FIRST[VARIABLE_ACCESS2]:= [NAME1];
     FIRST[FACTOR2]:= FIRST[CONSTANT2] + FIRST[VARIABLE_ACCESS2] +
                      [LEFT_PAREN1,NOT1];
     FIRST[MULTIPLYING_OPERATOR2]:= [MULT1,MOD1,DIV1];
     FIRST[TERM2]:= FIRST[FACTOR2];
     FIRST[ADDING_OPERATOR2]:= [PLUS1,MINUS1];
     FIRST[SIMPLE_EXPRESSION2]:= FIRST[TERM2] + [MINUS1];
     FIRST[RELATIONAL_OPERATOR2]:= [LESS1,EQUAL1,GREATER1];
     FIRST[PRIMARY_EXPRESSION2]:= FIRST[SIMPLE_EXPRESSION2];
     FIRST[PRIMARY_OPERATOR2]:= [AND1,OR1];
     FIRST[EXPRESSION2]:= FIRST[PRIMARY_EXPRESSION2];
     FIRST[GUARDED_COMMAND2]:= FIRST[EXPRESSION2];
     FIRST[GUARDED_COMMAND_LIST2]:= FIRST[GUARDED_COMMAND2];
     FIRST[DO_STATEMENT2]:= [DO1];
     FIRST[IF_STATEMENT2]:= [IF1];
     FIRST[PROCEDURE_STATEMENT2]:= [CALL1];
     FIRST[VARIABLE_ACCESS_LIST2]:= FIRST[VARIABLE_ACCESS2];
     FIRST[ASSIGNMENT_STATEMENT2]:= FIRST[VARIABLE_ACCESS_LIST2];
     FIRST[EXPRESSION_LIST2]:= FIRST[EXPRESSION2];
     FIRST[WRITE_STATEMENT2]:= [WRITE1];
     FIRST[READ_STATEMENT2]:= [READ1];
     FIRST[EMPTY_STATEMENT2]:= [SKIP1];
     FIRST[STATEMENT2]:= FIRST[EMPTY_STATEMENT2] + FIRST[READ_STATEMENT2] +
                         FIRST[WRITE_STATEMENT2] + FIRST[DO_STATEMENT2] +
                         FIRST[PROCEDURE_STATEMENT2] + FIRST[IF_STATEMENT2] +
                         FIRST[ASSIGNMENT_STATEMENT2];
     FIRST[STATEMENT_PART2]:= FIRST[STATEMENT2];
     FIRST[PROCEDURE_DEFINITION2]:= [PROC1];
     FIRST[VARIABLE_LIST2]:= [NAME1];
     FIRST[TYPE_SYMBOL2]:= [INTEGER1,BOOLEAN1];
     FIRST[ARRAY_TAIL2]:= [COMMA1,LEFT_BRACKET1];
     FIRST[ARRAY_GROUP2]:= [NAME1];
     FIRST[VARIABLE_DEFINITION2]:= FIRST[TYPE_SYMBOL2];
     FIRST[CONSTANT_DEFINITION2]:= [CONST1];
     FIRST[DEFINITION2]:= FIRST[CONSTANT_DEFINITION2] +
                          FIRST[VARIABLE_DEFINITION2] +
                          FIRST[PROCEDURE_DEFINITION2];
     FIRST[DEFINITION_PART2]:= FIRST[DEFINITION2];
     FIRST[BLOCK2]:= [BEGIN1];
     FIRST[PROGRAM2]:= FIRST[BLOCK2]
END;   { PROCEDURE MAKE_FIRSTS }

{-----------------------------------------------------------------------------}

{ PROCEDURES EMIT, EMIT1, EMIT2, EMIT3 - WRITE CODE TO THE TEMP ARRAY         }

PROCEDURE EMIT(ARGUMENT, COL: INTEGER);
{ GLOBAL VARIABLES - TEMP: TEMP_ARRAY; ROW, ADDRESS: INTEGER; }
BEGIN
     TEMP[ROW,COL]:= ARGUMENT;
     ADDRESS:= ADDRESS + 1
END;

PROCEDURE EMIT1(OPERATION: OPERATION_PART);
{ GLOBAL VARIABLE - ROW: INTEGER }
BEGIN
     ROW:= ROW + 1;
     EMIT(ORD(OPERATION),1)
END;

PROCEDURE EMIT2(OPERATION: OPERATION_PART; OPERAND: INTEGER);
{ GLOBAL VARIABLE - ROW: INTEGER }
BEGIN
     ROW:= ROW + 1;
     EMIT(ORD(OPERATION),1);
     EMIT(OPERAND,2)
END;

PROCEDURE EMIT3(OPERATION: OPERATION_PART; OPERAND1, OPERAND2: INTEGER);
{ GLOBAL VARIABLE - ROW: INTEGER }
BEGIN
     ROW:= ROW + 1;
     EMIT(ORD(OPERATION),1);
     EMIT(OPERAND1,2);
     EMIT(OPERAND2,3)
END;


{ FUNCTION TYPE_LENGTH - RETURNS THE SIZE OF THE OBJECT TYPE IN INTEGERS      }

FUNCTION TYPE_LENGTH(TYPEX: OBJECT_POINTER): INTEGER;
BEGIN
     IF TYPEX^.KIND = STANDARD_TYPE3
        THEN TYPE_LENGTH:= 1
        ELSE
          BEGIN
            ERROR(KIND4);
            TYPE_LENGTH:= 0
          END
END;


{ PROCEDURE NEW_LABEL - UPDATES THE LABEL NUMBER FOR THE ASSEMBLY TABLE       }

PROCEDURE NEW_LABEL(VAR NUMBER: RANGE);
{ GLOBAL VARIABLE - LABEL_NUMBER: RANGE }
BEGIN
     LABEL_NUMBER:= LABEL_NUMBER + 1;
     NUMBER:= LABEL_NUMBER
END;

{ PROCEDURE DEFINE_ADDRESS - ASSIGNS THE CORRECT ADDRESS TO A LABEL           }

PROCEDURE DEFINE_ADDRESS(LAB_NUMBER: RANGE);
{ GLOBAL VARIABLES - TABLE: ASSEMBLY_TABLE; ADDRESS: INTEGER }
BEGIN
     TABLE[LAB_NUMBER]:= ADDRESS
END;

{-----------------------------------------------------------------------------}
{----    PROCEDURE NEWLINE - UPDATES THE LINE NUMBER TO THE SCREEN        ----}
{-----------------------------------------------------------------------------}
PROCEDURE NEWLINE;
BEGIN
     GOTOXY(33,9);
     WRITE(LINENUM:5)
END;

PROCEDURE NEW_BLOCK;
{ GLOBAL VARIABLES: BLOCK: BLOCK_POINTER; BLOCK_NUM: INTEGER }
VAR
   BLOCK: BLOCK_POINTER;
BEGIN
     NEW(BLOCK);
     BLOCK^.PREVIOUS_BLOCK:= BLOCK_LEVEL;
     BLOCK_LEVEL:= BLOCK;
     BLOCK^.LAST_OBJECT:= NIL;
     BLOCK_NUM:= BLOCK_NUM + 1
END;    { PROCEDURE NEW_BLOCK }


PROCEDURE END_BLOCK;
VAR
   OLD_BLOCK: BLOCK_POINTER;
   P, Q: OBJECT_POINTER;
BEGIN
     OLD_BLOCK:= BLOCK_LEVEL;
     BLOCK_LEVEL:= BLOCK_LEVEL^.PREVIOUS_BLOCK;
     P:= OLD_BLOCK^.LAST_OBJECT;
     WHILE P <> NIL DO
       BEGIN
         Q:= P;
         P:= P^.PREVIOUS;
         DISPOSE(Q)
       END;
     DISPOSE(OLD_BLOCK);
     BLOCK_NUM:= BLOCK_NUM - 1
END;


PROCEDURE CHECK_TYPE(VAR TYPE1: OBJECT_POINTER; TYPE2: OBJECT_POINTER);
BEGIN
     IF TYPE1 <> TYPE2
        THEN
          BEGIN
            IF (TYPE1 <> UNIVERSAL_TYPE) AND (TYPE2 <> UNIVERSAL_TYPE)
               THEN ERROR(TYPE4);
            TYPE1:= UNIVERSAL_TYPE;
          END
END;   { PROCEDURE CHECK_TYPE }


PROCEDURE TYPE_ERROR(VAR TYPEX: OBJECT_POINTER);
BEGIN
     IF TYPEX <> UNIVERSAL_TYPE
        THEN
          BEGIN
            ERROR(TYPE4);
            TYPEX:= UNIVERSAL_TYPE
          END
END;   { PROCEDURE TYPE_ERROR }



PROCEDURE KIND_ERROR(OBJECT: OBJECT_POINTER);
BEGIN
     IF OBJECT^.KIND <> UNDEFINED3
        THEN ERROR(KIND4)
END;   { PROCEDURE KIND_ERROR }


PROCEDURE SEARCH(NAME: INTEGER; THIS_LEVEL: BLOCK_POINTER; VAR FOUND: BOOLEAN;
                 VAR OBJECT: OBJECT_POINTER);
VAR
   MORE: BOOLEAN;
BEGIN
     MORE:= TRUE;
     OBJECT:= THIS_LEVEL^.LAST_OBJECT;
     WHILE MORE DO
        IF OBJECT = NIL
           THEN
             BEGIN
               MORE:= FALSE;
               FOUND:= FALSE
             END
        ELSE IF OBJECT^.NAME = NAME
           THEN
             BEGIN
               MORE:= FALSE;
               FOUND:= TRUE
             END
        ELSE OBJECT:= OBJECT^.PREVIOUS
END;


PROCEDURE DEFINE(NAME: INTEGER; KIND: CLASS; VAR OBJECT: OBJECT_POINTER);
VAR
   FOUND: BOOLEAN;
   PNTR: OBJECT_POINTER;
BEGIN
     SEARCH(NAME,BLOCK_LEVEL,FOUND,PNTR);
     IF FOUND
        THEN ERROR(AMBIGUOUS4)
        ELSE
          BEGIN
            NEW(OBJECT);
            OBJECT^.NAME:= NAME;
            OBJECT^.PREVIOUS:= BLOCK_LEVEL^.LAST_OBJECT;
            OBJECT^.KIND:= KIND;
            BLOCK_LEVEL^.LAST_OBJECT:= OBJECT
          END
END;   { PROCEDURE DEFINE }


PROCEDURE FIND(NAME: INTEGER; VAR OBJECT: OBJECT_POINTER);
VAR
   MORE, FOUND: BOOLEAN;
   THIS_LEVEL: BLOCK_POINTER;
BEGIN
     MORE:= TRUE;
     THIS_LEVEL:= BLOCK_LEVEL;
     WHILE MORE DO
       BEGIN
         SEARCH(NAME,THIS_LEVEL,FOUND,OBJECT);
         IF FOUND OR (THIS_LEVEL^.PREVIOUS_BLOCK = NIL)
            THEN MORE:= FALSE
            ELSE THIS_LEVEL:= THIS_LEVEL^.PREVIOUS_BLOCK
       END;
     IF NOT FOUND
        THEN
          BEGIN
            ERROR(UNDEFINED4);
            DEFINE(NAME,UNDEFINED3,OBJECT)
          END
END;   { PROCEDURE FIND }

{-----------------------------------------------------------------------------}
{----        PROCEDURE NEXTSYMBOL - READS A SYMBOL FROM TEMP1             ----}
{-----------------------------------------------------------------------------}
PROCEDURE NEXTSYMBOL;
VAR
   ORDINAL: INTEGER;
BEGIN
     READ(TEMP1FILE,ORDINAL);
     SYMBOL:= SYMBOL_TYPE(ORDINAL);
     WHILE SYMBOL = NEWLINE1 DO
           BEGIN
                READ(TEMP1FILE,LINENUM);
                NEWLINE;
                READ(TEMP1FILE,ORDINAL);
                SYMBOL:= SYMBOL_TYPE(ORDINAL)
           END;
     IF SYMBOL IN LONGSYMBOLS
        THEN READ(TEMP1FILE,ARGUMENT)
END;  { PRODEDURE NEXTSYMBOL }

{-----------------------------------------------------------------------------}
{-- PROCEDURE SYNTAX_ERROR - WRITES MESSAGE TO ERROR FILE AND FINDS A STOP  --}
{-----------------------------------------------------------------------------}
PROCEDURE SYNTAX_ERROR(STOPS: SYMBOLS);
BEGIN
     ERROR(SYNTAX4);
     WHILE NOT (SYMBOL IN STOPS) DO
        NEXTSYMBOL
END;   { PROCEDURE SYNTAX_ERROR }

{-----------------------------------------------------------------------------}
{---- PROCEDURE SYNTAX_CHECK - CHECKS NEXT SYMBOL TO SEE IF ITS A STOP    ----}
{-----------------------------------------------------------------------------}
PROCEDURE SYNTAX_CHECK(STOPS: SYMBOLS);
BEGIN
     IF NOT (SYMBOL IN STOPS)
        THEN SYNTAX_ERROR(STOPS)
END;   { PROCEDURE SYNTAX_CHECK }

{-----------------------------------------------------------------------------}
{----  PROCEDURE EXPECT - CHECKS TO SEE THAT THE NEXT SYMBOL IS EXPECTED  ----}
{-----------------------------------------------------------------------------}
PROCEDURE EXPECT(THIS_SYMBOL: SYMBOL_TYPE; STOPS: SYMBOLS);
BEGIN
     IF SYMBOL = THIS_SYMBOL
        THEN NEXTSYMBOL
        ELSE SYNTAX_ERROR(STOPS);
     SYNTAX_CHECK(STOPS)
END;   { PROCEDURE EXPECT }


PROCEDURE EXPECT_NAME(VAR NAME: INTEGER; STOPS: SYMBOLS);
BEGIN
     IF SYMBOL = NAME1
        THEN
          BEGIN
            NAME:= ARGUMENT;
            NEXTSYMBOL
          END
        ELSE
          BEGIN
            NAME:= NO_NAME;
            SYNTAX_ERROR(STOPS)
          END;
     SYNTAX_CHECK(STOPS)
END;   { PROCEDURE EXPECT_NAME }


PROCEDURE STANDARD_BLOCK;
BEGIN
     BLOCK_NUM:= -1;
     BLOCK_LEVEL:= NIL;
     NEW_BLOCK;
     DEFINE(NO_NAME,STANDARD_TYPE3,UNIVERSAL_TYPE);
     DEFINE(ORD(INTEGER1),STANDARD_TYPE3,INTEGER_TYPE);
     DEFINE(ORD(BOOLEAN1),STANDARD_TYPE3,BOOLEAN_TYPE)
END;   { PROCEDURE STANDARD_BLOCK }

{-----------------------------------------------------------------------------}
{     THE FOLLOWING FORWARD DECLARATIONS ARE NEEDED TO KEEP THE BNF RULE      }
{  PROCEDURES IN THE SAME ORDER AS SHOWN IN THE TEXT.                         }
{                                                                             }
PROCEDURE EXPRESSION(VAR EXPR_TYPE: OBJECT_POINTER;
                     STOPS: SYMBOLS);            FORWARD;

PROCEDURE VARIABLE_ACCESS_LIST(VAR ACCESS_TYPE: OBJECT_POINTER;
                               VAR ACCESSES: INTEGER;
                               STOPS: SYMBOLS);  FORWARD;

PROCEDURE EXPRESSION_LIST(VAR EXPR_TYPE: OBJECT_POINTER; VAR EXPRS: INTEGER;
                          STOPS: SYMBOLS);       FORWARD;

PROCEDURE STATEMENT_PART(STOPS: SYMBOLS);        FORWARD;

PROCEDURE ARRAY_TAIL(VAR LENGTH, UPPER_BOUND: INTEGER;
                     ELEMENT_TYPE: OBJECT_POINTER;
                     VAR INDEX_TYPE: OBJECT_POINTER; STOPS: SYMBOLS);
                                                 FORWARD;

PROCEDURE BLOCK(VAR_LABEL, BEG_LABEL: RANGE; STOPS: SYMBOLS);
                                                 FORWARD;
{-----------------------------------------------------------------------------}

{-----------------------------------------------------------------------------}
{---- THE FOLLOWING ARE THE PROCEDURES FOR THE PL BNF RULES IN BOTTOMS UP ----}
{---- ORDERING.      ( NAME2..PROGRAM2 )                                  ----}
{                                                                             }
PROCEDURE NAMEX(VAR NAME: INTEGER; STOPS: SYMBOLS);
BEGIN
     EXPECT_NAME(NAME,STOPS)
END;

PROCEDURE NUMERAL(STOPS: SYMBOLS);
BEGIN
     EXPECT(NUMERAL1,STOPS)
END;

PROCEDURE BOOLEAN_SYMBOL(VAR VALUE: INTEGER; STOPS: SYMBOLS);

(* BOOLEAN SYMBOL = "FALSE" | "TRUE" *)

BEGIN
     IF SYMBOL = FALSE1
        THEN
          BEGIN
            EXPECT(FALSE1,STOPS);
            VALUE:= ORD(FALSE)
          END
     ELSE IF SYMBOL = TRUE1
        THEN
          BEGIN
            EXPECT(TRUE1,STOPS);
            VALUE:= ORD(TRUE)
          END
     ELSE
       BEGIN
         SYNTAX_ERROR(STOPS);
         VALUE:= ORD(FALSE)             {  PROGRAMMER'S CHOICE }
       END
END;



PROCEDURE CONSTANT(VAR VALUE: INTEGER; VAR TYPEX: OBJECT_POINTER;
                   STOPS: SYMBOLS);

(* CONSTANT = NUMERAL | BOOLEAN SYMBOL | NAME : "-" CONSTANT *)
VAR
   NAME,
   VALUE1: INTEGER;
   OBJECT: OBJECT_POINTER;

BEGIN
     CASE SYMBOL OF
         MINUS1:   BEGIN
                        EXPECT(MINUS1,STOPS+FIRST[CONSTANT2]);
                        IF SYMBOL IN FIRST[CONSTANT2]
                           THEN
                             BEGIN
                               CONSTANT(VALUE1,TYPEX,STOPS);
                               IF TYPEX <> INTEGER_TYPE
                                  THEN SYNTAX_ERROR(STOPS)
                                  ELSE VALUE:= -VALUE1
                             END
                           ELSE SYNTAX_ERROR(STOPS)
                   END;
         NUMERAL1: BEGIN
                        VALUE:= ARGUMENT;
                        TYPEX:= INTEGER_TYPE;
                        NUMERAL(STOPS)
                   END;
         TRUE1,
         FALSE1: BEGIN
                      BOOLEAN_SYMBOL(VALUE,STOPS);
                      TYPEX:= BOOLEAN_TYPE
                 END;
         NAME1:  BEGIN
                   NAMEX(NAME,STOPS);
                   FIND(NAME,OBJECT);
                   IF OBJECT^.KIND = CONST3
                      THEN
                        BEGIN
                          VALUE:= OBJECT^.CONST_VALUE;
                          TYPEX:= OBJECT^.CONST_TYPE
                        END
                      ELSE
                        BEGIN
                          KIND_ERROR(OBJECT);
                          VALUE:= 0;
                          TYPEX:= UNIVERSAL_TYPE
                        END
                 END
       ELSE
         BEGIN
           SYNTAX_ERROR(STOPS);
           VALUE:= 0;
           TYPEX:= UNIVERSAL_TYPE
         END
     END  { CASE }
END;     { PROCEDURE CONSTANT }



PROCEDURE INDEXED_SELECTOR(TYPEX: OBJECT_POINTER; STOPS: SYMBOLS);

(* INDEXED SELECTOR = "[" EXPRESSION "]" *)
VAR
   EXPR_TYPE: OBJECT_POINTER;

BEGIN
     EXPECT(LEFT_BRACKET1,STOPS + FIRST[EXPRESSION2] + [RIGHT_BRACKET1]);
     EXPRESSION(EXPR_TYPE,STOPS + [RIGHT_BRACKET1]);
     EXPECT(RIGHT_BRACKET1,STOPS);
     CHECK_TYPE(TYPEX,EXPR_TYPE)
END;



PROCEDURE VARIABLE_ACCESS(VAR TYPEX: OBJECT_POINTER; STOPS: SYMBOLS);

(* VARIABLE ACCESS = NAME[INDEXED SELECTOR] *)
VAR
   NAME: INTEGER;
   OBJECT: OBJECT_POINTER;

BEGIN
     NAMEX(NAME,STOPS + FIRST[INDEXED_SELECTOR2]);
     FIND(NAME,OBJECT);
     SYNTAX_CHECK(STOPS + FIRST[INDEXED_SELECTOR2]);
     IF OBJECT^.KIND = ARRAY3
        THEN
          BEGIN
            IF SYMBOL IN FIRST[INDEXED_SELECTOR2]
              THEN
                BEGIN
                  EMIT3(VARIABLE5,BLOCK_NUM - OBJECT^.ARRAY_LEVEL,
                        OBJECT^.ARRAY_DISPLACEMENT);
                  INDEXED_SELECTOR(OBJECT^.INDEX_TYPE,STOPS);
                  EMIT3(INDEX5,OBJECT^.UPPER_BOUND,LINENUM);
                  TYPEX:= OBJECT^.ELEMENT_TYPE
                END
              ELSE SYNTAX_ERROR(STOPS)
          END
     ELSE IF OBJECT^.KIND = VAR3
         THEN
           BEGIN
             TYPEX:= OBJECT^.VAR_TYPE;
             EMIT3(VARIABLE5,BLOCK_NUM - OBJECT^.VAR_LEVEL,
                   OBJECT^.VAR_DISPLACEMENT)
           END
     ELSE
       BEGIN
         SYNTAX_ERROR(STOPS);
         TYPEX:= UNIVERSAL_TYPE
       END
END;



PROCEDURE FACTOR(VAR TYPEX: OBJECT_POINTER; STOPS: SYMBOLS);

(* FACTOR = CONSTANT | VARIABLE ACCESS | "(" EXPRESSION ")" | "~" FACTOR *)
{     rewritten as: }
(* FACTOR = NUMERAL | BOOLEAN SYMBOL | VARIABLE ACCESS | "("EXPRESSION")" |
            "~"FACTOR *)
VAR
   NAME, VALUE: INTEGER;
   OBJECT: OBJECT_POINTER;

BEGIN
     IF SYMBOL IN [NUMERAL1,TRUE1,FALSE1]
        THEN
          BEGIN
            CONSTANT(VALUE,TYPEX,STOPS);
            EMIT2(CONSTANT5,VALUE)
          END
     ELSE IF SYMBOL = NAME1
        THEN
          BEGIN
            FIND(ARGUMENT,OBJECT);
            IF OBJECT^.KIND = CONST3
               THEN
                 BEGIN
                   CONSTANT(VALUE,TYPEX,STOPS);
                   EMIT2(CONSTANT5,VALUE)
                 END
            ELSE IF (OBJECT^.KIND = VAR3) OR (OBJECT^.KIND = ARRAY3)
               THEN
                 BEGIN
                   VARIABLE_ACCESS(TYPEX,STOPS);
                   EMIT1(VALUE5)
                 END
            ELSE
              BEGIN
                KIND_ERROR(OBJECT);
                TYPEX:= UNIVERSAL_TYPE;
                EXPECT(NAME1,STOPS)
              END
          END
     ELSE IF SYMBOL = LEFT_PAREN1
        THEN
          BEGIN
            EXPECT(LEFT_PAREN1,STOPS + FIRST[EXPRESSION2] + [RIGHT_PAREN1]);
            EXPRESSION(TYPEX,STOPS + [RIGHT_PAREN1]);
            EXPECT(RIGHT_PAREN1,STOPS)
          END
     ELSE IF SYMBOL = NOT1
        THEN
          BEGIN
            EXPECT(NOT1,STOPS + FIRST[FACTOR2]);
            FACTOR(TYPEX,STOPS);
            CHECK_TYPE(TYPEX,BOOLEAN_TYPE);
            EMIT1(NOT5)
          END
     ELSE
       BEGIN
         SYNTAX_ERROR(STOPS);
         TYPEX:= UNIVERSAL_TYPE
       END
END;     { PROCEDURE FACTOR }



PROCEDURE MULTIPLYING_OPERATOR(STOPS: SYMBOLS);

(* MULTIPLYING OPERATOR = "*" | "/" | "\" *)

BEGIN
     CASE SYMBOL OF
          MULT1: EXPECT(MULT1,STOPS);
          DIV1:  EXPECT(DIV1,STOPS);
          MOD1:  EXPECT(MOD1,STOPS)
        ELSE SYNTAX_ERROR(STOPS)
     END
END;



PROCEDURE TERM(VAR TERM_TYPE: OBJECT_POINTER; STOPS: SYMBOLS);

(* TERM = FACTOR { MULTIPLYING OPERATOR  FACTOR } *)
VAR
   OP: SYMBOL_TYPE;
BEGIN
    FACTOR(TERM_TYPE,STOPS + FIRST[MULTIPLYING_OPERATOR2]);
    IF SYMBOL IN FIRST[MULTIPLYING_OPERATOR2]
       THEN CHECK_TYPE(TERM_TYPE,INTEGER_TYPE);
    WHILE SYMBOL IN FIRST[MULTIPLYING_OPERATOR2] DO
       BEGIN
         OP:= SYMBOL;
         MULTIPLYING_OPERATOR(STOPS + FIRST[MULTIPLYING_OPERATOR2] +
                              FIRST[FACTOR2]);
         FACTOR(TERM_TYPE,STOPS + FIRST[MULTIPLYING_OPERATOR2]);
         CHECK_TYPE(TERM_TYPE,INTEGER_TYPE);
         TERM_TYPE:= INTEGER_TYPE;
         CASE OP OF
              MULT1: EMIT1(MULTIPLY5);
               DIV1: EMIT2(DIVIDE5,LINENUM);
               MOD1: EMIT2(MODULO5,LINENUM)
         END
       END
END;



PROCEDURE ADDING_OPERATOR(STOPS: SYMBOLS);

(* ADDING OPERATOR = "+" | "-" *)

BEGIN
     IF SYMBOL = PLUS1
        THEN EXPECT(PLUS1,STOPS)
     ELSE IF SYMBOL = MINUS1
        THEN EXPECT(MINUS1,STOPS)
     ELSE SYNTAX_ERROR(STOPS)
END;



PROCEDURE SIMPLE_EXPRESSION(VAR EXPR_TYPE: OBJECT_POINTER; STOPS: SYMBOLS);

(* SIMPLE EXPRESSION = ["-"] TERM { ADDING OPERATOR  TERM } *)
VAR
   OP: SYMBOL_TYPE;
BEGIN
     SYNTAX_CHECK(STOPS + [MINUS1] + FIRST[TERM2] + FIRST[ADDING_OPERATOR2]);
     IF SYMBOL = MINUS1
        THEN
          BEGIN
            EXPECT(MINUS1,STOPS + FIRST[TERM2] + FIRST[ADDING_OPERATOR2]);
            TERM(EXPR_TYPE,STOPS + FIRST[ADDING_OPERATOR2]);
            CHECK_TYPE(EXPR_TYPE,INTEGER_TYPE);
            EMIT1(MINUS5)
          END
        ELSE TERM(EXPR_TYPE,STOPS + FIRST[ADDING_OPERATOR2]);
     IF SYMBOL IN FIRST[ADDING_OPERATOR2]
        THEN CHECK_TYPE(EXPR_TYPE,INTEGER_TYPE);
     WHILE SYMBOL IN FIRST[ADDING_OPERATOR2] DO
        BEGIN
          OP:= SYMBOL;
          ADDING_OPERATOR(STOPS + FIRST[TERM2] + FIRST[ADDING_OPERATOR2]);
          TERM(EXPR_TYPE,STOPS + FIRST[ADDING_OPERATOR2]);
          CHECK_TYPE(EXPR_TYPE,INTEGER_TYPE);
          EXPR_TYPE:= INTEGER_TYPE;
          IF OP = PLUS1
             THEN EMIT1(ADD5)
             ELSE EMIT1(SUBTRACT5)
        END
END;



PROCEDURE RELATIONAL_OPERATOR(STOPS: SYMBOLS);

(* RELATIONAL OPERATOR = "<" | "=" | ">" *)

BEGIN
     CASE SYMBOL OF
          LESS1: EXPECT(LESS1,STOPS);
         EQUAL1: EXPECT(EQUAL1,STOPS);
       GREATER1: EXPECT(GREATER1,STOPS)
      ELSE SYNTAX_ERROR(STOPS)
     END   { CASE }
END;



PROCEDURE PRIMARY_EXPRESSION(VAR EXPR_TYPE: OBJECT_POINTER; STOPS: SYMBOLS);

(* PRIMARY EXPRESSION = SIMPLE EXPRESSION
                        [RELATIONAL OPERATOR  SIMPLE EXPRESSION] *)
VAR
   OP: SYMBOL_TYPE;
BEGIN
     SIMPLE_EXPRESSION(EXPR_TYPE,STOPS + FIRST[RELATIONAL_OPERATOR2]);
     IF SYMBOL IN FIRST[RELATIONAL_OPERATOR2]
        THEN
          BEGIN
            OP:= SYMBOL;
            CHECK_TYPE(EXPR_TYPE,INTEGER_TYPE);
            RELATIONAL_OPERATOR(STOPS + FIRST[SIMPLE_EXPRESSION2]);
            SIMPLE_EXPRESSION(EXPR_TYPE,STOPS);
            CHECK_TYPE(EXPR_TYPE,INTEGER_TYPE);
            EXPR_TYPE:= BOOLEAN_TYPE;
            CASE OP OF
                 LESS1: EMIT1(LESS5);
                EQUAL1: EMIT1(EQUAL5);
              GREATER1: EMIT1(GREATER5)
            END
          END
END;



PROCEDURE PRIMARY_OPERATOR(STOPS: SYMBOLS);

(* PRIMARY OPERATOR = "&" | "|" *)

BEGIN
     IF SYMBOL = AND1
        THEN EXPECT(AND1,STOPS)
     ELSE IF SYMBOL = OR1
        THEN EXPECT(OR1,STOPS)
     ELSE SYNTAX_ERROR(STOPS)
END;



PROCEDURE EXPRESSION{(VAR EXPR_TYPE: OBJECT_POINTER; STOPS: SYMBOLS)};
{ FORWARD REFERENCED }

(* EXPRESSION = PRIMARY EXPRESSION { PRIMARY OPERATOR  PRIMARY EXPRESSION }  *)
VAR
   OP: SYMBOL_TYPE;
BEGIN
     PRIMARY_EXPRESSION(EXPR_TYPE,STOPS + FIRST[PRIMARY_OPERATOR2]);
     IF SYMBOL IN FIRST[PRIMARY_OPERATOR2]
        THEN CHECK_TYPE(EXPR_TYPE,BOOLEAN_TYPE);
     WHILE SYMBOL IN FIRST[PRIMARY_OPERATOR2] DO
         BEGIN
           OP:= SYMBOL;
           PRIMARY_OPERATOR(STOPS + FIRST[PRIMARY_OPERATOR2] +
                            FIRST[PRIMARY_EXPRESSION2]);
           PRIMARY_EXPRESSION(EXPR_TYPE,STOPS + FIRST[PRIMARY_OPERATOR2]);
           IF OP = OR1
              THEN EMIT1(OR5)
              ELSE EMIT1(AND5);
           CHECK_TYPE(EXPR_TYPE,BOOLEAN_TYPE);
           EXPR_TYPE:= BOOLEAN_TYPE
         END
END;



PROCEDURE GUARDED_COMMAND(LABEL_: RANGE; STOPS: SYMBOLS);

(* GUARDED COMMAND = EXPRESSION "->" STATEMENT PART *)
VAR
   EXPR_TYPE: OBJECT_POINTER;

BEGIN
     EXPRESSION(EXPR_TYPE,STOPS + [ARROW1] + FIRST[STATEMENT_PART2]);
     CHECK_TYPE(EXPR_TYPE,BOOLEAN_TYPE);
     EXPR_TYPE:= BOOLEAN_TYPE;
     EXPECT(ARROW1,STOPS + FIRST[STATEMENT_PART2]);
     EMIT2(ARROW5,LABEL_);
     STATEMENT_PART(STOPS)
END;



PROCEDURE GUARDED_COMMAND_LIST(IF_DO: IF_DO_TYPE; STOPS: SYMBOLS);

(* GUARDED COMMAND LIST = GUARDED COMMAND { "[]" GUARDED COMMAND } *)
VAR
   THIS_LABEL,
   NEXT_LABEL: RANGE;
BEGIN
     NEW_LABEL(THIS_LABEL);
     NEW_LABEL(NEXT_LABEL);
     DEFINE_ADDRESS(THIS_LABEL);
     GUARDED_COMMAND(NEXT_LABEL,STOPS + [PAIRED_BRACKETS1]);
     IF IF_DO = DO_
        THEN EMIT2(BAR5,THIS_LABEL)
        ELSE EMIT2(BAR5,EXIT_LABEL);
     WHILE SYMBOL = PAIRED_BRACKETS1 DO
       BEGIN
         EXPECT(PAIRED_BRACKETS1,STOPS + [PAIRED_BRACKETS1] +
                                 FIRST[GUARDED_COMMAND2]);
         THIS_LABEL:= NEXT_LABEL;
         NEW_LABEL(NEXT_LABEL);
         DEFINE_ADDRESS(THIS_LABEL);
         GUARDED_COMMAND(NEXT_LABEL,STOPS + [PAIRED_BRACKETS1]);
         IF IF_DO = DO_
            THEN EMIT2(BAR5,THIS_LABEL)
            ELSE EMIT2(BAR5,EXIT_LABEL)
       END;
     DEFINE_ADDRESS(NEXT_LABEL)
END;



PROCEDURE DO_STATEMENT(STOPS: SYMBOLS);

(* DO STATEMENT = "DO" GUARDED COMMAND LIST "OD" *)

BEGIN
     EXPECT(DO1,STOPS + FIRST[GUARDED_COMMAND_LIST2] + [OD1]);
     GUARDED_COMMAND_LIST(DO_,STOPS + [OD1]);
     EXPECT(OD1,STOPS)
END;



PROCEDURE IF_STATEMENT(STOPS: SYMBOLS);

(* IF STATEMENT = "IF" GUARDED COMMAND LIST "FI" *)
BEGIN
     NEW_LABEL(EXIT_LABEL);
     EXPECT(IF1,STOPS + FIRST[GUARDED_COMMAND_LIST2] + [FI1]);
     GUARDED_COMMAND_LIST(IF_,STOPS + [FI1]);
     EXPECT(FI1,STOPS);
     EMIT2(FI5,LINENUM);
     DEFINE_ADDRESS(EXIT_LABEL)
END;



PROCEDURE PROCEDURE_STATEMENT(STOPS: SYMBOLS);

(* PROCEDURE STATEMENT = "CALL" NAME *)
VAR
   NAME: INTEGER;
   OBJECT: OBJECT_POINTER;

BEGIN
     EXPECT(CALL1,STOPS + [NAME1]);
     NAMEX(NAME,STOPS);
     FIND(NAME,OBJECT);
     IF OBJECT^.KIND <> PROC3
        THEN KIND_ERROR(OBJECT)
        ELSE EMIT3(CALL5,BLOCK_NUM - OBJECT^.PROC_LEVEL,OBJECT^.PROC_LABEL)
END;



PROCEDURE ASSIGNMENT_STATEMENT(STOPS: SYMBOLS);

(* ASSIGNMENT STATEMENT = VARIABLE ACCESS LIST ":=" EXPRESSION LIST *)
VAR
   NUM_ACCESSES,
   NUM_EXPRESSN: INTEGER;
   ACCESS_TYPE,
   EXPRES_TYPE: OBJECT_POINTER;

BEGIN
     VARIABLE_ACCESS_LIST(ACCESS_TYPE,NUM_ACCESSES,
                          STOPS + [BECOMES1] + FIRST[EXPRESSION_LIST2]);
     EXPECT(BECOMES1,STOPS + FIRST[EXPRESSION_LIST2]);
     EXPRESSION_LIST(EXPRES_TYPE,NUM_EXPRESSN,STOPS);
     IF NUM_EXPRESSN <> NUM_ACCESSES
        THEN ERROR(UNEQUAL4)
        ELSE EMIT2(ASSIGN5,NUM_ACCESSES);
     CHECK_TYPE(ACCESS_TYPE,EXPRES_TYPE);
END;



PROCEDURE EXPRESSION_LIST{(VAR EXPR_TYPE: OBJECT_POINTER; VAR EXPRS: INTEGER;
                           STOPS: SYMBOLS)};
{ FORWARD REFERENCED }

(* EXPRESSION LIST = EXPRESSION {"," EXPRESSION } *)
VAR
   TYPEX: OBJECT_POINTER;

BEGIN
     EXPRS:= 1;
     EXPRESSION(EXPR_TYPE,STOPS + [COMMA1]);
     WHILE SYMBOL = COMMA1 DO
       BEGIN
         EXPECT(COMMA1,STOPS + FIRST[EXPRESSION2] + [COMMA1]);
         EXPRESSION(TYPEX,STOPS + [COMMA1]);
         EXPRS:= EXPRS + 1;
         CHECK_TYPE(TYPEX,EXPR_TYPE)
       END
END;



PROCEDURE WRITE_STATEMENT(STOPS: SYMBOLS);

(* WRITE STATEMENT = "WRITE" EXPRESSION LIST *)
VAR
   EXPRS: INTEGER;
   EXPR_TYPE: OBJECT_POINTER;

BEGIN
     EXPECT(WRITE1,STOPS + FIRST[EXPRESSION_LIST2]);
     EXPRESSION_LIST(EXPR_TYPE,EXPRS,STOPS);
     CHECK_TYPE(EXPR_TYPE,INTEGER_TYPE);
     EMIT2(WRITE5,EXPRS)
END;



PROCEDURE VARIABLE_ACCESS_LIST{(VAR ACCESS_TYPE: OBJECT_POINTER;
                                VAR ACCESSES: INTEGER; STOPS: SYMBOLS)};
{ FORWARD REFERENCED }

(* VARIABLE ACCESS LIST = VARIABLE ACCESS {"," VARIABLE ACCESS } *)
VAR
   TYPEX: OBJECT_POINTER;

BEGIN
     ACCESSES:= 1;
     VARIABLE_ACCESS(ACCESS_TYPE,STOPS + [COMMA1]);
     WHILE SYMBOL = COMMA1 DO
        BEGIN
          EXPECT(COMMA1,STOPS + FIRST[VARIABLE_ACCESS2] + [COMMA1]);
          ACCESSES:= ACCESSES + 1;
          VARIABLE_ACCESS(TYPEX,STOPS + [COMMA1]);
          CHECK_TYPE(TYPEX,ACCESS_TYPE)
        END
END;



PROCEDURE READ_STATEMENT(STOPS: SYMBOLS);

(* READ STATEMENT = "READ" VARIABLE ACCESS LIST *)
VAR
   ACCESSES: INTEGER;
   ACCESS_TYPE: OBJECT_POINTER;
BEGIN
     EXPECT(READ1,STOPS + FIRST[VARIABLE_ACCESS_LIST2]);
     VARIABLE_ACCESS_LIST(ACCESS_TYPE,ACCESSES,STOPS);
     CHECK_TYPE(ACCESS_TYPE,INTEGER_TYPE);
     EMIT2(READ5,ACCESSES)
END;



PROCEDURE EMPTY_STATEMENT(STOPS: SYMBOLS);

(* EMPTY STATEMENT = "SKIP" *)

BEGIN
     EXPECT(SKIP1,STOPS)
END;



PROCEDURE STATEMENT(STOPS: SYMBOLS);

(* STATEMENT = EMPTY STATEMENT | READ STATEMENT | WRITE STATEMENT |
               ASSIGNMENT STATEMENT | PROCEDURE STATEMENT |
               DO STATEMENT | IF STATEMENT *)

BEGIN
     CASE SYMBOL OF
       SKIP1: EMPTY_STATEMENT(STOPS);
       READ1: READ_STATEMENT(STOPS);
      WRITE1: WRITE_STATEMENT(STOPS);
       NAME1: ASSIGNMENT_STATEMENT(STOPS);
       CALL1: PROCEDURE_STATEMENT(STOPS);
         IF1: IF_STATEMENT(STOPS);
         DO1: DO_STATEMENT(STOPS)
      ELSE SYNTAX_ERROR(STOPS)
     END
END;



PROCEDURE STATEMENT_PART{(STOPS: SYMBOLS)};      { FORWARD REFERENCED }

(* STATEMENT PART = { STATEMENT ";" } *)

BEGIN
     SYNTAX_CHECK(STOPS + FIRST[STATEMENT2]);
     WHILE SYMBOL IN FIRST[STATEMENT2] DO
       BEGIN
         STATEMENT(STOPS + FIRST[STATEMENT2] + [SEMICOLON1]);
         EXPECT(SEMICOLON1,STOPS + FIRST[STATEMENT2])
       END
END;



PROCEDURE PROCEDURE_DEFINITION(STOPS: SYMBOLS);

(* PROCEDURE DEFINITION = "PROC" NAME BLOCK *)
VAR
   NAME: INTEGER;
   OBJECT: OBJECT_POINTER;
   VAR_LABEL,
   BEG_LABEL: RANGE;
BEGIN
     EXPECT(PROC1,STOPS + [NAME1] + FIRST[BLOCK2]);
     NAMEX(NAME,STOPS + FIRST[BLOCK2]);
     DEFINE(NAME,PROC3,OBJECT);
     OBJECT^.PROC_LEVEL:= BLOCK_NUM;
     OBJECT^.PROC_LABEL:= ADDRESS;
     NEW_LABEL(VAR_LABEL);
     NEW_LABEL(BEG_LABEL);
     EMIT3(PROC5,VAR_LABEL,BEG_LABEL);
     BLOCK(VAR_LABEL,BEG_LABEL,STOPS);
     EMIT1(END_PROC5)
END;



PROCEDURE VARIABLE_LIST(VAR LENGTH: INTEGER;
                        TYPEX: OBJECT_POINTER; STOPS: SYMBOLS);

(* VARIABLE LIST = VARIABLE NAME { "," VARIABLE NAME } *)
VAR
   NAME: INTEGER;
   OBJECT: OBJECT_POINTER;
BEGIN
     NAMEX(NAME,STOPS + [COMMA1]);
     DEFINE(NAME,VAR3,OBJECT);
     OBJECT^.VAR_TYPE:= TYPEX;
     OBJECT^.VAR_LEVEL:= BLOCK_NUM;
     OBJECT^.VAR_DISPLACEMENT:= LENGTH;
     LENGTH:= LENGTH + TYPE_LENGTH(OBJECT^.VAR_TYPE);
     WHILE SYMBOL = COMMA1 DO
        BEGIN
          EXPECT(COMMA1,STOPS + [COMMA1] + FIRST[NAME2]);
          NAMEX(NAME,STOPS + [COMMA1]);
          DEFINE(NAME,VAR3,OBJECT);
          OBJECT^.VAR_TYPE:= TYPEX;
          OBJECT^.VAR_LEVEL:= BLOCK_NUM;
          OBJECT^.VAR_DISPLACEMENT:= LENGTH;
          LENGTH:= LENGTH + TYPE_LENGTH(OBJECT^.VAR_TYPE)
        END
END;



PROCEDURE TYPE_SYMBOL(VAR TYPEX: OBJECT_POINTER; STOPS: SYMBOLS);

(* TYPE SYMBOL = "INTEGER" | "BOOLEAN" *)

BEGIN
     IF SYMBOL = INTEGER1
        THEN
          BEGIN
            EXPECT(INTEGER1,STOPS);
            TYPEX:= INTEGER_TYPE
          END
     ELSE IF SYMBOL = BOOLEAN1
        THEN
          BEGIN
            EXPECT(BOOLEAN1,STOPS);
            TYPEX:= BOOLEAN_TYPE
          END
     ELSE
          BEGIN
            SYNTAX_ERROR(STOPS);
            TYPEX:= UNIVERSAL_TYPE
          END
END;

PROCEDURE ARRAY_GROUP(VAR LENGTH,UPPER_BOUND: INTEGER;
                      ELEMENT_TYPE: OBJECT_POINTER;
                      VAR INDEX_TYPE: OBJECT_POINTER; STOPS: SYMBOLS);

(* ARRAY_GROUP = NAME ARRAY_TAIL *)
VAR
   NAME,
   VALUE: INTEGER;
   ARRAY_: OBJECT_POINTER;
BEGIN
     NAMEX(NAME,STOPS + FIRST[ARRAY_TAIL2]);
     DEFINE(NAME,ARRAY3,ARRAY_);
     ARRAY_TAIL(LENGTH,UPPER_BOUND,ELEMENT_TYPE,INDEX_TYPE,STOPS);
     ARRAY_^.INDEX_TYPE:= INDEX_TYPE;
     ARRAY_^.ELEMENT_TYPE:= ELEMENT_TYPE;
     ARRAY_^.ARRAY_LEVEL:= BLOCK_NUM;
     ARRAY_^.ARRAY_DISPLACEMENT:= LENGTH;
     IF UPPER_BOUND <= 0
        THEN
            BEGIN
              ERROR(RANGE4);
              ARRAY_^.UPPER_BOUND:= -UPPER_BOUND
            END
        ELSE ARRAY_^.UPPER_BOUND:= UPPER_BOUND;
     LENGTH:= LENGTH + UPPER_BOUND * TYPE_LENGTH(ARRAY_^.ELEMENT_TYPE)
END;   { PROCEDURE ARRAY_GROUP }


PROCEDURE ARRAY_TAIL{(VAR LENGTH, UPPER_BOUND: INTEGER;
                      ELEMENT_TYPE: OBJECT_POINTER;
                      VAR INDEX_TYPE: POINTER; STOPS: SYMBOLS)};
{ FORWARD REFERENCED }

(* ARRAY_TAIL = "," ARRAY_GROUP | "[" CONSTANT "]" *)

BEGIN
     IF SYMBOL = COMMA1
        THEN
          BEGIN
            EXPECT(COMMA1,STOPS + FIRST[ARRAY_GROUP2]);
            ARRAY_GROUP(LENGTH,UPPER_BOUND,ELEMENT_TYPE,INDEX_TYPE,STOPS)
          END
     ELSE IF SYMBOL = LEFT_BRACKET1
        THEN
          BEGIN
            EXPECT(LEFT_BRACKET1,STOPS + FIRST[CONSTANT2] + [RIGHT_BRACKET1]);
            CONSTANT(UPPER_BOUND,INDEX_TYPE,STOPS + [RIGHT_BRACKET1]);
            EXPECT(RIGHT_BRACKET1,STOPS)
          END
     ELSE SYNTAX_ERROR(STOPS)
END;   { PROCEDURE ARRAY_TAIL }



PROCEDURE VARIABLE_DEFINITION(VAR LENGTH: INTEGER; STOPS: SYMBOLS);

(* VARIABLE DEFINITION = TYPE SYMBOL  VARIABLE LIST |
                        TYPE SYMBOL  "ARRAY"  ARRAY_GROUP *)
VAR
   TYPEX,
   INDEX: OBJECT_POINTER;
   UP: INTEGER;

BEGIN
     TYPE_SYMBOL(TYPEX,STOPS + [ARRAY1] + FIRST[VARIABLE_LIST2] +
                 [LEFT_BRACKET1] + FIRST[CONSTANT2] + [RIGHT_BRACKET1]);
     IF SYMBOL = ARRAY1
        THEN
          BEGIN
            EXPECT(ARRAY1,STOPS + FIRST[VARIABLE_LIST2] + [LEFT_BRACKET1] +
                          FIRST[CONSTANT2] + [RIGHT_BRACKET1]);
            ARRAY_GROUP(LENGTH,UP,TYPEX,INDEX,STOPS + FIRST[ARRAY_TAIL2])
          END
     ELSE IF SYMBOL = NAME1
        THEN VARIABLE_LIST(LENGTH,TYPEX,STOPS)
     ELSE SYNTAX_ERROR(STOPS)
END;



PROCEDURE CONSTANT_DEFINITION(STOPS: SYMBOLS);

(* CONSTANT DEFINITION = "CONST" NAME "=" CONSTANT *)
VAR
   VALUE,
   NAME: INTEGER;
   CONSTX, TYPEX: OBJECT_POINTER;

BEGIN
     EXPECT(CONST1,STOPS + [NAME1,EQUAL1] + FIRST[CONSTANT2]);
     NAMEX(NAME,STOPS + [EQUAL1] + FIRST[CONSTANT2]);
     EXPECT(EQUAL1,STOPS + FIRST[CONSTANT2]);
     CONSTANT(VALUE,TYPEX,STOPS);
     DEFINE(NAME,CONST3,CONSTX);
     CONSTX^.CONST_VALUE:= VALUE;
     CONSTX^.CONST_TYPE:= TYPEX
END;

PROCEDURE DEFINITION(VAR LENGTH: INTEGER; STOPS: SYMBOLS);

(* DEFINITION = CONSTANT DEFINITION | VARIABLE DEFINITION |
                PROCEDURE DEFINITION *)

BEGIN
     IF SYMBOL = CONST1
        THEN CONSTANT_DEFINITION(STOPS)
     ELSE IF SYMBOL IN FIRST[TYPE_SYMBOL2]
        THEN VARIABLE_DEFINITION(LENGTH,STOPS)
     ELSE IF SYMBOL = PROC1
        THEN PROCEDURE_DEFINITION(STOPS)
     ELSE SYNTAX_ERROR(STOPS)
END;



PROCEDURE DEFINITION_PART(VAR LENGTH: INTEGER; STOPS: SYMBOLS);

(* DEFINITION PART = { DEFINITION ";" }  *)

BEGIN
     LENGTH:= 3;
     SYNTAX_CHECK(STOPS + FIRST[DEFINITION2]);
     WHILE SYMBOL IN FIRST[DEFINITION2] DO
       BEGIN
         DEFINITION(LENGTH,STOPS + FIRST[DEFINITION2] + [SEMICOLON1]);
         EXPECT(SEMICOLON1,STOPS + FIRST[DEFINITION2])
       END
END;



PROCEDURE BLOCK{(VAR_LABEL, BEG_LABEL: RANGE;
                 STOPS: SYMBOLS)};        { FORWARD REFERENCED }

(* BLOCK = "BEGIN"  DEFINITION PART  STATEMENT PART  "END" *)
VAR
   VAR_LENGTH: INTEGER;
BEGIN
     NEW_BLOCK;
     EXPECT(BEGIN1,STOPS + FIRST[DEFINITION_PART2] + FIRST[STATEMENT_PART2] +
                   [END1]);
     DEFINITION_PART(VAR_LENGTH,STOPS + FIRST[STATEMENT_PART2] + [END1]);
     TABLE[VAR_LABEL]:= VAR_LENGTH;
     DEFINE_ADDRESS(BEG_LABEL);
     STATEMENT_PART(STOPS + [END1]);
     EXPECT(END1,STOPS);
     END_BLOCK
END;



PROCEDURE PROGRAMX(STOPS: SYMBOLS);

(* PROGRAM = BLOCK "." *)
VAR
   VAR_LABEL,
   BEG_LABEL: RANGE;
BEGIN
     STANDARD_BLOCK;
     NEW_LABEL(VAR_LABEL);
     NEW_LABEL(BEG_LABEL);
     EMIT3(PROG5,VAR_LABEL,BEG_LABEL);
     BLOCK(VAR_LABEL,BEG_LABEL,STOPS + [PERIOD1]);
     EXPECT(PERIOD1,STOPS);
     EMIT1(END_PROG5)
END;
{                                                                             }
{----                     END OF BNF RULE PROCEDURES                      ----}
{-----------------------------------------------------------------------------}

{ PROCEDURE SECOND_PASS - GOES THROUGH THE TEMP CODE AND COMPUTES LABEL       }
{                         ADDRESSES, THEN WRITES CODE TO 'TEMP2.'.            }
PROCEDURE SECOND_PASS;
VAR
   OPERATION: OPERATION_PART;
   OPERATIONX,
   OPERAND1, OPERAND2,
   K: INTEGER;
BEGIN
  FOR K:= 1 TO ROW DO
    BEGIN
      OPERATIONX:= TEMP[K,1];
      WRITE(TEMP2FILE,OPERATIONX:6);
      OPERATION:= OPERATION_PART(OPERATIONX);
      IF OPERATION IN ONE_OPERANDS
         THEN
           BEGIN
             OPERAND1:= TEMP[K,2];
             IF OPERATION IN [ARROW5,BAR5]
                THEN OPERAND1:= TABLE[OPERAND1];
             WRITE(TEMP2FILE,OPERAND1:6)
           END
      ELSE IF OPERATION IN TWO_OPERANDS
         THEN
           BEGIN
             OPERAND1:= TEMP[K,2];
             OPERAND2:= TEMP[K,3];
             IF OPERATION IN [PROC5,PROG5]
                THEN
                  BEGIN
                    OPERAND1:= TABLE[OPERAND1];
                    OPERAND2:= TABLE[OPERAND2]
                  END;
             WRITE(TEMP2FILE,OPERAND1:6);
             WRITE(TEMP2FILE,OPERAND2:6)
           END;
      WRITELN(TEMP2FILE)
    END  { FOR K }
END;     { PROCEDURE SECOND_PASS }

{-----------------------------------------------------------------------------}
{----           PROCEDURE INITIALIZE - SETS UP FOR THE RUN                ----}
{                                                                             }
PROCEDURE INITIALIZE;
VAR
   FIL: FILE;
BEGIN
     IF EXIST('TEMP2.')
        THEN
          BEGIN
            ASSIGN(FIL,'TEMP2.');
            ERASE(FIL)
          END;
     IF EXIST('ERROR2.')
        THEN
          BEGIN
            ASSIGN(FIL,'ERROR2.');
            ERASE(FIL)
          END;
     ERROPENED:= FALSE;
     MAKE_FIRSTS;
     ROW:= 0;
     ADDRESS:= 1;
     CLRSCR;
     WRITELN(
'PL PARSER - SCANS PL SCANNER CODE AND CONVERTS TO CODE FOR THE PL INTERPRETER'
     );
     LOWVIDEO;
     WRITELN(
   'PARSER V - ERROR RECOVERY, SCOPE AND TYPE ANALYSES, AND CODE GENERATION'
     );
     WRITE('AUTHOR:');
     NORMVIDEO;
     WRITE(' JAY MONFORT               ');
     LOWVIDEO;
     WRITE('FOR:');
     NORMVIDEO;
     WRITELN(' MATH 434, COMPILER DESIGN');
     LOWVIDEO;
     WRITE('DATE:');
     NORMVIDEO;
     WRITELN(' DECEMBER 11, 1986');
     WRITELN; WRITELN;
     OPEN_TEMP1;                       { OPEN SCANNER AND      }
     GOTOXY(20,9);
     LOWVIDEO;
     WRITE('LINE NUMBER: ');
     NORMVIDEO;
     OPEN_TEMP2                         {   INTERPRETER FILES....     }
END;    { PROCEDURE INITIALIZE }

{-----------------------------------------------------------------------------}
{----               PROCEDURE PARSE - STARTS UP THE PARSING               ----}
{                                                                             }
PROCEDURE PARSE;
BEGIN
     NEXTSYMBOL;
     PROGRAMX([ENDTEXT1]);
     SECOND_PASS
END;

{-----------------------------------------------------------------------------}
{----              PROCEDURE FINALIZE - ENDS EVERYTHING                   ----}
{                                                                             }
PROCEDURE FINALIZE;
VAR
   CHA: CHAR;
BEGIN
     FLUSH(TEMP2FILE);
     CLOSE(TEMP2FILE);
     CLOSE(TEMP1FILE);
     IF ERROPENED
        THEN
          BEGIN
            FLUSH(ERRFILE);
            CLOSE(ERRFILE);
            GOTOXY(10,11);
            WRITE('ERRORS FOUND IN SCANNER CODE - FILE ERROR2 EXISTS'^G^G);
            GOTOXY(20,13);
            WRITE('CONTINUE??=(Y/N)=>');
            REPEAT
                  READ(KBD,CHA)
            UNTIL UPCASE(CHA) IN ['Y','N'];
            IF UPCASE(CHA) = 'N'
               THEN HALT(100)
          END
END;   { PROCEDURE FINALIZE }



BEGIN           { PROGRAM PARSER }
     INITIALIZE;
     PARSE;
     FINALIZE
END.            { PROGRAM PARSER }