COMPILER M2c (* Modula-2 program modules with procedures and composites, MC64 backend (see MGen for details). Step 11 adds separate compilation units (DEFINITION / IMPLEMENTATION / IMPORT) into a single image: - session: M2c f1.def f2.mod ... prog.mod — definition files, then implementations, then exactly one program module; one .MC4 image, one .LST per input, fail-fast on the first bad file. SymTab.Init + MGen.OpenModule run once in the driver; the program unit sets the image name (SetModName). - DEFINITION MODULE L: CONST/TYPE/VAR + procedure headings only; everything declared is exported (export tables + in-memory interface side table); VAR/CONST allocate their global slots once ("L.x"); proc headings reserve numbers via the forward machinery. No nested MODULEs, no BEGIN. - IMPLEMENTATION MODULE L: needs its definition (201); re-enters the interface implicitly (redeclared exports are 200 duplicates); headings match via ReuseProc/VerifyProc (231); private decls allowed; every heading needs its body (231); optional BEGIN init runs at startup in file order. - IMPORT L validates a known definition (201); FROM L IMPORT x materializes real alias symbols (types/consts/vars share the definition's descriptors and globals via GlobAlias; procs share the number, so call checking is unchanged). Ghost names are 201, bad kinds 221, duplicates 200. - caps (phase): 8 definitions, 32 interface names each, 64 FROM-aliases; still one image, depCount 0 (no multi-.MC4, no circular imports, no opaque types). Older notes (steps 1-10): - program module only, no DEFINITION / IMPLEMENTATION split - local MODULEs (single-file, no nesting): EXPORT of VARs, CONSTs, TYPEs and procedures (value/VAR params, functions, open array formals with fixed actuals); use as M.x / M.P(args); optional BEGIN..END init bodies run at startup in declaration order; no PRIORITY - procedures: declarations (nested), value and VAR parameters, functions with RETURN, recursion, FORWARD headings; no procedure types/variables, no cones - composites (Phase 3): fixed ARRAYs (bounds, 1D/multi-D indexing, unchecked, byte-packed CHAR/BOOLEAN), RECORDs (field offsets, .field, WITH incl. nested), SETs (+ union, - difference, * intersection, inclusive .. ranges), POINTERs (NEW/DISPOSE via VM ALLOCATE, ^, NIL), strings (ARRAY OF CHAR literal assign). Open arrays deferred; whole array/record copy deferred except string literals; VAR actuals must be simple (no a[i]/p^/fields as VAR actuals, 233); value composite params rejected (230); composite function returns rejected (unchecked, avoid wrong LEAVE). - statements: assignment, procedure call, IF, CASE, WHILE, REPEAT, LOOP/EXIT, FOR, WITH, RETURN, NEW, DISPOSE - symbol table (SymTab) with static type checking: error codes 200/201/202 and 210-224 (as before), plus 231 (procedure forward mismatch or missing body), 232 (bad RETURN), 233 (invalid procedure call); same lenient rules (single pass, declare-before-use, except POINTER bases may be same-scope aliases with structural pointer compatibility in Assignable; INTEGER, CARDINAL and subranges form one integer family; no mixed INTEGER/REAL arithmetic; INTEGER assigns to REAL; 1-character literal is CHAR; InvalidType suppresses follow-on errors) - backend (MGen): single-module MC64 image .MC4, runnable with mcint. Procedures take table entries 1..N (0 = module body), run with ENTER frames, called via ED (global), EC (directly nested) or EE (display walk); actuals evaluate left-to-right into temps, then push reversed. Lowered: scalar + composite globals/frame vars (multi-slot, byte sizes, field/element offsets), CONST literals, SET masks with literals/ranges/IN/=/#/+-/*; full scalar + composite expressions (scaled indexing via IdxScale, field via FieldAdd, deref via 41H/60H, byte ops 0DH/1DH for CHAR); control flow via E0/E1 jumps; composite assign via StoreIndir0/StoreByte (scalar elems) and copy_block (strings). The rest parses and type-checks but gets error 230: open arrays, whole array/record copy (except string literals), value composite params/returns, non-literal CONST expressions and BY steps, EXIT outside LOOP, imported names used as values. - test convention (the language has no I/O): a global VAR ExitCode : INTEGER; is printed as decimal + CRLF through an embedded helper; without it the program just ends. - known semantic edges: INTEGER DIV/MOD truncate toward zero; CARDINAL past MAXINT compares as signed; AND/OR are eager; REAL widens to binary64; unchecked ARRAY indexing (no DA/DB); NIL dereference reads 0 (no static check, no VM trap yet); CHAR/BOOLEAN arrays byte-packed (1 byte/elem, slots over- allocated 8x); at most 64 procedures, 64 actuals per call, 16 names per FP-section, 8-deep nested calls, 8-deep WITH, 1024 slots max per type. *) IMPORT SymTab, MGen; 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; M2c.mod's Msg table is regenerated from M2c.err on every build (via compiler.frm). After grammar edits, rebuild and check that the messages still name the right tokens. *) M2c = Unit . Unit = DefUnit | ImplUnit | ProgUnit . Import (. VAR n: SymTab.Name; .) = "FROM" GetIdent (. IF ~SymTab.IsDefMod(n) THEN SemError(201) END; .) "IMPORT" ImpItem { "," ImpItem } ";" | "IMPORT" GetIdent (. IF ~SymTab.IsDefMod(n) THEN SemError(201) END; .) { "," GetIdent (. IF ~SymTab.IsDefMod(n) THEN SemError(201) END; .) } ";" . ImpItem (. VAR a: SymTab.Name; k: INTEGER; .) = GetIdent (. 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; .) . Block (. VAR began: BOOLEAN; .) = (. began := FALSE; .) { Declaration } [ "BEGIN" (. began := TRUE; IF isProc THEN MGen.ProcEntry( SymTab.CurProc(), SymTab.ProcNLocals()) ELSE MGen.BeginBody END; .) StatSeq ] "END" (. 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; .) . Declaration = "CONST" { ConstDecl ";" } | "TYPE" { TypeDecl ";" } | "VAR" { VarDecl ";" } | ProcedureDecl ";" | ModuleDecl ";" . ConstDecl (. VAR n: SymTab.Name; t: SymTab.TypeIndex; lx: MGen.LitStr; cls: INTEGER; .) = GetIdent (. IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END .) "=" (. MGen.NoEmitEnter; .) ConstExpr (. 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; .) . ConstExpr (. VAR vD: BOOLEAN; vnD: SymTab.Name; .) = Expr . TypeDecl (. VAR n: SymTab.Name; t0, t1: SymTab.TypeIndex; .) = GetIdent (. IF ~SymTab.Enter(n, SymTab.KindType) THEN SemError(200) END; t0 := SymTab.NewAlias(); SymTab.SetSymType(n, t0); .) "=" Type (. IF t1 = t0 THEN SemError(223); SymTab.SetTarget(t0, SymTab.InvalidType) ELSE SymTab.SetTarget(t0, t1) END; .) . VarDecl (. VAR t: SymTab.TypeIndex; i: CARDINAL; nm: SymTab.Name; cls: INTEGER; sl: CARDINAL; .) = VarIdents ":" Type (. 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); .) . VarIdents (. VAR n: SymTab.Name; .) = GetIdent (. IF ~SymTab.EnterPending(n, SymTab.KindVar) THEN SemError(200) END .) { "," GetIdent (. IF ~SymTab.EnterPending(n, SymTab.KindVar) THEN SemError(200) END .) } . ProcedureDecl (. VAR n, m: SymTab.Name; rt: SymTab.TypeIndex; hasR, ok: BOOLEAN; endL: INTEGER; .) = "PROCEDURE" (. hasR := FALSE; .) GetIdent (. IF SymTab.IsForward(n) THEN SymTab.ReuseProc(n) ELSIF ~SymTab.EnterProc(n) THEN SemError(200) END; SymTab.OpenProcScope; endL := MGen.NewLabel(); MGen.Jmp(endL); .) [ "(" FormalParams ")" ] [ ":" QualIdent (. hasR := TRUE; .) ] (. 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; .) ";" ( Block GetIdent (. IF ~SymTab.Equal(n, m) THEN SemError(202) END; MGen.DefLabel(endL); SymTab.CloseProc; .) | "FORWARD" (. SymTab.SetForward; SymTab.CloseProc; MGen.DefLabel(endL); .) ) . ModuleDecl (. VAR n, m, e: SymTab.Name; noMod, enterOk, hasInit: BOOLEAN; initL, initN: INTEGER; .) = "MODULE" (. noMod := SymTab.InProc() OR SymTab.InModule(); enterOk := FALSE; hasInit := FALSE; .) GetIdent (. IF noMod THEN SemError(230) ELSIF ~SymTab.EnterModule(n) THEN SemError(200) ELSE enterOk := TRUE END; .) [ "EXPORT" GetIdent (. IF ~noMod & enterOk THEN IF ~SymTab.ModuleAddExp(e) THEN SemError(200) END END; .) { "," GetIdent (. IF ~noMod & enterOk THEN IF ~SymTab.ModuleAddExp(e) THEN SemError(200) END END; .) } ] ";" { Declaration } [ "BEGIN" (. 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" GetIdent (. 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; .) . FormalParams = FPSection { ";" FPSection } . FPSection (. VAR isV: BOOLEAN; nn, i: CARDINAL; pn: ARRAY [0 .. 15] OF SymTab.Name; n: SymTab.Name; t: SymTab.TypeIndex; .) = (. isV := FALSE; nn := 0; .) [ "VAR" (. isV := TRUE; .) ] GetIdent (. IF nn <= HIGH(pn) THEN MGen.CopyName(n, pn[nn]) END; INC(nn); .) { "," GetIdent (. IF nn <= HIGH(pn) THEN MGen.CopyName(n, pn[nn]) END; INC(nn); .) } ":" Type (. 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; .) . QualIdent (. VAR n, m: SymTab.Name; .) = GetIdent (. 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; .) { "." GetIdent (. 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; .) } . (* Types: ProcedureType removed; subrange factored for LL(1) *) Type = SimpleType | ArrayType | RecordType | SetType | PointerType . SimpleType (. VAR t1, t2: SymTab.TypeIndex; lx1, lx2: MGen.LitStr; vD: BOOLEAN; vnD: SymTab.Name; loI, hiI: INTEGER; lok, hik: BOOLEAN; .) = QualIdent [ "[" (. MGen.NoEmitEnter; lok := FALSE; hik := FALSE; loI := 0; hiI := -1; .) ConstExpr (. IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END; .) ".." ConstExpr (. 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) & (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; .) ] | "[" (. MGen.NoEmitEnter; lok := FALSE; hik := FALSE; loI := 0; hiI := -1; .) ConstExpr (. IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END; .) ".." ConstExpr (. 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) & (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; .) | Enum . Enum (. VAR n: SymTab.Name; ord: INTEGER; .) = "(" (. t := SymTab.NewEnum(); ord := 0; .) GetIdent (. IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); SymTab.EnumAdd(t); MGen.DeclConstInt(n, ord); INC(ord); .) { "," GetIdent (. IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); SymTab.EnumAdd(t); MGen.DeclConstInt(n, ord); INC(ord); .) } ")" . ArrayType (. VAR s, s2, e: SymTab.TypeIndex; idx: ARRAY [0 .. 7] OF SymTab.TypeIndex; nc, kk: CARDINAL; loA, hiA: INTEGER; isOpenA: BOOLEAN; .) = "ARRAY" [ SimpleType (. 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); .) { "," SimpleType (. 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; .) } | (. nc := 0; isOpenA := TRUE; .) ] "OF" Type (. 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; .) . RecordType = "RECORD" (. t := SymTab.NewRecord(); .) FieldSeq "END" . FieldSeq = Field { ";" Field } . Field (. VAR et: SymTab.TypeIndex; .) = [ FieldIdents ":" Type (. IF (et # SymTab.InvalidType) & SymTab.IsOpen(et) THEN SemError(230) END; SymTab.FixPendingF(rt, et); .) ] . FieldIdents (. VAR n: SymTab.Name; .) = GetIdent (. IF ~SymTab.FieldPending(rt, n) THEN SemError(200) END .) { "," GetIdent (. IF ~SymTab.FieldPending(rt, n) THEN SemError(200) END .) } . SetType (. VAR s: SymTab.TypeIndex; .) = "SET" "OF" SimpleType (. 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); .) . PointerType (. VAR b: SymTab.TypeIndex; .) = "POINTER" "TO" Type (. t := SymTab.NewPtr(b); .) . (* Statements: RETURN added; calls via AssignOrCall *) StatSeq = Stat { ";" Stat } . Stat (. VAR lx: INTEGER; .) = [ AssignOrCall | IfStat | CaseStat | WhileStat | RepeatStat | LoopStat | ForStat | WithStat | ReturnStat | NewStat | DispStat | WriteIntStat | WriteStrStat | "EXIT" (. IF MGen.TopLoop(lx) THEN MGen.Jmp(lx) ELSE SemError(230) END; .) ] . 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; .) = (. sfx := FALSE; pushedDst := FALSE; pushedFld := FALSE; .) DesignHead DesignTail ( ":=" (. 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 (. 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; .) | CallTail | (. 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; .) ) . CallTail (. VAR t: SymTab.TypeIndex; lx: MGen.LitStr; v: BOOLEAN; vn: SymTab.Name; isModP: BOOLEAN; modPNum: INTEGER; modErr: BOOLEAN; .) = "(" (. 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; .) [ Expr (. 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; .) { "," Expr (. 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; .) } ] ")" (. 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; .) . IfStat (. VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; vC: BOOLEAN; vnC: SymTab.Name; elseL, endL: INTEGER; hasElse: BOOLEAN; .) = "IF" Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; elseL := MGen.NewLabel(); endL := MGen.NewLabel(); MGen.Jz(elseL); hasElse := FALSE; .) "THEN" StatSeq { "ELSIF" (. MGen.Jmp(endL); MGen.DefLabel(elseL); .) Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; elseL := MGen.NewLabel(); MGen.Jz(elseL); .) "THEN" StatSeq } [ "ELSE" (. MGen.Jmp(endL); MGen.DefLabel(elseL); hasElse := TRUE; .) StatSeq ] "END" (. IF ~hasElse THEN MGen.DefLabel(elseL) END; MGen.DefLabel(endL); .) . CaseStat (. VAR st: SymTab.TypeIndex; lxS: MGen.LitStr; vS: BOOLEAN; vnS: SymTab.Name; tmp, endL: INTEGER; .) = "CASE" Expr (. tmp := MGen.TempGlobal(); MGen.StoreTemp(tmp); endL := MGen.NewLabel(); .) "OF" Case { "|" Case } [ "ELSE" StatSeq ] "END" (. MGen.DefLabel(endL); .) . Case (. VAR lB, lN: INTEGER; .) = [ LabelList ":" (. MGen.DefLabel(lB); .) StatSeq (. MGen.Jmp(endL); MGen.DefLabel(lN); .) ] . LabelList = (. lB := MGen.NewLabel(); lN := MGen.NewLabel(); .) Labels { "," Labels } (. MGen.Jmp(lN); .) . Labels (. VAR t, t2: SymTab.TypeIndex; lx1, lx2: MGen.LitStr; v1, v2: BOOLEAN; vn1, vn2: SymTab.Name; ta, tb, chunk: INTEGER; r, hasRange: BOOLEAN; .) = ConstExpr (. 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; .) [ ".." ConstExpr (. IF ~SymTab.EqCheck(t2, sel) THEN SemError(213) END; tb := MGen.TempGlobal(); MGen.StoreTemp(tb); hasRange := TRUE; .) ] (. 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); .) . WhileStat (. VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; vC: BOOLEAN; vnC: SymTab.Name; topL, endL: INTEGER; .) = "WHILE" (. topL := MGen.NewLabel(); endL := MGen.NewLabel(); MGen.DefLabel(topL); .) Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; MGen.Jz(endL); .) "DO" StatSeq "END" (. MGen.Jmp(topL); MGen.DefLabel(endL); .) . RepeatStat (. VAR t: SymTab.TypeIndex; lxC: MGen.LitStr; vC: BOOLEAN; vnC: SymTab.Name; topL: INTEGER; .) = "REPEAT" (. topL := MGen.NewLabel(); MGen.DefLabel(topL); .) StatSeq "UNTIL" Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; MGen.Jz(topL); .) . LoopStat (. VAR topL, exitL: INTEGER; .) = "LOOP" (. topL := MGen.NewLabel(); exitL := MGen.NewLabel(); MGen.DefLabel(topL); MGen.PushLoop(exitL); .) StatSeq "END" (. MGen.Jmp(topL); MGen.DefLabel(exitL); MGen.PopLoop; .) . 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; .) = "FOR" GetIdent (. 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; .) ":=" Expr (. IF (lo # SymTab.InvalidType) & ~SymTab.IsIntFamily(lo) THEN SemError(220) END; IF storable THEN MGen.StoreFinish(lv) ELSE MGen.Drop END; .) "TO" Expr (. IF (hi # SymTab.InvalidType) & ~SymTab.IsIntFamily(hi) THEN SemError(220) END; ht := MGen.TempGlobal(); MGen.StoreTemp(ht); byV := 1; neg := FALSE; .) [ "BY" ByLit (. neg := byV < 0; .) ] "DO" (. lTop := MGen.NewLabel(); lChk := MGen.NewLabel(); lEnd := MGen.NewLabel(); MGen.Jmp(lChk); MGen.DefLabel(lTop); .) StatSeq "END" (. 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); .) . ByLit (. VAR s: ARRAY [0 .. 255] OF CHAR; .) = integer (. LexString(s); IF ~MGen.ParseInt(s, v) THEN v := 1 END; .) | "-" integer (. LexString(s); IF MGen.ParseInt(s, v) THEN v := -v ELSE v := -1 END; .) . WithStat (. VAR dt: SymTab.TypeIndex; dk: INTEGER; bnW: SymTab.Name; lxW: MGen.LitStr; sfxW: BOOLEAN; pushed: BOOLEAN; .) = "WITH" DesignHead DesignTail (. 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; .) "DO" StatSeq "END" (. IF pushed THEN SymTab.PopScope; MGen.WithExit END; .) . ReturnStat (. VAR t: SymTab.TypeIndex; lx: MGen.LitStr; v: BOOLEAN; vn: SymTab.Name; hasE, doRet, conv: BOOLEAN; .) = "RETURN" (. hasE := FALSE; .) [ Expr (. 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; .) ] (. IF ~hasE THEN IF ~SymTab.InProc() THEN SemError(232) ELSIF SymTab.InFunction() THEN SemError(232) ELSE MGen.Leave( SymTab.CurNPar(), FALSE) END END; .) . NewStat (. VAR dt: SymTab.TypeIndex; dk: INTEGER; bnN: SymTab.Name; lxN: MGen.LitStr; sfxN: BOOLEAN; baseT: SymTab.TypeIndex; slN: CARDINAL; .) = "NEW" "(" DesignHead DesignTail ")" (. 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; .) . DispStat (. VAR dt: SymTab.TypeIndex; dk: INTEGER; bnD: SymTab.Name; lxD: MGen.LitStr; sfxD: BOOLEAN; baseT: SymTab.TypeIndex; slD: CARDINAL; .) = "DISPOSE" "(" DesignHead DesignTail ")" (. 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; .) . WriteIntStat (. VAR t: SymTab.TypeIndex; lx: MGen.LitStr; v: BOOLEAN; vn: SymTab.Name; .) = "WriteInt" "(" Expr ")" (. IF t = SymTab.InvalidType THEN MGen.Drop ELSIF ~SymTab.IsIntFamily(t) THEN SemError(210); MGen.Drop ELSE MGen.CallPrint END; .) . WriteStrStat (. VAR t: SymTab.TypeIndex; lx: MGen.LitStr; v: BOOLEAN; vn: SymTab.Name; .) = "WriteString" "(" Expr ")" (. 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; .) . (* Expressions: Designator without ActualParameters (calls use CallTail). Each expression synthesizes its SymTab type in t, the source text in lx for single literals ("" otherwise), and whether it is a plain variable (v/vn) for VAR actuals. Values travel on the MC64 stack. *) DesignHead (. VAR n: SymTab.Name; cls: INTEGER; .) = GetIdent (. 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; .) . DesignTail (. 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; .) = (. sfx := FALSE; .) { "." (. 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 (. 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; .) | "[" (. 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 (. 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; .) { "," Expr (. 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; .) } "]" | "^" (. 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; .) } . Expr (. VAR t2: SymTab.TypeIndex; tc, op: INTEGER; lx2: MGen.LitStr; v2: BOOLEAN; vn2: SymTab.Name; r: BOOLEAN; .) = SimExpr [ Rel SimExpr (. 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; .) ] . Rel = "=" (. 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; op: INTEGER; lx2: MGen.LitStr; v2: BOOLEAN; vn2: SymTab.Name; neg, isR: BOOLEAN; .) = (. neg := FALSE; .) [ "+" | "-" (. neg := TRUE; .) ] Term (. 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; .) { AddOp Term (. 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; .) } . AddOp = "+" (. op := SymTab.OpAdd; .) | "-" (. op := SymTab.OpSub; .) | "OR" (. op := SymTab.OpOr; .) . Term (. VAR t2, res2: SymTab.TypeIndex; op: INTEGER; lx2: MGen.LitStr; v2: BOOLEAN; vn2: SymTab.Name; isR: BOOLEAN; mt: INTEGER; .) = Fact { MulOp Fact (. 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; .) } . MulOp = "*" (. op := SymTab.OpTimes; .) | "/" (. op := SymTab.OpSlash; .) | "DIV" (. op := SymTab.OpDiv; .) | "MOD" (. op := SymTab.OpMod; .) | "AND" (. op := SymTab.OpAnd; .) | "&" (. op := SymTab.OpAnd; .) . Fact (. 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; .) = integer (. 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(); .) | real (. 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(); .) | string (. 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; .) | "HIGH" "(" DesignHead DesignTail ")" (. 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; .) | DesignHead DesignTail (. 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); .) [ CallTail (. 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(); .) ] | "(" Expr ")" (. t := et; .) | ( "NOT" | "~" ) Fact (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); IF SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; MGen.Not; .) | SetLit (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); t := st; .) . SetLit (. VAR first, et: SymTab.TypeIndex; lxE, lxE2: MGen.LitStr; vE, vE2: BOOLEAN; vnE, vnE2: SymTab.Name; hasR: BOOLEAN; .) = "{" (. MGen.PushInt(0); t := SymTab.SetFor(SymTab.IntType()); .) [ Elem (. first := et; t := SymTab.SetFor(et); MGen.ClrStash(); IF hasR THEN MGen.PushInt(1); MGen.Add; MGen.FieldMask ELSE MGen.Power2 END; MGen.Or; .) { "," Elem (. 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; .) } ] "}" . Elem (. VAR t2: SymTab.TypeIndex; vD, vD2: BOOLEAN; vnD, vnD2: SymTab.Name; .) = Expr (. hasR := FALSE; lx2[0] := 0C; .) [ ".." Expr (. IF ~SymTab.SetElemCheck(t, t2) THEN SemError(222) END; hasR := TRUE; .) ] . GetIdent = ident (. LexName(n); .) . (* ---- step-11 separate compilation units (at end: the DEFINITION and IMPLEMENTATION keywords take fresh token numbers, leaving every existing token — and M2c.mod's messages — untouched) ---- *) DefUnit (. VAR m1, m2: SymTab.Name; .) = "DEFINITION" "MODULE" GetIdent (. IF ~SymTab.EnterModule(m1) THEN SemError(200) END; .) ";" { Import } { DefDecl } "END" GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; IF ~SymTab.ExitDefinition() THEN SemError(230) END; .) "." . DefDecl = "CONST" { ConstDecl ";" } | "TYPE" { TypeDecl ";" } | "VAR" { VarDecl ";" } | DefProcHead . DefProcHead (. VAR n: SymTab.Name; rt: SymTab.TypeIndex; hasR, ok: BOOLEAN; .) = "PROCEDURE" (. hasR := FALSE; .) GetIdent (. IF ~SymTab.EnterProc(n) THEN SemError(200) END; SymTab.OpenProcScope; .) [ "(" FormalParams ")" ] [ ":" QualIdent (. hasR := TRUE; .) ] (. 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; .) ";" . ImplUnit (. VAR m1, m2: SymTab.Name; hasInit: BOOLEAN; initL, initN: INTEGER; .) = "IMPLEMENTATION" "MODULE" GetIdent (. hasInit := FALSE; IF ~SymTab.OpenImplementation(m1) THEN SemError(201) END; .) ";" { Import } { Declaration } [ "BEGIN" (. hasInit := TRUE; initL := MGen.NewLabel(); MGen.Jmp(initL); initN := MGen.ModInitBegin(); IF initN < 0 THEN SemError(230) END; .) StatSeq ] "END" GetIdent (. 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; .) . ProgUnit (. VAR m1, m2: SymTab.Name; .) = "MODULE" GetIdent (. IF ~SymTab.NoteProgram() THEN SemError(230) END; MGen.SetModName(m1); IF ~SymTab.Enter(m1, SymTab.KindModule) THEN SemError(200) END; .) ";" { Import } Block GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) END; .) "." (. IF SymTab.AnyForward() THEN SemError(231) END; MGen.EndModule; SymTab.PrintTable; .) . END M2c.