COMPILER M2comp (* Step 2 — Coco/R lexer/parser + SymTab semantic analysis (no codegen). Lexer/scanner and parser are FULLY generated by Coco/R (CR): M2comp.atg --CR--> M2compS (scanner) + M2compP (parser) + M2comp (driver from compiler.frm) Static checks (SymTab): 200 duplicate, 201 undeclared, 202 name mismatch, 210 bad assignment, 211 arithmetic, 212 boolean operand, 213 comparison, 214 condition, 215 not a record, 216 unknown field, 217 not an array, 218 bad index, 219 not a pointer, 220 FOR misuse, 221 not a type, 222 set mismatch, 223 cyclical type, 224 ordinal required, 230 unsupported (EXIT outside LOOP, open array outside formal, FROM-lib import inside PROCEDURE, REAL/STRING CONST in a DEFINITION), 232 bad RETURN, 233 invalid call. 231 heading/ body mismatch or missing body (step 5, separate compilation). Kowarsch rules kept from step 1: local MODULEs in Wirth form, unary minus takes a Factor (3.3), abbreviated arrays (3.1), no octal B/C (2.1). "~" never added (2.2); "<>" still accepted. *) IMPORT SymTab, AST; CHARACTERS eol = CHR(13) . letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" . digit = "0123456789" . hexDigit = digit + "ABCDEF" . noQuote1 = ANY - "'" - eol . noQuote2 = ANY - '"' - eol . IGNORE CHR(9) .. CHR(13) COMMENTS FROM "(*" TO "*)" NESTED TOKENS ident = letter { letter | digit } . integer = digit { digit } | digit { digit } CONTEXT("..") | digit { hexDigit } "H" . real = digit { digit } "." { digit } [ "E" [ "+" | "-" ] digit { digit } ] . string = "'" { noQuote1 } "'" | '"' { noQuote2 } '"' . PRODUCTIONS (* NOTE: Coco/R numbers tokens by first occurrence; M2comp.mod's Msg table is regenerated from M2comp.err on every build (via compiler.frm). After grammar edits, rebuild and check that the messages still name the right tokens. *) M2comp = Unit "." . Unit = "DEFINITION" DefUnit | "IMPLEMENTATION" ImplUnit | Module . DefUnit (. VAR m1, m2: SymTab.Name; d, rt: AST.Node; im, ax, dn: AST.Node; .) = (. SymTab.SetUnit(SymTab.UnitDef); d := NIL; .) "MODULE" GetIdent (. IF ~SymTab.BeginDef(m1) THEN SemError(200) END; .) ";" { Import (. d := AST.Append(d, im); d := AST.Append(d, ax); .) } { DefDecl (. d := AST.Append(d, dn); .) } "END" GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) ELSIF ~SymTab.EndDef(m1) THEN SemError(200) END; rt := AST.MkModule(m1, d, NIL); AST.SetRoot(rt); SymTab.PrintTable; AST.DumpTree( AST.GetRoot()); .) . DefDecl (. VAR cn: AST.Node; .) = "CONST" (. n := NIL; .) { ConstDecl ";" (. n := AST.Append(n, cn); .) } | "TYPE" (. n := NIL; .) { TypeDecl ";" (. n := AST.Append(n, cn); .) } | "VAR" (. n := NIL; .) { VarDecl ";" (. n := AST.Append(n, cn); .) } | ProcHeading ";" (. n := NIL; .) . ProcHeading (. VAR m1: SymTab.Name; rt: SymTab.TypeIndex; p: AST.Node; .) = (. rt := SymTab.InvalidType; p := NIL; .) "PROCEDURE" GetIdent (. IF ~SymTab.EnterHeading(m1) THEN SemError(200) END; .) [ FormalParams

] [ ":" QualIdent (. SymTab.SetProcRet(rt); IF (rt # SymTab.InvalidType) & ((SymTab.ClassOf(rt) = SymTab.ClArray) OR (SymTab.ClassOf( rt) = SymTab.ClRecord)) THEN SemError(230) END; .) ] . ImplUnit (. VAR m1, m2: SymTab.Name; d, bs, rt: AST.Node; im, ax, dn: AST.Node; .) = (. SymTab.SetUnit(SymTab.UnitImpl); d := NIL; bs := NIL; .) "MODULE" GetIdent (. IF ~SymTab.DefExists(m1) THEN SemError(201) ELSIF SymTab.ImplDone(m1) THEN SemError(200) ELSIF ~SymTab.OpenImpl(m1) THEN SemError(230) END; .) ";" { Import (. d := AST.Append(d, im); d := AST.Append(d, ax); .) } { ImplDecl (. d := AST.Append(d, dn); .) } [ "BEGIN" StatSeq ] "END" GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) ELSIF ~SymTab.EndImpl(m1) THEN SemError(231) END; rt := AST.MkModule(m1, d, AST.MkBlock(NIL, bs)); AST.SetRoot(rt); SymTab.PrintTable; AST.DumpTree( AST.GetRoot()); .) . ImplDecl (. VAR cn: AST.Node; .) = "CONST" (. n := NIL; .) { ConstDecl ";" (. n := AST.Append(n, cn); .) } | "TYPE" (. n := NIL; .) { TypeDecl ";" (. n := AST.Append(n, cn); .) } | "VAR" (. n := NIL; .) { VarDecl ";" (. n := AST.Append(n, cn); .) } | ImplProcBody ";" (. n := cn; .) . ImplProcBody (. VAR m1, m2, lib: SymTab.Name; rt: SymTab.TypeIndex; p, bd, bs: AST.Node; pn: INTEGER; .) = (. rt := SymTab.InvalidType; p := NIL; .) "PROCEDURE" GetIdent (. SymTab.CurModName(lib); IF ~SymTab.BeginBody(lib, m1) THEN SemError(231) END; SymTab.OpenProcScope; .) [ FormalParams

] [ ":" QualIdent (. SymTab.SetProcRet(rt); IF (rt # SymTab.InvalidType) & ((SymTab.ClassOf(rt) = SymTab.ClArray) OR (SymTab.ClassOf( rt) = SymTab.ClRecord)) THEN SemError(230) END; .) ] ";" (. IF ~SymTab.EndBodyHeader() THEN SemError(231) END; pn := SymTab.ProcNum(m1); .) Block (. n := AST.MkProc(m1, rt, p, AST.MkBlock(bd, bs)); n^.num := pn; .) GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; SymTab.CloseProc; .) . Module (. VAR m1, m2: SymTab.Name; d, bd, bs, rt: AST.Node; im, ax: AST.Node; .) = (. SymTab.SetUnit(SymTab.UnitProg); d := NIL; .) "MODULE" GetIdent ";" { Import (. d := AST.Append(d, im); d := AST.Append(d, ax); .) } Block (. d := AST.Append(d, bd); rt := AST.MkModule(m1, d, AST.MkBlock(NIL, bs)); AST.SetRoot(rt); .) GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; SymTab.PrintTable; AST.DumpTree( AST.GetRoot()); .) . Import (. VAR mod: SymTab.Name; h, ah, t1, t2: AST.Node; m: SymTab.Name; sesh: BOOLEAN; .) = (. mod[0] := 0C; n := NIL; ax := NIL; sesh := FALSE; .) [ "FROM" GetIdent (. IF SymTab.DefExists(m) THEN IF ~SymTab.ImplDone(m) THEN SemError(201) END; IF SymTab.InProc() THEN SemError(230) END; mod := m; sesh := TRUE ELSE IF ~SymTab.Enter(m, SymTab.KindImport) THEN SemError(200) END; mod := m END; .) ] "IMPORT" ImpName (. ax := ah; .) { "," ImpName (. h := AST.Append(h, t1); ax := AST.Append(ax, t2); .) } ";" (. n := AST.MkImport(mod, h); .) . ImpName (. VAR nm: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex; v: INTEGER; nd: AST.Node; .) = GetIdent (. h := AST.MkImpName(nm); ah := NIL; IF sesh THEN IF SymTab.ExpKind(mod, nm) < 0 THEN SemError(201) ELSIF SymTab.Lookup(nm) THEN SemError(200) ELSIF ~SymTab.EnterAlias( mod, nm) THEN SemError(230) ELSE k := SymTab.SymKind(nm); IF k = SymTab.KindVar THEN t := SymTab.SymType( nm); nd := AST.MkVar(nm, t); nd^.tag := mod; ah := nd ELSIF k = SymTab.KindConst THEN t := SymTab.SymType( nm); IF SymTab.ExpConstVal( mod, nm, v) THEN ah := AST.MkConst( nm, AST.MkInt(v, t), t) ELSE SemError(230) END END END ELSE IF SymTab.DefExists(nm) THEN IF ~SymTab.ImplDone( nm) THEN SemError(201) END ELSIF ~SymTab.Enter(nm, SymTab.KindImport) THEN SemError(200) END END; .) . GetIdent = ident (. LexName(n); .) . Block (. VAR dn: AST.Node; .) = (. d := NIL; s := NIL; .) { Declaration (. d := AST.Append(d, dn); .) } [ "BEGIN" StatSeq ] "END" . Declaration (. VAR cn: AST.Node; .) = "CONST" (. n := NIL; .) { ConstDecl ";" (. n := AST.Append(n, cn); .) } | "TYPE" (. n := NIL; .) { TypeDecl ";" (. n := AST.Append(n, cn); .) } | "VAR" (. n := NIL; .) { VarDecl ";" (. n := AST.Append(n, cn); .) } | ProcDecl ";" | ModuleDecl ";" . ConstDecl (. VAR nm: SymTab.Name; t: SymTab.TypeIndex; en: AST.Node; cv: INTEGER; ok: BOOLEAN; .) = GetIdent (. IF ~SymTab.Enter(nm, SymTab.KindConst) THEN SemError(200) END; .) "=" ConstExpr (. SymTab.SetSymType(nm, t); ok := SymTab.ConstFold(en, cv); SymTab.NoteConst(nm, cv, ok); IF SymTab.InDef() & ((SymTab.ClassOf(t) = SymTab.ClReal) OR (SymTab.ClassOf( t) = SymTab.ClStr)) THEN SemError(230) END; n := AST.MkConst(nm, en, t); .) . ConstExpr (. VAR vD: BOOLEAN; .) = Expr . TypeDecl (. VAR nm: SymTab.Name; t0, t1: SymTab.TypeIndex; .) = GetIdent (. IF ~SymTab.Enter(nm, SymTab.KindType) THEN SemError(200) END; t0 := SymTab.NewAlias(); SymTab.SetSymType(nm, t0); .) "=" Type (. IF t1 = t0 THEN SemError(223); SymTab.SetTarget(t0, SymTab.InvalidType) ELSE SymTab.SetTarget(t0, t1) END; n := AST.MkTypeDecl(nm, t1); .) . VarDecl (. VAR t: SymTab.TypeIndex; h: AST.Node; .) = VarIdents ":" Type (. IF SymTab.IsOpen(t) THEN SemError(230) END; AST.SetChainType(h, t); SymTab.FixPending(t); n := h; .) . VarIdents (. VAR nm: SymTab.Name; .) = GetIdent (. IF ~SymTab.EnterPending(nm, SymTab.KindVar) THEN SemError(200) END; h := AST.MkVar(nm, SymTab.InvalidType); .) { "," GetIdent (. IF ~SymTab.EnterPending(nm, SymTab.KindVar) THEN SemError(200) END; h := AST.Append(h, AST.MkVar(nm, SymTab.InvalidType)); .) } . ProcDecl (. VAR m1, m2: SymTab.Name; rt, ret: SymTab.TypeIndex; p, bd, bs: AST.Node; pn: INTEGER; .) = (. ret := SymTab.InvalidType; p := NIL; .) "PROCEDURE" GetIdent (. IF ~SymTab.EnterProc(m1) THEN SemError(200) END; pn := SymTab.ProcNum(m1); SymTab.OpenProcScope; .) [ FormalParams

] [ ":" QualIdent (. ret := rt; SymTab.SetProcRet(rt); IF (rt # SymTab.InvalidType) & ((SymTab.ClassOf(rt) = SymTab.ClArray) OR (SymTab.ClassOf( rt) = SymTab.ClRecord)) THEN SemError(230) END; .) ] ";" Block (. n := AST.MkProc(m1, ret, p, AST.MkBlock(bd, bs)); n^.num := pn; .) GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; SymTab.CloseProc; .) . FormalParams (. VAR ps: AST.Node; .) = "(" (. p := NIL; .) [ FPSection (. p := AST.Append(p, ps); .) { ";" FPSection (. p := AST.Append(p, ps); .) } ] ")" . FPSection (. VAR isV: BOOLEAN; t: SymTab.TypeIndex; .) = (. isV := FALSE; .) [ "VAR" (. isV := TRUE; .) ] FPIdents ":" Type (. IF SymTab.IsOpen(t) & ~isV THEN SemError(230) ELSIF ~isV & (t # SymTab.InvalidType) & ((SymTab.ClassOf(t) = SymTab.ClArray) OR (SymTab.ClassOf(t) = SymTab.ClRecord)) THEN SemError(230) END; AST.SetChainType(p, t); IF ~SymTab.FixParamPending(t) THEN SemError(200) END; .) . FPIdents (. VAR n: SymTab.Name; .) = GetIdent (. IF ~SymTab.EnterParamPending(n, isV) THEN SemError(200) END; p := AST.MkParam(n, SymTab.InvalidType, isV); .) { "," GetIdent (. IF ~SymTab.EnterParamPending(n, isV) THEN SemError(200) END; p := AST.Append(p, AST.MkParam(n, SymTab.InvalidType, isV)); .) } . ModuleDecl (. VAR m1, m2: SymTab.Name; d, bd, bs: AST.Node; im, ax, en: AST.Node; .) = "MODULE" (* local module, Wirth form *) (. d := NIL; .) GetIdent (. IF ~SymTab.EnterModule(m1) THEN SemError(200) END; .) [ Priority ] ";" { Import (. d := AST.Append(d, im); d := AST.Append(d, ax); .) } [ Export (. d := AST.Append(d, en); .) ] Block (. d := AST.Append(d, bd); n := AST.MkModule(m1, d, AST.MkBlock(NIL, bs)); .) GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; IF ~SymTab.ExitModule() THEN SemError(201) END; .) . Priority (. VAR t: SymTab.TypeIndex; vD: BOOLEAN; en: AST.Node; .) = "[" Expr "]" . Export (. VAR nm: SymTab.Name; h: AST.Node; .) = "EXPORT" [ "QUALIFIED" ] GetIdent (. IF ~SymTab.ModuleAddExp(nm) THEN SemError(200) END; h := AST.MkImpName(nm); .) { "," GetIdent (. IF ~SymTab.ModuleAddExp(nm) THEN SemError(200) END; h := AST.Append(h, AST.MkImpName(nm)); .) } ";" (. n := AST.MkExport(h); .) . Type (. VAR c: CARDINAL; e, s: SymTab.TypeIndex; los, his: SymTab.BoundsArr; fh: AST.Node; i: CARDINAL; .) = BoundedBase | "ARRAY" (* abbreviated form only (3.1); nested ARRAY OF ARRAY long form flagged in step 4 sizing *) (. c := 0; i := 0; WHILE i <= 7 DO los[i] := 0; his[i] := -1; INC(i) END; .) [ IdxList ] "OF" Type (. t := SymTab.WrapArrayB(e, los, his, c); .) | "RECORD" (. t := SymTab.NewRecord(); .) FieldSeq "END" | "SET" "OF" QualIdent (. 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); .) | "POINTER" "TO" Type (. t := SymTab.NewPtr(e); .) . BoundedBase (. VAR t1, t2: SymTab.TypeIndex; vD, vD2: BOOLEAN; en, en2: AST.Node; lo, hi: INTEGER; .) = QualIdent [ "[" Expr (. IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END; .) ".." Expr (. IF (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t2) # SymTab.ClInt) & (SymTab.ClassOf(t2) # SymTab.ClChar) & (SymTab.ClassOf(t2) # SymTab.ClEnum) THEN SemError(224) END; IF (t1 = SymTab.InvalidType) OR (t2 = SymTab.InvalidType) THEN t := SymTab.NewSub(t1) ELSIF SymTab.ConstFold(en, lo) & SymTab.ConstFold(en2, hi) THEN t := SymTab.NewSubB(t1, lo, hi) ELSE SemError(230); t := SymTab.NewSub(t1) END; .) "]" ] | "[" Expr (. IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END; .) ".." Expr (. IF (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t2) # SymTab.ClInt) & (SymTab.ClassOf(t2) # SymTab.ClChar) & (SymTab.ClassOf(t2) # SymTab.ClEnum) THEN SemError(224) END; IF (t1 = SymTab.InvalidType) OR (t2 = SymTab.InvalidType) THEN t := SymTab.NewSub(t1) ELSIF SymTab.ConstFold(en, lo) & SymTab.ConstFold(en2, hi) THEN t := SymTab.NewSubB(t1, lo, hi) ELSE SemError(230); t := SymTab.NewSub(t1) END; .) "]" . IdxList (. VAR s: SymTab.TypeIndex; lo, hi: INTEGER; ok: BOOLEAN; .) = IndexType (. c := 1; los[0] := lo; his[0] := hi; .) { "," IndexType (. IF c <= 7 THEN los[c] := lo; his[c] := hi END; INC(c); .) } . IndexType (. VAR t1, t2: SymTab.TypeIndex; vD, vD2: BOOLEAN; en, en2: AST.Node; l2, h2: INTEGER; .) = QualIdent (. ok := SymTab.IndexBounds(t, lo, hi); .) [ "[" Expr (. IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END; .) ".." Expr (. IF (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t2) # SymTab.ClInt) & (SymTab.ClassOf(t2) # SymTab.ClChar) & (SymTab.ClassOf(t2) # SymTab.ClEnum) THEN SemError(224) END; IF (t1 = SymTab.InvalidType) OR (t2 = SymTab.InvalidType) THEN t := SymTab.NewSub(t1) ELSIF SymTab.ConstFold(en, l2) & SymTab.ConstFold(en2, h2) THEN t := SymTab.NewSubB(t1, l2, h2); lo := l2; hi := h2; ok := TRUE ELSE t := SymTab.NewSub(t1); ok := FALSE END; .) "]" ] (. IF (t # SymTab.InvalidType) & ~ok THEN SemError(230) END; .) | "[" Expr (. IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END; ok := FALSE; .) ".." Expr (. IF (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t2) # SymTab.ClInt) & (SymTab.ClassOf(t2) # SymTab.ClChar) & (SymTab.ClassOf(t2) # SymTab.ClEnum) THEN SemError(224) END; IF (t1 = SymTab.InvalidType) OR (t2 = SymTab.InvalidType) THEN t := SymTab.NewSub(t1) ELSIF SymTab.ConstFold(en, lo) & SymTab.ConstFold(en2, hi) THEN t := SymTab.NewSubB(t1, lo, hi); ok := TRUE ELSE SemError(230); t := SymTab.NewSub(t1) END; .) "]" . FieldSeq (. VAR fn: AST.Node; .) = Field (. h := fn; .) { ";" Field (. h := AST.Append(h, fn); .) } . Field (. VAR et: SymTab.TypeIndex; h: AST.Node; .) = (. n := NIL; .) [ FieldIdents ":" Type (. AST.SetChainType(h, et); SymTab.FixPendingF(rt, et); n := h; .) ] . FieldIdents (. VAR nm: SymTab.Name; .) = GetIdent (. IF ~SymTab.FieldPending(rt, nm) THEN SemError(200) END; h := AST.MkMember(nm, SymTab.InvalidType); .) { "," GetIdent (. IF ~SymTab.FieldPending(rt, nm) THEN SemError(200) END; h := AST.Append(h, AST.MkMember(nm, SymTab.InvalidType)); .) } . QualIdent (. VAR n, m: SymTab.Name; modHead: BOOLEAN; .) = (. modHead := FALSE; .) GetIdent (. IF ~SymTab.Lookup(n) THEN SemError(201); t := SymTab.InvalidType ELSIF SymTab.SymKind(n) = SymTab.KindModule THEN t := SymTab.InvalidType; modHead := TRUE 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; .) { "." GetIdent (. IF modHead THEN modHead := FALSE; IF SymTab.ExpKind(n, m) = SymTab.KindType THEN t := SymTab.ExpType(n, m) ELSIF SymTab.SelfKind(n, m) = SymTab.KindType THEN t := SymTab.SelfType(n, 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 ELSIF t # SymTab.InvalidType THEN SemError(221); t := SymTab.InvalidType END; .) } . StatSeq (. VAR st: AST.Node; .) = Stat (. s := st; .) { ";" Stat (. s := AST.Append(s, st); .) } . Stat = (. s := NIL; .) [ AssignOrCall | IfStat | WhileStat | RepeatStat | LoopStat | ForStat | WithStat | CaseStat | ReturnStat | "EXIT" (. IF ~SymTab.InLoop() THEN SemError(230) END; s := AST.MkExit(); .) ] . AssignOrCall (. VAR dt, et: SymTab.TypeIndex; dk, pn: INTEGER; ev: BOOLEAN; nn: CARDINAL; hadP: BOOLEAN; dn, en, ah: AST.Node; .) = Designator ( ":=" Expr (. IF dt = SymTab.InvalidType THEN (* cascade *) ELSIF (dk # SymTab.KindVar) & (dk # SymTab.KindParam) & (dk # SymTab.KindVarPar) & (dk # SymTab.KindField) THEN SemError(210) ELSIF ~SymTab.Assignable(et, dt) THEN SemError(210) END; s := AST.MkAssign(dn, en); .) | (. hadP := FALSE; nn := 0; ah := NIL; IF dk = SymTab.KindProc THEN SymTab.CallBeginNum(pn) ELSE SymTab.CallBeginNum(-1) END; IF (dk # SymTab.KindProc) & (dk # -1) THEN SemError(233) END; .) [ ActParams (. hadP := TRUE; .) ] (. IF ~SymTab.CallEndNum(nn) THEN SemError(233) END; s := AST.MkCall(dn, ah, pn); .) ) . Designator (. VAR n, m: SymTab.Name; it, it2: SymTab.TypeIndex; iv, iv2: BOOLEAN; ek, sk, p2: INTEGER; modHead, wasMod: BOOLEAN; en, en2, ih: AST.Node; .) = GetIdent (. modHead := FALSE; IF ~SymTab.Lookup(n) THEN SemError(201); t := SymTab.InvalidType; k := -1; pn := -1 ELSIF SymTab.SymKind(n) = SymTab.KindModule THEN t := SymTab.InvalidType; k := SymTab.KindModule; pn := -1; modHead := TRUE ELSE t := SymTab.SymType(n); k := SymTab.SymKind(n); IF k = SymTab.KindProc THEN pn := SymTab.ProcNum(n) ELSE pn := -1 END END; dn := AST.MkName(n, t); dn^.aux := k; .) { "." GetIdent (. wasMod := modHead; IF modHead THEN modHead := FALSE; ek := SymTab.ExpKind(n, m); sk := SymTab.SelfKind(n, m); IF ek = SymTab.KindType THEN t := SymTab.ExpType(n, m); k := SymTab.KindType ELSIF sk = SymTab.KindType THEN t := SymTab.SelfType(n, m); k := SymTab.KindType ELSIF ek = SymTab.KindProc THEN t := SymTab.ProcRetByNum( SymTab.ExpProc( n, m)); k := SymTab.KindProc; pn := SymTab.ExpProc( n, m) ELSIF sk = SymTab.KindProc THEN p2 := SymTab.SelfProc( n, m); t := SymTab.ProcRetByNum( p2); k := SymTab.KindProc; pn := p2 ELSIF ek >= 0 THEN t := SymTab.ExpType(n, m); k := ek; pn := -1 ELSIF sk >= 0 THEN t := SymTab.SelfType(n, m); k := sk; pn := -1 ELSE SemError(201); t := SymTab.InvalidType; k := -1; pn := -1 END ELSIF t = SymTab.InvalidType THEN (* cascade *) ELSIF SymTab.ClassOf(t) # SymTab.ClRecord THEN SemError(215); t := SymTab.InvalidType; k := -1; pn := -1 ELSIF ~SymTab.FieldExists(t, m) THEN SemError(216); t := SymTab.InvalidType; k := -1; pn := -1 ELSE t := SymTab.FieldType(t, m); k := SymTab.KindField; pn := -1 END; dn := AST.MkField(dn, m, t); dn^.aux := k; IF wasMod THEN dn^.tag := n END; .) | "[" Expr (. IF t = SymTab.InvalidType THEN (* cascade *) ELSIF SymTab.ClassOf(t) # SymTab.ClArray THEN SemError(217); t := SymTab.InvalidType; k := -1; pn := -1 ELSIF (it # SymTab.InvalidType) & ~SymTab.IsIntFamily( it) THEN SemError(218); t := SymTab.InvalidType; k := -1; pn := -1 ELSE t := SymTab.ArrayElem( t); pn := -1 END; ih := en; .) { "," Expr (. IF t = SymTab.InvalidType THEN (* cascade *) ELSIF SymTab.ClassOf(t) # SymTab.ClArray THEN SemError(217); t := SymTab.InvalidType; k := -1; pn := -1 ELSIF (it2 # SymTab.InvalidType) & ~SymTab.IsIntFamily( it2) THEN SemError(218) ELSE t := SymTab.ArrayElem( t) END; ih := AST.Append(ih, en2); .) } "]" (. dn := AST.MkIndex(dn, ih, t); dn^.aux := k; .) | "^" (. IF t = SymTab.InvalidType THEN (* cascade *) ELSIF SymTab.ClassOf(t) # SymTab.ClPtr THEN SemError(219); t := SymTab.InvalidType; k := -1; pn := -1 ELSE t := SymTab.PtrBase(t); pn := -1 END; dn := AST.MkDeref(dn, t); dn^.aux := k; .) } . ActParams (. VAR at: SymTab.TypeIndex; av: BOOLEAN; ae: AST.Node; .) = "(" (. h := NIL; n := 0; .) [ Expr (. IF ~SymTab.CallActual(at, av) THEN SemError(233) END; h := AST.Append(h, ae); n := 1; .) { "," Expr (. IF ~SymTab.CallActual(at, av) THEN SemError(233) END; h := AST.Append(h, ae); INC(n); .) } ] ")" . IfStat (. VAR t: SymTab.TypeIndex; vD: BOOLEAN; cn, th, el, p: AST.Node; .) = "IF" Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; .) "THEN" StatSeq (. s := AST.MkIf(cn, th, NIL); .) { "ELSIF" Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; .) "THEN" StatSeq (. th := AST.MkIf(cn, th, NIL); p := s; WHILE p^.extra # NIL DO p := p^.extra END; p^.extra := th; .) } [ "ELSE" StatSeq (. p := s; WHILE p^.extra # NIL DO p := p^.extra END; p^.extra := el; .) ] "END" . WhileStat (. VAR t: SymTab.TypeIndex; vD: BOOLEAN; cn, bd: AST.Node; .) = "WHILE" Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; .) "DO" StatSeq (. s := AST.MkWhile(cn, bd); .) "END" . RepeatStat (. VAR t: SymTab.TypeIndex; vD: BOOLEAN; cn, bd: AST.Node; .) = "REPEAT" StatSeq "UNTIL" Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; s := AST.MkRepeat(bd, cn); .) . LoopStat (. VAR bd: AST.Node; .) = "LOOP" (. SymTab.LoopEnter; .) StatSeq "END" (. SymTab.LoopExit; s := AST.MkLoop(bd); .) . ForStat (. VAR n: SymTab.Name; lo, hi, by: SymTab.TypeIndex; lv, lv2, lv3: BOOLEAN; ln, hn, bn, bd: AST.Node; .) = "FOR" GetIdent (. IF ~SymTab.Lookup(n) THEN SemError(201) ELSIF (SymTab.SymKind(n) # SymTab.KindVar) & (SymTab.SymKind(n) # SymTab.KindParam) & (SymTab.SymKind(n) # SymTab.KindVarPar) & (SymTab.SymKind(n) # SymTab.KindField) THEN SemError(220) ELSIF (SymTab.SymType(n) # SymTab.InvalidType) & ~SymTab.IsIntFamily( SymTab.SymType(n)) THEN SemError(220) END; .) ":=" Expr (. IF (lo # SymTab.InvalidType) & ~SymTab.IsIntFamily(lo) THEN SemError(220) END; .) "TO" Expr (. IF (hi # SymTab.InvalidType) & ~SymTab.IsIntFamily(hi) THEN SemError(220) END; bn := NIL; .) [ "BY" Expr (. IF (by # SymTab.InvalidType) & ~SymTab.IsIntFamily(by) THEN SemError(220) END; .) ] "DO" StatSeq (. s := AST.MkFor(n, ln, hn, bn, bd); .) "END" . WithStat (. VAR dt: SymTab.TypeIndex; dk, pn: INTEGER; dn, bs: AST.Node; pushed: BOOLEAN; .) = "WITH" Designator (. pushed := FALSE; IF dt = SymTab.InvalidType THEN (* cascade *) ELSIF SymTab.ClassOf(dt) # SymTab.ClRecord THEN SemError(215) ELSE pushed := SymTab.PushRecord(dt); IF ~pushed THEN SemError(215) END END; .) "DO" StatSeq "END" (. IF pushed THEN SymTab.PopScope END; s := AST.MkWith(dn, bs); .) . CaseStat (. VAR st: SymTab.TypeIndex; vD: BOOLEAN; se, arms, arm, el: AST.Node; .) = (. arms := NIL; el := NIL; .) "CASE" Expr (. IF (st # SymTab.InvalidType) & ~SymTab.IsIntFamily(st) & (SymTab.ClassOf(st) # SymTab.ClChar) THEN SemError(213) END; .) "OF" [ CaseArm (. arms := arm; .) { "|" CaseArm (. arms := AST.Append(arms, arm); .) } ] [ "ELSE" StatSeq ] "END" (. s := AST.MkCase(se, arms, el); .) . CaseArm (. VAR lh, lab, bs: AST.Node; .) = CaseLabel (. lh := lab; .) { "," CaseLabel (. lh := AST.Append(lh, lab); .) } ":" StatSeq (. n := AST.MkCaseArm(lh, bs); .) . CaseLabel (. VAR t, t2: SymTab.TypeIndex; vD, vD2: BOOLEAN; en, en2: AST.Node; lo, hi: INTEGER; .) = ConstExpr (. n := NIL; IF t = SymTab.InvalidType THEN (* cascade *) ELSIF ~SymTab.EqCheck(t, st) THEN SemError(213) ELSIF ~SymTab.ConstFold(en, lo) THEN SemError(230) ELSE n := AST.MkInt(lo, t) END; .) [ ".." ConstExpr (. IF (t2 # SymTab.InvalidType) & ~SymTab.EqCheck(t2, st) THEN SemError(213) ELSIF ~SymTab.ConstFold(en2, hi) THEN SemError(230) ELSE n := AST.MkRange(lo, hi) END; .) ] . ReturnStat (. VAR et: SymTab.TypeIndex; ev, hasE: BOOLEAN; en, e0: AST.Node; .) = (. hasE := FALSE; e0 := NIL; .) "RETURN" [ Expr (. hasE := TRUE; e0 := en; .) ] (. IF ~SymTab.InProc() THEN SemError(232) ELSIF SymTab.InFunction() & ~hasE THEN SemError(232) ELSIF ~SymTab.InFunction() & hasE THEN SemError(232) END; s := AST.MkReturn(e0); .) . Expr (. VAR t2: SymTab.TypeIndex; v2: BOOLEAN; op: INTEGER; e2: AST.Node; .) = SimExpr [ Relation SimExpr (. v := FALSE; IF op = SymTab.OpIn THEN IF SymTab.InCheck(t, t2) THEN t := SymTab.BoolType() ELSE SemError(222); t := SymTab.InvalidType END ELSE IF SymTab.RelCheck(t, t2, op) THEN t := SymTab.BoolType() ELSE SemError(213); t := SymTab.InvalidType END END; e := AST.MkBin(op, e, e2, t); .) ] . Relation = "=" (. op := SymTab.OpEq; .) | "#" (. op := SymTab.OpNeq1; .) | "<>" (. op := SymTab.OpNeq2; .) | "<" (. op := SymTab.OpLt; .) | "<=" (. op := SymTab.OpLe; .) | ">" (. op := SymTab.OpGt; .) | ">=" (. op := SymTab.OpGe; .) | "IN" (. op := SymTab.OpIn; .) . SimExpr (. VAR t2, res2: SymTab.TypeIndex; v2: BOOLEAN; op: INTEGER; e2: AST.Node; .) = ( "+" Term (. IF ~SymTab.UnaryCheck(t, res2) THEN SemError(211); t := SymTab.InvalidType ELSE t := res2 END; v := FALSE; e := AST.MkUn(AST.opPos, e, t); .) | "-" Fact (. IF ~SymTab.UnaryCheck(t, res2) THEN SemError(211); t := SymTab.InvalidType ELSE t := res2 END; v := FALSE; e := AST.MkUn(AST.opNeg, e, t); .) | Term ) { AddOp Term (. v := FALSE; IF op = SymTab.OpOr THEN IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END ELSE IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2 ELSE SemError(211); t := SymTab.InvalidType END END; e := AST.MkBin(op, e, e2, t); .) } . AddOp = "+" (. op := SymTab.OpAdd; .) | "-" (. op := SymTab.OpSub; .) | "OR" (. op := SymTab.OpOr; .) . Term (. VAR t2, res2: SymTab.TypeIndex; v2: BOOLEAN; op: INTEGER; e2: AST.Node; .) = Fact { MulOp Fact (. v := FALSE; IF op = SymTab.OpAnd THEN IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType 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 END; e := AST.MkBin(op, e, e2, t); .) } . MulOp = "*" (. op := SymTab.OpTimes; .) | "/" (. op := SymTab.OpSlash; .) | "DIV" (. op := SymTab.OpDiv; .) | "MOD" (. op := SymTab.OpMod; .) | "AND" (. op := SymTab.OpAnd; .) . Fact (. VAR s: ARRAY [0 .. 255] OF CHAR; t2, et, dt: SymTab.TypeIndex; dk, pn: INTEGER; nn: CARDINAL; hadP, ce, pushed: BOOLEAN; ev, v2: BOOLEAN; dn, ah, en: AST.Node; iv: INTEGER; ok: BOOLEAN; .) = integer (. LexString(s); t := SymTab.IntType(); v := FALSE; ok := AST.ParseInt(s, iv); IF ~ok THEN iv := 0 END; e := AST.MkInt(iv, t); .) | real (. LexString(s); t := SymTab.RealType(); v := FALSE; e := AST.MkReal(s, t); .) | string (. LexString(s); IF SymTab.StrLen(s) <= 3 THEN t := SymTab.CharType(); e := AST.MkChar( ORD(s[1]), t) ELSE t := SymTab.NewStr(); e := AST.MkStr(s, t) END; v := FALSE; .) | Designator (. hadP := FALSE; nn := 0; IF dk = SymTab.KindProc THEN SymTab.CallBeginNum(pn); pushed := TRUE ELSE pushed := FALSE END; .) [ (. IF ~pushed THEN SymTab.CallBeginNum(-1); pushed := TRUE END; .) ActParams (. hadP := TRUE; .) ] (. IF pushed THEN ce := SymTab.CallEndNum(nn) END; IF hadP THEN v := FALSE; IF dk # SymTab.KindProc THEN SemError(233); t := SymTab.InvalidType ELSIF SymTab.ProcRetByNum( pn) = SymTab.InvalidType THEN SemError(233); t := SymTab.InvalidType ELSIF ~ce THEN SemError(233); t := SymTab.InvalidType ELSE t := SymTab.ProcRetByNum(pn) END; e := AST.MkCallExpr(dn, ah, pn, t) ELSE IF dk = SymTab.KindProc THEN SemError(233); t := SymTab.InvalidType; v := FALSE; e := AST.MkName("?", t) ELSE t := dt; v := (dt # SymTab.InvalidType) & ((dk = SymTab.KindVar) OR (dk = SymTab.KindParam) OR (dk = SymTab.KindVarPar) OR (dk = SymTab.KindField)); e := dn END END; .) | "(" Expr ")" (. t := et; v := FALSE; e := en; .) | "NOT" Fact (. IF SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; v := FALSE; e := AST.MkUn(AST.opNot, en, t); .) . END M2comp.