IMPLEMENTATION MODULE SimpleQP; (* Parser generated by Coco/R - assuming ISO IO library will be available. *) IMPORT SimpleQS, FileIO; IMPORT SymTab, QbeGen; 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 SimpleQS.Error(errNo, SimpleQS.line, SimpleQS.col, SimpleQS.pos); END; errDist := 0; END SemError; PROCEDURE SynError (errNo: INTEGER); BEGIN IF errDist >= minErrDist THEN SimpleQS.Error(errNo, SimpleQS.nextLine, SimpleQS.nextCol, SimpleQS.nextPos); END; errDist := 0; END SynError; PROCEDURE Get; VAR s: ARRAY [0 .. 31] OF CHAR; BEGIN REPEAT SimpleQS.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 SimpleQS.GetName(SimpleQS.pos, SimpleQS.len, Lex) END LexName; PROCEDURE LexString (VAR Lex: ARRAY OF CHAR); BEGIN SimpleQS.GetString(SimpleQS.pos, SimpleQS.len, Lex) END LexString; PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR); BEGIN SimpleQS.GetName(SimpleQS.nextPos, SimpleQS.nextLen, Lex) END LookAheadName; PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR); BEGIN SimpleQS.GetString(SimpleQS.nextPos, SimpleQS.nextLen, Lex) END LookAheadString; PROCEDURE Successful (): BOOLEAN; BEGIN RETURN SimpleQS.errors = 0 END Successful; (* ----- FORWARD not needed in multipass compilers PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD; PROCEDURE SetLit (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE MulOp (VAR op: INTEGER); FORWARD; PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD; PROCEDURE AddOp (VAR op: INTEGER); FORWARD; PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD; PROCEDURE Rel (VAR op: INTEGER); FORWARD; PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD; PROCEDURE Labels (sel: SymTab.TypeIndex; sq: QbeGen.QVal; lB: QbeGen.QVal); FORWARD; PROCEDURE LabelList (sel: SymTab.TypeIndex; sq: QbeGen.QVal; VAR lB: QbeGen.QVal; VAR lN: QbeGen.QVal); FORWARD; PROCEDURE Case (sel: SymTab.TypeIndex; sq: QbeGen.QVal; endL: QbeGen.QVal); FORWARD; PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN); 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 q: QbeGen.QVal); FORWARD; PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); 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 SimpleQ; FORWARD; ----- *) PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); VAR t2: SymTab.TypeIndex; q2: QbeGen.QVal; BEGIN Expr(t, q); IF (sym = 19) THEN Get; Expr(t2, q2); IF ~SymTab.SetElemCheck(t, t2) THEN SemError(222) END;; END; END Elem; PROCEDURE SetLit (VAR t: SymTab.TypeIndex); VAR first, et: SymTab.TypeIndex; qe: QbeGen.QVal; BEGIN Expect(64); t := SymTab.SetFor(SymTab.IntType());; IF In(symSet[1], sym) THEN Elem(et, qe); first := et; t := SymTab.SetFor(et);; WHILE (sym = 10) DO Get; Elem(et, qe); IF ~SymTab.SetElemCheck(first, et) THEN SemError(222) END;; 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 q: QbeGen.QVal); VAR s: ARRAY [0 .. 255] OF CHAR; t2, et, dt, st: SymTab.TypeIndex; dk: INTEGER; qd, q2: QbeGen.QVal; qnF: SymTab.Name; sfxF: BOOLEAN; BEGIN CASE sym OF 2 : Get; LexString(s); QbeGen.NormInt(s, q); t := SymTab.IntType();; | 3 : Get; LexString(s); QbeGen.NormReal(s, q); t := SymTab.RealType();; | 4 : Get; LexString(s); IF SymTab.StrLen(s) <= 3 THEN t := SymTab.CharType(); QbeGen.IntStr( QbeGen.CharVal(s), q) ELSE t := SymTab.NewStr(); SemError(230); QbeGen.CopyOp("0", q) END;; | 1 : Design(dt, dk, qd, qnF, sfxF); t := dt; QbeGen.CopyOp(qd, q);; | 21 : Get; Expr(et, q); Expect(22); t := et;; | 62, 63 : IF (sym = 62) THEN Get; ELSE Get; END; Fact(t2, q2); IF SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; IF t # SymTab.InvalidType THEN QbeGen.NotQ(q2, q) ELSE QbeGen.CopyOp("0", q) END;; | 64 : SetLit(st); t := st; SemError(230); QbeGen.CopyOp("0", q);; ELSE SynError(68); END; END Fact; PROCEDURE AddOp (VAR op: INTEGER); BEGIN IF (sym = 53) THEN Get; op := SymTab.OpAdd;; ELSIF (sym = 54) 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 q: QbeGen.QVal); VAR t2, res2: SymTab.TypeIndex; op: INTEGER; q2, qt: QbeGen.QVal; isR: BOOLEAN; BEGIN Fact(t, q); WHILE In(symSet[2], sym) DO MulOp(op); Fact(t2, q2); IF op = SymTab.OpAnd THEN IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; IF t # SymTab.InvalidType THEN QbeGen.NewTemp(qt); QbeGen.Op3("and", qt, q, q2, FALSE); QbeGen.CopyOp(qt, q) ELSE QbeGen.CopyOp("0", q) END ELSE IF SymTab.ArithCheck(t, t2, (op = SymTab.OpDiv) OR (op = SymTab.OpMod), res2) THEN t := res2 ELSE SemError(211); t := SymTab.InvalidType END; IF t # SymTab.InvalidType THEN isR := SymTab.ClassOf(t) = SymTab.ClReal; QbeGen.NewTemp(qt); IF op = SymTab.OpTimes THEN QbeGen.Op3("mul", qt, q, q2, isR) ELSIF op = SymTab.OpSlash THEN QbeGen.Op3("div", qt, q, q2, isR) ELSIF op = SymTab.OpDiv THEN QbeGen.Op3("div", qt, q, q2, FALSE) ELSE QbeGen.Op3("rem", qt, q, q2, FALSE) END; QbeGen.CopyOp(qt, q) ELSE QbeGen.CopyOp("0", q) END END;; END; END Term; PROCEDURE Rel (VAR op: INTEGER); BEGIN CASE sym OF 16 : Get; op := SymTab.OpEq;; | 46 : Get; op := SymTab.OpNeq1;; | 47 : Get; op := SymTab.OpNeq2;; | 48 : Get; op := SymTab.OpLt;; | 49 : Get; op := SymTab.OpLe;; | 50 : Get; op := SymTab.OpGt;; | 51 : Get; op := SymTab.OpGe;; | 52 : Get; op := SymTab.OpIn;; ELSE SynError(70); END; END Rel; PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); VAR t2, res2: SymTab.TypeIndex; op: INTEGER; q2, qt: QbeGen.QVal; neg, isR: BOOLEAN; BEGIN neg := FALSE;; IF (sym = 53) OR (sym = 54) THEN IF (sym = 53) THEN Get; ELSE Get; neg := TRUE;; END; END; Term(t, q); IF neg THEN IF QbeGen.IsImm(q) THEN QbeGen.NegFold(q, q) ELSE QbeGen.NewTemp(qt); QbeGen.NegQ(q, qt, SymTab.ClassOf(t) = SymTab.ClReal); QbeGen.CopyOp(qt, q) END END;; WHILE (sym = 53) OR (sym = 54) OR (sym = 55) DO AddOp(op); Term(t2, q2); IF op = SymTab.OpOr THEN IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; IF t # SymTab.InvalidType THEN QbeGen.NewTemp(qt); QbeGen.Op3("or", qt, q, q2, FALSE); QbeGen.CopyOp(qt, q) ELSE QbeGen.CopyOp("0", q) END ELSE IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2 ELSE SemError(211); t := SymTab.InvalidType END; IF t # SymTab.InvalidType THEN isR := SymTab.ClassOf(t) = SymTab.ClReal; QbeGen.NewTemp(qt); IF op = SymTab.OpAdd THEN QbeGen.Op3("add", qt, q, q2, isR) ELSE QbeGen.Op3("sub", qt, q, q2, isR) END; QbeGen.CopyOp(qt, q) ELSE QbeGen.CopyOp("0", q) END END;; END; END SimExpr; PROCEDURE Labels (sel: SymTab.TypeIndex; sq: QbeGen.QVal; lB: QbeGen.QVal); VAR t, t2: SymTab.TypeIndex; q, q2, qk, qg, ql, qb: QbeGen.QVal; lC: QbeGen.QVal; r, hasRange: BOOLEAN; BEGIN ConstExpr(t, q); IF ~SymTab.EqCheck(t, sel) THEN SemError(213) END; r := (SymTab.ClassOf(sel) = SymTab.ClReal) & (SymTab.ClassOf(t) = SymTab.ClReal); hasRange := FALSE;; IF (sym = 19) THEN Get; ConstExpr(t2, q2); IF ~SymTab.EqCheck(t2, sel) THEN SemError(213) END; hasRange := TRUE;; END; IF hasRange THEN QbeGen.Cmp(SymTab.OpGe, sq, q, qg, r); QbeGen.Cmp(SymTab.OpLe, sq, q2, ql, r); QbeGen.NewTemp(qb); QbeGen.Op3("and", qb, qg, ql, FALSE) ELSE QbeGen.Cmp(SymTab.OpEq, sq, q, qb, r) END; QbeGen.NewLabel(lC); QbeGen.Jnz(qb, lB, lC); QbeGen.EmitLabel(lC);; END Labels; PROCEDURE LabelList (sel: SymTab.TypeIndex; sq: QbeGen.QVal; VAR lB: QbeGen.QVal; VAR lN: QbeGen.QVal); BEGIN QbeGen.NewLabel(lB); QbeGen.NewLabel(lN);; Labels(sel, sq, lB); WHILE (sym = 10) DO Get; Labels(sel, sq, lB); END; QbeGen.Jmp(lN);; END LabelList; PROCEDURE Case (sel: SymTab.TypeIndex; sq: QbeGen.QVal; endL: QbeGen.QVal); VAR lB, lN: QbeGen.QVal; BEGIN IF In(symSet[1], sym) THEN LabelList(sel, sq, lB, lN); Expect(17); QbeGen.EmitLabel(lB);; StatSeq; QbeGen.Jmp(endL); QbeGen.EmitLabel(lN);; END; END Case; PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN); VAR n, m: SymTab.Name; it: SymTab.TypeIndex; qr: QbeGen.QVal; cls: INTEGER; BEGIN GetIdent(n); QbeGen.CopyOp(n, qn); sfx := FALSE; IF ~SymTab.Lookup(n) THEN SemError(201); t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q) ELSE t := SymTab.SymType(n); k := SymTab.SymKind(n); IF k = SymTab.KindConst THEN IF SymTab.Equal(n, "TRUE") THEN t := SymTab.BoolType(); QbeGen.CopyOp("1", q) ELSIF SymTab.Equal(n, "FALSE") THEN t := SymTab.BoolType(); QbeGen.CopyOp("0", q) 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 QbeGen.LoadVar(n, cls = SymTab.ClReal, q) ELSE QbeGen.CopyOp("0", q) 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) THEN QbeGen.LoadVar(n, cls = SymTab.ClReal, q) ELSE SemError(230); QbeGen.CopyOp("0", q) END ELSE QbeGen.CopyOp("0", q); IF k = SymTab.KindField THEN IF ~QbeGen.NoQbe() THEN SemError(230) END ELSIF k = SymTab.KindImport THEN SemError(230) END END END;; WHILE (sym = 7) OR (sym = 18) OR (sym = 45) DO IF (sym = 7) THEN Get; sfx := TRUE;; 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; QbeGen.CopyOp("0", q);; ELSIF (sym = 18) THEN Get; sfx := TRUE;; Expr(it, qr); 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; QbeGen.CopyOp("0", q);; WHILE (sym = 10) DO Get; Expr(it, qr); IF (it # SymTab.InvalidType) & ~SymTab.IsIntFamily(it) THEN SemError(218) END;; END; Expect(20); ELSE Get; sfx := TRUE; 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; QbeGen.CopyOp("0", q);; END; END; END Design; PROCEDURE WithStat; VAR dt: SymTab.TypeIndex; dk: INTEGER; dq: QbeGen.QVal; qn: SymTab.Name; sfx: BOOLEAN; pushed: BOOLEAN; BEGIN Expect(44); Design(dt, dk, dq, qn, sfx); pushed := FALSE; IF dt # SymTab.InvalidType THEN pushed := SymTab.PushRecord(dt); IF ~pushed THEN SemError(215) END END; IF pushed THEN QbeGen.NoQbeEnter; SemError(230) END;; Expect(38); StatSeq; Expect(12); IF pushed THEN SymTab.PopScope; QbeGen.NoQbeExit END;; END WithStat; PROCEDURE ForStat; VAR n, lv: SymTab.Name; lo, hi, by: SymTab.TypeIndex; qlo, qhi, qby, hiS, byS: QbeGen.QVal; qt, qk: QbeGen.QVal; lTop, lChk, lEnd: QbeGen.QVal; 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; QbeGen.CopyOp(n, lv);; Expect(30); Expr(lo, qlo); IF (lo # SymTab.InvalidType) & ~SymTab.IsIntFamily(lo) THEN SemError(220) END; IF (lo # SymTab.InvalidType) & SymTab.IsIntFamily(lo) THEN QbeGen.StoreVar(lv, qlo, FALSE) ELSE QbeGen.StoreVar(lv, "0", FALSE) END;; Expect(28); Expr(hi, qhi); IF (hi # SymTab.InvalidType) & ~SymTab.IsIntFamily(hi) THEN SemError(220) END; QbeGen.CopyOp(qhi, hiS); QbeGen.CopyOp("1", byS); neg := FALSE; by := SymTab.IntType();; IF (sym = 43) THEN Get; ConstExpr(by, qby); IF (by # SymTab.InvalidType) & ~SymTab.IsIntFamily(by) THEN SemError(220) END; IF QbeGen.IsImm(qby) THEN QbeGen.CopyOp(qby, byS); neg := QbeGen.IsNeg(qby) ELSE SemError(230); QbeGen.CopyOp("1", byS); neg := FALSE END;; END; Expect(38); QbeGen.NewLabel(lTop); QbeGen.NewLabel(lChk); QbeGen.NewLabel(lEnd); QbeGen.Jmp(lChk); QbeGen.EmitLabel(lTop);; StatSeq; Expect(12); QbeGen.LoadVar(lv, FALSE, qt); QbeGen.NewTemp(qk); QbeGen.Op3("add", qk, qt, byS, FALSE); QbeGen.StoreVar(lv, qk, FALSE); QbeGen.EmitLabel(lChk); QbeGen.LoadVar(lv, FALSE, qt); QbeGen.NewTemp(qk); IF neg THEN QbeGen.Op3("csgew", qk, qt, hiS, FALSE) ELSE QbeGen.Op3("cslew", qk, qt, hiS, FALSE) END; QbeGen.Jnz(qk, lTop, lEnd); QbeGen.EmitLabel(lEnd);; END ForStat; PROCEDURE LoopStat; VAR lTop, lE: QbeGen.QVal; BEGIN Expect(41); QbeGen.NewLabel(lTop); QbeGen.NewLabel(lE); QbeGen.EmitLabel(lTop); QbeGen.PushLoop(lE);; StatSeq; Expect(12); QbeGen.Jmp(lTop); QbeGen.EmitLabel(lE); QbeGen.PopLoop;; END LoopStat; PROCEDURE RepeatStat; VAR t: SymTab.TypeIndex; q: QbeGen.QVal; lTop, lE: QbeGen.QVal; BEGIN Expect(39); QbeGen.NewLabel(lTop); QbeGen.NewLabel(lE); QbeGen.EmitLabel(lTop);; StatSeq; Expect(40); Expr(t, q); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; QbeGen.Jnz(q, lE, lTop); QbeGen.EmitLabel(lE);; END RepeatStat; PROCEDURE WhileStat; VAR t: SymTab.TypeIndex; q: QbeGen.QVal; lC, lB, lE: QbeGen.QVal; BEGIN Expect(37); QbeGen.NewLabel(lC); QbeGen.NewLabel(lB); QbeGen.NewLabel(lE); QbeGen.EmitLabel(lC);; Expr(t, q); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; QbeGen.Jnz(q, lB, lE); QbeGen.EmitLabel(lB);; Expect(38); StatSeq; Expect(12); QbeGen.Jmp(lC); QbeGen.EmitLabel(lE);; END WhileStat; PROCEDURE CaseStat; VAR st: SymTab.TypeIndex; sq: QbeGen.QVal; lEnd: QbeGen.QVal; BEGIN Expect(35); Expr(st, sq); Expect(24); QbeGen.NewLabel(lEnd);; Case(st, sq, lEnd); WHILE (sym = 36) DO Get; Case(st, sq, lEnd); END; IF (sym = 34) THEN Get; StatSeq; END; Expect(12); QbeGen.EmitLabel(lEnd);; END CaseStat; PROCEDURE IfStat; VAR t: SymTab.TypeIndex; q: QbeGen.QVal; lThen, lElse, lEnd: QbeGen.QVal; hasElse: BOOLEAN; BEGIN Expect(31); Expr(t, q); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; QbeGen.NewLabel(lThen); QbeGen.NewLabel(lElse); QbeGen.NewLabel(lEnd); QbeGen.Jnz(q, lThen, lElse); QbeGen.EmitLabel(lThen); hasElse := FALSE;; Expect(32); StatSeq; WHILE (sym = 33) DO Get; QbeGen.Jmp(lEnd); QbeGen.EmitLabel(lElse);; Expr(t, q); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; QbeGen.NewLabel(lThen); QbeGen.NewLabel(lElse); QbeGen.Jnz(q, lThen, lElse); QbeGen.EmitLabel(lThen);; Expect(32); StatSeq; END; IF (sym = 34) THEN Get; QbeGen.Jmp(lEnd); QbeGen.EmitLabel(lElse); hasElse := TRUE;; StatSeq; END; Expect(12); IF ~hasElse THEN QbeGen.EmitLabel(lElse) END; QbeGen.EmitLabel(lEnd);; END IfStat; PROCEDURE Assign; VAR dt, et: SymTab.TypeIndex; dk: INTEGER; qd, qe, qt: QbeGen.QVal; qn: SymTab.Name; sfx: BOOLEAN; isR, conv: BOOLEAN; BEGIN Design(dt, dk, qd, qn, sfx); Expect(30); Expr(et, qe); 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 ~sfx & (dk = SymTab.KindVar) THEN IF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.StoreVar(qn, qt, TRUE) ELSE QbeGen.StoreVar(qn, qe, isR) END END;; END Assign; PROCEDURE Stat; VAR lx: QbeGen.QVal; BEGIN IF In(symSet[3], sym) THEN CASE sym OF 1 : Assign; | 31 : IfStat; | 35 : CaseStat; | 37 : WhileStat; | 39 : RepeatStat; | 41 : LoopStat; | 42 : ForStat; | 44 : WithStat; | 29 : Get; IF QbeGen.TopLoop(lx) THEN QbeGen.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; qs: QbeGen.QVal; 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); QbeGen.IntStr(ord, qs); QbeGen.DeclConst(n, qs, t); INC(ord);; WHILE (sym = 10) DO Get; GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); QbeGen.IntStr(ord, qs); QbeGen.DeclConst(n, qs, t); 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; qs: QbeGen.QVal; 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; q1, q2: QbeGen.QVal; BEGIN IF (sym = 1) THEN QualIdent(t); IF (sym = 18) THEN Get; ConstExpr(t1, q1); 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, q2); 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);; END; ELSIF (sym = 18) THEN Get; ConstExpr(t1, q1); 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, q2); 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);; ELSIF (sym = 21) THEN Enum(t); ELSE SynError(71); 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(72); END; END Type; PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); VAR t2: SymTab.TypeIndex; tc, op: INTEGER; q2, qk: QbeGen.QVal; r: BOOLEAN; BEGIN SimExpr(t, q); IF In(symSet[4], sym) THEN Rel(op); SimExpr(t2, q2); IF op = SymTab.OpIn THEN IF SymTab.InCheck(t, t2) THEN t := SymTab.BoolType(); SemError(230) ELSE SemError(222); t := SymTab.InvalidType END; QbeGen.CopyOp("0", q) 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; QbeGen.Cmp(op, q, q2, qk, r); QbeGen.CopyOp(qk, q) ELSE QbeGen.CopyOp("0", q) END END;; END; END Expr; PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); BEGIN Expr(t, q); 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) THEN SemError(230) END; i := 0; WHILE i < SymTab.PendCount() DO SymTab.PendName(i, nm); QbeGen.DeclVar(nm, t); 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; qv: QbeGen.QVal; cls: INTEGER; BEGIN GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; Expect(16); ConstExpr(t, qv); SymTab.SetSymType(n, t); cls := SymTab.ClassOf(t); IF cls = SymTab.ClStr THEN SemError(230) ELSIF ~QbeGen.IsImm(qv) THEN SemError(230) END; QbeGen.DeclConst(n, qv, t);; 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(73); 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; QbeGen.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(74); END; END Import; PROCEDURE GetIdent (VAR n: SymTab.Name); BEGIN Expect(1); LexName(n);; END GetIdent; PROCEDURE SimpleQ; VAR m1, m2: SymTab.Name; BEGIN Expect(5); GetIdent(m1); SymTab.Init; QbeGen.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); QbeGen.EndModule; SymTab.PrintTable;; END SimpleQ; PROCEDURE Parse; BEGIN SimpleQS.Reset; Get; SimpleQ; 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{}; symSet[ 1, 3] := BITSET{5, 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, 12}; symSet[ 3, 3] := BITSET{}; symSet[ 3, 4] := BITSET{}; symSet[ 4, 0] := BITSET{}; symSet[ 4, 1] := BITSET{0}; symSet[ 4, 2] := BITSET{14, 15}; symSet[ 4, 3] := BITSET{0, 1, 2, 3, 4}; symSet[ 4, 4] := BITSET{}; END SimpleQP.