IMPLEMENTATION MODULE M2cP; (* Parser generated by Coco/R - assuming ISO IO library will be available. *) IMPORT M2cS, FileIO; IMPORT SymTab, MGen; CONST maxT = 77; 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 .. 6] 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 DefProcHead; FORWARD; PROCEDURE DefDecl; FORWARD; 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; VAR v: BOOLEAN; VAR vn: SymTab.Name); FORWARD; PROCEDURE AddOp (VAR op: INTEGER); FORWARD; PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR v: BOOLEAN; VAR vn: SymTab.Name); FORWARD; PROCEDURE Rel (VAR op: INTEGER); FORWARD; PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR v: BOOLEAN; VAR vn: SymTab.Name); 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 CallTail (pn: SymTab.Name; exp: SymTab.Name; sfx: BOOLEAN; inExpr: BOOLEAN; VAR ok: BOOLEAN; hasDead: BOOLEAN); FORWARD; PROCEDURE DesignTail (VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr; VAR sfx: BOOLEAN); FORWARD; PROCEDURE DesignHead (VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr); FORWARD; PROCEDURE WriteStrStat; FORWARD; PROCEDURE WriteIntStat; FORWARD; PROCEDURE DispStat; FORWARD; PROCEDURE NewStat; FORWARD; PROCEDURE ReturnStat; FORWARD; PROCEDURE WithStat; FORWARD; PROCEDURE ForStat; FORWARD; PROCEDURE LoopStat; FORWARD; PROCEDURE RepeatStat; FORWARD; PROCEDURE WhileStat; FORWARD; PROCEDURE CaseStat; FORWARD; PROCEDURE IfStat; FORWARD; PROCEDURE AssignOrCall; 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 FPSection; FORWARD; PROCEDURE QualIdent (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE FormalParams; FORWARD; PROCEDURE VarIdents; FORWARD; PROCEDURE Type (VAR t: SymTab.TypeIndex); FORWARD; PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR v: BOOLEAN; VAR vn: SymTab.Name); FORWARD; PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); FORWARD; PROCEDURE ModuleDecl; FORWARD; PROCEDURE ProcedureDecl; FORWARD; PROCEDURE VarDecl; FORWARD; PROCEDURE TypeDecl; FORWARD; PROCEDURE ConstDecl; FORWARD; PROCEDURE StatSeq; FORWARD; PROCEDURE Declaration; FORWARD; PROCEDURE Block (isProc: BOOLEAN); FORWARD; PROCEDURE ImpItem (mod: SymTab.Name); FORWARD; PROCEDURE GetIdent (VAR n: SymTab.Name); FORWARD; PROCEDURE Import; FORWARD; PROCEDURE ProgUnit; FORWARD; PROCEDURE ImplUnit; FORWARD; PROCEDURE DefUnit; FORWARD; PROCEDURE Unit; FORWARD; PROCEDURE M2c; FORWARD; ----- *) PROCEDURE DefProcHead; VAR n: SymTab.Name; rt: SymTab.TypeIndex; hasR, ok: BOOLEAN; BEGIN Expect(16); hasR := FALSE;; GetIdent(n); IF ~SymTab.EnterProc(n) THEN SemError(200) END; SymTab.OpenProcScope;; IF (sym = 17) THEN Get; FormalParams; Expect(18); END; IF (sym = 15) THEN Get; QualIdent(rt); hasR := TRUE;; END; IF hasR THEN ok := SymTab.SetProcRet(rt) ELSE ok := SymTab.SetProcRet( SymTab.InvalidType) END; IF ~ok THEN SemError(231) END; IF ~SymTab.VerifyProc() THEN SemError(231) END; SymTab.SetForward; SymTab.CloseProc;; Expect(8); END DefProcHead; PROCEDURE DefDecl; BEGIN IF (sym = 11) THEN Get; WHILE (sym = 1) DO ConstDecl; Expect(8); END; ELSIF (sym = 12) THEN Get; WHILE (sym = 1) DO TypeDecl; Expect(8); END; ELSIF (sym = 13) THEN Get; WHILE (sym = 1) DO VarDecl; Expect(8); END; ELSIF (sym = 16) THEN DefProcHead; ELSE SynError(78); END; END DefDecl; PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN); VAR t2: SymTab.TypeIndex; vD, vD2: BOOLEAN; vnD, vnD2: SymTab.Name; BEGIN Expr(t, lx, vD, vnD); hasR := FALSE; lx2[0] := 0C;; IF (sym = 24) THEN Get; Expr(t2, lx2, vD2, vnD2); 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; vE, vE2: BOOLEAN; vnE, vnE2: SymTab.Name; hasR: BOOLEAN; BEGIN Expect(73); 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); MGen.ClrStash(); IF hasR THEN MGen.PushInt(1); MGen.Add; MGen.FieldMask ELSE MGen.Power2 END; MGen.Or;; WHILE (sym = 7) DO Get; Elem(et, lxE, lxE2, hasR); IF ~SymTab.SetElemCheck(first, et) THEN SemError(222) END; MGen.ClrStash(); IF hasR THEN MGen.PushInt(1); MGen.Add; MGen.FieldMask ELSE MGen.Power2 END; MGen.Or;; END; END; Expect(74); END SetLit; PROCEDURE MulOp (VAR op: INTEGER); BEGIN CASE sym OF 64 : Get; op := SymTab.OpTimes;; | 65 : Get; op := SymTab.OpSlash;; | 66 : Get; op := SymTab.OpDiv;; | 67 : Get; op := SymTab.OpMod;; | 68 : Get; op := SymTab.OpAnd;; | 69 : Get; op := SymTab.OpAnd;; ELSE SynError(79); END; END MulOp; PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR v: BOOLEAN; VAR vn: SymTab.Name); VAR s: ARRAY [0 .. 255] OF CHAR; t2, et, dt, st: SymTab.TypeIndex; dk: INTEGER; bnF: SymTab.Name; lxD, lx2: MGen.LitStr; v2: BOOLEAN; vn2: SymTab.Name; vi, mpF: INTEGER; c: CARDINAL; b: LONGCARD; sfxF: BOOLEAN; okF: BOOLEAN; BEGIN CASE sym OF 2 : Get; LexString(s); MGen.CopyName(s, lx); v := FALSE; MGen.ClrStash(); IF MGen.ParseInt(s, vi) THEN MGen.PushInt(vi) 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); v := FALSE; MGen.ClrStash(); IF MGen.ParseReal(s, b) THEN MGen.PushBits(b) ELSE MGen.PushBits(0H) END; t := SymTab.RealType();; | 4 : Get; LexString(s); v := FALSE; MGen.ClrStash(); IF SymTab.StrLen(s) <= 3 THEN t := SymTab.CharType(); MGen.CopyName(s, lx); MGen.PushInt( MGen.CharOrd(s)) ELSE t := SymTab.NewStr(); MGen.CopyName(s, lx); MGen.EmitString(s) END;; | 70 : Get; Expect(17); DesignHead(dt, dk, bnF, FALSE, lxD); DesignTail(dt, dk, bnF, FALSE, lxD, sfxF); Expect(18); lx[0] := 0C; v := FALSE; MGen.ClrStash(); IF dt = SymTab.InvalidType THEN IF sfxF THEN MGen.Drop END; MGen.PushInt(0); t := SymTab.InvalidType ELSIF SymTab.ClassOf(dt) # SymTab.ClArray THEN SemError(217); IF sfxF THEN MGen.Drop END; MGen.PushInt(0); t := SymTab.InvalidType ELSIF SymTab.IsOpen(dt) THEN IF sfxF THEN MGen.Drop END; IF (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar) THEN IF SymTab.CurDepth() = SymTab.SymDepth(bnF) THEN MGen.LoadLocal( SymTab.SymSlot(bnF) + 1) ELSE MGen.FrameAddr( SymTab.SymSlot(bnF) + 1, VAL(CARDINAL, SymTab.CurDepth() - 1 - SymTab.SymDepth(bnF))); MGen.LoadIndir END; MGen.PushInt(1); MGen.Sub; t := SymTab.IntType() ELSE MGen.PushInt(0); t := SymTab.InvalidType END ELSE IF sfxF THEN MGen.Drop END; MGen.PushInt( SymTab.ArrayHi(dt)); t := SymTab.IntType() END;; | 1 : DesignHead(dt, dk, bnF, TRUE, lxD); DesignTail(dt, dk, bnF, TRUE, lxD, sfxF); t := dt; MGen.CopyName(lxD, lx); IF sfxF & (t # SymTab.InvalidType) & MGen.ActIsVarNext() & ((dk = SymTab.KindVar) OR (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar) OR (dk = SymTab.KindField)) & (SymTab.SymKind(bnF) # SymTab.KindModule) & (SymTab.ClassOf(t) # SymTab.ClChar) & (SymTab.ClassOf(t) # SymTab.ClBool) THEN MGen.StashAddr() END; IF sfxF & (t # SymTab.InvalidType) & (SymTab.ClassOf(t) # SymTab.ClArray) & (SymTab.ClassOf(t) # SymTab.ClRecord) THEN IF (SymTab.ClassOf(t) = SymTab.ClChar) OR (SymTab.ClassOf(t) = SymTab.ClBool) THEN MGen.LoadByte ELSE MGen.LoadIndir END END; v := ~sfxF & ((dk = SymTab.KindVar) OR (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar)); MGen.CopyName(bnF, vn);; IF (sym = 17) THEN CallTail(bnF, lxD, sfxF, TRUE, okF, TRUE); IF okF THEN IF SymTab.SymKind(bnF) = SymTab.KindProc THEN t := SymTab.ProcRet(bnF) ELSIF (SymTab.SymKind(bnF) = SymTab.KindModule) & sfxF & (SymTab.StrLen(lxD) > 0) THEN mpF := SymTab.ExpProc(bnF, lxD); IF (mpF < 0) & (SymTab.SelfKind(bnF, lxD) = SymTab.KindProc) THEN mpF := SymTab.ProcNum(lxD) END; IF mpF >= 0 THEN t := SymTab.ProcRetByNum(mpF) ELSE t := SymTab.InvalidType END ELSE t := SymTab.InvalidType END ELSE t := SymTab.InvalidType END; lx[0] := 0C; v := FALSE; MGen.ClrStash();; END; | 17 : Get; Expr(et, lx, v, vn); Expect(18); t := et;; | 71, 72 : IF (sym = 71) THEN Get; ELSE Get; END; Fact(t2, lx2, v2, vn2); lx[0] := 0C; v := FALSE; MGen.ClrStash(); IF SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; MGen.Not;; | 73 : SetLit(st); lx[0] := 0C; v := FALSE; MGen.ClrStash(); t := st;; ELSE SynError(80); END; END Fact; PROCEDURE AddOp (VAR op: INTEGER); BEGIN IF (sym = 62) THEN Get; op := SymTab.OpAdd;; ELSIF (sym = 47) THEN Get; op := SymTab.OpSub;; ELSIF (sym = 63) THEN Get; op := SymTab.OpOr;; ELSE SynError(81); END; END AddOp; PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR v: BOOLEAN; VAR vn: SymTab.Name); VAR t2, res2: SymTab.TypeIndex; op: INTEGER; lx2: MGen.LitStr; v2: BOOLEAN; vn2: SymTab.Name; isR: BOOLEAN; mt: INTEGER; BEGIN Fact(t, lx, v, vn); WHILE In(symSet[2], sym) DO MulOp(op); Fact(t2, lx2, v2, vn2); lx[0] := 0C; v := FALSE; MGen.ClrStash(); 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 ELSIF (op = SymTab.OpTimes) & (t # SymTab.InvalidType) & (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t) = SymTab.ClSet) & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN 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 14 : Get; op := SymTab.OpEq;; | 55 : Get; op := SymTab.OpNeq1;; | 56 : Get; op := SymTab.OpNeq2;; | 57 : Get; op := SymTab.OpLt;; | 58 : Get; op := SymTab.OpLe;; | 59 : Get; op := SymTab.OpGt;; | 60 : Get; op := SymTab.OpGe;; | 61 : Get; op := SymTab.OpIn;; ELSE SynError(82); END; END Rel; PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR v: BOOLEAN; VAR vn: SymTab.Name); VAR t2, res2: SymTab.TypeIndex; op: INTEGER; lx2: MGen.LitStr; v2: BOOLEAN; vn2: SymTab.Name; neg, isR: BOOLEAN; BEGIN neg := FALSE;; IF (sym = 47) OR (sym = 62) THEN IF (sym = 62) THEN Get; ELSE Get; neg := TRUE;; END; END; Term(t, lx, v, vn); IF neg THEN v := FALSE; MGen.ClrStash(); 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 = 47) OR (sym = 62) OR (sym = 63) DO AddOp(op); Term(t2, lx2, v2, vn2); lx[0] := 0C; v := FALSE; MGen.ClrStash(); 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 ELSIF (t # SymTab.InvalidType) & (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t) = SymTab.ClSet) & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN IF op = SymTab.OpAdd THEN MGen.Or ELSE MGen.PushBits(0FFFFFFFFFFFFFFFFH); MGen.BitXor; MGen.And END 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 = 47) THEN Get; Expect(2); LexString(s); IF MGen.ParseInt(s, v) THEN v := -v ELSE v := -1 END;; ELSE SynError(83); END; END ByLit; PROCEDURE Labels (sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER); VAR t, t2: SymTab.TypeIndex; lx1, lx2: MGen.LitStr; v1, v2: BOOLEAN; vn1, vn2: SymTab.Name; 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 = 24) 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 = 7) 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(15); MGen.DefLabel(lB);; StatSeq; MGen.Jmp(endL); MGen.DefLabel(lN);; END; END Case; PROCEDURE CallTail (pn: SymTab.Name; exp: SymTab.Name; sfx: BOOLEAN; inExpr: BOOLEAN; VAR ok: BOOLEAN; hasDead: BOOLEAN); VAR t: SymTab.TypeIndex; lx: MGen.LitStr; v: BOOLEAN; vn: SymTab.Name; isModP: BOOLEAN; modPNum: INTEGER; modErr: BOOLEAN; BEGIN Expect(17); ok := FALSE; modErr := FALSE; isModP := (SymTab.SymKind(pn) = SymTab.KindModule) & sfx & (SymTab.StrLen(exp) > 0); IF hasDead THEN MGen.Drop END; IF isModP THEN modPNum := SymTab.ExpProc(pn, exp); IF (modPNum < 0) & (SymTab.SelfKind(pn, exp) = SymTab.KindProc) THEN modPNum := SymTab.ProcNum(exp) END; IF modPNum < 0 THEN IF SymTab.ExpKind(pn, exp) # -1 THEN SemError(233) END; modErr := TRUE ELSIF inExpr & (SymTab.ProcRetByNum( modPNum) = SymTab.InvalidType) THEN SemError(233); modErr := TRUE END; MGen.ActBeginNum(modPNum) ELSE MGen.ActBegin(pn) END;; IF In(symSet[1], sym) THEN Expr(t, lx, v, vn); IF isModP THEN IF ~modErr & (MGen.ActValue(t, v, vn) # 0) THEN SemError(233); modErr := TRUE END ELSIF MGen.ActValue(t, v, vn) # 0 THEN SemError(233) END;; WHILE (sym = 7) DO Get; Expr(t, lx, v, vn); IF isModP THEN IF ~modErr & (MGen.ActValue(t, v, vn) # 0) THEN SemError(233); modErr := TRUE END ELSIF MGen.ActValue(t, v, vn) # 0 THEN SemError(233) END;; END; END; Expect(18); IF isModP THEN IF ~modErr THEN IF MGen.ActEndNum(modPNum, inExpr) # 0 THEN SemError(233) ELSE ok := TRUE END END ELSIF MGen.ActEnd(pn, sfx, inExpr) # 0 THEN SemError(233) ELSE ok := TRUE END;; END CallTail; PROCEDURE DesignTail (VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr; VAR sfx: BOOLEAN); VAR m: SymTab.Name; it: SymTab.TypeIndex; lxI: MGen.LitStr; vI: BOOLEAN; vnI: SymTab.Name; loA: INTEGER; elemT: SymTab.TypeIndex; esl, ebytes: CARDINAL; firstT: BOOLEAN; clsI: INTEGER; sk: INTEGER; qM: SymTab.Name; BEGIN sfx := FALSE;; WHILE (sym = 22) OR (sym = 23) OR (sym = 54) DO IF (sym = 22) THEN Get; firstT := ~sfx; sfx := TRUE; lx[0] := 0C; IF ~doLoad & firstT THEN IF (k = SymTab.KindVar) OR (k = SymTab.KindParam) OR (k = SymTab.KindVarPar) THEN MGen.PushAddr(bn) ELSIF k = SymTab.KindField THEN MGen.WithAddr(bn) ELSIF k = SymTab.KindModule THEN ELSE MGen.PushInt(0) END END;; GetIdent(m); IF (k = SymTab.KindModule) THEN IF SymTab.ExpKind(bn, m) = -1 THEN sk := SymTab.SelfKind(bn, m); IF sk = SymTab.KindProc THEN MGen.CopyName(m, lx); t := SymTab.InvalidType; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSIF firstT THEN ELSE MGen.Drop END ELSIF sk # -1 THEN t := SymTab.SymType(m); k := sk; SymTab.SelfQual(m, qM); IF doLoad THEN MGen.Drop; MGen.GlobalAddr(qM) ELSE IF firstT THEN ELSE MGen.Drop END; MGen.GlobalAddr(qM) END ELSE SemError(201); MGen.CopyName(m, lx); t := SymTab.InvalidType; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSIF firstT THEN ELSE MGen.Drop END END ELSIF SymTab.ExpKind(bn, m) = SymTab.KindProc THEN MGen.CopyName(m, lx); t := SymTab.InvalidType; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSIF firstT THEN ELSE MGen.Drop END ELSE t := SymTab.ExpType(bn, m); k := SymTab.ExpKind(bn, m); SymTab.ExpQual(bn, m, qM); IF doLoad THEN MGen.Drop; MGen.GlobalAddr(qM) ELSE IF firstT THEN ELSE MGen.Drop END; MGen.GlobalAddr(qM) END END ELSIF t = SymTab.InvalidType THEN IF ~doLoad & firstT THEN MGen.Drop ELSIF doLoad THEN MGen.Drop; MGen.PushInt(0) END ELSIF SymTab.ClassOf(t) # SymTab.ClRecord THEN SemError(215); t := SymTab.InvalidType; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSIF firstT THEN MGen.Drop END ELSIF ~SymTab.FieldExists(t, m) THEN SemError(216); t := SymTab.InvalidType; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSIF firstT THEN MGen.Drop END ELSE loA := SymTab.FieldOffset(t, m); elemT := SymTab.FieldType(t, m); IF loA < 0 THEN SemError(216); t := SymTab.InvalidType; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSIF firstT THEN MGen.Drop END ELSE MGen.FieldAdd( VAL(CARDINAL, loA)); t := elemT END END;; ELSIF (sym = 23) THEN Get; firstT := ~sfx; sfx := TRUE; lx[0] := 0C; IF ~doLoad & firstT THEN IF (k = SymTab.KindVar) OR (k = SymTab.KindParam) OR (k = SymTab.KindVarPar) THEN MGen.PushAddr(bn) ELSIF k = SymTab.KindField THEN MGen.WithAddr(bn) ELSE MGen.PushInt(0) END END;; Expr(it, lxI, vI, vnI); IF t = SymTab.InvalidType THEN MGen.Drop; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSE IF ~firstT THEN ELSE MGen.Drop END END ELSIF SymTab.ClassOf(t) # SymTab.ClArray THEN SemError(217); t := SymTab.InvalidType; MGen.Drop; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSE IF ~firstT THEN ELSE MGen.Drop END END ELSE clsI := SymTab.ClassOf(it); IF (it # SymTab.InvalidType) & (clsI # SymTab.ClInt) & (clsI # SymTab.ClChar) & (clsI # SymTab.ClEnum) & (clsI # SymTab.ClBool) THEN SemError(218); t := SymTab.InvalidType; MGen.Drop; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSE IF ~firstT THEN ELSE MGen.Drop END END ELSE loA := SymTab.ArrayLo(t); elemT := SymTab.ArrayElem(t); esl := SymTab.TypeSlots(elemT); IF esl = 0 THEN SemError(230); esl := 1 END; IF (SymTab.ClassOf(elemT) = SymTab.ClChar) OR (SymTab.ClassOf(elemT) = SymTab.ClBool) THEN ebytes := 1 ELSE ebytes := esl * 8 END; MGen.IdxScale(loA, ebytes); t := elemT END END;; WHILE (sym = 7) DO Get; Expr(it, lxI, vI, vnI); IF t = SymTab.InvalidType THEN MGen.Drop; IF doLoad THEN MGen.Drop; MGen.PushInt(0); t := SymTab.InvalidType END ELSIF SymTab.ClassOf(t) # SymTab.ClArray THEN SemError(217); t := SymTab.InvalidType; MGen.Drop; IF doLoad THEN MGen.Drop; MGen.PushInt(0) END ELSE clsI := SymTab.ClassOf(it); IF (it # SymTab.InvalidType) & (clsI # SymTab.ClInt) & (clsI # SymTab.ClChar) & (clsI # SymTab.ClEnum) & (clsI # SymTab.ClBool) THEN SemError(218); t := SymTab.InvalidType; MGen.Drop; IF doLoad THEN MGen.Drop; MGen.PushInt(0) END ELSE loA := SymTab.ArrayLo(t); elemT := SymTab.ArrayElem(t); esl := SymTab.TypeSlots(elemT); IF esl = 0 THEN SemError(230); esl := 1 END; IF (SymTab.ClassOf(elemT) = SymTab.ClChar) OR (SymTab.ClassOf(elemT) = SymTab.ClBool) THEN ebytes := 1 ELSE ebytes := esl * 8 END; MGen.IdxScale(loA, ebytes); t := elemT END END;; END; Expect(25); ELSE Get; firstT := ~sfx; sfx := TRUE; lx[0] := 0C; IF ~doLoad & firstT THEN IF (k = SymTab.KindVar) OR (k = SymTab.KindParam) OR (k = SymTab.KindVarPar) THEN MGen.PushAddr(bn) ELSIF k = SymTab.KindField THEN MGen.WithAddr(bn) ELSE MGen.PushInt(0) END END;; IF t = SymTab.InvalidType THEN IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSIF firstT THEN MGen.Drop END ELSIF SymTab.ClassOf(t) # SymTab.ClPtr THEN SemError(219); t := SymTab.InvalidType; IF doLoad THEN MGen.Drop; MGen.PushInt(0) ELSIF firstT THEN MGen.Drop END ELSE elemT := SymTab.PtrBase(t); t := elemT; IF doLoad THEN IF ~(firstT & ((k = SymTab.KindVar) OR (k = SymTab.KindParam) OR (k = SymTab.KindVarPar))) THEN MGen.LoadIndir END ELSE MGen.LoadIndir END END;; END; END; END DesignTail; PROCEDURE DesignHead (VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr); VAR n: SymTab.Name; 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) OR (k = SymTab.KindParam) OR (k = SymTab.KindVarPar) 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) OR (cls = SymTab.ClPtr) THEN IF doLoad THEN MGen.PushVar(n) END ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClRecord) THEN IF doLoad THEN MGen.PushAddr(n) END ELSIF t = SymTab.InvalidType THEN IF doLoad THEN MGen.PushInt(0) END ELSE SemError(230); IF doLoad THEN MGen.PushInt(0) END END ELSE IF doLoad THEN IF k = SymTab.KindField THEN MGen.WithAddr(n); cls := SymTab.ClassOf(t); IF (t = SymTab.InvalidType) OR (cls = SymTab.ClArray) OR (cls = SymTab.ClRecord) THEN ELSE IF (cls = SymTab.ClChar) OR (cls = SymTab.ClBool) THEN MGen.LoadByte ELSE MGen.LoadIndir END END ELSE MGen.PushInt(0) END END; IF k = SymTab.KindField THEN ELSIF k = SymTab.KindImport THEN SemError(230) END END END;; END DesignHead; PROCEDURE WriteStrStat; VAR t: SymTab.TypeIndex; lx: MGen.LitStr; v: BOOLEAN; vn: SymTab.Name; BEGIN Expect(53); Expect(17); Expr(t, lx, v, vn); Expect(18); IF t = SymTab.InvalidType THEN MGen.Drop ELSIF (SymTab.ClassOf(t) = SymTab.ClStr) THEN MGen.PushInt(1); MGen.SysCall ELSIF (SymTab.ClassOf(t) = SymTab.ClArray) & (SymTab.ClassOf( SymTab.ArrayElem(t)) = SymTab.ClChar) THEN MGen.PushInt(1); MGen.SysCall ELSE SemError(210); MGen.Drop END;; END WriteStrStat; PROCEDURE WriteIntStat; VAR t: SymTab.TypeIndex; lx: MGen.LitStr; v: BOOLEAN; vn: SymTab.Name; BEGIN Expect(52); Expect(17); Expr(t, lx, v, vn); Expect(18); IF t = SymTab.InvalidType THEN MGen.Drop ELSIF ~SymTab.IsIntFamily(t) THEN SemError(210); MGen.Drop ELSE MGen.CallPrint END;; END WriteIntStat; PROCEDURE DispStat; VAR dt: SymTab.TypeIndex; dk: INTEGER; bnD: SymTab.Name; lxD: MGen.LitStr; sfxD: BOOLEAN; baseT: SymTab.TypeIndex; slD: CARDINAL; BEGIN Expect(51); Expect(17); DesignHead(dt, dk, bnD, FALSE, lxD); DesignTail(dt, dk, bnD, FALSE, lxD, sfxD); Expect(18); IF dt = SymTab.InvalidType THEN IF sfxD THEN MGen.Drop END ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN SemError(219); IF sfxD THEN MGen.Drop END ELSE baseT := SymTab.PtrBase(dt); slD := SymTab.TypeSlots(baseT); IF slD = 0 THEN SemError(230); slD := 1 END; IF ~sfxD THEN IF (dk = SymTab.KindVar) OR (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar) THEN MGen.PushAddr(bnD) ELSIF dk = SymTab.KindField THEN MGen.WithAddr(bnD) ELSE MGen.PushInt(0) END END; MGen.PushBytes(slD * 8); MGen.DeallocOp END;; END DispStat; PROCEDURE NewStat; VAR dt: SymTab.TypeIndex; dk: INTEGER; bnN: SymTab.Name; lxN: MGen.LitStr; sfxN: BOOLEAN; baseT: SymTab.TypeIndex; slN: CARDINAL; BEGIN Expect(50); Expect(17); DesignHead(dt, dk, bnN, FALSE, lxN); DesignTail(dt, dk, bnN, FALSE, lxN, sfxN); Expect(18); IF dt = SymTab.InvalidType THEN IF sfxN THEN MGen.Drop END ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN SemError(219); IF sfxN THEN MGen.Drop END ELSE baseT := SymTab.PtrBase(dt); slN := SymTab.TypeSlots(baseT); IF slN = 0 THEN SemError(230); slN := 1 END; IF ~sfxN THEN IF (dk = SymTab.KindVar) OR (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar) THEN MGen.PushAddr(bnN) ELSIF dk = SymTab.KindField THEN MGen.WithAddr(bnN) ELSE MGen.PushInt(0) END END; MGen.PushBytes(slN * 8); MGen.AllocOp END;; END NewStat; PROCEDURE ReturnStat; VAR t: SymTab.TypeIndex; lx: MGen.LitStr; v: BOOLEAN; vn: SymTab.Name; hasE, doRet, conv: BOOLEAN; BEGIN Expect(49); hasE := FALSE;; IF In(symSet[1], sym) THEN Expr(t, lx, v, vn); hasE := TRUE; doRet := FALSE; IF ~SymTab.InProc() THEN SemError(232) ELSIF ~SymTab.InFunction() THEN SemError(232) ELSIF ~SymTab.Assignable( t, SymTab.CurRet()) THEN SemError(232) ELSE doRet := TRUE END; conv := doRet & SymTab.IsIntFamily(t) & (SymTab.ClassOf( SymTab.CurRet()) = SymTab.ClReal); IF doRet THEN IF conv THEN MGen.IntToReal END; MGen.Leave( SymTab.CurNPar(), TRUE) ELSE MGen.Drop END;; END; IF ~hasE THEN IF ~SymTab.InProc() THEN SemError(232) ELSIF SymTab.InFunction() THEN SemError(232) ELSE MGen.Leave( SymTab.CurNPar(), FALSE) END END;; END ReturnStat; PROCEDURE WithStat; VAR dt: SymTab.TypeIndex; dk: INTEGER; bnW: SymTab.Name; lxW: MGen.LitStr; sfxW: BOOLEAN; pushed: BOOLEAN; BEGIN Expect(48); DesignHead(dt, dk, bnW, FALSE, lxW); DesignTail(dt, dk, bnW, FALSE, lxW, sfxW); pushed := FALSE; IF dt = SymTab.InvalidType THEN IF sfxW THEN MGen.Drop END ELSIF SymTab.ClassOf(dt) # SymTab.ClRecord THEN SemError(215); IF sfxW THEN MGen.Drop END ELSE IF ~sfxW THEN IF (dk = SymTab.KindVar) OR (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar) THEN MGen.PushAddr(bnW) ELSIF dk = SymTab.KindField THEN MGen.WithAddr(bnW) ELSE MGen.PushInt(0) END END; MGen.WithEnter(dt); pushed := SymTab.PushRecord(dt); IF ~pushed THEN SemError(215) END END;; Expect(41); StatSeq; Expect(10); IF pushed THEN SymTab.PopScope; MGen.WithExit END;; END WithStat; PROCEDURE ForStat; VAR n, lv: SymTab.Name; fk: INTEGER; lo, hi: SymTab.TypeIndex; lxLo, lxHi: MGen.LitStr; vLo, vHi: BOOLEAN; vnLo, vnHi: SymTab.Name; byV, ht: INTEGER; lTop, lChk, lEnd: INTEGER; neg, storable: BOOLEAN; BEGIN Expect(45); GetIdent(n); IF ~SymTab.Lookup(n) THEN SemError(201); fk := -1 ELSIF (SymTab.SymKind(n) # SymTab.KindVar) & (SymTab.SymKind(n) # SymTab.KindParam) & (SymTab.SymKind(n) # SymTab.KindVarPar) & (SymTab.SymKind(n) # SymTab.KindField) THEN SemError(220); fk := -1 ELSIF (SymTab.SymType(n) # SymTab.InvalidType) & ~SymTab.IsIntFamily( SymTab.SymType(n)) THEN SemError(220); fk := -1 ELSE fk := SymTab.SymKind(n) END; MGen.CopyName(n, lv); storable := (fk = SymTab.KindVar) OR (fk = SymTab.KindParam) OR (fk = SymTab.KindVarPar); IF storable THEN MGen.StoreSetup(lv) END;; Expect(33); Expr(lo, lxLo, vLo, vnLo); IF (lo # SymTab.InvalidType) & ~SymTab.IsIntFamily(lo) THEN SemError(220) END; IF storable THEN MGen.StoreFinish(lv) ELSE MGen.Drop END;; Expect(31); Expr(hi, lxHi, vHi, vnHi); IF (hi # SymTab.InvalidType) & ~SymTab.IsIntFamily(hi) THEN SemError(220) END; ht := MGen.TempGlobal(); MGen.StoreTemp(ht); byV := 1; neg := FALSE;; IF (sym = 46) THEN Get; ByLit(byV); neg := byV < 0;; END; Expect(41); lTop := MGen.NewLabel(); lChk := MGen.NewLabel(); lEnd := MGen.NewLabel(); MGen.Jmp(lChk); MGen.DefLabel(lTop);; StatSeq; Expect(10); MGen.PushVar(lv); MGen.PushInt(byV); MGen.Add; IF storable THEN MGen.StoreFinish(lv) ELSE MGen.Drop END; MGen.DefLabel(lChk); MGen.PushVar(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(44); topL := MGen.NewLabel(); exitL := MGen.NewLabel(); MGen.DefLabel(topL); MGen.PushLoop(exitL);; StatSeq; Expect(10); MGen.Jmp(topL); MGen.DefLabel(exitL); MGen.PopLoop;; END LoopStat; PROCEDURE RepeatStat; VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; vC: BOOLEAN; vnC: SymTab.Name; topL: INTEGER; BEGIN Expect(42); topL := MGen.NewLabel(); MGen.DefLabel(topL);; StatSeq; Expect(43); Expr(t, lxC, vC, vnC); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; MGen.Jz(topL);; END RepeatStat; PROCEDURE WhileStat; VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; vC: BOOLEAN; vnC: SymTab.Name; topL, endL: INTEGER; BEGIN Expect(40); topL := MGen.NewLabel(); endL := MGen.NewLabel(); MGen.DefLabel(topL);; Expr(t, lxC, vC, vnC); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; MGen.Jz(endL);; Expect(41); StatSeq; Expect(10); MGen.Jmp(topL); MGen.DefLabel(endL);; END WhileStat; PROCEDURE CaseStat; VAR st: SymTab.TypeIndex; lxS: MGen.LitStr; vS: BOOLEAN; vnS: SymTab.Name; tmp, endL: INTEGER; BEGIN Expect(38); Expr(st, lxS, vS, vnS); tmp := MGen.TempGlobal(); MGen.StoreTemp(tmp); endL := MGen.NewLabel();; Expect(27); Case(st, tmp, endL); WHILE (sym = 39) DO Get; Case(st, tmp, endL); END; IF (sym = 37) THEN Get; StatSeq; END; Expect(10); MGen.DefLabel(endL);; END CaseStat; PROCEDURE IfStat; VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; vC: BOOLEAN; vnC: SymTab.Name; elseL, endL: INTEGER; hasElse: BOOLEAN; BEGIN Expect(34); Expr(t, lxC, vC, vnC); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; elseL := MGen.NewLabel(); endL := MGen.NewLabel(); MGen.Jz(elseL); hasElse := FALSE;; Expect(35); StatSeq; WHILE (sym = 36) DO Get; MGen.Jmp(endL); MGen.DefLabel(elseL);; Expr(t, lxC, vC, vnC); IF ~SymTab.BoolCheck(t) THEN SemError(214) END; elseL := MGen.NewLabel(); MGen.Jz(elseL);; Expect(35); StatSeq; END; IF (sym = 37) THEN Get; MGen.Jmp(endL); MGen.DefLabel(elseL); hasElse := TRUE;; StatSeq; END; Expect(10); IF ~hasElse THEN MGen.DefLabel(elseL) END; MGen.DefLabel(endL);; END IfStat; PROCEDURE AssignOrCall; VAR dt, et: SymTab.TypeIndex; dk: INTEGER; bn: SymTab.Name; lxD, lxe: MGen.LitStr; vE: BOOLEAN; vnE: SymTab.Name; sfx: BOOLEAN; okC: BOOLEAN; isR, conv, storable, pushedDst, pushedFld: BOOLEAN; dstBytes, srcBytes: CARDINAL; elemDt: SymTab.TypeIndex; modBare: INTEGER; BEGIN sfx := FALSE; pushedDst := FALSE; pushedFld := FALSE;; DesignHead(dt, dk, bn, FALSE, lxD); DesignTail(dt, dk, bn, FALSE, lxD, sfx); IF (sym = 33) THEN Get; storable := (dk = SymTab.KindVar) OR (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar); IF (dk = SymTab.KindField) & (~sfx) & (dt # SymTab.InvalidType) THEN MGen.WithAddr(bn); pushedFld := TRUE END; IF storable & ~sfx & (dt # SymTab.InvalidType) & ((SymTab.ClassOf(dt) = SymTab.ClArray) OR (SymTab.ClassOf(dt) = SymTab.ClRecord)) THEN MGen.PushAddr(bn); pushedDst := TRUE ELSIF ((dk = SymTab.KindVar) OR (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar) OR (dk = SymTab.KindField)) & sfx & (dt # SymTab.InvalidType) & ((SymTab.ClassOf(dt) = SymTab.ClArray) OR (SymTab.ClassOf(dt) = SymTab.ClRecord)) THEN pushedDst := TRUE END; IF storable & ~sfx & ~pushedDst THEN IF (dt # SymTab.InvalidType) & (SymTab.TypeSlots(dt) > 1) THEN ELSE MGen.StoreSetup(bn) END END;; Expr(et, lxe, vE, vnE); IF (dt # SymTab.InvalidType) & (dk # SymTab.KindVar) & (dk # SymTab.KindParam) & (dk # SymTab.KindVarPar) & (dk # SymTab.KindField) & (dk # SymTab.KindImport) THEN SemError(210) ELSIF pushedDst THEN IF et = SymTab.InvalidType THEN MGen.Drop; MGen.Drop ELSIF (SymTab.ClassOf(dt) = SymTab.ClArray) & (SymTab.ClassOf( SymTab.ArrayElem(dt)) = SymTab.ClChar) & (SymTab.ClassOf(et) = SymTab.ClStr) THEN srcBytes := MGen.StrLenOf(lxe) + 1; dstBytes := SymTab.TypeSlots(dt) * 8; IF srcBytes > dstBytes THEN SemError(210); MGen.Drop; MGen.Drop ELSE MGen.PushBytes(srcBytes); MGen.CopyBlock END ELSIF ~SymTab.Assignable(et, dt) THEN SemError(210); MGen.Drop; MGen.Drop ELSE dstBytes := SymTab.TypeSlots(dt) * 8; MGen.PushBytes(dstBytes); MGen.CopyBlock END ELSIF pushedFld THEN IF et = SymTab.InvalidType THEN MGen.Drop; MGen.Drop ELSIF (SymTab.TypeSlots(dt) > 1) THEN IF (SymTab.ClassOf(dt) = SymTab.ClArray) & (SymTab.ClassOf( SymTab.ArrayElem(dt)) = SymTab.ClChar) & (SymTab.ClassOf(et) = SymTab.ClStr) THEN srcBytes := MGen.StrLenOf(lxe) + 1; dstBytes := SymTab.TypeSlots(dt) * 8; IF srcBytes > dstBytes THEN SemError(210); MGen.Drop; MGen.Drop ELSE MGen.PushBytes(srcBytes); MGen.CopyBlock END ELSIF ~SymTab.Assignable(et, dt) THEN SemError(210); MGen.Drop; MGen.Drop ELSE dstBytes := SymTab.TypeSlots(dt) * 8; MGen.PushBytes(dstBytes); MGen.CopyBlock END ELSE IF ~SymTab.Assignable(et, dt) THEN SemError(210); MGen.Drop; MGen.Drop ELSE isR := (SymTab.ClassOf(dt) = SymTab.ClReal); conv := isR & SymTab.IsIntFamily(et); IF conv THEN MGen.IntToReal END; IF (SymTab.ClassOf(dt) = SymTab.ClChar) OR (SymTab.ClassOf(dt) = SymTab.ClBool) THEN MGen.StoreByte ELSE MGen.StoreIndir0 END END END ELSIF (dt # SymTab.InvalidType) & ~sfx & (SymTab.TypeSlots(dt) > 1) THEN IF ~SymTab.Assignable(et, dt) THEN SemError(210) ELSE SemError(230) END ELSIF ~SymTab.Assignable(et, dt) THEN SemError(210) END; IF dk = SymTab.KindImport THEN SemError(230) END; isR := (dt # SymTab.InvalidType) & ~pushedDst & ~pushedFld & (SymTab.ClassOf(dt) = SymTab.ClReal); conv := isR & SymTab.IsIntFamily(et); IF pushedDst THEN ELSIF pushedFld THEN ELSIF (dt # SymTab.InvalidType) & sfx THEN IF conv THEN MGen.IntToReal END; IF (SymTab.ClassOf(dt) = SymTab.ClChar) OR (SymTab.ClassOf(dt) = SymTab.ClBool) THEN MGen.StoreByte ELSE MGen.StoreIndir0 END ELSIF storable & ~sfx THEN IF (dt # SymTab.InvalidType) & (SymTab.TypeSlots(dt) > 1) THEN MGen.Drop ELSE IF conv THEN MGen.IntToReal END; MGen.StoreFinish(bn) END ELSE MGen.Drop END;; ELSIF (sym = 17) THEN CallTail(bn, lxD, sfx, FALSE, okC, FALSE); ELSIF In(symSet[3], sym) THEN IF (SymTab.SymKind(bn) = SymTab.KindModule) & sfx & (SymTab.StrLen(lxD) > 0) THEN modBare := SymTab.ExpProc(bn, lxD); IF modBare < 0 THEN IF SymTab.ExpKind(bn, lxD) # -1 THEN SemError(233) END ELSIF SymTab.ProcNParByNum( modBare) # 0 THEN SemError(233) ELSE MGen.CallProc(modBare); IF SymTab.ProcRetByNum( modBare) # SymTab.InvalidType THEN MGen.Drop END END ELSE MGen.ActBegin(bn); IF MGen.ActEnd(bn, FALSE, FALSE) # 0 THEN SemError(233) END END;; ELSE SynError(84); END; END AssignOrCall; PROCEDURE Stat; VAR lx: INTEGER; BEGIN IF In(symSet[4], sym) THEN CASE sym OF 1 : AssignOrCall; | 34 : IfStat; | 38 : CaseStat; | 40 : WhileStat; | 42 : RepeatStat; | 44 : LoopStat; | 45 : ForStat; | 48 : WithStat; | 49 : ReturnStat; | 50 : NewStat; | 51 : DispStat; | 52 : WriteIntStat; | 53 : WriteStrStat; | 32 : 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 = 7) 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(15); Type(et); IF (et # SymTab.InvalidType) & SymTab.IsOpen(et) THEN SemError(230) END; SymTab.FixPendingF(rt, et);; END; END Field; PROCEDURE FieldSeq (rt: SymTab.TypeIndex); BEGIN Field(rt); WHILE (sym = 8) DO Get; Field(rt); END; END FieldSeq; PROCEDURE Enum (VAR t: SymTab.TypeIndex); VAR n: SymTab.Name; ord: INTEGER; BEGIN Expect(17); t := SymTab.NewEnum(); ord := 0;; GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); SymTab.EnumAdd(t); MGen.DeclConstInt(n, ord); INC(ord);; WHILE (sym = 7) DO Get; GetIdent(n); IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); SymTab.EnumAdd(t); MGen.DeclConstInt(n, ord); INC(ord);; END; Expect(18); END Enum; PROCEDURE PointerType (VAR t: SymTab.TypeIndex); VAR b: SymTab.TypeIndex; BEGIN Expect(30); Expect(31); Type(b); t := SymTab.NewPtr(b);; END PointerType; PROCEDURE SetType (VAR t: SymTab.TypeIndex); VAR s: SymTab.TypeIndex; BEGIN Expect(29); Expect(27); 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(28); t := SymTab.NewRecord();; FieldSeq(t); Expect(10); END RecordType; PROCEDURE ArrayType (VAR t: SymTab.TypeIndex); VAR s, s2, e: SymTab.TypeIndex; idx: ARRAY [0 .. 7] OF SymTab.TypeIndex; nc, kk: CARDINAL; loA, hiA: INTEGER; isOpenA: BOOLEAN; BEGIN Expect(26); IF (sym = 1) OR (sym = 17) OR (sym = 23) OR (sym = 27) THEN IF (sym = 1) OR (sym = 17) OR (sym = 23) THEN 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; nc := 0; isOpenA := FALSE; idx[nc] := s; INC(nc);; WHILE (sym = 7) 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; IF nc <= HIGH(idx) THEN idx[nc] := s2; INC(nc) END;; END; ELSE nc := 0; isOpenA := TRUE;; END; END; Expect(27); Type(e); IF isOpenA THEN t := SymTab.NewOpen(e) ELSE t := e; kk := nc; WHILE kk > 0 DO DEC(kk); loA := SymTab.TypeLo(idx[kk]); hiA := SymTab.TypeHi(idx[kk]); IF SymTab.TypeLen(idx[kk]) = 0 THEN IF idx[kk] # SymTab.InvalidType THEN SemError(230) END; loA := 0; hiA := -1 END; t := SymTab.NewArrayB(t, loA, hiA) END END;; END ArrayType; PROCEDURE SimpleType (VAR t: SymTab.TypeIndex); VAR t1, t2: SymTab.TypeIndex; lx1, lx2: MGen.LitStr; vD: BOOLEAN; vnD: SymTab.Name; loI, hiI: INTEGER; lok, hik: BOOLEAN; BEGIN IF (sym = 1) THEN QualIdent(t); IF (sym = 23) THEN Get; MGen.NoEmitEnter; lok := FALSE; hik := FALSE; loI := 0; hiI := -1;; 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(24); 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(25); IF (t1 # SymTab.InvalidType) & (t2 # SymTab.InvalidType) THEN IF MGen.IsLit(lx1) THEN IF SymTab.ClassOf(t1) = SymTab.ClChar THEN loI := MGen.CharOrd(lx1); lok := TRUE ELSIF MGen.ParseInt(lx1, loI) THEN lok := TRUE END END; IF MGen.IsLit(lx2) THEN IF SymTab.ClassOf(t2) = SymTab.ClChar THEN hiI := MGen.CharOrd(lx2); hik := TRUE ELSIF MGen.ParseInt(lx2, hiI) THEN hik := TRUE END END END; IF lok & hik THEN t := SymTab.NewSubB(t1, loI, hiI) ELSE t := SymTab.NewSub(t1); IF (t1 # SymTab.InvalidType) & (t2 # SymTab.InvalidType) THEN SemError(230) END END; MGen.NoEmitExit;; END; ELSIF (sym = 23) THEN Get; MGen.NoEmitEnter; lok := FALSE; hik := FALSE; loI := 0; hiI := -1;; 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(24); 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(25); IF (t1 # SymTab.InvalidType) & (t2 # SymTab.InvalidType) THEN IF MGen.IsLit(lx1) THEN IF SymTab.ClassOf(t1) = SymTab.ClChar THEN loI := MGen.CharOrd(lx1); lok := TRUE ELSIF MGen.ParseInt(lx1, loI) THEN lok := TRUE END END; IF MGen.IsLit(lx2) THEN IF SymTab.ClassOf(t2) = SymTab.ClChar THEN hiI := MGen.CharOrd(lx2); hik := TRUE ELSIF MGen.ParseInt(lx2, hiI) THEN hik := TRUE END END END; IF lok & hik THEN t := SymTab.NewSubB(t1, loI, hiI) ELSE t := SymTab.NewSub(t1); IF (t1 # SymTab.InvalidType) & (t2 # SymTab.InvalidType) THEN SemError(230) END END; MGen.NoEmitExit;; ELSIF (sym = 17) THEN Enum(t); ELSE SynError(85); END; END SimpleType; PROCEDURE FPSection; VAR isV: BOOLEAN; nn, i: CARDINAL; pn: ARRAY [0 .. 15] OF SymTab.Name; n: SymTab.Name; t: SymTab.TypeIndex; BEGIN isV := FALSE; nn := 0;; IF (sym = 13) THEN Get; isV := TRUE;; END; GetIdent(n); IF nn <= HIGH(pn) THEN MGen.CopyName(n, pn[nn]) END; INC(nn);; WHILE (sym = 7) DO Get; GetIdent(n); IF nn <= HIGH(pn) THEN MGen.CopyName(n, pn[nn]) END; INC(nn);; END; Expect(15); Type(t); IF ~isV & (t # SymTab.InvalidType) & (SymTab.TypeSlots(t) > 1) THEN SemError(230) END; i := 0; WHILE i < nn DO IF i <= HIGH(pn) THEN IF ~SymTab.EnterParam( pn[i], isV, t) THEN SemError(200) END END; INC(i) END;; END FPSection; 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.KindModule THEN 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 = 22) DO Get; GetIdent(m); IF SymTab.SymKind(n) = SymTab.KindModule THEN IF SymTab.ExpKind(n, m) = SymTab.KindType THEN t := SymTab.ExpType(n, m) ELSIF SymTab.SelfKind(n, m) = SymTab.KindType THEN t := SymTab.SymType(m) ELSE IF SymTab.ExpKind(n, m) < 0 THEN IF SymTab.SelfKind(n, m) < 0 THEN SemError(201) ELSE SemError(221) END ELSE SemError(221) END; t := SymTab.InvalidType END ELSE t := SymTab.InvalidType END;; END; END QualIdent; PROCEDURE FormalParams; BEGIN FPSection; WHILE (sym = 8) DO Get; FPSection; END; END FormalParams; PROCEDURE VarIdents; VAR n: SymTab.Name; BEGIN GetIdent(n); IF ~SymTab.EnterPending(n, SymTab.KindVar) THEN SemError(200) END; WHILE (sym = 7) 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 = 17) OR (sym = 23) THEN SimpleType(t); ELSIF (sym = 26) THEN ArrayType(t); ELSIF (sym = 28) THEN RecordType(t); ELSIF (sym = 29) THEN SetType(t); ELSIF (sym = 30) THEN PointerType(t); ELSE SynError(86); END; END Type; PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr; VAR v: BOOLEAN; VAR vn: SymTab.Name); VAR t2: SymTab.TypeIndex; tc, op: INTEGER; lx2: MGen.LitStr; v2: BOOLEAN; vn2: SymTab.Name; r: BOOLEAN; BEGIN SimExpr(t, lx, v, vn); IF In(symSet[5], sym) THEN Rel(op); SimExpr(t2, lx2, v2, vn2); lx[0] := 0C; v := FALSE; MGen.ClrStash(); 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 ELSIF (t # SymTab.InvalidType) & (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t) = SymTab.ClArray) & (SymTab.ClassOf(t2) = SymTab.ClArray) & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar) & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar) & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN t := SymTab.BoolType(); MGen.PushBytes(SymTab.TypeSlots(t) * 8); MGen.PushBytes(SymTab.TypeSlots(t2) * 8); MGen.StrComp; IF op = SymTab.OpEq THEN MGen.Or; MGen.Not ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN MGen.Or ELSIF op = SymTab.OpLt THEN MGen.Swap; MGen.Drop ELSIF op = SymTab.OpLe THEN MGen.Drop; MGen.Not ELSIF op = SymTab.OpGt THEN MGen.Drop ELSE MGen.Swap; MGen.Drop; MGen.Not END ELSIF (t # SymTab.InvalidType) & (t2 # SymTab.InvalidType) & ((SymTab.ClassOf(t) = SymTab.ClArray) OR (SymTab.ClassOf(t) = SymTab.ClRecord) OR (SymTab.ClassOf(t2) = SymTab.ClArray) OR (SymTab.ClassOf(t2) = SymTab.ClRecord)) THEN SemError(213); t := SymTab.InvalidType; MGen.Drop; MGen.Drop; MGen.PushInt(0) 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); VAR vD: BOOLEAN; vnD: SymTab.Name; BEGIN Expr(t, lx, vD, vnD); END ConstExpr; PROCEDURE ModuleDecl; VAR n, m, e: SymTab.Name; noMod, enterOk, hasInit: BOOLEAN; initL, initN: INTEGER; BEGIN Expect(20); noMod := SymTab.InProc() OR SymTab.InModule(); enterOk := FALSE; hasInit := FALSE;; GetIdent(n); IF noMod THEN SemError(230) ELSIF ~SymTab.EnterModule(n) THEN SemError(200) ELSE enterOk := TRUE END;; IF (sym = 21) THEN Get; GetIdent(e); IF ~noMod & enterOk THEN IF ~SymTab.ModuleAddExp(e) THEN SemError(200) END END;; WHILE (sym = 7) DO Get; GetIdent(e); IF ~noMod & enterOk THEN IF ~SymTab.ModuleAddExp(e) THEN SemError(200) END END;; END; END; Expect(8); WHILE (sym = 11) OR (sym = 12) OR (sym = 13) OR (sym = 16) OR (sym = 20) DO Declaration; END; IF (sym = 9) THEN Get; hasInit := TRUE; IF ~noMod & enterOk THEN initL := MGen.NewLabel(); MGen.Jmp(initL); initN := MGen.ModInitBegin(); IF initN < 0 THEN SemError(230) END END;; StatSeq; END; Expect(10); GetIdent(m); IF ~SymTab.Equal(n, m) THEN SemError(202) END; IF hasInit & ~noMod & enterOk THEN MGen.ModInitEnd(initN); MGen.DefLabel(initL) END; IF ~noMod & enterOk THEN IF ~SymTab.ExitModule() THEN SemError(201) END END;; END ModuleDecl; PROCEDURE ProcedureDecl; VAR n, m: SymTab.Name; rt: SymTab.TypeIndex; hasR, ok: BOOLEAN; endL: INTEGER; BEGIN Expect(16); hasR := FALSE;; GetIdent(n); IF SymTab.IsForward(n) THEN SymTab.ReuseProc(n) ELSIF ~SymTab.EnterProc(n) THEN SemError(200) END; SymTab.OpenProcScope; endL := MGen.NewLabel(); MGen.Jmp(endL);; IF (sym = 17) THEN Get; FormalParams; Expect(18); END; IF (sym = 15) THEN Get; QualIdent(rt); hasR := TRUE;; END; IF hasR THEN ok := SymTab.SetProcRet(rt) ELSE ok := SymTab.SetProcRet( SymTab.InvalidType) END; IF ~ok THEN SemError(231) END; IF ~SymTab.VerifyProc() THEN SemError(231) END;; Expect(8); IF In(symSet[6], sym) THEN Block(TRUE); GetIdent(m); IF ~SymTab.Equal(n, m) THEN SemError(202) END; MGen.DefLabel(endL); SymTab.CloseProc;; ELSIF (sym = 19) THEN Get; SymTab.SetForward; SymTab.CloseProc; MGen.DefLabel(endL);; ELSE SynError(87); END; END ProcedureDecl; PROCEDURE VarDecl; VAR t: SymTab.TypeIndex; i: CARDINAL; nm: SymTab.Name; cls: INTEGER; sl: CARDINAL; BEGIN VarIdents; Expect(15); 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) & (cls # SymTab.ClArray) & (cls # SymTab.ClRecord) & (cls # SymTab.ClPtr) THEN SemError(230) END; sl := SymTab.TypeSlots(t); IF sl = 0 THEN SemError(230); sl := 1 END; i := 0; WHILE i < SymTab.PendCount() DO SymTab.PendName(i, nm); IF SymTab.SymDepth(nm) = 0 THEN MGen.DeclVarSized(nm, sl) END; 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(14); 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(14); 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 = 8) DO Get; Stat; END; END StatSeq; PROCEDURE Declaration; BEGIN IF (sym = 11) THEN Get; WHILE (sym = 1) DO ConstDecl; Expect(8); END; ELSIF (sym = 12) THEN Get; WHILE (sym = 1) DO TypeDecl; Expect(8); END; ELSIF (sym = 13) THEN Get; WHILE (sym = 1) DO VarDecl; Expect(8); END; ELSIF (sym = 16) THEN ProcedureDecl; Expect(8); ELSIF (sym = 20) THEN ModuleDecl; Expect(8); ELSE SynError(88); END; END Declaration; PROCEDURE Block (isProc: BOOLEAN); VAR began: BOOLEAN; BEGIN began := FALSE;; WHILE (sym = 11) OR (sym = 12) OR (sym = 13) OR (sym = 16) OR (sym = 20) DO Declaration; END; IF (sym = 9) THEN Get; began := TRUE; IF isProc THEN MGen.ProcEntry( SymTab.CurProc(), SymTab.ProcNLocals()) ELSE MGen.BeginBody END;; StatSeq; END; Expect(10); IF isProc THEN IF ~began THEN MGen.ProcEntry( SymTab.CurProc(), SymTab.ProcNLocals()) END; IF SymTab.InFunction() THEN MGen.PushInt(0) END; MGen.Leave(SymTab.CurNPar(), SymTab.InFunction()) END;; END Block; PROCEDURE ImpItem (mod: SymTab.Name); VAR a: SymTab.Name; k: INTEGER; BEGIN GetIdent(a); IF ~SymTab.ImpBind(mod, a) THEN SemError(201) ELSE k := SymTab.ExpKind(mod, a); IF k = SymTab.KindType THEN IF ~SymTab.Enter(a, k) THEN SemError(200); SymTab.ImpUnbind(a) ELSE SymTab.SetSymType(a, SymTab.ExpType(mod, a)) END ELSIF (k = SymTab.KindConst) OR (k = SymTab.KindVar) THEN IF ~SymTab.Enter(a, k) THEN SemError(200); SymTab.ImpUnbind(a) ELSE SymTab.SetSymType(a, SymTab.ExpType(mod, a)) END ELSIF k = SymTab.KindProc THEN IF ~SymTab.EnterImpProc(a, SymTab.ExpProc(mod, a)) THEN SemError(200); SymTab.ImpUnbind(a) END ELSE SemError(221); SymTab.ImpUnbind(a) END END;; END ImpItem; PROCEDURE GetIdent (VAR n: SymTab.Name); BEGIN Expect(1); LexName(n);; END GetIdent; PROCEDURE Import; VAR n: SymTab.Name; BEGIN IF (sym = 5) THEN Get; GetIdent(n); IF ~SymTab.IsDefMod(n) THEN SemError(201) END;; Expect(6); ImpItem(n); WHILE (sym = 7) DO Get; ImpItem(n); END; Expect(8); ELSIF (sym = 6) THEN Get; GetIdent(n); IF ~SymTab.IsDefMod(n) THEN SemError(201) END;; WHILE (sym = 7) DO Get; GetIdent(n); IF ~SymTab.IsDefMod(n) THEN SemError(201) END;; END; Expect(8); ELSE SynError(89); END; END Import; PROCEDURE ProgUnit; VAR m1, m2: SymTab.Name; BEGIN Expect(20); GetIdent(m1); IF ~SymTab.NoteProgram() THEN SemError(230) END; MGen.SetModName(m1); IF ~SymTab.Enter(m1, SymTab.KindModule) THEN SemError(200) END;; Expect(8); WHILE (sym = 5) OR (sym = 6) DO Import; END; Block(FALSE); GetIdent(m2); IF ~SymTab.Equal(m1, m2) THEN SemError(202) END;; Expect(22); IF SymTab.AnyForward() THEN SemError(231) END; MGen.EndModule; SymTab.PrintTable;; END ProgUnit; PROCEDURE ImplUnit; VAR m1, m2: SymTab.Name; hasInit: BOOLEAN; initL, initN: INTEGER; BEGIN Expect(76); Expect(20); GetIdent(m1); hasInit := FALSE; IF ~SymTab.OpenImplementation(m1) THEN SemError(201) END;; Expect(8); WHILE (sym = 5) OR (sym = 6) DO Import; END; WHILE (sym = 11) OR (sym = 12) OR (sym = 13) OR (sym = 16) OR (sym = 20) DO Declaration; END; IF (sym = 9) THEN Get; hasInit := TRUE; initL := MGen.NewLabel(); MGen.Jmp(initL); initN := MGen.ModInitBegin(); IF initN < 0 THEN SemError(230) END;; StatSeq; END; Expect(10); GetIdent(m2); IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; IF hasInit THEN MGen.ModInitEnd(initN); MGen.DefLabel(initL) END; IF ~SymTab.CloseImplementation() THEN SemError(231) END;; END ImplUnit; PROCEDURE DefUnit; VAR m1, m2: SymTab.Name; BEGIN Expect(75); Expect(20); GetIdent(m1); IF ~SymTab.EnterModule(m1) THEN SemError(200) END;; Expect(8); WHILE (sym = 5) OR (sym = 6) DO Import; END; WHILE (sym = 11) OR (sym = 12) OR (sym = 13) OR (sym = 16) DO DefDecl; END; Expect(10); GetIdent(m2); IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; IF ~SymTab.ExitDefinition() THEN SemError(230) END;; Expect(22); END DefUnit; PROCEDURE Unit; BEGIN IF (sym = 75) THEN DefUnit; ELSIF (sym = 76) THEN ImplUnit; ELSIF (sym = 20) THEN ProgUnit; ELSE SynError(90); END; END Unit; PROCEDURE M2c; BEGIN Unit; 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{1}; symSet[ 1, 2] := BITSET{15}; symSet[ 1, 3] := BITSET{14}; symSet[ 1, 4] := BITSET{6, 7, 8, 9}; symSet[ 2, 0] := BITSET{}; symSet[ 2, 1] := BITSET{}; symSet[ 2, 2] := BITSET{}; symSet[ 2, 3] := BITSET{}; symSet[ 2, 4] := BITSET{0, 1, 2, 3, 4, 5}; symSet[ 3, 0] := BITSET{8, 10}; symSet[ 3, 1] := BITSET{}; symSet[ 3, 2] := BITSET{4, 5, 7, 11}; symSet[ 3, 3] := BITSET{}; symSet[ 3, 4] := BITSET{}; symSet[ 4, 0] := BITSET{1}; symSet[ 4, 1] := BITSET{}; symSet[ 4, 2] := BITSET{0, 2, 6, 8, 10, 12, 13}; symSet[ 4, 3] := BITSET{0, 1, 2, 3, 4, 5}; symSet[ 4, 4] := BITSET{}; symSet[ 5, 0] := BITSET{14}; symSet[ 5, 1] := BITSET{}; symSet[ 5, 2] := BITSET{}; symSet[ 5, 3] := BITSET{7, 8, 9, 10, 11, 12, 13}; symSet[ 5, 4] := BITSET{}; symSet[ 6, 0] := BITSET{9, 10, 11, 12, 13}; symSet[ 6, 1] := BITSET{0, 4}; symSet[ 6, 2] := BITSET{}; symSet[ 6, 3] := BITSET{}; symSet[ 6, 4] := BITSET{}; END M2cP.