IMPLEMENTATION MODULE M2cP; (* Parser generated by Coco/R - assuming ISO IO library will be available. *) IMPORT M2cS, FileIO; IMPORT SymTab, MGen; CONST maxT = 66; 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 M2cS.Error(errNo, M2cS.line, M2cS.col, M2cS.pos); END; errDist := 0; END SemError; PROCEDURE SynError (errNo: INTEGER); BEGIN IF errDist >= minErrDist THEN M2cS.Error(errNo, M2cS.nextLine, M2cS.nextCol, M2cS.nextPos); END; errDist := 0; END SynError; PROCEDURE Get; VAR s: ARRAY [0 .. 31] OF CHAR; BEGIN REPEAT M2cS.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 M2cS.GetName(M2cS.pos, M2cS.len, Lex) END LexName; PROCEDURE LexString (VAR Lex: ARRAY OF CHAR); BEGIN M2cS.GetString(M2cS.pos, M2cS.len, Lex) END LexString; PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR); BEGIN M2cS.GetName(M2cS.nextPos, M2cS.nextLen, Lex) END LookAheadName; PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR); BEGIN M2cS.GetString(M2cS.nextPos, M2cS.nextLen, Lex) END LookAheadString; PROCEDURE Successful (): BOOLEAN; BEGIN RETURN M2cS.errors = 0 END Successful; (* ----- FORWARD not needed in multipass compilers PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN); FORWARD; PROCEDURE SetLit (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE MulOp (VAR op: INTEGER); FORWARD; PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); FORWARD; PROCEDURE AddOp (VAR op: INTEGER); FORWARD; PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); FORWARD; PROCEDURE Rel (VAR op: INTEGER); FORWARD; PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); FORWARD; PROCEDURE ByLit (VAR v: INTEGER); FORWARD; PROCEDURE Labels (sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER); FORWARD; PROCEDURE LabelList (sel: SymTab.TypeIndex; tmp: INTEGER; VAR lB: INTEGER; VAR lN: INTEGER); FORWARD; PROCEDURE Case (sel: SymTab.TypeIndex; tmp: INTEGER; endL: INTEGER); FORWARD; PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr); FORWARD; PROCEDURE WithStat; FORWARD; PROCEDURE ForStat; FORWARD; PROCEDURE LoopStat; FORWARD; PROCEDURE RepeatStat; FORWARD; PROCEDURE WhileStat; FORWARD; PROCEDURE CaseStat; FORWARD; PROCEDURE IfStat; FORWARD; PROCEDURE Assign; FORWARD; PROCEDURE Stat; FORWARD; PROCEDURE FieldIdents (rt: SymTab.TypeIndex); FORWARD; PROCEDURE Field (rt: SymTab.TypeIndex); FORWARD; PROCEDURE FieldSeq (rt: SymTab.TypeIndex); FORWARD; PROCEDURE Enum (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE PointerType (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE SetType (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE RecordType (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE ArrayType (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE SimpleType (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE QualIdent (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE VarIdents; FORWARD; PROCEDURE Type (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); FORWARD; PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); FORWARD; PROCEDURE VarDecl; FORWARD; PROCEDURE TypeDecl; FORWARD; PROCEDURE ConstDecl; FORWARD; PROCEDURE StatSeq; FORWARD; PROCEDURE Declaration; FORWARD; PROCEDURE ImportList; FORWARD; PROCEDURE Block; FORWARD; PROCEDURE Import; FORWARD; PROCEDURE GetIdent (VAR n: SymTab.Name); FORWARD; PROCEDURE M2c; FORWARD; ----- *) PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN); VAR t2: SymTab.TypeIndex; BEGIN Expr(t, lx); hasR := FALSE; lx2[0] := 0C;; IF (sym = 19) THEN Get; Expr(t2, lx2); IF ~SymTab.SetElemCheck(t, t2) THEN SemError(222) END; hasR := TRUE;; END; END Elem; PROCEDURE SetLit (VAR t: SymTab.TypeIndex); VAR first, et: SymTab.TypeIndex; lxE, lxE2: MGen.LitStr; hasR: BOOLEAN; BEGIN Expect(64); MGen.PushInt(0); t := SymTab.SetFor(SymTab.IntType());; IF In(symSet[1], sym) THEN Elem(et, lxE, lxE2, hasR); first := et; t := SymTab.SetFor(et); IF hasR THEN MGen.FieldMask ELSE MGen.Power2 END; MGen.Or;; WHILE (sym = 10) DO Get; Elem(et, lxE, lxE2, hasR); IF ~SymTab.SetElemCheck(first, et) THEN SemError(222) END; IF hasR THEN MGen.FieldMask ELSE MGen.Power2 END; MGen.Or;; END; END; Expect(65); END SetLit; PROCEDURE MulOp (VAR op: INTEGER); BEGIN CASE sym OF 56 : Get; op := SymTab.OpTimes;; | 57 : Get; op := SymTab.OpSlash;; | 58 : Get; op := SymTab.OpDiv;; | 59 : Get; op := SymTab.OpMod;; | 60 : Get; op := SymTab.OpAnd;; | 61 : Get; op := SymTab.OpAnd;; ELSE SynError(67); END; END MulOp; PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); VAR s: ARRAY [0 .. 255] OF CHAR; t2, et, dt, st: SymTab.TypeIndex; dk: INTEGER; bnF: SymTab.Name; lxD, lx2: MGen.LitStr; v: INTEGER; c: CARDINAL; b: LONGCARD; BEGIN CASE sym OF 2 : Get; LexString(s); MGen.CopyName(s, lx); IF MGen.ParseInt(s, v) THEN MGen.PushInt(v) ELSIF MGen.ParseCard(s, c) THEN MGen.PushBits( VAL(LONGCARD, c)) ELSE MGen.PushInt(0) END; t := SymTab.IntType();; | 3 : Get; LexString(s); MGen.CopyName(s, lx); IF MGen.ParseReal(s, b) THEN MGen.PushBits(b) ELSE MGen.PushBits(0H) END; t := SymTab.RealType();; | 4 : Get; LexString(s); IF SymTab.StrLen(s) <= 3 THEN t := SymTab.CharType(); MGen.CopyName(s, lx); MGen.PushInt( MGen.CharOrd(s)) ELSE t := SymTab.NewStr(); SemError(230); lx[0] := 0C; MGen.PushInt(0) END;; | 1 : Design(dt, dk, bnF, TRUE, lxD); t := dt; MGen.CopyName(lxD, lx);; | 21 : Get; Expr(et, lx); Expect(22); t := et;; | 62, 63 : IF (sym = 62) THEN Get; ELSE Get; END; Fact(t2, lx2); lx[0] := 0C; IF SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; MGen.Not;; | 64 : SetLit(st); lx[0] := 0C; t := st;; ELSE SynError(68); END; END Fact; PROCEDURE AddOp (VAR op: INTEGER); BEGIN IF (sym = 54) THEN Get; op := SymTab.OpAdd;; ELSIF (sym = 44) THEN Get; op := SymTab.OpSub;; ELSIF (sym = 55) THEN Get; op := SymTab.OpOr;; ELSE SynError(69); END; END AddOp; PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); VAR t2, res2: SymTab.TypeIndex; op: INTEGER; lx2: MGen.LitStr; isR: BOOLEAN; mt: INTEGER; BEGIN Fact(t, lx); WHILE In(symSet[2], sym) DO MulOp(op); Fact(t2, lx2); lx[0] := 0C; IF op = SymTab.OpAnd THEN IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; MGen.And ELSE IF SymTab.ArithCheck(t, t2, (op = SymTab.OpDiv) OR (op = SymTab.OpMod), res2) THEN t := res2 ELSE SemError(211); t := SymTab.InvalidType END; isR := (t # SymTab.InvalidType) & (SymTab.ClassOf(t) = SymTab.ClReal); IF op = SymTab.OpTimes THEN IF isR THEN MGen.RealMul ELSE MGen.MulU END ELSIF op = SymTab.OpSlash THEN IF isR THEN MGen.RealDiv ELSE MGen.DivI END ELSIF op = SymTab.OpDiv THEN MGen.DivI ELSE mt := MGen.TempGlobal(); MGen.ModI(mt) END END;; END; END Term; PROCEDURE Rel (VAR op: INTEGER); BEGIN CASE sym OF 16 : Get; op := SymTab.OpEq;; | 47 : Get; op := SymTab.OpNeq1;; | 48 : Get; op := SymTab.OpNeq2;; | 49 : Get; op := SymTab.OpLt;; | 50 : Get; op := SymTab.OpLe;; | 51 : Get; op := SymTab.OpGt;; | 52 : Get; op := SymTab.OpGe;; | 53 : Get; op := SymTab.OpIn;; ELSE SynError(70); END; END Rel; PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); VAR t2, res2: SymTab.TypeIndex; op: INTEGER; lx2: MGen.LitStr; neg, isR: BOOLEAN; BEGIN neg := FALSE;; IF (sym = 44) OR (sym = 54) THEN IF (sym = 54) THEN Get; ELSE Get; neg := TRUE;; END; END; Term(t, lx); IF neg THEN IF MGen.IsLit(lx) THEN MGen.NegFold(lx, lx) ELSE lx[0] := 0C END; IF SymTab.ClassOf(t) = SymTab.ClReal THEN MGen.NegReal ELSE MGen.NegInt END END;; WHILE (sym = 44) OR (sym = 54) OR (sym = 55) DO AddOp(op); Term(t2, lx2); lx[0] := 0C; IF op = SymTab.OpOr THEN IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; MGen.Or ELSE IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2 ELSE SemError(211); t := SymTab.InvalidType END; isR := (t # SymTab.InvalidType) & (SymTab.ClassOf(t) = SymTab.ClReal); IF op = SymTab.OpAdd THEN IF isR THEN MGen.RealAdd ELSE MGen.Add END ELSE IF isR THEN MGen.RealSub ELSE MGen.Sub END END END;; END; END SimExpr; PROCEDURE ByLit (VAR v: INTEGER); VAR s: ARRAY [0 .. 255] OF CHAR; BEGIN IF (sym = 2) THEN Get; LexString(s); IF ~MGen.ParseInt(s, v) THEN v := 1 END;; ELSIF (sym = 44) THEN Get; Expect(2); LexString(s); IF MGen.ParseInt(s, v) THEN v := -v ELSE v := -1 END;; ELSE SynError(71); END; END ByLit; PROCEDURE Labels (sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER); VAR t, t2: SymTab.TypeIndex; lx1, lx2: MGen.LitStr; ta, tb, chunk: INTEGER; r, hasRange: BOOLEAN; BEGIN ConstExpr(t, lx1); IF ~SymTab.EqCheck(t, sel) THEN SemError(213) END; r := (SymTab.ClassOf(sel) = SymTab.ClReal) & (SymTab.ClassOf(t) = SymTab.ClReal); ta := MGen.TempGlobal(); MGen.StoreTemp(ta); hasRange := FALSE;; IF (sym = 19) THEN Get; ConstExpr(t2, lx2); IF ~SymTab.EqCheck(t2, sel) THEN SemError(213) END; tb := MGen.TempGlobal(); MGen.StoreTemp(tb); hasRange := TRUE;; END; IF hasRange THEN MGen.LoadTemp(tmp); MGen.LoadTemp(ta); IF r THEN MGen.RealGe ELSE MGen.IGe END; MGen.LoadTemp(tmp); MGen.LoadTemp(tb); IF r THEN MGen.RealLe ELSE MGen.ILe END; MGen.And ELSE MGen.LoadTemp(tmp); MGen.LoadTemp(ta); IF r THEN MGen.RealEq ELSE MGen.Eq END END; chunk := MGen.NewLabel(); MGen.Jz(chunk); MGen.Jmp(bodyL); MGen.DefLabel(chunk);; END Labels; PROCEDURE LabelList (sel: SymTab.TypeIndex; tmp: INTEGER; VAR lB: INTEGER; VAR lN: INTEGER); BEGIN lB := MGen.NewLabel(); lN := MGen.NewLabel();; Labels(sel, tmp, lB); WHILE (sym = 10) DO Get; Labels(sel, tmp, lB); END; MGen.Jmp(lN);; END LabelList; PROCEDURE Case (sel: SymTab.TypeIndex; tmp: INTEGER; endL: INTEGER); VAR lB, lN: INTEGER; BEGIN IF In(symSet[1], sym) THEN LabelList(sel, tmp, lB, lN); Expect(17); MGen.DefLabel(lB);; StatSeq; MGen.Jmp(endL); MGen.DefLabel(lN);; END; END Case; PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr); VAR n, m: SymTab.Name; it: SymTab.TypeIndex; lxI: MGen.LitStr; cls: INTEGER; BEGIN GetIdent(n); MGen.CopyName(n, bn); lx[0] := 0C; IF ~SymTab.Lookup(n) THEN SemError(201); t := SymTab.InvalidType; k := -1; IF doLoad THEN MGen.PushInt(0) END ELSE t := SymTab.SymType(n); k := SymTab.SymKind(n); IF k = SymTab.KindConst THEN IF SymTab.Equal(n, "TRUE") THEN t := SymTab.BoolType(); MGen.CopyName("TRUE", lx); IF doLoad THEN MGen.PushInt(1) END ELSIF SymTab.Equal(n, "FALSE") THEN t := SymTab.BoolType(); MGen.CopyName("FALSE", lx); IF doLoad THEN MGen.PushInt(0) END ELSE cls := SymTab.ClassOf(t); IF (t # SymTab.InvalidType) & (cls # SymTab.ClStr) & ((cls = SymTab.ClInt) OR (cls = SymTab.ClReal) OR (cls = SymTab.ClBool) OR (cls = SymTab.ClChar) OR (cls = SymTab.ClEnum)) THEN IF doLoad THEN MGen.LoadVar(n) END ELSIF doLoad THEN MGen.PushInt(0) END END ELSIF k = SymTab.KindVar THEN cls := SymTab.ClassOf(t); IF (cls = SymTab.ClInt) OR (cls = SymTab.ClReal) OR (cls = SymTab.ClBool) OR (cls = SymTab.ClChar) OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClSet) THEN IF doLoad THEN MGen.LoadVar(n) END ELSE SemError(230); IF doLoad THEN MGen.PushInt(0) END END ELSE IF doLoad THEN MGen.PushInt(0) END; IF k = SymTab.KindField THEN IF ~MGen.NoSup() THEN SemError(230) END ELSIF k = SymTab.KindImport THEN SemError(230) END END END;; WHILE (sym = 7) OR (sym = 18) OR (sym = 46) DO IF (sym = 7) THEN Get; lx[0] := 0C;; GetIdent(m); IF t = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(t) # SymTab.ClRecord THEN SemError(215); t := SymTab.InvalidType ELSIF ~SymTab.FieldExists(t, m) THEN SemError(216); t := SymTab.InvalidType ELSE t := SymTab.FieldType(t, m); SemError(230) END; IF doLoad THEN MGen.Drop; MGen.PushInt(0) END;; ELSIF (sym = 18) THEN Get; Expr(it, lxI); MGen.Drop; IF t = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(t) # SymTab.ClArray THEN SemError(217); t := SymTab.InvalidType ELSIF (it # SymTab.InvalidType) & ~SymTab.IsIntFamily(it) THEN SemError(218); t := SymTab.InvalidType ELSE t := SymTab.ArrayElem(t); SemError(230) END; IF doLoad THEN MGen.Drop; MGen.PushInt(0) END;; WHILE (sym = 10) DO Get; Expr(it, lxI); MGen.Drop; IF (it # SymTab.InvalidType) & ~SymTab.IsIntFamily(it) THEN SemError(218) END;; END; Expect(20); ELSE Get; lx[0] := 0C; IF t = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(t) # SymTab.ClPtr THEN SemError(219); t := SymTab.InvalidType ELSE t := SymTab.PtrBase(t); SemError(230) END; IF doLoad THEN MGen.Drop; MGen.PushInt(0) END;; END; END; END Design; PROCEDURE WithStat; VAR dt: SymTab.TypeIndex; dk: INTEGER; bnW: SymTab.Name; lxW: MGen.LitStr; pushed: BOOLEAN; BEGIN Expect(45); Design(dt, dk, bnW, FALSE, lxW); pushed := FALSE; IF dt # SymTab.InvalidType THEN pushed := SymTab.PushRecord(dt); IF ~pushed THEN SemError(215) END END; IF pushed THEN MGen.NoSupEnter; SemError(230) END;; Expect(38); StatSeq; Expect(12); IF pushed THEN SymTab.PopScope; MGen.NoSupExit END;; END WithStat; PROCEDURE ForStat; VAR n, lv: SymTab.Name; lo, hi: SymTab.TypeIndex; lxLo, lxHi: MGen.LitStr; byV, ht: INTEGER; lTop, lChk, lEnd: INTEGER; neg: BOOLEAN; BEGIN Expect(42); GetIdent(n); IF ~SymTab.Lookup(n) THEN SemError(201) ELSIF (SymTab.SymKind(n) # SymTab.KindVar) & (SymTab.SymKind(n) # SymTab.KindField) THEN SemError(220) ELSIF (SymTab.SymType(n) # SymTab.InvalidType) & ~SymTab.IsIntFamily( SymTab.SymType(n)) THEN SemError(220) END; MGen.CopyName(n, lv);; Expect(30); Expr(lo, lxLo); IF (lo # SymTab.InvalidType) & ~SymTab.IsIntFamily(lo) THEN SemError(220) END; MGen.StoreVar(lv);; Expect(28); Expr(hi, lxHi); IF (hi # SymTab.InvalidType) & ~SymTab.IsIntFamily(hi) THEN SemError(220) END; ht := MGen.TempGlobal(); MGen.StoreTemp(ht); byV := 1; neg := FALSE;; IF (sym = 43) THEN Get; ByLit(byV); neg := byV < 0;; END; Expect(38); lTop := MGen.NewLabel(); lChk := MGen.NewLabel(); lEnd := MGen.NewLabel(); MGen.Jmp(lChk); MGen.DefLabel(lTop);; StatSeq; Expect(12); MGen.LoadVar(lv); MGen.PushInt(byV); MGen.Add; MGen.StoreVar(lv); MGen.DefLabel(lChk); MGen.LoadVar(lv); MGen.LoadTemp(ht); IF neg THEN MGen.IGe ELSE MGen.ILe END; MGen.Jz(lEnd); MGen.Jmp(lTop); MGen.DefLabel(lEnd);; END ForStat; PROCEDURE LoopStat; VAR topL, exitL: INTEGER; BEGIN Expect(41); topL := MGen.NewLabel(); exitL := MGen.NewLabel(); MGen.DefLabel(topL); MGen.PushLoop(exitL);; StatSeq; Expect(12); MGen.Jmp(topL); MGen.DefLabel(exitL); MGen.PopLoop;; END LoopStat; PROCEDURE RepeatStat; VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; topL: INTEGER; BEGIN Expect(39); topL := MGen.NewLabel(); MGen.DefLabel(topL);; StatSeq; Expect(40); Expr(t, lxC); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; MGen.Jz(topL);; END RepeatStat; PROCEDURE WhileStat; VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; topL, endL: INTEGER; BEGIN Expect(37); topL := MGen.NewLabel(); endL := MGen.NewLabel(); MGen.DefLabel(topL);; Expr(t, lxC); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; MGen.Jz(endL);; Expect(38); StatSeq; Expect(12); MGen.Jmp(topL); MGen.DefLabel(endL);; END WhileStat; PROCEDURE CaseStat; VAR st: SymTab.TypeIndex; lxS: MGen.LitStr; tmp, endL: INTEGER; BEGIN Expect(35); Expr(st, lxS); tmp := MGen.TempGlobal(); MGen.StoreTemp(tmp); endL := MGen.NewLabel();; Expect(24); Case(st, tmp, endL); WHILE (sym = 36) DO Get; Case(st, tmp, endL); END; IF (sym = 34) THEN Get; StatSeq; END; Expect(12); MGen.DefLabel(endL);; END CaseStat; PROCEDURE IfStat; VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; elseL, endL: INTEGER; hasElse: BOOLEAN; BEGIN Expect(31); Expr(t, lxC); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; elseL := MGen.NewLabel(); endL := MGen.NewLabel(); MGen.Jz(elseL); hasElse := FALSE;; Expect(32); StatSeq; WHILE (sym = 33) DO Get; MGen.Jmp(endL); MGen.DefLabel(elseL);; Expr(t, lxC); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; elseL := MGen.NewLabel(); MGen.Jz(elseL);; Expect(32); StatSeq; END; IF (sym = 34) THEN Get; MGen.Jmp(endL); MGen.DefLabel(elseL); hasElse := TRUE;; StatSeq; END; Expect(12); IF ~hasElse THEN MGen.DefLabel(elseL) END; MGen.DefLabel(endL);; END IfStat; PROCEDURE Assign; VAR dt, et: SymTab.TypeIndex; dk: INTEGER; bn: SymTab.Name; lxe, lxD: MGen.LitStr; isR, conv: BOOLEAN; BEGIN Design(dt, dk, bn, FALSE, lxD); Expect(30); Expr(et, lxe); IF (dt # SymTab.InvalidType) & (dk # SymTab.KindVar) & (dk # SymTab.KindField) & (dk # SymTab.KindImport) THEN SemError(210) ELSIF ~SymTab.Assignable(et, dt) THEN SemError(210) END; IF dk = SymTab.KindImport THEN SemError(230) END; isR := (dt # SymTab.InvalidType) & (SymTab.ClassOf(dt) = SymTab.ClReal); conv := isR & SymTab.IsIntFamily(et); IF dk = SymTab.KindVar THEN IF conv THEN MGen.IntToReal; END; MGen.StoreVar(bn) ELSE MGen.Drop END;; END Assign; PROCEDURE Stat; VAR lx: INTEGER; BEGIN IF In(symSet[3], sym) THEN CASE sym OF 1 : Assign; | 31 : IfStat; | 35 : CaseStat; | 37 : WhileStat; | 39 : RepeatStat; | 41 : LoopStat; | 42 : ForStat; | 45 : WithStat; | 29 : Get; IF MGen.TopLoop(lx) THEN MGen.Jmp(lx) ELSE SemError(230) END;; END; END; END Stat; PROCEDURE FieldIdents (rt: SymTab.TypeIndex); VAR n: SymTab.Name; BEGIN GetIdent(n); IF ~SymTab.FieldPending(rt, n) THEN SemError(200) END; WHILE (sym = 10) DO Get; GetIdent(n); IF ~SymTab.FieldPending(rt, n) THEN SemError(200) END; END; END FieldIdents; PROCEDURE Field (rt: SymTab.TypeIndex); VAR et: SymTab.TypeIndex; BEGIN IF (sym = 1) THEN FieldIdents(rt); Expect(17); Type(et); SymTab.FixPendingF(rt, et);; END; END Field; PROCEDURE FieldSeq (rt: SymTab.TypeIndex); BEGIN Field(rt); WHILE (sym = 6) DO Get; Field(rt); END; END FieldSeq; PROCEDURE Enum (VAR t: SymTab.TypeIndex); VAR n: SymTab.Name; ord: INTEGER; BEGIN Expect(21); t := SymTab.NewEnum(); ord := 0;; GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); MGen.DeclConstInt(n, ord); INC(ord);; WHILE (sym = 10) DO Get; GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); MGen.DeclConstInt(n, ord); INC(ord);; END; Expect(22); END Enum; PROCEDURE PointerType (VAR t: SymTab.TypeIndex); VAR b: SymTab.TypeIndex; BEGIN Expect(27); Expect(28); Type(b); t := SymTab.NewPtr(b);; END PointerType; PROCEDURE SetType (VAR t: SymTab.TypeIndex); VAR s: SymTab.TypeIndex; BEGIN Expect(26); Expect(24); SimpleType(s); IF (s # SymTab.InvalidType) & (SymTab.ClassOf(s) # SymTab.ClInt) & (SymTab.ClassOf(s) # SymTab.ClChar) & (SymTab.ClassOf(s) # SymTab.ClEnum) THEN SemError(224) END; t := SymTab.NewSet(s);; END SetType; PROCEDURE RecordType (VAR t: SymTab.TypeIndex); BEGIN Expect(25); t := SymTab.NewRecord();; FieldSeq(t); Expect(12); END RecordType; PROCEDURE ArrayType (VAR t: SymTab.TypeIndex); VAR s, s2, e: SymTab.TypeIndex; BEGIN Expect(23); SimpleType(s); IF (s # SymTab.InvalidType) & (SymTab.ClassOf(s) # SymTab.ClInt) & (SymTab.ClassOf(s) # SymTab.ClChar) & (SymTab.ClassOf(s) # SymTab.ClEnum) THEN SemError(224) END;; WHILE (sym = 10) DO Get; SimpleType(s2); IF (s2 # SymTab.InvalidType) & (SymTab.ClassOf(s2) # SymTab.ClInt) & (SymTab.ClassOf(s2) # SymTab.ClChar) & (SymTab.ClassOf(s2) # SymTab.ClEnum) THEN SemError(224) END;; END; Expect(24); Type(e); t := SymTab.NewArray(e);; END ArrayType; PROCEDURE SimpleType (VAR t: SymTab.TypeIndex); VAR t1, t2: SymTab.TypeIndex; lx1, lx2: MGen.LitStr; BEGIN IF (sym = 1) THEN QualIdent(t); IF (sym = 18) THEN Get; MGen.NoEmitEnter;; ConstExpr(t1, lx1); IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END;; Expect(19); ConstExpr(t2, lx2); IF (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t2) # SymTab.ClInt) & (SymTab.ClassOf(t2) # SymTab.ClChar) & (SymTab.ClassOf(t2) # SymTab.ClEnum) THEN SemError(224) END;; Expect(20); t := SymTab.NewSub(t1); MGen.NoEmitExit;; END; ELSIF (sym = 18) THEN Get; MGen.NoEmitEnter;; ConstExpr(t1, lx1); IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END;; Expect(19); ConstExpr(t2, lx2); IF (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t2) # SymTab.ClInt) & (SymTab.ClassOf(t2) # SymTab.ClChar) & (SymTab.ClassOf(t2) # SymTab.ClEnum) THEN SemError(224) END;; Expect(20); t := SymTab.NewSub(t1); MGen.NoEmitExit;; ELSIF (sym = 21) THEN Enum(t); ELSE SynError(72); END; END SimpleType; PROCEDURE QualIdent (VAR t: SymTab.TypeIndex); VAR n, m: SymTab.Name; BEGIN GetIdent(n); IF ~SymTab.Lookup(n) THEN SemError(201); t := SymTab.InvalidType ELSIF (SymTab.SymKind(n) # SymTab.KindType) & (SymTab.SymKind(n) # SymTab.KindPredef) & (SymTab.SymKind(n) # SymTab.KindImport) THEN SemError(221); t := SymTab.InvalidType ELSE t := SymTab.SymType(n) END;; WHILE (sym = 7) DO Get; GetIdent(m); t := SymTab.InvalidType;; END; END QualIdent; PROCEDURE VarIdents; VAR n: SymTab.Name; BEGIN GetIdent(n); IF ~SymTab.EnterPending(n, SymTab.KindVar) THEN SemError(200) END; WHILE (sym = 10) DO Get; GetIdent(n); IF ~SymTab.EnterPending(n, SymTab.KindVar) THEN SemError(200) END; END; END VarIdents; PROCEDURE Type (VAR t: SymTab.TypeIndex); BEGIN IF (sym = 1) OR (sym = 18) OR (sym = 21) THEN SimpleType(t); ELSIF (sym = 23) THEN ArrayType(t); ELSIF (sym = 25) THEN RecordType(t); ELSIF (sym = 26) THEN SetType(t); ELSIF (sym = 27) THEN PointerType(t); ELSE SynError(73); END; END Type; PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); VAR t2: SymTab.TypeIndex; tc, op: INTEGER; lx2: MGen.LitStr; r: BOOLEAN; BEGIN SimExpr(t, lx); IF In(symSet[4], sym) THEN Rel(op); SimExpr(t2, lx2); lx[0] := 0C; IF op = SymTab.OpIn THEN IF SymTab.InCheck(t, t2) THEN t := SymTab.BoolType(); MGen.BitIn ELSE SemError(222); t := SymTab.InvalidType; MGen.Drop; MGen.Drop; MGen.PushInt(0) END ELSE tc := SymTab.ClassOf(t); IF SymTab.RelCheck(t, t2, op) THEN t := SymTab.BoolType() ELSE SemError(213); t := SymTab.InvalidType END; IF t # SymTab.InvalidType THEN r := tc = SymTab.ClReal; IF r THEN IF op = SymTab.OpEq THEN MGen.RealEq ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN MGen.RealNe ELSIF op = SymTab.OpLt THEN MGen.RealLt ELSIF op = SymTab.OpLe THEN MGen.RealLe ELSIF op = SymTab.OpGt THEN MGen.RealGt ELSE MGen.RealGe END ELSE IF op = SymTab.OpEq THEN MGen.Eq ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN MGen.Neq ELSIF op = SymTab.OpLt THEN MGen.ILt ELSIF op = SymTab.OpLe THEN MGen.ILe ELSIF op = SymTab.OpGt THEN MGen.IGt ELSE MGen.IGe END END ELSE MGen.Drop; MGen.Drop; MGen.PushInt(0) END END;; END; END Expr; PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); BEGIN Expr(t, lx); END ConstExpr; PROCEDURE VarDecl; VAR t: SymTab.TypeIndex; i: CARDINAL; nm: SymTab.Name; cls: INTEGER; BEGIN VarIdents; Expect(17); Type(t); cls := SymTab.ClassOf(t); IF (cls # SymTab.ClInt) & (cls # SymTab.ClReal) & (cls # SymTab.ClBool) & (cls # SymTab.ClChar) & (cls # SymTab.ClEnum) & (cls # SymTab.ClSet) THEN SemError(230) END; i := 0; WHILE i < SymTab.PendCount() DO SymTab.PendName(i, nm); MGen.DeclVar(nm); INC(i) END; SymTab.FixPending(t);; END VarDecl; PROCEDURE TypeDecl; VAR n: SymTab.Name; t0, t1: SymTab.TypeIndex; BEGIN GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindType) THEN SemError(200) END; t0 := SymTab.NewAlias(); SymTab.SetSymType(n, t0);; Expect(16); Type(t1); IF t1 = t0 THEN SemError(223); SymTab.SetTarget(t0, SymTab.InvalidType) ELSE SymTab.SetTarget(t0, t1) END;; END TypeDecl; PROCEDURE ConstDecl; VAR n: SymTab.Name; t: SymTab.TypeIndex; lx: MGen.LitStr; cls: INTEGER; BEGIN GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; Expect(16); MGen.NoEmitEnter;; ConstExpr(t, lx); SymTab.SetSymType(n, t); cls := SymTab.ClassOf(t); IF cls = SymTab.ClStr THEN SemError(230) ELSIF ~MGen.IsLit(lx) THEN SemError(230) END; MGen.DeclConst(n, lx, t); MGen.NoEmitExit;; END ConstDecl; PROCEDURE StatSeq; BEGIN Stat; WHILE (sym = 6) DO Get; Stat; END; END StatSeq; PROCEDURE Declaration; BEGIN IF (sym = 13) THEN Get; WHILE (sym = 1) DO ConstDecl; Expect(6); END; ELSIF (sym = 14) THEN Get; WHILE (sym = 1) DO TypeDecl; Expect(6); END; ELSIF (sym = 15) THEN Get; WHILE (sym = 1) DO VarDecl; Expect(6); END; ELSE SynError(74); END; END Declaration; PROCEDURE ImportList; VAR n: SymTab.Name; BEGIN GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindImport) THEN SemError(200) END; WHILE (sym = 10) DO Get; GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindImport) THEN SemError(200) END; END; END ImportList; PROCEDURE Block; BEGIN WHILE (sym = 13) OR (sym = 14) OR (sym = 15) DO Declaration; END; IF (sym = 11) THEN Get; MGen.BeginBody;; StatSeq; END; Expect(12); END Block; PROCEDURE Import; VAR n: SymTab.Name; BEGIN IF (sym = 8) THEN Get; GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindImport) THEN SemError(200) END; Expect(9); ImportList; Expect(6); ELSIF (sym = 9) THEN Get; ImportList; Expect(6); ELSE SynError(75); END; END Import; PROCEDURE GetIdent (VAR n: SymTab.Name); BEGIN Expect(1); LexName(n);; END GetIdent; PROCEDURE M2c; VAR m1, m2: SymTab.Name; BEGIN Expect(5); GetIdent(m1); SymTab.Init; MGen.OpenModule(m1); IF ~SymTab.Enter(m1, SymTab.KindModule) THEN SemError(200) END; Expect(6); WHILE (sym = 8) OR (sym = 9) DO Import; END; Block; GetIdent(m2); IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; Expect(7); MGen.EndModule; SymTab.PrintTable;; END M2c; PROCEDURE Parse; BEGIN M2cS.Reset; Get; M2c; END Parse; BEGIN errDist := minErrDist; symSet[ 0, 0] := BITSET{0}; symSet[ 0, 1] := BITSET{}; symSet[ 0, 2] := BITSET{}; symSet[ 0, 3] := BITSET{}; symSet[ 0, 4] := BITSET{}; symSet[ 1, 0] := BITSET{1, 2, 3, 4}; symSet[ 1, 1] := BITSET{5}; symSet[ 1, 2] := BITSET{12}; symSet[ 1, 3] := BITSET{6, 14, 15}; symSet[ 1, 4] := BITSET{0}; symSet[ 2, 0] := BITSET{}; symSet[ 2, 1] := BITSET{}; symSet[ 2, 2] := BITSET{}; symSet[ 2, 3] := BITSET{8, 9, 10, 11, 12, 13}; symSet[ 2, 4] := BITSET{}; symSet[ 3, 0] := BITSET{1}; symSet[ 3, 1] := BITSET{13, 15}; symSet[ 3, 2] := BITSET{3, 5, 7, 9, 10, 13}; symSet[ 3, 3] := BITSET{}; symSet[ 3, 4] := BITSET{}; symSet[ 4, 0] := BITSET{}; symSet[ 4, 1] := BITSET{0}; symSet[ 4, 2] := BITSET{15}; symSet[ 4, 3] := BITSET{0, 1, 2, 3, 4, 5}; symSet[ 4, 4] := BITSET{}; END M2cP.