IMPLEMENTATION MODULE Lower; (* Scalar/boolean/control-flow walk (L0-L2): see Lower.def and docs/plan-lower.md. No FORWARD declarations: sequence iteration and statement dispatch are merged into CanStmt / LowerStmt. *) IMPORT AST, SymTab, QbeGen; (* ---------------- self-contained symbol tables (zero SymTab surface) ---- Flat arrays only, no ARRAY OF RECORD: a record's array field loses its length word in static array data, and V3 miscompiles that when the field is passed as an open array (docs/wip/nested-array-field-bug.mod). Names live in flat CHAR arrays indexed manually at slot * 64. *) CONST MaxSym = 512; MaxName = 63; MaxProc = 64; MaxPar = 32; VAR symName : ARRAY [0 .. MaxSym * 64 - 1] OF CHAR; symKind : ARRAY [0 .. MaxSym - 1] OF INTEGER; symTy : ARRAY [0 .. MaxSym - 1] OF SymTab.TypeIndex; nSyms : CARDINAL; procName : ARRAY [0 .. MaxProc * 64 - 1] OF CHAR; procUid : ARRAY [0 .. MaxProc - 1] OF CARDINAL; procRes : ARRAY [0 .. MaxProc - 1] OF SymTab.TypeIndex; procDep : ARRAY [0 .. MaxProc - 1] OF CARDINAL; procExt : ARRAY [0 .. MaxProc - 1] OF BOOLEAN; procNpar : ARRAY [0 .. MaxProc - 1] OF CARDINAL; parTy : ARRAY [0 .. MaxProc * MaxPar - 1] OF SymTab.TypeIndex; parVar : ARRAY [0 .. MaxProc * MaxPar - 1] OF BOOLEAN; parName : ARRAY [0 .. MaxProc * MaxPar * 64 - 1] OF CHAR; nProcs : CARDINAL; withRec : ARRAY [0 .. 15] OF SymTab.TypeIndex; withTop : CARDINAL; curMethCls : SymTab.TypeIndex; (* class bound by the last obj.Method *) curImplCls : SymTab.TypeIndex; (* class whose implementation is open *) curUnitName : SymTab.Name; (* unit being re-emitted (LowerSession) *) PROCEDURE CopyN (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR); VAR i: CARDINAL; BEGIN i := 0; WHILE (i < MaxName) AND (src[i] # CHR(0)) DO dst[i] := src[i]; INC(i) END; dst[i] := CHR(0) END CopyN; PROCEDURE CopySpan (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; srcOff, dstOff: CARDINAL); VAR i: CARDINAL; BEGIN i := 0; WHILE (i < MaxName) AND (src[srcOff + i] # CHR(0)) DO dst[dstOff + i] := src[srcOff + i]; INC(i) END; dst[dstOff + i] := CHR(0) END CopySpan; PROCEDURE Reset; BEGIN nSyms := 0; nProcs := 0 END Reset; PROCEDURE NoteVar (name: ARRAY OF CHAR; kind: INTEGER; t: SymTab.TypeIndex); BEGIN IF nSyms >= MaxSym THEN RETURN END; CopySpan(name, symName, 0, nSyms * 64); symKind[nSyms] := kind; symTy[nSyms] := t; INC(nSyms) END NoteVar; PROCEDURE ScopeEnter; BEGIN END ScopeEnter; PROCEDURE ScopeLeave; BEGIN END ScopeLeave; PROCEDURE NoteProc (name: ARRAY OF CHAR; uid: CARDINAL; res: SymTab.TypeIndex; depth: CARDINAL; ext: BOOLEAN); BEGIN IF nProcs >= MaxProc THEN RETURN END; CopySpan(name, procName, 0, nProcs * 64); procUid[nProcs] := uid; procRes[nProcs] := res; procDep[nProcs] := depth; procExt[nProcs] := ext; procNpar[nProcs] := 0; INC(nProcs) END NoteProc; PROCEDURE SetProcRes (t: SymTab.TypeIndex); BEGIN IF nProcs > 0 THEN procRes[nProcs - 1] := t END END SetProcRes; PROCEDURE NoteParam (name: ARRAY OF CHAR; t: SymTab.TypeIndex; isVar: BOOLEAN); VAR j: CARDINAL; BEGIN IF nProcs = 0 THEN RETURN END; j := procNpar[nProcs - 1]; IF j >= MaxPar THEN RETURN END; CopySpan(name, parName, 0, (nProcs - 1) * MaxPar * 64 + j * 64); parTy[(nProcs - 1) * MaxPar + j] := t; parVar[(nProcs - 1) * MaxPar + j] := isVar; procNpar[nProcs - 1] := j + 1 END NoteParam; PROCEDURE FindSym (name: ARRAY OF CHAR; VAR kind: INTEGER; VAR t: SymTab.TypeIndex): BOOLEAN; VAR i: CARDINAL; j: CARDINAL; ok: BOOLEAN; BEGIN i := nSyms; WHILE i > 0 DO DEC(i); ok := TRUE; j := 0; WHILE ok AND (j < 64) AND (symName[i * 64 + j] # CHR(0)) DO IF symName[i * 64 + j] # name[j] THEN ok := FALSE END; INC(j) END; IF ok AND (symName[i * 64 + j] = name[j]) THEN kind := symKind[i]; t := symTy[i]; RETURN TRUE END END; RETURN FALSE END FindSym; PROCEDURE FindProc (name: ARRAY OF CHAR): INTEGER; VAR i: CARDINAL; j: CARDINAL; ok: BOOLEAN; BEGIN i := nProcs; WHILE i > 0 DO DEC(i); ok := TRUE; j := 0; WHILE ok AND (j < 64) AND (procName[i * 64 + j] # CHR(0)) DO IF procName[i * 64 + j] # name[j] THEN ok := FALSE END; INC(j) END; IF ok AND (procName[i * 64 + j] = name[j]) THEN RETURN VAL(INTEGER, i) END END; RETURN -1 END FindProc; PROCEDURE Resolve (nm: ARRAY OF CHAR; VAR k: INTEGER; VAR t: SymTab.TypeIndex): BOOLEAN; VAR kind: INTEGER; ti: SymTab.TypeIndex; BEGIN IF FindSym(nm, kind, ti) THEN k := kind; t := ti; RETURN TRUE END; IF SymTab.Lookup(nm) THEN k := SymTab.SymKind(nm); t := SymTab.SymType(nm); RETURN TRUE END; RETURN FALSE END Resolve; PROCEDURE ProcInfo (nm: ARRAY OF CHAR; VAR uid: CARDINAL; VAR res: SymTab.TypeIndex; VAR depth: CARDINAL; VAR ext: BOOLEAN; VAR npar: CARDINAL): BOOLEAN; VAR i: INTEGER; BEGIN i := FindProc(nm); IF i < 0 THEN RETURN FALSE END; uid := procUid[i]; res := procRes[i]; depth := procDep[i]; ext := procExt[i]; npar := procNpar[i]; RETURN TRUE END ProcInfo; PROCEDURE ParamInfo (nm: ARRAY OF CHAR; i: CARDINAL; VAR t: SymTab.TypeIndex; VAR isVar: BOOLEAN; VAR pn: ARRAY OF CHAR): BOOLEAN; VAR k: INTEGER; BEGIN k := FindProc(nm); IF (k < 0) OR (i >= procNpar[k]) THEN RETURN FALSE END; t := parTy[VAL(CARDINAL, k) * MaxPar + i]; isVar := parVar[VAL(CARDINAL, k) * MaxPar + i]; CopySpan(parName, pn, VAL(CARDINAL, k) * MaxPar * 64 + i * 64, 0); RETURN TRUE END ParamInfo; PROCEDURE WithField (nm: ARRAY OF CHAR; VAR k: INTEGER; VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal): BOOLEAN; (* Resolves a bare ident as a field of an open WITH record (innermost first), leaving the field address in q and k=KindField. *) VAR wt: CARDINAL; fo: INTEGER; qb: QbeGen.QVal; BEGIN wt := withTop; WHILE wt > 0 DO DEC(wt); IF SymTab.FieldExists(withRec[wt], nm) THEN t := SymTab.FieldType(withRec[wt], nm); fo := SymTab.FieldOffset(withRec[wt], nm); k := SymTab.KindField; IF QbeGen.TopWith(qb) THEN QbeGen.FieldAddr(qb, fo, q) ELSE QbeGen.CopyOp("0", q) END; RETURN TRUE END END; RETURN FALSE END WithField; PROCEDURE Name (n: AST.Node; VAR s: ARRAY OF CHAR); BEGIN IF n = AST.NoNode THEN s[0] := CHR(0) ELSE AST.Txt(AST.Child(n, 0), s) END END Name; PROCEDURE ParamName (proc: ARRAY OF CHAR; i: CARDINAL; VAR s: ARRAY OF CHAR); VAR t: SymTab.TypeIndex; isV: BOOLEAN; BEGIN IF NOT ParamInfo(proc, i, t, isV, s) THEN s[0] := CHR(0) END END ParamName; PROCEDURE IsArith (op: INTEGER): BOOLEAN; BEGIN RETURN (op = AST.OpAdd) OR (op = AST.OpSub) OR (op = AST.OpMul) OR (op = AST.OpDiv) OR (op = AST.OpMod) END IsArith; PROCEDURE IsRel (op: INTEGER): BOOLEAN; BEGIN RETURN ((op >= AST.OpEq) AND (op <= AST.OpGe)) OR (op = AST.OpIn) END IsRel; PROCEDURE RelSym (a: INTEGER; VAR s: INTEGER): BOOLEAN; BEGIN IF a = AST.OpEq THEN s := SymTab.OpEq ELSIF a = AST.OpNe THEN s := SymTab.OpNeq1 ELSIF a = AST.OpLt THEN s := SymTab.OpLt ELSIF a = AST.OpLe THEN s := SymTab.OpLe ELSIF a = AST.OpGt THEN s := SymTab.OpGt ELSIF a = AST.OpGe THEN s := SymTab.OpGe ELSE RETURN FALSE END; RETURN TRUE END RelSym; PROCEDURE IsScalarClass (cls: INTEGER): BOOLEAN; BEGIN RETURN (cls = SymTab.ClInt) OR (cls = SymTab.ClBool) OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar) OR (cls = SymTab.ClEnum) END IsScalarClass; PROCEDURE IsSimpleScalar (n: AST.Node): BOOLEAN; VAR nm: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex; BEGIN IF (AST.Kind(n) # AST.NkDesignator) OR (AST.NChild(n) # 1) THEN RETURN FALSE END; IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END; Name(AST.Child(n, 0), nm); IF NOT Resolve(nm, k, t) THEN RETURN FALSE END; IF (k # SymTab.KindVar) AND (k # SymTab.KindParam) AND (k # SymTab.KindConst) THEN RETURN FALSE END; IF SymTab.Equal(nm, "TRUE") OR SymTab.Equal(nm, "FALSE") THEN RETURN TRUE END; RETURN IsScalarClass(SymTab.ClassOf(t)) END IsSimpleScalar; PROCEDURE CalleeName (call: AST.Node; VAR nm: SymTab.Name); (* The callee of NkCall: child 0 is a designator (or bare ident). *) VAR d: AST.Node; BEGIN nm[0] := CHR(0); d := AST.Child(call, 0); IF d = AST.NoNode THEN RETURN END; IF AST.Kind(d) = AST.NkDesignator THEN d := AST.Child(d, 0) END; IF (d # AST.NoNode) AND (AST.Kind(d) = AST.NkIdent) THEN Name(d, nm) END END CalleeName; PROCEDURE IsCall (n: AST.Node): BOOLEAN; VAR nm: SymTab.Name; BEGIN IF (AST.Kind(n) # AST.NkCall) OR (AST.NChild(n) < 1) THEN RETURN FALSE END; CalleeName(n, nm); RETURN FindProc(nm) >= 0 END IsCall; PROCEDURE CanCallArgs (n: AST.Node): BOOLEAN; VAR nm: SymTab.Name; i: CARDINAL; uid, depth, np: CARDINAL; res: SymTab.TypeIndex; ext: BOOLEAN; BEGIN CalleeName(n, nm); IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN FALSE END; IF np # (AST.NChild(n) - 1) THEN RETURN FALSE END; i := 1; WHILE i < AST.NChild(n) DO IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END; INC(i) END; RETURN TRUE END CanCallArgs; PROCEDURE CanType (t: SymTab.TypeIndex): BOOLEAN; VAR cls: INTEGER; BEGIN IF t = SymTab.InvalidType THEN RETURN FALSE END; cls := SymTab.ClassOf(t); RETURN (cls = SymTab.ClInt) OR (cls = SymTab.ClBool) OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar) OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal) OR (cls = SymTab.ClLong) OR (cls = SymTab.ClArray) OR (cls = SymTab.ClSet) OR (cls = SymTab.ClRecord) OR (cls = SymTab.ClPtr) OR (cls = SymTab.ClClass) END CanType; PROCEDURE CanWithField (nm: ARRAY OF CHAR; VAR t: SymTab.TypeIndex): BOOLEAN; VAR wt: CARDINAL; BEGIN wt := withTop; WHILE wt > 0 DO DEC(wt); IF SymTab.FieldExists(withRec[wt], nm) THEN t := SymTab.FieldType(withRec[wt], nm); RETURN TRUE END END; RETURN FALSE END CanWithField; PROCEDURE DesignTypeOf (n: AST.Node): SymTab.TypeIndex; (* Static type of a designator (no emit); used to push WITH scopes. *) VAR nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex; i: CARDINAL; sel: AST.Node; BEGIN IF (n = AST.NoNode) OR (AST.Kind(n) # AST.NkDesignator) THEN RETURN SymTab.InvalidType END; Name(AST.Child(n, 0), nm); IF NOT Resolve(nm, k, t) THEN IF NOT CanWithField(nm, t) THEN RETURN SymTab.InvalidType END END; i := 1; WHILE i < AST.NChild(n) DO sel := AST.Child(n, i); IF AST.Op(sel) = AST.SelField THEN Name(AST.Child(sel, 0), fn); t := SymTab.FieldType(t, fn) ELSIF AST.Op(sel) = AST.SelIndex THEN t := SymTab.ArrayElem(t) ELSIF AST.Op(sel) = AST.SelDeref THEN t := SymTab.PtrBase(t) END; INC(i) END; RETURN t END DesignTypeOf; PROCEDURE CanDesign (n: AST.Node): BOOLEAN; VAR nm, fn, mal: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex; i: CARDINAL; sel: AST.Node; BEGIN IF AST.Kind(n) # AST.NkDesignator THEN RETURN FALSE END; IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END; Name(AST.Child(n, 0), nm); IF NOT Resolve(nm, k, t) THEN IF CanWithField(nm, t) THEN k := SymTab.KindField ELSIF (curImplCls # SymTab.InvalidType) AND SymTab.MethodExists(curImplCls, nm) THEN k := SymTab.KindProc ELSE RETURN FALSE END END; IF k = SymTab.KindModule THEN (* qualified name: the first .field resolves the export *) ELSE IF (k # SymTab.KindVar) AND (k # SymTab.KindParam) AND (k # SymTab.KindConst) AND (k # SymTab.KindField) THEN RETURN FALSE END; IF NOT CanType(t) THEN RETURN FALSE END END; i := 1; WHILE i < AST.NChild(n) DO sel := AST.Child(n, i); IF AST.Op(sel) = AST.SelField THEN Name(AST.Child(sel, 0), fn); IF k = SymTab.KindModule THEN IF NOT SymTab.MaterializeAlias(nm, fn, mal) THEN RETURN FALSE END; t := SymTab.SymType(mal); k := SymTab.SymKind(mal) ELSIF t = SymTab.InvalidType THEN RETURN FALSE ELSIF (SymTab.ClassOf(t) = SymTab.ClClass) AND SymTab.MethodExists(t, fn) THEN k := SymTab.KindProc; t := SymTab.InvalidType ELSIF (SymTab.ClassOf(t) # SymTab.ClRecord) AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN RETURN FALSE ELSIF NOT SymTab.FieldExists(t, fn) THEN RETURN FALSE ELSE t := SymTab.FieldType(t, fn) END ELSIF AST.Op(sel) = AST.SelIndex THEN IF (t = SymTab.InvalidType) OR (SymTab.ClassOf(t) # SymTab.ClArray) THEN RETURN FALSE END; IF NOT CanExpr(AST.Child(sel, 0)) THEN RETURN FALSE END; t := SymTab.ArrayElem(t) ELSIF AST.Op(sel) = AST.SelDeref THEN IF (t = SymTab.InvalidType) OR (SymTab.ClassOf(t) # SymTab.ClPtr) THEN RETURN FALSE END; t := SymTab.PtrBase(t) ELSE RETURN FALSE END; IF (k # SymTab.KindProc) AND NOT CanType(t) THEN RETURN FALSE END; INC(i) END; RETURN TRUE END CanDesign; PROCEDURE IsMethodCall (n: AST.Node): BOOLEAN; (* n is a call whose callee resolves to a class method: `obj.Method`, `p^.Method`, or a bare sibling name inside an implementation. *) VAR d, sel: AST.Node; nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex; i: CARDINAL; BEGIN IF (AST.Kind(n) # AST.NkCall) OR (AST.NChild(n) < 1) THEN RETURN FALSE END; d := AST.Child(n, 0); IF AST.Kind(d) # AST.NkDesignator THEN RETURN FALSE END; IF AST.NChild(d) = 1 THEN (* bare name: a sibling method inside a class implementation? *) Name(AST.Child(d, 0), nm); RETURN (curImplCls # SymTab.InvalidType) AND SymTab.MethodExists(curImplCls, nm) END; Name(AST.Child(d, 0), nm); IF NOT Resolve(nm, k, t) THEN RETURN FALSE END; i := 1; WHILE i < AST.NChild(d) DO sel := AST.Child(d, i); IF AST.Op(sel) = AST.SelField THEN Name(AST.Child(sel, 0), fn); IF (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClClass) AND SymTab.MethodExists(t, fn) THEN RETURN i = AST.NChild(d) - 1 END; IF (t = SymTab.InvalidType) OR NOT SymTab.FieldExists(t, fn) THEN RETURN FALSE END; t := SymTab.FieldType(t, fn) ELSIF AST.Op(sel) = AST.SelIndex THEN IF (t = SymTab.InvalidType) OR (SymTab.ClassOf(t) # SymTab.ClArray) THEN RETURN FALSE END; t := SymTab.ArrayElem(t) ELSIF AST.Op(sel) = AST.SelDeref THEN IF (t = SymTab.InvalidType) OR (SymTab.ClassOf(t) # SymTab.ClPtr) THEN RETURN FALSE END; t := SymTab.PtrBase(t) ELSE RETURN FALSE END; INC(i) END; RETURN FALSE END IsMethodCall; PROCEDURE CanMethodCall (n: AST.Node): BOOLEAN; VAR i: CARDINAL; BEGIN IF NOT IsMethodCall(n) THEN RETURN FALSE END; i := 1; WHILE i < AST.NChild(n) DO IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END; INC(i) END; RETURN TRUE END CanMethodCall; PROCEDURE CalleeAlias (call: AST.Node; VAR mal: SymTab.Name): BOOLEAN; (* Callee is `M.P` (module-qualified): materialize the export alias. *) VAR d, sel: AST.Node; nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex; BEGIN d := AST.Child(call, 0); IF (AST.Kind(d) # AST.NkDesignator) OR (AST.NChild(d) # 2) THEN RETURN FALSE END; sel := AST.Child(d, 1); IF AST.Op(sel) # AST.SelField THEN RETURN FALSE END; Name(AST.Child(d, 0), nm); IF NOT Resolve(nm, k, t) THEN RETURN FALSE END; IF k # SymTab.KindModule THEN RETURN FALSE END; Name(AST.Child(sel, 0), fn); RETURN SymTab.MaterializeAlias(nm, fn, mal) END CalleeAlias; PROCEDURE IsQualifiedCall (n: AST.Node): BOOLEAN; VAR mal: SymTab.Name; BEGIN IF AST.Kind(n) # AST.NkCall THEN RETURN FALSE END; RETURN CalleeAlias(n, mal) END IsQualifiedCall; PROCEDURE CanQualifiedCall (n: AST.Node): BOOLEAN; VAR i: CARDINAL; BEGIN i := 1; WHILE i < AST.NChild(n) DO IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END; INC(i) END; RETURN TRUE END CanQualifiedCall; PROCEDURE CanBuiltin (n: AST.Node): BOOLEAN; VAR i: CARDINAL; BEGIN i := 1; WHILE i < AST.NChild(n) DO IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END; INC(i) END; RETURN TRUE END CanBuiltin; PROCEDURE CanCaseLabel (lab: AST.Node): BOOLEAN; BEGIN IF AST.Kind(lab) = AST.NkSubrange THEN RETURN CanExpr(AST.Child(lab, 0)) AND CanExpr(AST.Child(lab, 1)) END; RETURN CanExpr(lab) END CanCaseLabel; PROCEDURE CanExpr (n: AST.Node): BOOLEAN; VAR op: INTEGER; nm: SymTab.Name; i: CARDINAL; BEGIN IF n = AST.NoNode THEN RETURN FALSE END; IF AST.Kind(n) = AST.NkIntLit THEN RETURN TRUE END; IF AST.Kind(n) = AST.NkCharLit THEN RETURN TRUE END; IF AST.Kind(n) = AST.NkRealLit THEN RETURN TRUE END; IF AST.Kind(n) = AST.NkStrLit THEN RETURN TRUE END; IF AST.Kind(n) = AST.NkSetLit THEN i := 0; WHILE i < AST.NChild(n) DO IF AST.Kind(AST.Child(n, i)) = AST.NkSubrange THEN IF NOT CanExpr(AST.Child(AST.Child(n, i), 0)) THEN RETURN FALSE END; IF NOT CanExpr(AST.Child(AST.Child(n, i), 1)) THEN RETURN FALSE END ELSIF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END; INC(i) END; RETURN TRUE END; IF AST.Kind(n) = AST.NkDesignator THEN RETURN CanDesign(n) END; IF AST.Kind(n) = AST.NkCall THEN IF IsMethodCall(n) THEN RETURN CanMethodCall(n) END; IF IsQualifiedCall(n) THEN RETURN CanQualifiedCall(n) END; CalleeName(n, nm); IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END; RETURN IsCall(n) AND CanCallArgs(n) END; IF AST.Kind(n) = AST.NkUnary THEN op := AST.Op(n); IF (op # AST.OpSub) AND (op # AST.OpNot) THEN RETURN FALSE END; RETURN CanExpr(AST.Child(n, 0)) END; IF AST.Kind(n) = AST.NkBinExpr THEN op := AST.Op(n); IF NOT (IsArith(op) OR IsRel(op) OR (op = AST.OpAnd) OR (op = AST.OpOr)) THEN RETURN FALSE END; RETURN CanExpr(AST.Child(n, 0)) AND CanExpr(AST.Child(n, 1)) END; RETURN FALSE END CanExpr; PROCEDURE CanStmt (n: AST.Node): BOOLEAN; VAR i: CARDINAL; k: INTEGER; by: AST.Node; nm: SymTab.Name; arm: AST.Node; j: CARDINAL; withSave: CARDINAL; ok: BOOLEAN; BEGIN IF n = AST.NoNode THEN RETURN TRUE END; k := AST.Kind(n); IF k = AST.NkBlock THEN i := 0; WHILE i < AST.NChild(n) DO IF NOT CanStmt(AST.Child(n, i)) THEN RETURN FALSE END; INC(i) END; RETURN TRUE END; IF k = AST.NkAssign THEN RETURN CanDesign(AST.Child(n, 0)) AND CanExpr(AST.Child(n, 1)) END; IF k = AST.NkIf THEN RETURN CanExpr(AST.Child(n, 0)) AND CanStmt(AST.Child(n, 1)) AND CanStmt(AST.Child(n, 2)) END; IF k = AST.NkWhile THEN RETURN CanExpr(AST.Child(n, 0)) AND CanStmt(AST.Child(n, 1)) END; IF k = AST.NkRepeat THEN RETURN CanStmt(AST.Child(n, 0)) AND CanExpr(AST.Child(n, 1)) END; IF k = AST.NkLoop THEN RETURN CanStmt(AST.Child(n, 0)) END; IF k = AST.NkExit THEN RETURN TRUE END; IF k = AST.NkFor THEN by := AST.Child(n, 3); IF (by # AST.NoNode) AND (AST.Kind(by) # AST.NkIntLit) THEN RETURN FALSE END; RETURN (AST.Kind(AST.Child(n, 0)) = AST.NkIdent) AND CanExpr(AST.Child(n, 1)) AND CanExpr(AST.Child(n, 2)) AND CanStmt(AST.Child(n, 4)) END; IF k = AST.NkWith THEN withSave := withTop; j := 0; WHILE j + 1 < AST.NChild(n) DO IF NOT CanDesign(AST.Child(n, j)) THEN withTop := withSave; RETURN FALSE END; IF withTop <= HIGH(withRec) THEN withRec[withTop] := DesignTypeOf(AST.Child(n, j)); INC(withTop) END; INC(j) END; ok := CanStmt(AST.Child(n, AST.NChild(n) - 1)); withTop := withSave; RETURN ok END; IF k = AST.NkCase THEN IF NOT CanExpr(AST.Child(n, 0)) THEN RETURN FALSE END; i := 1; WHILE i < AST.NChild(n) DO arm := AST.Child(n, i); IF AST.Op(arm) = 1 THEN IF NOT CanStmt(AST.Child(arm, 0)) THEN RETURN FALSE END ELSE j := 0; WHILE j + 1 < AST.NChild(arm) DO IF NOT CanCaseLabel(AST.Child(arm, j)) THEN RETURN FALSE END; INC(j) END; IF NOT CanStmt(AST.Child(arm, AST.NChild(arm) - 1)) THEN RETURN FALSE END END; INC(i) END; RETURN TRUE END; IF k = AST.NkHalt THEN IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END; RETURN CanExpr(AST.Child(n, 0)) END; IF k = AST.NkReturn THEN IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END; RETURN CanExpr(AST.Child(n, 0)) END; IF k = AST.NkCall THEN IF IsMethodCall(n) THEN RETURN CanMethodCall(n) END; IF IsQualifiedCall(n) THEN RETURN CanQualifiedCall(n) END; CalleeName(n, nm); IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END; RETURN IsCall(n) AND CanCallArgs(n) END; RETURN FALSE END CanStmt; PROCEDURE CanMethod (m: AST.Node; ct: SymTab.TypeIndex): BOOLEAN; VAR nm: SymTab.Name; uid, depth, np: CARDINAL; res, t: SymTab.TypeIndex; ext, isV: BOOLEAN; pn: SymTab.Name; i: CARDINAL; ok: BOOLEAN; save: CARDINAL; saveCls: SymTab.TypeIndex; BEGIN IF (AST.Op(m) # 0) AND (AST.Op(m) # 3) THEN RETURN FALSE END; Name(AST.Child(m, 0), nm); IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN FALSE END; IF (res # SymTab.InvalidType) AND NOT CanType(res) THEN RETURN FALSE END; i := 0; WHILE i < np DO IF NOT ParamInfo(nm, i, t, isV, pn) THEN RETURN FALSE END; IF NOT CanType(t) THEN RETURN FALSE END; INC(i) END; save := withTop; saveCls := curImplCls; curImplCls := ct; IF withTop <= HIGH(withRec) THEN withRec[withTop] := ct; INC(withTop) END; ok := CanDecls(AST.Child(m, 2)) AND CanStmt(AST.Child(m, 1)); withTop := save; curImplCls := saveCls; RETURN ok END CanMethod; PROCEDURE CanMethods (seq: AST.Node; ct: SymTab.TypeIndex): BOOLEAN; VAR i: CARDINAL; m: AST.Node; BEGIN IF seq = AST.NoNode THEN RETURN TRUE END; i := 0; WHILE i < AST.NChild(seq) DO m := AST.Child(seq, i); IF i = AST.MaxChild - 1 THEN IF NOT CanMethods(m, ct) THEN RETURN FALSE END ELSIF AST.Kind(m) = AST.NkFieldDecl THEN IF NOT CanMethods(m, ct) THEN RETURN FALSE END ELSIF AST.Kind(m) = AST.NkProcDecl THEN IF NOT CanMethod(m, ct) THEN RETURN FALSE END END; INC(i) END; RETURN TRUE END CanMethods; PROCEDURE CanDecl (c: AST.Node): BOOLEAN; VAR i: CARDINAL; nm: SymTab.Name; k: INTEGER; ct: SymTab.TypeIndex; BEGIN IF AST.Kind(c) = AST.NkClassDecl THEN IF AST.Op(c) = 1 THEN Name(AST.Child(c, 0), nm); IF NOT Resolve(nm, k, ct) THEN RETURN FALSE END; IF SymTab.ClassOf(ct) # SymTab.ClClass THEN RETURN FALSE END; IF NOT CanMethods(AST.Child(c, 3), ct) THEN RETURN FALSE END; IF AST.Child(c, 2) # AST.NoNode THEN IF NOT CanStmt(AST.Child(c, 2)) THEN RETURN FALSE END END; RETURN TRUE END; RETURN TRUE END; IF AST.Kind(c) = AST.NkUnit THEN IF AST.Child(c, 3) # AST.NoNode THEN RETURN FALSE END; RETURN CanDecls(AST.Child(c, 1)) AND CanStmt(AST.Child(c, 2)) END; IF AST.Kind(c) = AST.NkTypeDecl THEN RETURN TRUE END; IF AST.Kind(c) = AST.NkVarDecl THEN IF NOT CanType(AST.Ty(c)) THEN RETURN FALSE END; IF AST.NChild(c) < 1 THEN RETURN FALSE END; i := 0; WHILE i < AST.NChild(c) DO IF AST.Kind(AST.Child(c, i)) # AST.NkIdent THEN RETURN FALSE END; INC(i) END; RETURN TRUE END; IF AST.Kind(c) = AST.NkConstDecl THEN RETURN IsScalarClass(SymTab.ClassOf(AST.Ty(c))) AND (AST.Kind(AST.Child(c, 1)) = AST.NkIntLit) END; IF AST.Kind(c) = AST.NkProcDecl THEN RETURN CanProc(c) END; RETURN FALSE END CanDecl; PROCEDURE CanDecls (seq: AST.Node): BOOLEAN; VAR i: CARDINAL; c: AST.Node; BEGIN IF seq = AST.NoNode THEN RETURN TRUE END; i := 0; WHILE i < AST.NChild(seq) DO c := AST.Child(seq, i); IF i = AST.MaxChild - 1 THEN IF NOT CanDecls(c) THEN RETURN FALSE END ELSIF AST.Kind(c) = AST.NkDeclSeq THEN IF NOT CanDecls(c) THEN RETURN FALSE END ELSIF NOT CanDecl(c) THEN RETURN FALSE END; INC(i) END; RETURN TRUE END CanDecls; PROCEDURE CanLower (unit: AST.Node): BOOLEAN; BEGIN withTop := 0; curImplCls := SymTab.InvalidType; IF AST.Kind(unit) # AST.NkUnit THEN RETURN FALSE END; IF AST.Kind(AST.Child(unit, 0)) # AST.NkIdent THEN RETURN FALSE END; RETURN CanDecls(AST.Child(unit, 1)) AND CanStmt(AST.Child(unit, 2)) END CanLower; PROCEDURE CanProc (proc: AST.Node): BOOLEAN; VAR nm: SymTab.Name; i: CARDINAL; uid, depth, np: CARDINAL; res: SymTab.TypeIndex; ext: BOOLEAN; t: SymTab.TypeIndex; isV: BOOLEAN; pn: SymTab.Name; BEGIN IF AST.Op(proc) # 0 THEN RETURN FALSE END; Name(AST.Child(proc, 0), nm); IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN FALSE END; IF (res # SymTab.InvalidType) AND NOT IsScalarClass(SymTab.ClassOf(res)) THEN RETURN FALSE END; i := 0; WHILE i < np DO IF NOT ParamInfo(nm, i, t, isV, pn) THEN RETURN FALSE END; IF NOT CanType(t) THEN RETURN FALSE END; INC(i) END; RETURN CanDecls(AST.Child(proc, 2)) AND CanStmt(AST.Child(proc, 1)) END CanProc; PROCEDURE FinalLoad (t: SymTab.TypeIndex; sfx: BOOLEAN; VAR q: QbeGen.QVal); (* Fact's final load after a designator/result suffix: scalars/pointers are loaded from their address; aggregates keep the address. *) VAR cls: INTEGER; q2: QbeGen.QVal; BEGIN IF NOT sfx THEN RETURN END; IF t = SymTab.InvalidType THEN QbeGen.CopyOp("0", q); RETURN END; cls := SymTab.ClassOf(t); IF (cls # SymTab.ClRecord) AND (cls # SymTab.ClSet) AND (cls # SymTab.ClArray) AND (cls # SymTab.ClClass) THEN QbeGen.ElemLoad(q, t, q2); QbeGen.CopyOp(q2, q) END END FinalLoad; PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER; VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN); (* Base ident then selectors (mirrors the grammar's Design). Leaves the address in q with sfx=TRUE for selectors; base vars/consts load. *) VAR nm, fn, mal: SymTab.Name; cv: QbeGen.QVal; cls, op: INTEGER; i: CARDINAL; sel: AST.Node; eT, it: SymTab.TypeIndex; iq, ql, qlo, qhi, qe: QbeGen.QVal; lo, hi, fo: INTEGER; isOpen: BOOLEAN; BEGIN Name(AST.Child(n, 0), nm); QbeGen.CopyOp(nm, qn); sfx := FALSE; IF NOT Resolve(nm, k, t) THEN IF WithField(nm, k, t, q) THEN sfx := TRUE ELSIF (curImplCls # SymTab.InvalidType) AND SymTab.MethodExists(curImplCls, nm) THEN (* bare sibling method name inside a class implementation *) QbeGen.ThisBase(q); QbeGen.ArmRecv(q); curMethCls := curImplCls; k := SymTab.KindProc; t := SymTab.InvalidType; sfx := FALSE ELSE t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q); RETURN END END; IF k = SymTab.KindConst THEN IF SymTab.Equal(nm, "TRUE") THEN t := SymTab.BoolType(); QbeGen.CopyOp("1", q) ELSIF SymTab.Equal(nm, "FALSE") THEN t := SymTab.BoolType(); QbeGen.CopyOp("0", q) ELSIF SymTab.Equal(nm, "NIL") THEN QbeGen.CopyOp("0", q) ELSIF SymTab.GetSymVal(nm, cv) AND QbeGen.IsImm(cv) THEN QbeGen.CopyOp(cv, q) ELSE QbeGen.CopyOp("0", q) END ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN cls := SymTab.ClassOf(t); IF (cls = SymTab.ClInt) OR (cls = SymTab.ClBool) OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar) OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal) THEN QbeGen.LoadVar(nm, cls = SymTab.ClReal, q) ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc) THEN QbeGen.LoadPtr(nm, q) ELSIF cls = SymTab.ClLong THEN QbeGen.LoadLong(nm, q) ELSE QbeGen.AddrOf(nm, q) END ELSIF k = SymTab.KindField THEN (* q already holds the field address (WithField) *) ELSE QbeGen.CopyOp("0", q) END; i := 1; WHILE i < AST.NChild(n) DO sel := AST.Child(n, i); op := AST.Op(sel); IF op = AST.SelField THEN Name(AST.Child(sel, 0), fn); IF k = SymTab.KindModule THEN (* qualified L.x: materialize the export, then load it *) IF SymTab.MaterializeAlias(nm, fn, mal) THEN QbeGen.CopyOp(mal, qn); t := SymTab.SymType(mal); k := SymTab.SymKind(mal); sfx := FALSE; IF k = SymTab.KindProc THEN QbeGen.CopyOp("0", q) ELSIF NOT QbeGen.LoadDesignator(mal, t, k, q) THEN t := SymTab.InvalidType; QbeGen.CopyOp("0", q) END ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q) END ELSIF t = SymTab.InvalidType THEN ELSIF (SymTab.ClassOf(t) = SymTab.ClClass) AND SymTab.MethodExists(t, fn) THEN (* obj.Method: bind the receiver; the call supplies the value *) QbeGen.ArmRecv(q); QbeGen.CopyOp(fn, qn); curMethCls := t; k := SymTab.KindProc; t := SymTab.InvalidType ELSIF NOT SymTab.FieldExists(t, fn) THEN t := SymTab.InvalidType ELSE fo := SymTab.FieldOffset(t, fn); t := SymTab.FieldType(t, fn); QbeGen.FieldAddr(q, fo, qe); QbeGen.CopyOp(qe, q); sfx := TRUE END ELSIF op = AST.SelIndex THEN LowerExpr(AST.Child(sel, 0), it, iq); IF t = SymTab.InvalidType THEN ELSE QbeGen.WidenIndex(iq, ql); isOpen := SymTab.IsOpenArray(t); IF isOpen THEN QbeGen.CopyOp("0", qlo); IF SymTab.IsCharArray(t) OR SymTab.IsUCharArray(t) THEN QbeGen.OpenHiChar(q, qhi) ELSE QbeGen.OpenHi(q, qhi) END ELSE lo := SymTab.ArrayLo(t); hi := SymTab.ArrayHi(t); IF SymTab.IsCharArray(t) OR SymTab.IsUCharArray(t) THEN hi := hi + 1 END; QbeGen.IntStr(lo, qlo); QbeGen.IntStr(hi, qhi) END; QbeGen.CheckRange(ql, qlo, qhi); eT := SymTab.ArrayElem(t); QbeGen.ElemAddr(q, ql, qlo, t, qe); IF SymTab.ClassOf(eT) = SymTab.ClArray THEN QbeGen.ElemLoad(qe, eT, q) ELSE QbeGen.CopyOp(qe, q) END; t := eT; sfx := TRUE END ELSIF op = AST.SelDeref THEN IF t = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(t) # SymTab.ClPtr THEN t := SymTab.InvalidType ELSE IF sfx THEN QbeGen.ElemLoad(q, t, qe); QbeGen.CopyOp(qe, q) END; t := SymTab.PtrBase(t); sfx := TRUE END END; INC(i) END END LowerDesign; PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal; want: BOOLEAN); VAR nm, pn: SymTab.Name; i: CARDINAL; at, ft, res: SymTab.TypeIndex; qa, qt, qe, mg: QbeGen.QVal; conv, isV, qual: BOOLEAN; uid, depth, np: CARDINAL; ext: BOOLEAN; BEGIN qual := CalleeAlias(n, nm); IF qual THEN uid := SymTab.ProcUid(nm); res := SymTab.ProcRes(nm); depth := SymTab.ProcDepthOf(nm); ext := SymTab.IsExternal(nm); np := SymTab.ProcNPar(nm) ELSE CalleeName(n, nm); IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN END END; QbeGen.Mangled(nm, uid, mg); QbeGen.CallBegin(mg, res, depth, ext); i := 1; WHILE i < AST.NChild(n) DO LowerExpr(AST.Child(n, i), at, qe); IF qual THEN ft := SymTab.ParamType(nm, i - 1); isV := SymTab.ParamIsVar(nm, i - 1) ELSE IF NOT ParamInfo(nm, i - 1, ft, isV, pn) THEN END END; IF isV THEN IF QbeGen.AddrOfVal(qe, qa) THEN IF NOT QbeGen.CallArg(qa, "l") THEN END END ELSE conv := (SymTab.ClassOf(ft) = SymTab.ClReal) AND SymTab.IsIntFamily(at); IF conv THEN QbeGen.ConvIR(qe, qt); IF NOT QbeGen.CallArg(qt, "d") THEN END ELSE IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END END END; INC(i) END; IF want THEN t := res; QbeGen.CallEnd(TRUE, q) ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q) END END LowerCall; PROCEDURE IsBuiltin (nm: ARRAY OF CHAR): BOOLEAN; BEGIN RETURN SymTab.Equal(nm, "ABS") OR SymTab.Equal(nm, "CAP") OR SymTab.Equal(nm, "CHR") OR SymTab.Equal(nm, "ORD") OR SymTab.Equal(nm, "SIZE") OR SymTab.Equal(nm, "TSIZE") OR SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX") OR SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE") OR SymTab.Equal(nm, "ADR") OR SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC") OR SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL") OR SymTab.Equal(nm, "NEW") OR SymTab.Equal(nm, "DISPOSE") END IsBuiltin; PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name; VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); (* Value builtins (Fact). *) VAR et, et2, dt: SymTab.TypeIndex; qa, qt, q2, qd: QbeGen.QVal; k, lo, hi: INTEGER; qn: SymTab.Name; sfx: BOOLEAN; isMax: BOOLEAN; BEGIN IF SymTab.Equal(nm, "ABS") THEN LowerExpr(AST.Child(n, 1), et, q); QbeGen.AbsQ(q, qa, SymTab.ClassOf(et) = SymTab.ClReal); QbeGen.CopyOp(qa, q); t := et ELSIF SymTab.Equal(nm, "CAP") THEN LowerExpr(AST.Child(n, 1), et, q); QbeGen.CapQ(q, qa); QbeGen.CopyOp(qa, q); t := SymTab.CharType() ELSIF SymTab.Equal(nm, "CHR") THEN LowerExpr(AST.Child(n, 1), et, q); t := SymTab.CharType() ELSIF SymTab.Equal(nm, "ORD") THEN LowerExpr(AST.Child(n, 1), et, q); t := SymTab.IntType() ELSIF SymTab.Equal(nm, "SIZE") THEN LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx); QbeGen.IntStr(VAL(INTEGER, SymTab.ObjectSize(dt)), q); t := SymTab.IntType() ELSIF SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX") THEN isMax := SymTab.Equal(nm, "MAX"); LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx); IF SymTab.ClassOf(dt) = SymTab.ClReal THEN IF isMax THEN QbeGen.NormReal("3.402823e38", q) ELSE QbeGen.NormReal("-3.402823e38", q) END; t := SymTab.RealType() ELSIF SymTab.ClassOf(dt) = SymTab.ClLong THEN IF isMax THEN QbeGen.CopyOp("9223372036854775807", q) ELSE QbeGen.CopyOp("-9223372036854775808", q) END; t := SymTab.LongType() ELSIF SymTab.TypeBounds(dt, lo, hi) THEN IF isMax THEN QbeGen.IntStr(hi, q) ELSE QbeGen.IntStr(lo, q) END; t := SymTab.IntType() ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q) END ELSIF SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE") THEN LowerExpr(AST.Child(n, 1), et, q); LowerExpr(AST.Child(n, 2), et2, q2); QbeGen.SetShift(q, q2, SymTab.SetWords(et), SymTab.SetCount(et), SymTab.Equal(nm, "ROTATE"), qt); t := et; QbeGen.CopyOp(qt, q) ELSIF SymTab.Equal(nm, "ADR") THEN LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx); IF sfx THEN QbeGen.CopyOp(qd, q) ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN QbeGen.AddrOf(qn, q) ELSE QbeGen.CopyOp("0", q) END; t := SymTab.AddrType() ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q) END END LowerBuiltinExpr; PROCEDURE LowerBuiltinStmt (n: AST.Node; nm: SymTab.Name); (* Statement builtins (AssOrCall): INC/DEC, INCL/EXCL, NEW/DISPOSE. *) VAR dt, at, et2, bt: SymTab.TypeIndex; dk: INTEGER; qd, qv, qe, qn2, qstep, qm: QbeGen.QVal; qn: SymTab.Name; sfx, isInc: BOOLEAN; BEGIN IF SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC") THEN isInc := SymTab.Equal(nm, "INC"); QbeGen.CopyOp("1", qstep); LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx); IF AST.NChild(n) > 2 THEN LowerExpr(AST.Child(n, 2), et2, qstep) END; IF dt = SymTab.InvalidType THEN ELSE IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv) ELSE QbeGen.LoadVar(qn, FALSE, qv) END; QbeGen.NewTemp(qn2); IF isInc THEN QbeGen.Op3("add", qn2, qv, qstep, FALSE) ELSE QbeGen.Op3("sub", qn2, qv, qstep, FALSE) END; IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qn2, dt) ELSE QbeGen.StoreVar(qn, qn2, FALSE) END END ELSIF SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL") THEN isInc := SymTab.Equal(nm, "INCL"); LowerDesign(AST.Child(n, 1), at, dk, qd, qn, sfx); LowerExpr(AST.Child(n, 2), et2, qe); IF at = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(at) # SymTab.ClSet THEN ELSE IF isInc THEN QbeGen.SetBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at)) ELSE QbeGen.SetClearBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at)) END END ELSIF SymTab.Equal(nm, "NEW") THEN LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx); IF dt = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN ELSE bt := SymTab.PtrBase(dt); IF bt # SymTab.InvalidType THEN QbeGen.NewHeap(bt, qm); QbeGen.InitHeap(qm, bt); IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qm, dt) ELSE QbeGen.StorePtr(qn, qm) END END END ELSIF SymTab.Equal(nm, "DISPOSE") THEN LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx); IF dt = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN ELSE IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv) ELSE QbeGen.LoadPtr(qn, qv) END; QbeGen.FreeHeap(qv); IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, "0", dt) ELSE QbeGen.StorePtr(qn, "0") END END END END LowerBuiltinStmt; PROCEDURE LowerMethod (m: AST.Node; ct: SymTab.TypeIndex); (* A class method: hidden THIS receiver, then declared formals; the body runs with THIS pushed as the WITH base (bare field names resolve). *) VAR nm, txt: SymTab.Name; mg, thisQ: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex; pv, ext: BOOLEAN; j: CARDINAL; saveCls: SymTab.TypeIndex; BEGIN IF (AST.Op(m) # 0) AND (AST.Op(m) # 3) THEN RETURN END; Name(AST.Child(m, 0), nm); IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN END; QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg); QbeGen.BeginFunc(mg); IF NOT QbeGen.FuncParam("THIS", TRUE, ct) THEN END; j := 0; WHILE j < np DO IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END; IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END; INC(j) END; QbeGen.SetFuncRes(res); QbeGen.EndFuncHeader; QbeGen.ThisBase(thisQ); saveCls := curImplCls; curImplCls := ct; QbeGen.PushWith(thisQ); IF withTop <= HIGH(withRec) THEN withRec[withTop] := ct; INC(withTop) END; LowerDecls(AST.Child(m, 2)); LowerStmt(AST.Child(m, 1)); IF withTop > 0 THEN DEC(withTop) END; curImplCls := saveCls; QbeGen.PopWith; QbeGen.EndFunc(res) END LowerMethod; PROCEDURE LowerMethods (seq: AST.Node; ct: SymTab.TypeIndex); VAR i: CARDINAL; m: AST.Node; BEGIN IF seq = AST.NoNode THEN RETURN END; i := 0; WHILE i < AST.NChild(seq) DO m := AST.Child(seq, i); IF i = AST.MaxChild - 1 THEN LowerMethods(m, ct) ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethods(m, ct) ELSIF AST.Kind(m) = AST.NkProcDecl THEN LowerMethod(m, ct) END; INC(i) END END LowerMethods; PROCEDURE LowerMethodHeadings (seq: AST.Node; ct: SymTab.TypeIndex); (* Class-declaration method headings: emit+discard a function header per method so the backend temp counters advance exactly as the legacy parse did (the implementation's temps then line up). *) VAR i, j: CARDINAL; m: AST.Node; nm, txt: SymTab.Name; mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex; pv, ext: BOOLEAN; BEGIN IF seq = AST.NoNode THEN RETURN END; i := 0; WHILE i < AST.NChild(seq) DO m := AST.Child(seq, i); IF i = AST.MaxChild - 1 THEN LowerMethodHeadings(m, ct) ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethodHeadings(m, ct) ELSIF AST.Kind(m) = AST.NkProcDecl THEN Name(AST.Child(m, 0), nm); IF ProcInfo(nm, uid, res, depth, ext, np) THEN QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg); QbeGen.BeginFunc(mg); j := 0; WHILE j < np DO IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END; IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END; INC(j) END; QbeGen.SetFuncRes(res); QbeGen.AbortFunc END END; INC(i) END END LowerMethodHeadings; PROCEDURE LowerMethodCall (n: AST.Node; VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal; want: BOOLEAN); VAR d: AST.Node; ct, res, ft, at: SymTab.TypeIndex; cq, mg, qa, qt, qe: QbeGen.QVal; fn, pn: SymTab.Name; k, vs: INTEGER; i: CARDINAL; sfx, isV, conv: BOOLEAN; BEGIN d := AST.Child(n, 0); curMethCls := SymTab.InvalidType; LowerDesign(d, ct, k, cq, pn, sfx); ct := curMethCls; IF ct = SymTab.InvalidType THEN t := SymTab.InvalidType; QbeGen.CopyOp("0", q); RETURN END; IF AST.NChild(d) = 1 THEN Name(AST.Child(d, 0), fn) ELSE Name(AST.Child(AST.Child(d, AST.NChild(d) - 1), 0), fn) END; res := SymTab.ClassMethodRes(ct, fn); vs := SymTab.VirtSlot(ct, fn); IF vs >= 0 THEN QbeGen.VirtCallBegin(cq, vs, res) ELSE QbeGen.Mangled(fn, SymTab.ClassMethodUid(ct, fn), mg); QbeGen.CallBegin(mg, res, 0, FALSE) END; i := 1; WHILE i < AST.NChild(n) DO LowerExpr(AST.Child(n, i), at, qe); ft := SymTab.ClassMethodParamType(ct, fn, i - 1); isV := SymTab.ClassMethodParamIsVar(ct, fn, i - 1); IF isV THEN IF QbeGen.AddrOfVal(qe, qa) THEN IF NOT QbeGen.CallArg(qa, "l") THEN END END ELSE conv := (SymTab.ClassOf(ft) = SymTab.ClReal) AND SymTab.IsIntFamily(at); IF conv THEN QbeGen.ConvIR(qe, qt); IF NOT QbeGen.CallArg(qt, "d") THEN END ELSE IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END END END; INC(i) END; IF want THEN t := res; QbeGen.CallEnd(TRUE, q) ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q) END END LowerMethodCall; PROCEDURE LowerCase (n: AST.Node); (* CASE as a compare-chain (mirrors CaseStat/CaseAlt/CaseLabel). *) VAR i, j: CARDINAL; arm, lab: AST.Node; tsel, t2, t3: SymTab.TypeIndex; qsel, q2, q3, qc, qd, qe, lEnd, lBody, lAfter, lNext: QbeGen.QVal; BEGIN LowerExpr(AST.Child(n, 0), tsel, qsel); QbeGen.NewLabel(lEnd); i := 1; WHILE i < AST.NChild(n) DO arm := AST.Child(n, i); IF AST.Op(arm) = 1 THEN (* ELSE arm: emitted after the alternatives *) ELSE QbeGen.NewLabel(lBody); QbeGen.NewLabel(lAfter); j := 0; WHILE j + 1 < AST.NChild(arm) DO lab := AST.Child(arm, j); IF AST.Kind(lab) = AST.NkSubrange THEN LowerExpr(AST.Child(lab, 0), t2, q2); QbeGen.NewLabel(lNext); QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE); QbeGen.Jnz(qc, lBody, lNext); QbeGen.EmitLabel(lNext); LowerExpr(AST.Child(lab, 1), t3, q3); QbeGen.Cmp(SymTab.OpGe, qsel, q2, qc, FALSE); QbeGen.Cmp(SymTab.OpLe, qsel, q3, qd, FALSE); QbeGen.NewTemp(qe); QbeGen.Op3("and", qe, qc, qd, FALSE); QbeGen.NewLabel(lNext); QbeGen.Jnz(qe, lBody, lNext); QbeGen.EmitLabel(lNext) ELSE LowerExpr(lab, t2, q2); QbeGen.NewLabel(lNext); QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE); QbeGen.Jnz(qc, lBody, lNext); QbeGen.EmitLabel(lNext) END; INC(j) END; QbeGen.Jmp(lAfter); QbeGen.EmitLabel(lBody); LowerStmt(AST.Child(arm, AST.NChild(arm) - 1)); QbeGen.Jmp(lEnd); QbeGen.EmitLabel(lAfter) END; INC(i) END; i := 1; WHILE i < AST.NChild(n) DO arm := AST.Child(n, i); IF AST.Op(arm) = 1 THEN LowerStmt(AST.Child(arm, 0)) END; INC(i) END; QbeGen.EmitLabel(lEnd) END LowerCase; PROCEDURE LowerWith (n: AST.Node); (* WITH: push each record's base address, lower the body, pop. *) VAR i: CARDINAL; dt: SymTab.TypeIndex; dk: INTEGER; qd: QbeGen.QVal; qn: SymTab.Name; sfx: BOOLEAN; BEGIN i := 0; WHILE i + 1 < AST.NChild(n) DO LowerDesign(AST.Child(n, i), dt, dk, qd, qn, sfx); QbeGen.PushWith(qd); IF withTop <= HIGH(withRec) THEN withRec[withTop] := dt; INC(withTop) END; INC(i) END; LowerStmt(AST.Child(n, AST.NChild(n) - 1)); WHILE withTop > 0 DO DEC(withTop); QbeGen.PopWith END END LowerWith; PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal; VAR k: INTEGER; VAR qn: SymTab.Name; VAR sfx: BOOLEAN; asAddr: BOOLEAN); VAR t2: SymTab.TypeIndex; q2, qt, qf, qs, qr: QbeGen.QVal; lNext, lFalse, lTrue, lDone: QbeGen.QVal; kind, op, rop: INTEGER; folded, isR, isCh: BOOLEAN; i: CARDINAL; el: AST.Node; lw, rw, mw: CARDINAL; idx: INTEGER; fok, isL: BOOLEAN; lt, rt: SymTab.TypeIndex; qw: QbeGen.QVal; BEGIN IF AST.Kind(n) = AST.NkDesignator THEN LowerDesign(n, t, k, q, qn, sfx); IF NOT asAddr THEN FinalLoad(t, sfx, q) END; RETURN END; k := -1; qn[0] := CHR(0); sfx := FALSE; IF AST.Kind(n) = AST.NkIntLit THEN Name(n, qn); QbeGen.NormInt(qn, q); t := SymTab.IntType() ELSIF AST.Kind(n) = AST.NkCharLit THEN Name(n, qn); QbeGen.NormLit(qn, q, isCh); t := SymTab.CharType() ELSIF AST.Kind(n) = AST.NkRealLit THEN Name(n, qn); QbeGen.NormReal(qn, q); t := SymTab.RealType() ELSIF AST.Kind(n) = AST.NkStrLit THEN Name(n, qn); IF SymTab.StrLen(qn) = 3 THEN t := SymTab.CharType(); QbeGen.IntStr(QbeGen.CharVal(qn), q) ELSE t := SymTab.NewStr(); QbeGen.DeclStr(qn, q); QbeGen.NoteAddr(q, q) END ELSIF AST.Kind(n) = AST.NkSetLit THEN t := SymTab.NewSet(SymTab.NewSubR(0, 255)); QbeGen.NewSetTemp(8, q); QbeGen.SetZero(q, 8); i := 0; WHILE i < AST.NChild(n) DO el := AST.Child(n, i); IF AST.Kind(el) = AST.NkSubrange THEN LowerExpr(AST.Child(el, 0), t2, q2); LowerExpr(AST.Child(el, 1), t2, qt); QbeGen.SetRange(q, q2, qt, SymTab.SetBaseLo(t), SymTab.SetCount(t)) ELSE LowerExpr(el, t2, q2); QbeGen.SetBit(q, q2, SymTab.SetBaseLo(t), SymTab.SetCount(t)) END; INC(i) END ELSIF AST.Kind(n) = AST.NkDesignator THEN LowerDesign(n, t, k, q, qn, sfx) ELSIF AST.Kind(n) = AST.NkCall THEN IF IsMethodCall(n) THEN LowerMethodCall(n, t, q, TRUE) ELSE CalleeName(n, qn); IF IsBuiltin(qn) THEN LowerBuiltinExpr(n, qn, t, q) ELSE LowerCall(n, t, q, TRUE) END END ELSIF AST.Kind(n) = AST.NkUnary THEN LowerExpr(AST.Child(n, 0), t, q); IF AST.Op(n) = AST.OpSub THEN IF QbeGen.IsImm(q) THEN QbeGen.NegFold(q, q) ELSE QbeGen.NewTemp(qt); QbeGen.NegQ(q, qt, FALSE); QbeGen.CopyOp(qt, q) END ELSE QbeGen.NotQ(q, qt); QbeGen.CopyOp(qt, q); t := SymTab.BoolType() END ELSIF AST.Kind(n) = AST.NkBinExpr THEN op := AST.Op(n); IF IsRel(op) THEN LowerExpr(AST.Child(n, 0), t, q); LowerExpr(AST.Child(n, 1), t2, q2); rop := SymTab.OpEq; folded := RelSym(op, rop); IF op = AST.OpIn THEN QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2), SymTab.SetCount(t2), qt); t := SymTab.BoolType(); QbeGen.CopyOp(qt, q) ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr) OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN QbeGen.CmpL(rop, q, q2, qt); t := SymTab.BoolType(); QbeGen.CopyOp(qt, q) ELSIF (SymTab.ClassOf(t) = SymTab.ClSet) OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN QbeGen.CmpSet(rop, q, q2, SymTab.SetWords(t), SymTab.SetWords(t2), qt); t := SymTab.BoolType(); QbeGen.CopyOp(qt, q) ELSIF SymTab.StrCompat(t, t2) THEN QbeGen.StrEq(rop, q, q2, qt); t := SymTab.BoolType(); QbeGen.CopyOp(qt, q) ELSIF SymTab.IsLongFamily(t) OR SymTab.IsLongFamily(t2) THEN IF SymTab.IsIntFamily(t) THEN QbeGen.WidenLong(q, qf); QbeGen.CopyOp(qf, q) END; IF SymTab.IsIntFamily(t2) THEN QbeGen.WidenLong(q2, qf); QbeGen.CopyOp(qf, q2) END; QbeGen.CmpLong(rop, q, q2, qt); t := SymTab.BoolType(); QbeGen.CopyOp(qt, q) ELSE isR := (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClReal); t := SymTab.BoolType(); QbeGen.Cmp(rop, q, q2, qt, isR); QbeGen.CopyOp(qt, q) END ELSIF op = AST.OpAnd THEN LowerExpr(AST.Child(n, 0), t, q); QbeGen.DelayBegin; LowerExpr(AST.Child(n, 1), t2, q2); QbeGen.DelayEnd; QbeGen.Slot4(qs); QbeGen.NewLabel(lNext); QbeGen.NewLabel(lFalse); QbeGen.NewLabel(lDone); QbeGen.Jnz(q, lNext, lFalse); QbeGen.EmitLabel(lNext); QbeGen.DelayFlush; QbeGen.StoreW(qs, q2); QbeGen.Jmp(lDone); QbeGen.EmitLabel(lFalse); QbeGen.StoreW(qs, "0"); QbeGen.Jmp(lDone); QbeGen.EmitLabel(lDone); QbeGen.LoadW(qs, qr); QbeGen.CopyOp(qr, q); t := SymTab.BoolType() ELSIF op = AST.OpOr THEN LowerExpr(AST.Child(n, 0), t, q); QbeGen.DelayBegin; LowerExpr(AST.Child(n, 1), t2, q2); QbeGen.DelayEnd; QbeGen.Slot4(qs); QbeGen.NewLabel(lTrue); QbeGen.NewLabel(lNext); QbeGen.NewLabel(lDone); QbeGen.Jnz(q, lTrue, lNext); QbeGen.EmitLabel(lTrue); QbeGen.StoreW(qs, "1"); QbeGen.Jmp(lDone); QbeGen.EmitLabel(lNext); QbeGen.DelayFlush; QbeGen.StoreW(qs, q2); QbeGen.Jmp(lDone); QbeGen.EmitLabel(lDone); QbeGen.LoadW(qs, qr); QbeGen.CopyOp(qr, q); t := SymTab.BoolType() ELSE LowerExpr(AST.Child(n, 0), t, q); LowerExpr(AST.Child(n, 1), t2, q2); IF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClSet) AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN (* set union/diff (Add/Sub) or intersection/symdiff (Mul/Div) *) lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2); mw := lw; IF rw > mw THEN mw := rw END; IF op = AST.OpAdd THEN idx := 0 ELSIF op = AST.OpSub THEN idx := 2 ELSIF op = AST.OpMul THEN idx := 1 ELSE idx := 3 END; QbeGen.SetBinOp(idx, q, q2, lw, rw, qt); t := SymTab.NewSet(SymTab.NewSubR(0, VAL(INTEGER, mw) * 32 - 1)); QbeGen.CopyOp(qt, q) ELSIF (op = AST.OpAdd) AND (SymTab.StrCompat(t, t2) OR (SymTab.IsStrType(t) AND (SymTab.ClassOf(t2) = SymTab.ClChar)) OR ((SymTab.ClassOf(t) = SymTab.ClChar) AND SymTab.IsStrType(t2))) THEN QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2), qt, fok); IF NOT fok THEN IF SymTab.StrCompat(t, t2) THEN QbeGen.StrCat(q, q2, qt) ELSIF SymTab.IsStrType(t) THEN QbeGen.DeclCharStr(q2, qs); QbeGen.StrCat(q, qs, qt) ELSE QbeGen.DeclCharStr(q, qs); QbeGen.StrCat(qs, q2, qt) END END; t := SymTab.NewStr(); QbeGen.CopyOp(qt, q) ELSE lt := t; rt := t2; IF (SymTab.ClassOf(lt) = SymTab.ClReal) OR (SymTab.ClassOf(rt) = SymTab.ClReal) THEN t := SymTab.RealType() ELSIF SymTab.IsLongFamily(lt) OR SymTab.IsLongFamily(rt) THEN t := SymTab.LongType() ELSE t := SymTab.IntType() END; isL := SymTab.IsLongFamily(t); isR := SymTab.ClassOf(t) = SymTab.ClReal; kind := 0; IF op = AST.OpSub THEN kind := 1 ELSIF op = AST.OpMul THEN kind := 2 ELSIF op = AST.OpDiv THEN kind := 3 ELSIF op = AST.OpMod THEN kind := 4 END; folded := FALSE; IF (NOT isL) AND (NOT isR) AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN folded := QbeGen.Fold2(kind, q, q2, qf) END; IF folded THEN QbeGen.CopyOp(qf, q) ELSE IF isL THEN IF SymTab.IsIntFamily(lt) THEN QbeGen.WidenLong(q, qw); QbeGen.CopyOp(qw, q) END; IF SymTab.IsIntFamily(rt) THEN QbeGen.WidenLong(q2, qw); QbeGen.CopyOp(qw, q2) END; QbeGen.NewTemp(qt); IF op = AST.OpAdd THEN QbeGen.Op3L("add", qt, q, q2) ELSIF op = AST.OpSub THEN QbeGen.Op3L("sub", qt, q, q2) ELSIF op = AST.OpMul THEN QbeGen.Op3L("mul", qt, q, q2) ELSE QbeGen.Op3L("div", qt, q, q2) END ELSE QbeGen.NewTemp(qt); IF op = AST.OpAdd THEN QbeGen.Op3("add", qt, q, q2, isR) ELSIF op = AST.OpSub THEN QbeGen.Op3("sub", qt, q, q2, isR) ELSIF op = AST.OpMul THEN QbeGen.Op3("mul", qt, q, q2, isR) ELSIF op = AST.OpDiv THEN QbeGen.Op3("div", qt, q, q2, isR) ELSE QbeGen.Op3("rem", qt, q, q2, isR) END END; QbeGen.CopyOp(qt, q) END END END END END LowerExprFull; PROCEDURE LowerExpr (n: AST.Node; VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); VAR k: INTEGER; qn: SymTab.Name; sfx: BOOLEAN; BEGIN LowerExprFull(n, t, q, k, qn, sfx, FALSE) END LowerExpr; PROCEDURE LowerStmt (seq: AST.Node); VAR i: CARDINAL; c, els, by: AST.Node; k: INTEGER; t, t2, dt, et: SymTab.TypeIndex; q, q2, qt, qf, qd, qe: QbeGen.QVal; qlo, qhi, qk, qb, ql: QbeGen.QVal; lTop, lBody, lEnd, lThen, lElse, lNext, lFalse, lDone, lx: QbeGen.QVal; qn, lv: SymTab.Name; kind, op, rop, cls: INTEGER; sfx, folded, isR, conv, wconv, hasElse: BOOLEAN; BEGIN IF seq = AST.NoNode THEN RETURN END; k := AST.Kind(seq); IF k = AST.NkBlock THEN i := 0; WHILE i < AST.NChild(seq) DO LowerStmt(AST.Child(seq, i)); INC(i) END ELSIF k = AST.NkAssign THEN LowerDesign(AST.Child(seq, 0), dt, cls, qd, qn, sfx); LowerExpr(AST.Child(seq, 1), et, qe); isR := (dt # SymTab.InvalidType) AND (SymTab.ClassOf(dt) = SymTab.ClReal); conv := isR AND SymTab.IsIntFamily(et); wconv := (dt # SymTab.InvalidType) AND SymTab.IsLongFamily(dt) AND SymTab.IsIntFamily(et); IF sfx OR (cls = SymTab.KindField) THEN IF SymTab.ClassOf(dt) = SymTab.ClArray THEN IF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr) AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe) ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe) ELSE QbeGen.CopyArray(qd, qe, dt) END ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN QbeGen.CopySet(qd, qe, SymTab.SetWords(dt), SymTab.SetWords(et)) ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN QbeGen.CopyRecord(qd, qe, dt) ELSIF SymTab.IsLongFamily(dt) THEN IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.ElemStore(qd, ql, dt) ELSE QbeGen.ElemStore(qd, qe, dt) END ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.ElemStore(qd, qt, dt) ELSE QbeGen.ElemStore(qd, qe, dt) END ELSE IF SymTab.ClassOf(dt) = SymTab.ClArray THEN IF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr) AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe) ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe) ELSE QbeGen.CopyArray(qd, qe, dt) END ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN QbeGen.CopySet(qd, qe, SymTab.SetWords(dt), SymTab.SetWords(et)) ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN QbeGen.CopyRecord(qd, qe, dt) ELSIF (SymTab.ClassOf(dt) = SymTab.ClPtr) OR (SymTab.ClassOf(dt) = SymTab.ClProc) THEN QbeGen.StorePtr(qn, qe) ELSIF SymTab.IsLongFamily(dt) THEN IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.StoreLong(qn, ql) ELSE QbeGen.StoreLong(qn, qe) END ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.StoreVar(qn, qt, TRUE) ELSE QbeGen.StoreVar(qn, qe, isR) END END ELSIF k = AST.NkIf THEN LowerExpr(AST.Child(seq, 0), t, q); QbeGen.NewLabel(lThen); QbeGen.NewLabel(lElse); QbeGen.NewLabel(lEnd); QbeGen.Jnz(q, lThen, lElse); QbeGen.EmitLabel(lThen); LowerStmt(AST.Child(seq, 1)); QbeGen.Jmp(lEnd); els := AST.Child(seq, 2); hasElse := FALSE; WHILE (els # AST.NoNode) AND (AST.Kind(els) = AST.NkIf) DO QbeGen.EmitLabel(lElse); QbeGen.NewLabel(lElse); LowerExpr(AST.Child(els, 0), t, q); QbeGen.NewLabel(lThen); QbeGen.Jnz(q, lThen, lElse); QbeGen.EmitLabel(lThen); LowerStmt(AST.Child(els, 1)); QbeGen.Jmp(lEnd); els := AST.Child(els, 2) END; IF els # AST.NoNode THEN QbeGen.EmitLabel(lElse); hasElse := TRUE; LowerStmt(els) END; IF hasElse THEN QbeGen.EmitLabel(lEnd) ELSE QbeGen.EmitLabel(lElse); QbeGen.EmitLabel(lEnd) END ELSIF k = AST.NkWhile THEN QbeGen.NewLabel(lTop); QbeGen.NewLabel(lBody); QbeGen.NewLabel(lEnd); QbeGen.EmitLabel(lTop); LowerExpr(AST.Child(seq, 0), t, q); QbeGen.Jnz(q, lBody, lEnd); QbeGen.EmitLabel(lBody); LowerStmt(AST.Child(seq, 1)); QbeGen.Jmp(lTop); QbeGen.EmitLabel(lEnd) ELSIF k = AST.NkRepeat THEN QbeGen.NewLabel(lTop); QbeGen.NewLabel(lEnd); QbeGen.EmitLabel(lTop); LowerStmt(AST.Child(seq, 0)); LowerExpr(AST.Child(seq, 1), t, q); QbeGen.Jnz(q, lEnd, lTop); QbeGen.EmitLabel(lEnd) ELSIF k = AST.NkLoop THEN QbeGen.NewLabel(lTop); QbeGen.NewLabel(lEnd); QbeGen.PushLoop(lEnd); QbeGen.EmitLabel(lTop); LowerStmt(AST.Child(seq, 0)); QbeGen.Jmp(lTop); QbeGen.PopLoop; QbeGen.EmitLabel(lEnd) ELSIF k = AST.NkExit THEN IF QbeGen.TopLoop(lx) THEN QbeGen.Jmp(lx) END ELSIF k = AST.NkFor THEN Name(AST.Child(seq, 0), lv); LowerExpr(AST.Child(seq, 1), t, qlo); LowerExpr(AST.Child(seq, 2), t2, qhi); QbeGen.StoreVar(lv, qlo, FALSE); QbeGen.NewLabel(lTop); QbeGen.NewLabel(lBody); QbeGen.NewLabel(lEnd); QbeGen.EmitLabel(lTop); QbeGen.LoadVar(lv, FALSE, qt); QbeGen.NewTemp(qk); QbeGen.Op3("cslew", qk, qt, qhi, FALSE); QbeGen.Jnz(qk, lBody, lEnd); QbeGen.EmitLabel(lBody); LowerStmt(AST.Child(seq, 4)); QbeGen.LoadVar(lv, FALSE, qt); QbeGen.IntStr(1, qb); QbeGen.NewTemp(qk); QbeGen.Op3("add", qk, qt, qb, FALSE); QbeGen.StoreVar(lv, qk, FALSE); QbeGen.Jmp(lTop); QbeGen.EmitLabel(lEnd) ELSIF k = AST.NkHalt THEN IF AST.Child(seq, 0) # AST.NoNode THEN LowerExpr(AST.Child(seq, 0), t, q) END; QbeGen.HaltQ ELSIF k = AST.NkReturn THEN IF AST.Child(seq, 0) = AST.NoNode THEN QbeGen.EmitRet(q, FALSE) ELSE LowerExpr(AST.Child(seq, 0), t, q); conv := (SymTab.ClassOf(SymTab.CurRes()) = SymTab.ClReal) AND SymTab.IsIntFamily(t); IF conv THEN QbeGen.ConvIR(q, qt); QbeGen.EmitRet(qt, TRUE) ELSE QbeGen.EmitRet(q, TRUE) END END ELSIF k = AST.NkCase THEN LowerCase(seq) ELSIF k = AST.NkWith THEN LowerWith(seq) ELSIF k = AST.NkCall THEN IF IsMethodCall(seq) THEN LowerMethodCall(seq, t, q, FALSE) ELSE CalleeName(seq, qn); IF IsBuiltin(qn) THEN LowerBuiltinStmt(seq, qn) ELSE LowerCall(seq, t, q, FALSE) END END END END LowerStmt; PROCEDURE ReenterGlobals (seq: AST.Node); (* Re-registers a nested module's non-exported globals in the enclosing (still-open) module scope, so QbeGen.GlobalRef can resolve their "_" symbols after the nested scope has been popped. *) VAR i, j: CARDINAL; c: AST.Node; nm: SymTab.Name; BEGIN IF seq = AST.NoNode THEN RETURN END; i := 0; WHILE i < AST.NChild(seq) DO c := AST.Child(seq, i); IF i = AST.MaxChild - 1 THEN ReenterGlobals(c) ELSIF AST.Kind(c) = AST.NkDeclSeq THEN ReenterGlobals(c) ELSIF AST.Kind(c) = AST.NkVarDecl THEN j := 0; WHILE j < AST.NChild(c) DO Name(AST.Child(c, j), nm); IF SymTab.ReenterModGlobal(nm, SymTab.KindVar, curUnitName) THEN SymTab.SetSymType(nm, AST.Ty(c)) END; INC(j) END END; INC(i) END END ReenterGlobals; PROCEDURE LowerDecls (seq: AST.Node); VAR i, j: CARDINAL; c: AST.Node; nm, txt: SymTab.Name; qv: QbeGen.QVal; mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex; ext, pv: BOOLEAN; kk: INTEGER; ct: SymTab.TypeIndex; BEGIN IF seq = AST.NoNode THEN RETURN END; i := 0; WHILE i < AST.NChild(seq) DO c := AST.Child(seq, i); IF i = AST.MaxChild - 1 THEN LowerDecls(c) ELSIF AST.Kind(c) = AST.NkDeclSeq THEN LowerDecls(c) ELSIF AST.Kind(c) = AST.NkClassDecl THEN Name(AST.Child(c, 0), nm); IF Resolve(nm, kk, ct) THEN IF SymTab.ClassOf(ct) = SymTab.ClClass THEN IF AST.Op(c) = 1 THEN LowerMethods(AST.Child(c, 3), ct); IF AST.Child(c, 2) # AST.NoNode THEN QbeGen.BeginInit(nm); LowerStmt(AST.Child(c, 2)); QbeGen.EndInit END ELSE LowerMethodHeadings(AST.Child(c, 3), ct) END END END ELSIF AST.Kind(c) = AST.NkUnit THEN Name(AST.Child(c, 0), nm); ReenterGlobals(AST.Child(c, 1)); LowerDecls(AST.Child(c, 1)); IF AST.Child(c, 2) # AST.NoNode THEN QbeGen.BeginInit(nm); LowerStmt(AST.Child(c, 2)); QbeGen.EndInit END ELSIF AST.Kind(c) = AST.NkVarDecl THEN j := 0; WHILE j < AST.NChild(c) DO Name(AST.Child(c, j), nm); QbeGen.DeclVar(nm, AST.Ty(c)); INC(j) END ELSIF AST.Kind(c) = AST.NkConstDecl THEN Name(AST.Child(c, 0), nm); Name(AST.Child(c, 1), txt); QbeGen.NormInt(txt, qv); QbeGen.DeclConst(nm, qv, AST.Ty(c)) ELSIF AST.Kind(c) = AST.NkProcDecl THEN Name(AST.Child(c, 0), nm); IF ProcInfo(nm, uid, res, depth, ext, np) THEN QbeGen.Mangled(nm, uid, mg); QbeGen.BeginFunc(mg); j := 0; WHILE j < np DO IF ParamInfo(nm, j, pt, pv, txt) THEN IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END END; INC(j) END; QbeGen.SetFuncRes(res); IF AST.Child(c, 1) = AST.NoNode THEN (* declaration-only (definition module): replay the heading *) QbeGen.AbortFunc ELSE QbeGen.EndFuncHeader; LowerDecls(AST.Child(c, 2)); LowerStmt(AST.Child(c, 1)); QbeGen.EndFunc(res) END END END; INC(i) END END LowerDecls; PROCEDURE MaterializeGlobals (unitName: ARRAY OF CHAR; decls: AST.Node); (* Make a unit's module-level VAR/CONST visible in the (global) scope Lower runs in at session end, so GlobalRef resolves "_". *) VAR i, j: CARDINAL; c: AST.Node; nm: SymTab.Name; BEGIN IF decls = AST.NoNode THEN RETURN END; i := 0; WHILE i < AST.NChild(decls) DO c := AST.Child(decls, i); IF i = AST.MaxChild - 1 THEN MaterializeGlobals(unitName, c) ELSIF AST.Kind(c) = AST.NkDeclSeq THEN MaterializeGlobals(unitName, c) ELSIF (AST.Kind(c) = AST.NkVarDecl) OR (AST.Kind(c) = AST.NkConstDecl) THEN j := 0; WHILE j < AST.NChild(c) DO IF AST.Kind(AST.Child(c, j)) = AST.NkIdent THEN Name(AST.Child(c, j), nm); IF NOT SymTab.Materialize(unitName, nm) THEN END END; INC(j) END ELSIF (AST.Kind(c) = AST.NkTypeDecl) OR (AST.Kind(c) = AST.NkClassDecl) THEN IF AST.NChild(c) >= 1 THEN Name(AST.Child(c, 0), nm); IF NOT SymTab.Materialize(unitName, nm) THEN END END END; INC(i) END END MaterializeGlobals; PROCEDURE LowerOneUnit (u: AST.Node; isProg: BOOLEAN); VAR nm: SymTab.Name; BEGIN Name(AST.Child(u, 0), nm); CopySpan(nm, curUnitName, 0, 0); QbeGen.SetModule(nm); MaterializeGlobals(nm, AST.Child(u, 1)); LowerDecls(AST.Child(u, 1)); IF isProg THEN QbeGen.BeginBody; LowerStmt(AST.Child(u, 2)) ELSIF AST.Child(u, 2) # AST.NoNode THEN QbeGen.BeginInit(nm); LowerStmt(AST.Child(u, 2)); QbeGen.EndInit END END LowerOneUnit; PROCEDURE LowerSession (units: ARRAY OF AST.Node; n: CARDINAL; progName: ARRAY OF CHAR); (* Re-emit a whole session (all units, in order) into one image. *) VAR i, j: CARDINAL; out: ARRAY [0 .. 255] OF CHAR; pn: SymTab.Name; BEGIN IF n = 0 THEN RETURN END; Name(AST.Child(units[n - 1], 0), pn); j := 0; WHILE (j <= 254) AND (pn[j] # CHR(0)) DO out[j] := pn[j]; INC(j) END; out[j] := "L"; INC(j); out[j] := CHR(0); withTop := 0; curImplCls := SymTab.InvalidType; QbeGen.OpenModule(progName); QbeGen.SetOutName(out); i := 0; WHILE i < n DO LowerOneUnit(units[i], i = n - 1); INC(i) END; QbeGen.EndModule(pn) END LowerSession; PROCEDURE LowerUnit (unit: AST.Node); VAR nm: SymTab.Name; out: ARRAY [0 .. 255] OF CHAR; i: CARDINAL; BEGIN withTop := 0; curImplCls := SymTab.InvalidType; Name(AST.Child(unit, 0), nm); i := 0; WHILE (i <= 254) AND (i <= HIGH(nm)) AND (nm[i] # CHR(0)) DO out[i] := nm[i]; INC(i) END; out[i] := "L"; INC(i); out[i] := CHR(0); QbeGen.OpenModule(nm); QbeGen.SetOutName(out); QbeGen.SetModule(nm); LowerDecls(AST.Child(unit, 1)); QbeGen.BeginBody; LowerStmt(AST.Child(unit, 2)); QbeGen.EndModule(nm) END LowerUnit; BEGIN END Lower.