home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
interpre
/
pl
/
parser.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-12-14
|
50KB
|
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 }