IMPLEMENTATION MODULE PascalP; (* Parser generated by Coco/R - assuming ISO IO library will be available. *) IMPORT PascalS, FileIO; CONST maxT = 62; minErrDist = 2; (* minimal distance (good tokens) between two errors *) setsize = 16; (* sets are stored in 16 bits *) TYPE SymbolSet = ARRAY [0 .. maxT DIV setsize] OF BITSET; VAR symSet: ARRAY [0 .. 4] OF SymbolSet; (*symSet[0] = allSyncSyms*) errDist: CARDINAL; (* number of symbols recognized since last error *) sym: CARDINAL; (* current input symbol *) PROCEDURE SemError (errNo: INTEGER); BEGIN IF errDist >= minErrDist THEN PascalS.Error(errNo, PascalS.line, PascalS.col, PascalS.pos); END; errDist := 0; END SemError; PROCEDURE SynError (errNo: INTEGER); BEGIN IF errDist >= minErrDist THEN PascalS.Error(errNo, PascalS.nextLine, PascalS.nextCol, PascalS.nextPos); END; errDist := 0; END SynError; PROCEDURE Get; VAR s: ARRAY [0 .. 31] OF CHAR; BEGIN REPEAT PascalS.Get(sym); IF sym <= maxT THEN INC(errDist); ELSE END; UNTIL sym <= maxT END Get; PROCEDURE In (VAR s: SymbolSet; x: CARDINAL): BOOLEAN; BEGIN RETURN x MOD setsize IN s[x DIV setsize]; END In; PROCEDURE Expect (n: CARDINAL); BEGIN IF sym = n THEN Get ELSE SynError(n) END END Expect; PROCEDURE ExpectWeak (n, follow: CARDINAL); BEGIN IF sym = n THEN Get ELSE SynError(n); WHILE ~ In(symSet[follow], sym) DO Get END END END ExpectWeak; PROCEDURE WeakSeparator (n, syFol, repFol: CARDINAL): BOOLEAN; VAR s: SymbolSet; i: CARDINAL; BEGIN IF sym = n THEN Get; RETURN TRUE ELSIF In(symSet[repFol], sym) THEN RETURN FALSE ELSE i := 0; WHILE i <= maxT DIV setsize DO s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i]; INC(i) END; SynError(n); WHILE ~ In(s, sym) DO Get END; RETURN In(symSet[syFol], sym) END END WeakSeparator; PROCEDURE LexName (VAR Lex: ARRAY OF CHAR); BEGIN PascalS.GetName(PascalS.pos, PascalS.len, Lex) END LexName; PROCEDURE LexString (VAR Lex: ARRAY OF CHAR); BEGIN PascalS.GetString(PascalS.pos, PascalS.len, Lex) END LexString; PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR); BEGIN PascalS.GetName(PascalS.nextPos, PascalS.nextLen, Lex) END LookAheadName; PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR); BEGIN PascalS.GetString(PascalS.nextPos, PascalS.nextLen, Lex) END LookAheadString; PROCEDURE Successful (): BOOLEAN; BEGIN RETURN PascalS.errors = 0 END Successful; (* ----- FORWARD not needed in multipass compilers PROCEDURE Member; FORWARD; PROCEDURE ExpList; FORWARD; PROCEDURE SetConstructor; FORWARD; PROCEDURE UnsignedLiteral; FORWARD; PROCEDURE MulOp; FORWARD; PROCEDURE Factor; FORWARD; PROCEDURE AddOp; FORWARD; PROCEDURE Term; FORWARD; PROCEDURE RelOp; FORWARD; PROCEDURE SimpleExpression; FORWARD; PROCEDURE RecVarList; FORWARD; PROCEDURE ControlVariable; FORWARD; PROCEDURE CaseLabel; FORWARD; PROCEDURE OneCase; FORWARD; PROCEDURE CaseList; FORWARD; PROCEDURE OrdinalExpression; FORWARD; PROCEDURE BooleanExpression; FORWARD; PROCEDURE IntegerExpression; FORWARD; PROCEDURE FieldWidth; FORWARD; PROCEDURE ActualParameter; FORWARD; PROCEDURE ActualParams; FORWARD; PROCEDURE Expression; FORWARD; PROCEDURE Designator; FORWARD; PROCEDURE WithStatement; FORWARD; PROCEDURE ForStatement; FORWARD; PROCEDURE CaseStatement; FORWARD; PROCEDURE IfStatement; FORWARD; PROCEDURE RepeatStatement; FORWARD; PROCEDURE WhileStatement; FORWARD; PROCEDURE GotoStatement; FORWARD; PROCEDURE AssignmentOrCall; FORWARD; PROCEDURE Statement; FORWARD; PROCEDURE StatementSequence; FORWARD; PROCEDURE CompoundStatement; FORWARD; PROCEDURE IndexSpec; FORWARD; PROCEDURE IndexSpecList; FORWARD; PROCEDURE ParamType; FORWARD; PROCEDURE ParamGroup; FORWARD; PROCEDURE FormalSection; FORWARD; PROCEDURE ReturnType; FORWARD; PROCEDURE FormalParams; FORWARD; PROCEDURE Body; FORWARD; PROCEDURE FuncHeading; FORWARD; PROCEDURE ProcHeading; FORWARD; PROCEDURE VarDecl; FORWARD; PROCEDURE CaseLabelList; FORWARD; PROCEDURE Variant; FORWARD; PROCEDURE VariantSelector; FORWARD; PROCEDURE RecordSection; FORWARD; PROCEDURE VariantPart; FORWARD; PROCEDURE fixedPart; FORWARD; PROCEDURE FieldList; FORWARD; PROCEDURE IndexList; FORWARD; PROCEDURE FileType; FORWARD; PROCEDURE SetType; FORWARD; PROCEDURE RecordType; FORWARD; PROCEDURE ArrayType; FORWARD; PROCEDURE SubrangeType; FORWARD; PROCEDURE EnumerationType; FORWARD; PROCEDURE TypeIdent; FORWARD; PROCEDURE StructType; FORWARD; PROCEDURE SimpleType; FORWARD; PROCEDURE Type; FORWARD; PROCEDURE TypeDef; FORWARD; PROCEDURE UnsignedReal; FORWARD; PROCEDURE String; FORWARD; PROCEDURE ConstIdent; FORWARD; PROCEDURE UnsignedNumber; FORWARD; PROCEDURE Constant; FORWARD; PROCEDURE ConstDef; FORWARD; PROCEDURE UnsignedInt; FORWARD; PROCEDURE Label; FORWARD; PROCEDURE Labels; FORWARD; PROCEDURE ProcDeclarations; FORWARD; PROCEDURE VarDeclarations; FORWARD; PROCEDURE TypeDefinitions; FORWARD; PROCEDURE ConstDefinitions; FORWARD; PROCEDURE LabelDeclarations; FORWARD; PROCEDURE StatementPart; FORWARD; PROCEDURE DeclarationPart; FORWARD; PROCEDURE NewIdentList; FORWARD; PROCEDURE Block; FORWARD; PROCEDURE ExternalFiles; FORWARD; PROCEDURE NewIdent; FORWARD; PROCEDURE Pascal; FORWARD; ----- *) PROCEDURE Member; BEGIN Expression; IF (sym = 19) THEN Get; Expression; END; END Member; PROCEDURE ExpList; BEGIN Expression; WHILE (sym = 11) DO Get; Expression; END; END ExpList; PROCEDURE SetConstructor; BEGIN Expect(21); Member; WHILE (sym = 11) DO Get; Member; END; Expect(22); END SetConstructor; PROCEDURE UnsignedLiteral; BEGIN IF (sym = 2) OR (sym = 3) THEN UnsignedNumber; ELSIF (sym = 61) THEN Get; ELSIF (sym = 4) THEN String; ELSE SynError(63); END; END UnsignedLiteral; PROCEDURE MulOp; BEGIN IF (sym = 55) THEN Get; ELSIF (sym = 56) THEN Get; ELSIF (sym = 57) THEN Get; ELSIF (sym = 58) THEN Get; ELSIF (sym = 59) THEN Get; ELSE SynError(64); END; END MulOp; PROCEDURE Factor; BEGIN IF (sym = 1) THEN Designator; IF (sym = 8) THEN ActualParams; END; ELSIF (sym = 2) OR (sym = 3) OR (sym = 4) OR (sym = 61) THEN UnsignedLiteral; ELSIF (sym = 21) THEN SetConstructor; ELSIF (sym = 8) THEN Get; Expression; Expect(9); ELSIF (sym = 60) THEN Get; Factor; ELSE SynError(65); END; END Factor; PROCEDURE AddOp; BEGIN IF (sym = 14) THEN Get; ELSIF (sym = 15) THEN Get; ELSIF (sym = 54) THEN Get; ELSE SynError(66); END; END AddOp; PROCEDURE Term; BEGIN Factor; WHILE (sym = 55) OR (sym = 56) OR (sym = 57) OR (sym = 58) OR (sym = 59) DO MulOp; Factor; END; END Term; PROCEDURE RelOp; BEGIN CASE sym OF 13 : Get; | 48 : Get; | 49 : Get; | 50 : Get; | 51 : Get; | 52 : Get; | 53 : Get; ELSE SynError(67); END; END RelOp; PROCEDURE SimpleExpression; BEGIN IF (sym = 14) THEN Get; Term; ELSIF (sym = 15) THEN Get; Term; ELSIF In(symSet[1], sym) THEN Term; ELSE SynError(68); END; WHILE (sym = 14) OR (sym = 15) OR (sym = 54) DO AddOp; Term; END; END SimpleExpression; PROCEDURE RecVarList; BEGIN Designator; WHILE (sym = 11) DO Get; Designator; END; END RecVarList; PROCEDURE ControlVariable; BEGIN Expect(1); END ControlVariable; PROCEDURE CaseLabel; BEGIN Constant; END CaseLabel; PROCEDURE OneCase; BEGIN CaseLabelList; Expect(28); Statement; END OneCase; PROCEDURE CaseList; BEGIN OneCase; WHILE (sym = 6) DO Get; OneCase; END; IF (sym = 6) THEN Get; END; END CaseList; PROCEDURE OrdinalExpression; BEGIN Expression; END OrdinalExpression; PROCEDURE BooleanExpression; BEGIN Expression; END BooleanExpression; PROCEDURE IntegerExpression; BEGIN Expression; END IntegerExpression; PROCEDURE FieldWidth; BEGIN Expect(28); IntegerExpression; IF (sym = 28) THEN Get; IntegerExpression; END; END FieldWidth; PROCEDURE ActualParameter; BEGIN Expression; IF (sym = 28) THEN FieldWidth; END; END ActualParameter; PROCEDURE ActualParams; BEGIN Expect(8); ActualParameter; WHILE (sym = 11) DO Get; ActualParameter; END; Expect(9); END ActualParams; PROCEDURE Expression; BEGIN SimpleExpression; IF In(symSet[2], sym) THEN RelOp; SimpleExpression; END; END Expression; PROCEDURE Designator; BEGIN Expect(1); WHILE (sym = 7) OR (sym = 18) OR (sym = 21) DO IF (sym = 7) THEN Get; Expect(1); ELSIF (sym = 21) THEN Get; ExpList; Expect(22); ELSE Get; END; END; END Designator; PROCEDURE WithStatement; BEGIN Expect(47); RecVarList; Expect(38); Statement; END WithStatement; PROCEDURE ForStatement; BEGIN Expect(44); ControlVariable; Expect(35); OrdinalExpression; IF (sym = 45) THEN Get; ELSIF (sym = 46) THEN Get; ELSE SynError(69); END; OrdinalExpression; Expect(38); Statement; END ForStatement; PROCEDURE CaseStatement; BEGIN Expect(29); OrdinalExpression; Expect(23); CaseList; Expect(25); END CaseStatement; PROCEDURE IfStatement; BEGIN Expect(41); BooleanExpression; Expect(42); Statement; IF (sym = 43) THEN Get; Statement; END; END IfStatement; PROCEDURE RepeatStatement; BEGIN Expect(39); StatementSequence; Expect(40); BooleanExpression; END RepeatStatement; PROCEDURE WhileStatement; BEGIN Expect(37); BooleanExpression; Expect(38); Statement; END WhileStatement; PROCEDURE GotoStatement; BEGIN Expect(36); Label; END GotoStatement; PROCEDURE AssignmentOrCall; BEGIN Designator; IF (sym = 35) THEN Get; Expression; ELSIF (sym = 6) OR (sym = 8) OR (sym = 25) OR (sym = 40) OR (sym = 43) THEN IF (sym = 8) THEN ActualParams; END; ELSE SynError(70); END; END AssignmentOrCall; PROCEDURE Statement; BEGIN IF (sym = 2) THEN Label; Expect(28); END; IF In(symSet[3], sym) THEN CASE sym OF 1 : AssignmentOrCall; | 34 : CompoundStatement; | 36 : GotoStatement; | 37 : WhileStatement; | 39 : RepeatStatement; | 41 : IfStatement; | 29 : CaseStatement; | 44 : ForStatement; | 47 : WithStatement; END; END; END Statement; PROCEDURE StatementSequence; BEGIN Statement; WHILE (sym = 6) DO Get; Statement; END; END StatementSequence; PROCEDURE CompoundStatement; BEGIN Expect(34); StatementSequence; Expect(25); END CompoundStatement; PROCEDURE IndexSpec; BEGIN NewIdent; Expect(19); NewIdent; Expect(28); TypeIdent; END IndexSpec; PROCEDURE IndexSpecList; BEGIN IndexSpec; WHILE (sym = 6) DO Get; IndexSpec; END; END IndexSpecList; PROCEDURE ParamType; BEGIN IF (sym = 1) THEN TypeIdent; ELSIF (sym = 20) THEN Get; Expect(21); IndexSpecList; Expect(22); Expect(23); ParamType; ELSIF (sym = 17) THEN Get; Expect(20); Expect(21); IndexSpec; Expect(22); Expect(23); TypeIdent; ELSE SynError(71); END; END ParamType; PROCEDURE ParamGroup; BEGIN NewIdentList; Expect(28); ParamType; END ParamGroup; PROCEDURE FormalSection; BEGIN IF (sym = 1) OR (sym = 30) THEN IF (sym = 30) THEN Get; END; ParamGroup; ELSIF (sym = 31) THEN ProcHeading; ELSIF (sym = 32) THEN FuncHeading; ELSE SynError(72); END; END FormalSection; PROCEDURE ReturnType; BEGIN IF (sym = 28) THEN Get; TypeIdent; END; END ReturnType; PROCEDURE FormalParams; BEGIN Expect(8); FormalSection; WHILE (sym = 6) DO Get; FormalSection; END; Expect(9); END FormalParams; PROCEDURE Body; BEGIN IF In(symSet[4], sym) THEN Block; ELSIF (sym = 33) THEN Get; ELSE SynError(73); END; END Body; PROCEDURE FuncHeading; BEGIN Expect(32); NewIdent; IF (sym = 8) THEN FormalParams; END; ReturnType; END FuncHeading; PROCEDURE ProcHeading; BEGIN Expect(31); NewIdent; IF (sym = 8) THEN FormalParams; END; END ProcHeading; PROCEDURE VarDecl; BEGIN NewIdentList; Expect(28); Type; Expect(6); END VarDecl; PROCEDURE CaseLabelList; BEGIN CaseLabel; WHILE (sym = 11) DO Get; CaseLabel; END; END CaseLabelList; PROCEDURE Variant; BEGIN CaseLabelList; Expect(28); Expect(8); FieldList; Expect(9); END Variant; PROCEDURE VariantSelector; BEGIN IF (sym = 1) THEN NewIdent; Expect(28); END; TypeIdent; END VariantSelector; PROCEDURE RecordSection; BEGIN NewIdentList; Expect(28); Type; END RecordSection; PROCEDURE VariantPart; BEGIN Expect(29); VariantSelector; Expect(23); Variant; WHILE (sym = 6) DO Get; Variant; END; END VariantPart; PROCEDURE fixedPart; BEGIN RecordSection; WHILE (sym = 6) DO Get; RecordSection; END; END fixedPart; PROCEDURE FieldList; BEGIN IF (sym = 1) OR (sym = 29) THEN IF (sym = 1) THEN fixedPart; IF (sym = 6) THEN Get; VariantPart; END; ELSE VariantPart; END; IF (sym = 6) THEN Get; END; END; END FieldList; PROCEDURE IndexList; BEGIN SimpleType; WHILE (sym = 11) DO Get; SimpleType; END; END IndexList; PROCEDURE FileType; BEGIN Expect(27); Expect(23); Type; END FileType; PROCEDURE SetType; BEGIN Expect(26); Expect(23); SimpleType; END SetType; PROCEDURE RecordType; BEGIN Expect(24); FieldList; Expect(25); END RecordType; PROCEDURE ArrayType; BEGIN Expect(20); Expect(21); IndexList; Expect(22); Expect(23); Type; END ArrayType; PROCEDURE SubrangeType; BEGIN Constant; Expect(19); Constant; END SubrangeType; PROCEDURE EnumerationType; BEGIN Expect(8); NewIdentList; Expect(9); END EnumerationType; PROCEDURE TypeIdent; BEGIN Expect(1); END TypeIdent; PROCEDURE StructType; BEGIN IF (sym = 20) THEN ArrayType; ELSIF (sym = 24) THEN RecordType; ELSIF (sym = 26) THEN SetType; ELSIF (sym = 27) THEN FileType; ELSE SynError(74); END; END StructType; PROCEDURE SimpleType; BEGIN IF (sym = 1) THEN TypeIdent; ELSIF (sym = 8) THEN EnumerationType; ELSIF (sym < 16) (* prevent range error *) AND (sym IN BITSET{1, 2, 3, 4, 14, 15}) THEN SubrangeType; ELSE SynError(75); END; END SimpleType; PROCEDURE Type; BEGIN IF (sym < 16) (* prevent range error *) AND (sym IN BITSET{1, 2, 3, 4, 8, 14, 15}) THEN SimpleType; ELSIF (sym = 17) OR (sym = 20) OR (sym = 24) OR (sym = 26) OR (sym = 27) THEN IF (sym = 17) THEN Get; END; StructType; ELSIF (sym = 18) THEN Get; TypeIdent; ELSE SynError(76); END; END Type; PROCEDURE TypeDef; BEGIN NewIdent; Expect(13); Type; Expect(6); END TypeDef; PROCEDURE UnsignedReal; BEGIN Expect(3); END UnsignedReal; PROCEDURE String; BEGIN Expect(4); END String; PROCEDURE ConstIdent; BEGIN Expect(1); END ConstIdent; PROCEDURE UnsignedNumber; BEGIN IF (sym = 2) THEN UnsignedInt; ELSIF (sym = 3) THEN UnsignedReal; ELSE SynError(77); END; END UnsignedNumber; PROCEDURE Constant; BEGIN IF (sym = 1) OR (sym = 2) OR (sym = 3) OR (sym = 14) OR (sym = 15) THEN IF (sym = 14) OR (sym = 15) THEN IF (sym = 14) THEN Get; ELSE Get; END; END; IF (sym = 2) OR (sym = 3) THEN UnsignedNumber; ELSIF (sym = 1) THEN ConstIdent; ELSE SynError(78); END; ELSIF (sym = 4) THEN String; ELSE SynError(79); END; END Constant; PROCEDURE ConstDef; BEGIN NewIdent; Expect(13); Constant; Expect(6); END ConstDef; PROCEDURE UnsignedInt; BEGIN Expect(2); END UnsignedInt; PROCEDURE Label; BEGIN UnsignedInt; END Label; PROCEDURE Labels; BEGIN Label; WHILE (sym = 11) DO Get; Label; END; END Labels; PROCEDURE ProcDeclarations; BEGIN IF (sym = 31) THEN ProcHeading; ELSIF (sym = 32) THEN FuncHeading; ELSE SynError(80); END; Expect(6); Body; Expect(6); END ProcDeclarations; PROCEDURE VarDeclarations; BEGIN IF (sym = 30) THEN Get; VarDecl; WHILE (sym = 1) DO VarDecl; END; END; END VarDeclarations; PROCEDURE TypeDefinitions; BEGIN IF (sym = 16) THEN Get; TypeDef; WHILE (sym = 1) DO TypeDef; END; END; END TypeDefinitions; PROCEDURE ConstDefinitions; BEGIN IF (sym = 12) THEN Get; ConstDef; WHILE (sym = 1) DO ConstDef; END; END; END ConstDefinitions; PROCEDURE LabelDeclarations; BEGIN IF (sym = 10) THEN Get; Labels; Expect(6); END; END LabelDeclarations; PROCEDURE StatementPart; BEGIN CompoundStatement; END StatementPart; PROCEDURE DeclarationPart; BEGIN LabelDeclarations; ConstDefinitions; TypeDefinitions; VarDeclarations; WHILE (sym = 31) OR (sym = 32) DO ProcDeclarations; END; END DeclarationPart; PROCEDURE NewIdentList; BEGIN NewIdent; WHILE (sym = 11) DO Get; NewIdent; END; END NewIdentList; PROCEDURE Block; BEGIN DeclarationPart; StatementPart; END Block; PROCEDURE ExternalFiles; BEGIN Expect(8); NewIdentList; Expect(9); END ExternalFiles; PROCEDURE NewIdent; BEGIN Expect(1); END NewIdent; PROCEDURE Pascal; BEGIN Expect(5); NewIdent; IF (sym = 8) THEN ExternalFiles; END; Expect(6); Block; Expect(7); END Pascal; PROCEDURE Parse; BEGIN PascalS.Reset; Get; Pascal; END Parse; BEGIN errDist := minErrDist; symSet[ 0, 0] := BITSET{0}; symSet[ 0, 1] := BITSET{}; symSet[ 0, 2] := BITSET{}; symSet[ 0, 3] := BITSET{}; symSet[ 1, 0] := BITSET{1, 2, 3, 4, 8}; symSet[ 1, 1] := BITSET{5}; symSet[ 1, 2] := BITSET{}; symSet[ 1, 3] := BITSET{12, 13}; symSet[ 2, 0] := BITSET{13}; symSet[ 2, 1] := BITSET{}; symSet[ 2, 2] := BITSET{}; symSet[ 2, 3] := BITSET{0, 1, 2, 3, 4, 5}; symSet[ 3, 0] := BITSET{1}; symSet[ 3, 1] := BITSET{13}; symSet[ 3, 2] := BITSET{2, 4, 5, 7, 9, 12, 15}; symSet[ 3, 3] := BITSET{}; symSet[ 4, 0] := BITSET{10, 12}; symSet[ 4, 1] := BITSET{0, 14, 15}; symSet[ 4, 2] := BITSET{0, 2}; symSet[ 4, 3] := BITSET{}; END PascalP.