<<>> <> <> <> <> <> <> DIRECTORY Alloc USING [Base, Notifier], Basics USING [LowHalf], IntCodeDefs USING [ArithClass, ArithSelector, ByteSequence, CaseList, CaseListRep, ConstNode, DerefLocation, Label, LocalVarLocation, Location, LocationRep, Node, NodeList, NodeRep, OperRep, Var], IntCodeUtils USING [Fetch, IdTab, NewIdTab, SideEffectFree, SimplyEqual, Store], LiteralOps USING [StringValue, Value, ValueBits, ValueCard, ValueInt, ValueReal], Literals USING [Base, LTIndex, ltType, STIndex, stType], MimCode USING [BitAddress, BitCount, caseCV, caseType, CodeList, firstMappedAddress, RegisterNotifier, StoreOptions, trueNode, VLoc, xtracting, xtractNode, z], MimData USING [wordAlignment, worstAlignment], MimosaLog USING [ErrorTree, WarningSei], MimP5 USING [All, BindStmtExp, CaseStmtExp, Construct, Exp, FlowExp, GetCanonicalType, ListCons, MakeString, New, ProcDescForBti, RowCons, SignalForSei, StatementTree, VarForLink, visibleContext], MimP5S USING [AssignExp, Call, Create, DIndex, ExtractExp, ForkExp, Index, Join, ProcCheck, SeqIndex, SigErr, SplitArith, Start, StringInit, Subst, SysErrExp, Temporize], MimP5Stuff USING [ShiftLeft, SimplifyParts], MimP5U USING [Address, AdjustLoc, AlignmentFromTree, AlignmentFromType, AllocLabel, ApplyOp, ArithClassForTree, ArithClassForType, ArithOpForTree, Assign, BinaryArithOp, BitsForType, BoolTest, BoundsCheck, CedarOpNode, CompareOp, Declare, Deref, EqualTest, Extend, FnField, ForceBool, FullWordBits, InsertLabel, MakeArgList, MakeArgList2, MakeCaseList, MakeComposite, MakeConstCard, MakeConstInt, MakeDummy, MakeGoTo, MakeNodeList, MakeNodeList2, MakeTemp, MakeVar, MaybeBlock, MesaOpNode, MoreCode, NewCodeList, NodeAnd, NodeForType, NodeIf, NodeOr, OperandType, ProcessSafens, RecField, ReferentType, TakeField, TypeForTree, VariantTag, ZeroExtend], SymbolOps USING [CtxLevel, DecodeBti, DecodeCard, DecodeLink, EqTypes, FindExtension, own, RCType, ToType, TransferTypes, TypeForm, TypeLink, TypeRoot, UnderType, VariantField, XferMode], Symbols USING [Alignment, Base, bodyType, BTIndex, CBTIndex, CBTNull, ContextLevel, CSEIndex, CTXIndex, ISEIndex, ISENull, lG, lZ, nullName, RecordSEIndex, seType, Type], Table USING [IndexRep], Target: TYPE MachineParms USING [AlignmentIndex, Alignments, bitsPerAU, bitsPerByte, bitsPerLongWord, bitsPerProgram, bitsPerRef, bitsPerSignal, bitsPerWord], TargetConversions USING [BitsWritten, PutCard, NewWriter, Writer, WriterContents], Tree USING [Base, Index, Info, Link, NodeName, Null, Scan, treeType], TreeOps USING [GetNode, GetSe, GetTag, ListLength, ScanList], Types USING [Equivalent, OpaqueValue]; MimExpr: PROGRAM IMPORTS Basics, IntCodeUtils, LiteralOps, MimCode, MimData, MimosaLog, MimP5, MimP5S, MimP5Stuff, MimP5U, SymbolOps, TargetConversions, TreeOps, Types EXPORTS MimP5 = { OPEN IntCodeDefs, MimCode, Target; bitsPerPtr: NAT = Target.bitsPerRef; bitsPerWord: NAT = Target.bitsPerWord; bytesPerWord: NAT = bitsPerWord/Target.bitsPerByte; firstMappedBit: CARD = MimCode.firstMappedAddress*Target.bitsPerAU; wordPadDeref: BOOL = TRUE; <> minReferentAlignment: Symbols.Alignment ¬ MimData.wordAlignment; minReferentBits: NAT ¬ bitsPerWord; hackForPad: BOOL ¬ TRUE; <> <> TreeType: PROC [node: Tree.Index] RETURNS [Symbols.Type] = INLINE { RETURN [SymbolOps.ToType[tb[node].info]]; }; <> ExprOptions: MimCode.StoreOptions = [expr: TRUE, init: TRUE]; BTIndex: TYPE = Symbols.BTIndex; CBTIndex: TYPE = Symbols.CBTIndex; CBTNull: CBTIndex = Symbols.CBTNull; ContextLevel: TYPE = Symbols.ContextLevel; CSEIndex: TYPE = Symbols.CSEIndex; CTXIndex: TYPE = Symbols.CTXIndex; ISEIndex: TYPE = Symbols.ISEIndex; ISENull: ISEIndex = Symbols.ISENull; lG: ContextLevel = Symbols.lG; LTIndex: TYPE = Literals.LTIndex; lZ: ContextLevel = Symbols.lZ; RecordSEIndex: TYPE = Symbols.RecordSEIndex; Type: TYPE = Symbols.Type; <> TreeIndexSeen: SIGNAL = CODE; debugTreeIndex: Tree.Link ¬ Tree.Null; NotYetImplemented: SIGNAL = CODE; <> <<>> ExpList: PUBLIC PROC [t: Tree.Link, wordPad: BOOL] RETURNS [head, tail: NodeList ¬ NIL] = { OneExp: Tree.Scan = { nl: NodeList; n: Node ¬ MimP5.Exp[t]; IF wordPad THEN { nb: INT = n.bits; mod: NAT = Basics.LowHalf[nb] MOD bitsPerWord; IF mod # 0 THEN <> n ¬ MimP5U.Extend[n, nb+(bitsPerWord-mod), MimP5U.OperandType[t]]; }; nl ¬ MimP5U.MakeNodeList[n]; IF tail = NIL THEN head ¬ nl ELSE tail.rest ¬ nl; tail ¬ nl; }; TreeOps.ScanList[t, OneExp]; }; Exp: PUBLIC PROC [t: Tree.Link] RETURNS [l: IntCodeDefs.Node] = { <> WITH e: t SELECT TreeOps.GetTag[t] FROM literal => RETURN [MakeConst[e.index]]; string => RETURN [MimP5.MakeString[t]]; symbol => { sei: ISEIndex = e.index; IF ~seb[sei].constant THEN { IF seb[sei].idDecl = 1 THEN MimosaLog.WarningSei[uninitialized, sei]; <> l ¬ VarForSei[e.index]; } ELSE SELECT SymbolOps.XferMode[SymbolOps.own, seb[sei].idType] FROM proc => { IF seb[sei].extended THEN { <> link: Tree.Link ¬ SymbolOps.FindExtension[SymbolOps.own, sei].tree; WITH sub: link SELECT TreeOps.GetTag[link] FROM subtree => RETURN [MachineCodeBytes[tb[sub.index].son[1]]]; ENDCASE => ERROR; }; RETURN [MimP5.ProcDescForBti[SymbolOps.DecodeBti[seb[sei].idInfo]]]; }; signal, error => { <> l ¬ MimP5.SignalForSei[sei]; }; program => { <> l ¬ MimP5U.MesaOpNode[globalFrame, 0, Target.bitsPerProgram] }; ENDCASE => ERROR; }; subtree => { node: Tree.Index ¬ e.index; IF tb[node].free THEN ERROR; recentExp ¬ t; IF e = Tree.Null THEN { <> l ¬ IF MimCode.xtracting THEN MimCode.xtractNode ELSE MimCode.caseCV; IF l = NIL THEN ERROR; RETURN; }; IF t = debugTreeIndex THEN SIGNAL TreeIndexSeen; SELECT tb[node].name FROM casex => l ¬ MimP5.CaseStmtExp[node, TRUE]; bindx => l ¬ MimP5.BindStmtExp[node, TRUE]; assignx => l ¬ MimP5S.AssignExp[node]; extractx => l ¬ MimP5S.ExtractExp[node]; plus => l ¬ BinaryOp[node, add]; minus => l ¬ BinaryOp[node, sub]; div => l ¬ BinaryOp[node, div]; mod => l ¬ BinaryOp[node, mod]; times => l ¬ BinaryOp[node, mul]; power => l ¬ BinaryOp[node, pow]; dot, uparrow => l ¬ DotOrUparrow[node]; reloc => { <> son2: Tree.Link = tb[node].son[2]; bits: INT ¬ MimP5U.BitsForType[TreeType[node]]; align: Symbols.Alignment = MAX[ MimP5U.AlignmentFromTree[son2, TRUE], minReferentAlignment]; base: Node = Exp[tb[node].son[1]]; relptr: Node ¬ Exp[son2]; sum: Node; IF tb[node].attr1 THEN { <> relptr ¬ MimP5U.TakeField[relptr, 0, bitsPerWord]; }; sum ¬ MimP5U.ApplyOp[ oper: MimP5U.ArithOpForTree[node, add], args: MimP5U.MakeNodeList2[base, relptr], bits: bitsPerPtr]; IF wordPadDeref AND bits < bitsPerWord THEN IF ORD[align] >= ORD[MimData.wordAlignment] THEN bits ¬ bitsPerWord; l ¬ MimP5U.Deref[n: sum, bits: bits, align: align]; }; dollar => l ¬ Dollar[node]; addr => { <> op1: Node = Exp[tb[node].son[1]]; l ¬ MimP5U.Address[op1]; }; index => l ¬ MimP5S.Index[node]; dindex => l ¬ MimP5S.DIndex[node]; construct => l ¬ MimP5.Construct[Tree.Null, node, ExprOptions]; arraydesc => { subNode: Tree.Index = TreeOps.GetNode[tb[node].son[1]]; base: Node = Exp[tb[subNode].son[1]]; lenLink: Tree.Link = tb[subNode].son[2]; length: Node ¬ IF lenLink = Tree.Null THEN MimP5U.MakeConstInt[0] ELSE MimP5U.Extend[Exp[lenLink], bitsPerWord, MimP5U.OperandType[lenLink]]; bits: INT = base.bits + length.bits; l ¬ MimP5U.MakeComposite[MimP5U.MakeNodeList2[base, length], bits]; }; length => { <> ad: Node = Exp[tb[node].son[1]]; l ¬ MimP5U.TakeField[ad, bitsPerWord, bitsPerWord]; }; base => { <> ad: Node = Exp[tb[node].son[1]]; l ¬ MimP5U.TakeField[ad, 0, bitsPerWord]; }; body => { bti: CBTIndex = LOOPHOLE[tb[node].info]; l ¬ MimP5.ProcDescForBti[bti]; }; rowcons => l ¬ MimP5.RowCons[Tree.Null, node, ExprOptions]; stringinit => l ¬ MimP5S.StringInit[node]; pad => { padType: Type = TreeType[node]; dstBits: BitCount = MimP5U.BitsForType[padType]; son: Tree.Link = tb[node].son[1]; sonType: Type = MimP5U.OperandType[son]; sonBits: INT = MimP5U.BitsForType[sonType]; val: Node ¬ Exp[son]; valBits: INT ¬ val.bits; IF valBits = bitsPerWord AND dstBits <= bitsPerWord AND sonBits < dstBits THEN IF hackForPad THEN { val ¬ MimP5Stuff.ShiftLeft[val, dstBits-sonBits, bitsPerWord]; RETURN [val]; }; IF sonBits < valBits AND sonBits < bitsPerWord THEN { val ¬ MimP5U.TakeField[val, valBits-sonBits, sonBits]; valBits ¬ sonBits; }; SELECT valBits FROM dstBits => {}; < dstBits => { <> dummy: Node = MimP5U.MakeDummy[dstBits-valBits]; parts: NodeList ¬ MimP5U.MakeNodeList2[val, dummy]; parts ¬ MimP5Stuff.SimplifyParts[parts]; IF parts.rest = NIL THEN val ¬ parts.first ELSE val ¬ MimP5U.MakeComposite[parts, dstBits]; }; ENDCASE => ERROR; <> RETURN [val]; }; ord, val => l ¬ Exp[tb[node].son[1]]; cast, loophole => { son: Tree.Link = tb[node].son[1]; ut: CSEIndex = Clarify[MimP5U.OperandType[t]]; ub: NAT = MimP5U.BitsForType[ut]; ac: ArithClass = MimP5U.ArithClassForType[ut]; l ¬ Exp[son]; WITH u: seb[ut] SELECT FROM subrange => IF NOT u.biased AND u.origin < 0 THEN { lb: NAT = l.bits; IF ub < lb THEN <> l ¬ MimP5U.TakeField[l, lb-ub, ub]; GO TO castDone; }; ENDCASE; SELECT ac.kind FROM address, real => { <> IF l.bits < ub THEN l ¬ MimP5U.ZeroExtend[l, ub]; }; ENDCASE; EXITS castDone => {}; }; safen => { cl: CodeList ¬ MimP5U.NewCodeList[]; nt: Tree.Link ¬ MimP5U.ProcessSafens[cl, [subtree[node]]]; l ¬ MimP5U.MaybeBlock[cl, Exp[nt]]; }; seqindex => l ¬ MimP5S.SeqIndex[node]; item => l ¬ Exp[tb[node].son[2]]; callx, portcallx => l ¬ MimP5S.Call[node]; substx => { resultType: Symbols.Type = SymbolOps.TransferTypes[SymbolOps.own, MimP5U.OperandType[tb[node].son[1]]].typeOut; l ¬ MimP5S.Subst[node, resultType]; }; signalx => l ¬ MimP5S.SigErr[node: node, error: FALSE, stmt: FALSE]; errorx => l ¬ MimP5S.SigErr[node: node, error: TRUE, stmt: FALSE]; syserrorx => l ¬ MimP5S.SysErrExp[node]; startx => l ¬ MimP5S.Start[node]; new => l ¬ MimP5.New[node]; listcons => l ¬ MimP5.ListCons[node]; create => l ¬ MimP5S.Create[node]; mwconst => SELECT tb[node].nSons FROM 0 => ERROR; <> 1 => l ¬ Exp[tb[node].son[1]]; <> ENDCASE => { <> list: NodeList ¬ NIL; bits: INT ¬ 0; FOR i: NAT DECREASING IN [1..tb[node].nSons] DO part: Node = Exp[tb[node].son[i]]; IF part # NIL THEN { list ¬ MimP5U.MakeNodeList[part, list]; bits ¬ bits + part.bits; }; ENDLOOP; l ¬ MimP5U.MakeComposite[list, bits]; }; fork => l ¬ MimP5S.ForkExp[node]; joinx => l ¬ MimP5S.Join[node]; narrow => l ¬ NarrowExp[node]; check => l ¬ MimP5U.BoundsCheck[Exp[tb[node].son[1]], Exp[tb[node].son[2]]]; proccheck => l ¬ MimP5S.ProcCheck[node]; chop => { val: Node ¬ Exp[tb[node].son[1]]; srcBits: BitCount = val.bits; dstBits: BitCount = MimP5U.BitsForType[TreeType[node]]; SELECT srcBits FROM dstBits => {}; < dstBits => ERROR; <> ENDCASE => val ¬ MimP5U.TakeField[val, 0, dstBits]; RETURN [val]; }; all => l ¬ MimP5.All[Tree.Null, node, ExprOptions]; nil => { type: Type = MimP5U.OperandType[t]; n: BitCount = MimP5U.BitsForType[type]; IF n <= Target.bitsPerLongWord THEN l ¬ MimP5U.MakeConstCard[0, n] ELSE { head: NodeList ¬ NIL; tail: NodeList ¬ NIL; rem: INT ¬ n; WHILE rem > 0 DO bits: INT ¬ MIN[n, Target.bitsPerLongWord]; nl: NodeList ¬ MimP5U.MakeNodeList[MimP5U.MakeConstCard[0, bits]]; IF tail = NIL THEN head ¬ nl ELSE tail.rest ¬ nl; tail ¬ nl; rem ¬ rem - bits; ENDLOOP; l ¬ MimP5U.MakeComposite[head, n]; }; }; gcrt => l ¬ MimP5.GetCanonicalType[node]; ENDCASE => l ¬ MimP5.FlowExp[node]; }; ENDCASE; }; VarForSei: PUBLIC PROC [sei: ISEIndex] RETURNS [l: Var] = { ut: CSEIndex ¬ Clarify[seb[sei].idType]; bits: INT ¬ MimP5U.BitsForType[ut]; IF seb[sei].linkSpace THEN { <> bits ¬ MimP5U.FullWordBits[bits]; l ¬ MimP5.VarForLink[SymbolOps.DecodeLink[seb[sei].idValue], bits]; <> l.flags[constant] ¬ TRUE; } ELSE { loc: Location; ctx: CTXIndex ¬ seb[sei].idCtx; id: INT; level: ContextLevel ¬ SymbolOps.CtxLevel[SymbolOps.own, ctx]; index: Table.IndexRep ¬ LOOPHOLE[sei]; index.tag ¬ 0; id ¬ LOOPHOLE[index]; WITH IntCodeUtils.Fetch[idTab, id] SELECT FROM v: Var => RETURN [v]; ENDCASE; IF NOT seb[sei].constant THEN <> bits ¬ MimP5U.FullWordBits[SymbolOps.DecodeCard[seb[sei].idInfo]]; SELECT level FROM lZ => ERROR; lG => loc ¬ z.NEW[LocationRep.globalVar ¬ [globalVar[id: 0]]]; ENDCASE => { parent: IntCodeDefs.Label ¬ NIL; IF MimP5.visibleContext # NIL THEN <> parent ¬ MimP5.visibleContext[level]; loc ¬ z.NEW[LocationRep.localVar ¬ [localVar[id: 0, parent: parent]]]; }; l ¬ MimP5U.MakeVar[bits: bits, id: id, loc: loc]; l.flags[named] ¬ seb[sei].hash # Symbols.nullName; IF seb[sei].idDecl = 2 THEN l.flags[constant] ¬ TRUE; [] ¬ IntCodeUtils.Store[idTab, id, l]; <> }; }; BinaryOp: PROC [node: Tree.Index, op: ArithSelector] RETURNS [Node] = { <> exp: Node ¬ NIL; ac: ArithClass ¬ MimP5U.ArithClassForTree[node]; son1: Tree.Link = tb[node].son[1]; op1: Node ¬ Exp[son1]; son2: Tree.Link = tb[node].son[2]; op2: Node ¬ Exp[son2]; bits: NAT ¬ MAX[NAT[ac.precision], NAT[op1.bits], NAT[op2.bits]]; <> IF bits MOD bitsPerWord # 0 THEN bits ¬ bits + (bitsPerWord-(bits MOD bitsPerWord)); ac.precision ¬ bits; IF bits > op1.bits THEN <> op1 ¬ MimP5U.Extend[op1, bits, MimP5U.OperandType[son1]]; IF bits > op2.bits THEN <> op2 ¬ MimP5U.Extend[op2, bits, MimP5U.OperandType[son2]]; exp ¬ MimP5U.BinaryArithOp[op, ac, op1, op2]; SELECT op FROM add, sub => IF bits <= BITS[CARD] THEN { const: CARD ¬ 0; [op1, const] ¬ MimP5S.SplitArith[exp]; <> SELECT TRUE FROM op1 = NIL => exp ¬ MimP5U.MakeConstCard[const]; const = 0 => exp ¬ op1; ENDCASE => { <> int: INT ¬ LOOPHOLE[const]; op ¬ add; IF int < 0 THEN {int ¬ -int; op ¬ sub}; op2 ¬ MimP5U.MakeConstInt[int]; exp ¬ MimP5U.BinaryArithOp[op, ac, op1, op2]; }; }; ENDCASE; RETURN [exp]; }; DotOrUparrow: PROC [mainnode: Tree.Index] RETURNS [l: Node] = { <> t1: Tree.Link = tb[mainnode].son[1]; tt: Type = TreeType[mainnode]; ac: ArithClass ¬ MimP5U.ArithClassForType[tt]; bitsForType: CARD = MimP5U.BitsForType[tt]; align: Symbols.Alignment ¬ MAX[ MimP5U.AlignmentFromTree[t1, TRUE], minReferentAlignment]; ptr: Node ¬ Exp[t1]; bits: CARD ¬ bitsForType; end: CARD ¬ bitsForType; derefVar: Var ¬ MimP5U.Deref[n: ptr, bits: 0, align: align]; derefLoc: DerefLocation ¬ NARROW[derefVar.location]; IF tb[mainnode].name = uparrow THEN { bits ¬ end ¬ MimP5U.BitsForType[TreeType[mainnode]]; IF wordPadDeref AND bits > 0 AND bits < bitsPerWord THEN IF ORD[align] >= ORD[MimData.wordAlignment] THEN bits ¬ bitsPerWord; l ¬ derefVar; } ELSE { sei: ISEIndex = TreeOps.GetSe[tb[mainnode].son[2]]; psei: CSEIndex = Normalize[MimP5U.OperandType[t1]]; WITH se: seb[psei] SELECT FROM ref => { rsei: CSEIndex = Normalize[se.refType]; rbits: INT = MimP5U.BitsForType[rsei]; offset: BitAddress ¬ 0; field: VLoc ¬ [disp: 0, size: Target.bitsPerWord]; [offset: offset, size: bits] ¬ MimP5U.RecField[sei]; offset ¬ offset + LeftPadding[rsei, bitsPerWord, rbits]; end ¬ offset+bits; field ¬ [disp: offset, size: bits]; l ¬ MimP5U.TakeField[derefVar, offset, bits]; }; ENDCASE => ERROR; }; l.bits ¬ bits; IF tb[mainnode].attr1 THEN { <> nilCheck: BOOL ¬ end > firstMappedBit; IF nilCheck THEN derefLoc.addr ¬ MimP5U.ApplyOp[ oper: MimP5U.MesaOpNode[nilck], args: MimP5U.MakeNodeList[ptr], bits: bitsPerPtr]; }; IF ac.kind = lastExtension AND bits > bitsForType AND bitsForType # 0 THEN { <> start: INT = IF bitsForType <= bitsPerWord THEN bits-bitsForType ELSE 0; l ¬ MimP5U.TakeField[l, start, bitsForType]; }; }; LeftPadding: PROC [type: Type, vBits: BitCount, bits: BitCount] RETURNS [BitAddress] = { IF bits < vBits AND vBits IN [1..bitsPerWord] AND bits # 0 THEN { uType: CSEIndex = Normalize[type]; seqId: ISEIndex = SymbolOps.VariantField[SymbolOps.own, uType]; IF seqId # ISENull THEN { seqSei: CSEIndex = Normalize[seb[seqId].idType]; WITH sse: seb[seqSei] SELECT FROM sequence => RETURN [0]; <> ENDCASE; }; RETURN [vBits-bits]; }; RETURN [0]; }; SmartDeref: PROC [exp: Node, type: Type, align: Symbols.Alignment] RETURNS [Node] = { bits: INT = MimP5U.BitsForType[type]; dBits: INT = MAX[minReferentBits, bits]; deref: Node ¬ MimP5U.Deref[exp, dBits, align]; IF bits IN [1..bitsPerWord) THEN { off: INT ¬ LeftPadding[type, bitsPerWord, bits]; deref ¬ MimP5U.TakeField[deref, off, bits]; }; RETURN [deref]; }; SmartField: PROC [exp: Node, type: Type, off: BitAddress] RETURNS [Node] = { bits: INT ¬ MimP5U.BitsForType[type]; off ¬ off + LeftPadding[type, MAX[bitsPerWord, exp.bits], bits]; RETURN [MimP5U.TakeField[exp, off, bits]]; }; Dollar: PROC [node: Tree.Index] RETURNS [Node] = { <> ac: ArithClass ¬ MimP5U.ArithClassForTree[node]; bitsForType: INT = MimP5U.BitsForType[TreeType[node]]; son1: Tree.Link = tb[node].son[1]; rsei: CSEIndex = MimP5U.OperandType[son1]; WITH seb[rsei] SELECT FROM record => { rcsei: RecordSEIndex = LOOPHOLE[rsei]; bitsForRec: INT ¬ MimP5U.BitsForType[rcsei]; sei: ISEIndex = TreeOps.GetSe[tb[node].son[2]]; rec: Node ¬ Exp[son1]; functionCall: BOOL = seb[rcsei].argument; offset: BitAddress; size: INT; vl: VLoc; varBits: INT ¬ rec.bits; IF bitsForRec # 0 AND bitsForRec < bitsPerWord AND bitsForRec < varBits THEN { <> <<(bitsForRec = 0 happens for COMPUTED sequences)>> rec ¬ MimP5U.TakeField[rec, varBits-bitsForRec, bitsForRec]; varBits ¬ rec.bits; }; IF functionCall THEN [offset, size] ¬ MimP5U.FnField[sei] ELSE [offset, size] ¬ MimP5U.RecField[sei]; vl ¬ [disp: offset, size: size]; IF varBits < bitsPerWord THEN { <> vl ¬ MimP5U.AdjustLoc[vl: vl, rSei: rcsei, fSei: sei, tBits: varBits]; }; IF ac.kind = lastExtension AND vl.size > bitsForType THEN { <> IF vl.size <= bitsPerWord THEN { delta: INT ¬ vl.size - bitsForType; vl.disp ¬ vl.disp + delta; }; vl.size ¬ bitsForType; }; IF vl.size < rec.bits THEN rec ¬ MimP5U.TakeField[rec, vl.disp, vl.size]; RETURN [rec]; }; ENDCASE => SIGNAL Bogus; <> RETURN [NIL]; }; Bogus: SIGNAL = CODE; MachineCodeBytes: PROC [link: Tree.Link] RETURNS [Node ¬ NIL] = { collectBytes: Tree.Scan = { DO IF t # Tree.Null THEN WITH e: t SELECT TreeOps.GetTag[t] FROM string => { str: LONG STRING ¬ LiteralOps.StringValue[e.index]; FOR i: NAT IN [0..str.length) DO TargetConversions.PutCard[writer, str[i].ORD, bitsPerByte]; ENDLOOP; }; literal => { byte: CARD ¬ LiteralOps.ValueBits[e.index]; TargetConversions.PutCard[writer, byte, bitsPerByte]; }; subtree => SELECT tb[e.index].name FROM list => TreeOps.ScanList[t, collectBytes]; pad, cast, lengthen, shorten => {t ¬ tb[e.index].son[1]; LOOP}; ENDCASE => ERROR; ENDCASE => ERROR; EXIT; ENDLOOP; }; writer: TargetConversions.Writer ¬ TargetConversions.NewWriter[]; collectBytes[link]; IF TargetConversions.BitsWritten[writer] = 0 THEN MimosaLog.ErrorTree[looksUgly, link]; RETURN [z.NEW[NodeRep.machineCode ¬ [details: machineCode[TargetConversions.WriterContents[writer]]]]]; }; MakeConst: PROC [lti: LTIndex] RETURNS [Node] = { WITH ll: ltb[lti] SELECT FROM short => SELECT LiteralOps.Value[lti].class FROM unsigned => RETURN [MimP5U.MakeConstCard[LiteralOps.ValueCard[lti]]]; signed, either => RETURN [MimP5U.MakeConstInt[LiteralOps.ValueInt[lti]]]; real => { <> int: INT = LOOPHOLE[LiteralOps.ValueReal[lti]]; RETURN [MimP5U.MakeConstInt[int]]; }; ENDCASE => RETURN [MimP5U.MakeConstCard[LiteralOps.ValueBits[lti]]]; long => { bits: INT ¬ ll.bits; writer: TargetConversions.Writer ¬ TargetConversions.NewWriter[]; align: NAT ¬ Target.Alignments[Target.AlignmentIndex.LAST]; FOR i: Target.AlignmentIndex IN Target.AlignmentIndex DO IF Target.Alignments[i] >= bits THEN {align ¬ Target.Alignments[i]; EXIT}; ENDLOOP; FOR i: CARDINAL IN [0..ll.max) DO TargetConversions.PutCard[writer, SymbolOps.DecodeCard[ll.value[i]], 32]; ENDLOOP; RETURN [z.NEW[NodeRep.const.bytes ¬ [ bits, const[bytes[align, TargetConversions.WriterContents[writer]]]]]]; }; ENDCASE => ERROR; }; <> <<>> <> <<>> CaseStmtExp: PUBLIC PROC [root: Tree.Index, isExp: BOOL] RETURNS [Node] = { <> saveCaseType: Symbols.Type = MimCode.caseType; saveCaseCV: Node = MimCode.caseCV; saveExtracting: BOOL = MimCode.xtracting; cvr: Node; maxBits: INT ¬ 0; minBits: INT ¬ INT.LAST; cl: CodeList ¬ MimP5U.NewCodeList[]; armHead, armTail: CaseList ¬ NIL; t3: Tree.Link ¬ tb[root].son[3]; caseVal: Tree.Link ¬ tb[root].son[1]; caseVarType: Type = MimP5U.OperandType[caseVal]; PruneTests: PROC [tests: NodeList] RETURNS [NodeList] = { <> head: NodeList ¬ NIL; tail: NodeList ¬ NIL; WHILE tests # NIL DO next: NodeList ¬ tests.rest; SELECT MimP5U.BoolTest[tests.first] FROM false => {tests ¬ next; LOOP}; true => {next ¬ NIL; keepScanning ¬ FALSE}; ENDCASE; tail ¬ IF tail = NIL THEN head ¬ tests ELSE tail.rest ¬ tests; tail.rest ¬ NIL; tests ¬ next; ENDLOOP; RETURN [head]; }; CaseArm: Tree.Scan = { IF keepScanning THEN { node: Tree.Index ¬ TreeOps.GetNode[t]; SELECT tb[node].name FROM item => { <> tests: NodeList ¬ PruneTests[ExpList[tb[node].son[1], FALSE].head]; IF tests # NIL THEN { t2: Tree.Link ¬ tb[node].son[2]; body: Node ¬ IF isExp THEN MimP5.Exp[t2] ELSE MimP5.StatementTree[t2]; IF MimP5U.BoolTest[tests.first] = true THEN tests ¬ NIL; IF tests = NIL AND armTail = NIL THEN onlyBody ¬ body ELSE { arm: CaseList ¬ z.NEW[CaseListRep ¬ [tests: tests, body: body, rest: NIL]]; IF isExp AND body # NIL THEN { nbits: INT ¬ body.bits; SELECT TRUE FROM armTail = NIL => maxBits ¬ minBits ¬ nbits; nbits > maxBits => maxBits ¬ nbits; nbits < minBits => minBits ¬ nbits; ENDCASE; }; IF armTail = NIL THEN armHead ¬ arm ELSE armTail.rest ¬ arm; armTail ¬ arm; }; }; }; caseswitch => ERROR; <> ENDCASE => ERROR; }; }; keepScanning: BOOL ¬ TRUE; onlyBody: Node ¬ NIL; MimCode.caseType ¬ caseVarType; MimCode.xtracting ¬ FALSE; cvr ¬ MimP5.Exp[caseVal]; { WITH cvr SELECT FROM const: ConstNode => MimCode.caseCV ¬ cvr; var: Var => IF var.flags[constant] THEN MimCode.caseCV ¬ var ELSE GO TO needTemp; ENDCASE => GO TO needTemp; EXITS needTemp => { cvTemp: Var ¬ MimP5S.Temporize[cl, cvr, caseVarType]; MimCode.caseCV ¬ cvTemp; }; }; TreeOps.ScanList[tb[root].son[2], CaseArm]; IF keepScanning AND t3 # Tree.Null THEN { ec: Node ¬ IF isExp THEN MimP5.Exp[t3] ELSE MimP5.StatementTree[t3]; SELECT TRUE FROM armTail = NIL => { <> onlyBody ¬ ec; GO TO onlyEndcase; }; isExp AND ec # NIL => { nbits: INT ¬ ec.bits; SELECT nbits FROM > maxBits => maxBits ¬ nbits; < minBits => minBits ¬ nbits; ENDCASE; }; ENDCASE; armTail ¬ armTail.rest ¬ z.NEW[CaseListRep ¬ [tests: NIL, body: ec, rest: NIL]]; EXITS onlyEndcase => {}; }; MimCode.caseCV ¬ saveCaseCV; MimCode.caseType ¬ saveCaseType; MimCode.xtracting ¬ saveExtracting; IF armHead = NIL THEN { <> RETURN [MimP5U.MaybeBlock[cl, onlyBody]]; }; RETURN [MimP5U.MaybeBlock[cl, MakeBalancedCond[armHead, maxBits, minBits]]]; }; BindStmtExp: PUBLIC PROC [root: Tree.Index, isExp: BOOL] RETURNS [Node] = { <> cl: CodeList = MimP5U.NewCodeList[]; son1: Tree.Link = tb[root].son[1]; sourceType: Type ¬ MimP5U.OperandType[son1]; unboundVar: Var = MimP5S.Temporize[cl: cl, n: MimP5.Exp[son1]]; tagExp: Node ¬ NIL; deref: Node ¬ unboundVar; endLabel: Label ¬ NIL; caseListTree: Tree.Link = tb[root].son[2]; endCaseTree: Tree.Link = tb[root].son[3]; indirect: BOOL = tb[root].attr1; typeDiscrim: BOOL = tb[root].attr2; align: Symbols.Alignment = IF typeDiscrim THEN MimData.worstAlignment ELSE MimP5U.AlignmentFromType[sourceType, indirect]; nCases: INT = TreeOps.ListLength[caseListTree]; maxBits: INT ¬ 0; minBits: INT ¬ 0; caseListHead: IntCodeDefs.CaseList ¬ NIL; caseListTail: IntCodeDefs.CaseList ¬ NIL; casesActive: BOOL ¬ TRUE; AddCase: PROC [test: Node, body: Tree.Link, var: Var] = { node: Node ¬ IF isExp THEN MimP5.Exp[body] ELSE MimP5.StatementTree[body]; list: NodeList = IF test = NIL THEN NIL ELSE MimP5U.MakeNodeList[test]; newCase: IntCodeDefs.CaseList ¬ NIL; nbits: INT ¬ 0; IF var # NIL THEN { <> cl: CodeList = MimP5U.NewCodeList[]; temp: Node ¬ unboundVar; IF temp # NIL AND temp.bits # var.bits THEN { IF temp.bits < var.bits THEN ERROR; <> IF temp.bits < bitsPerWord THEN ERROR; <> IF var.bits < bitsPerWord THEN ERROR; <> temp ¬ MimP5U.TakeField[temp, 0, var.bits]; }; MimP5U.Declare[cl, var, temp]; node ¬ MimP5U.MaybeBlock[cl, node]; }; newCase ¬ MimP5U.MakeCaseList[list, node]; IF isExp AND node # NIL THEN { nbits ¬ node.bits; SELECT TRUE FROM caseListTail = NIL => maxBits ¬ minBits ¬ nbits; nbits > maxBits => maxBits ¬ nbits; nbits < minBits => minBits ¬ nbits; ENDCASE; }; IF test = NIL AND endLabel # NIL THEN { <> n: Node ¬ z.NEW [NodeRep.label ¬ [bits: nbits, details: label[endLabel]]]; endLabel.node ¬ node; newCase.body ¬ n; }; IF caseListTail # NIL THEN caseListTail.rest ¬ newCase ELSE caseListHead ¬ newCase; caseListTail ¬ newCase; IF list = NIL THEN casesActive ¬ FALSE; }; EachCase: PROC [t: Tree.Link] = { IF NOT casesActive THEN RETURN; WITH x: t SELECT TreeOps.GetTag[t] FROM subtree => SELECT tb[x.index].name FROM ditem => { bodyTree: Tree.Link ¬ tb[x.index].son[2]; declTree: Tree.Link ¬ tb[x.index].son[1]; WITH y: declTree SELECT TreeOps.GetTag[declTree] FROM subtree => SELECT tb[y.index].name FROM decl => { id: Tree.Link ¬ tb[y.index].son[1]; targetType: Type ¬ MimP5U.TypeForTree[tb[y.index].son[2]]; IF indirect THEN targetType ¬ MimP5U.ReferentType[targetType]; AddCase[ test: TypePredicate[sourceType, targetType, deref, tagExp], body: bodyTree, var: NARROW[MimP5.Exp[id]]]; }; ENDCASE => GO TO oops; ENDCASE => GO TO oops; }; ENDCASE => GO TO oops; ENDCASE => GO TO oops; EXITS oops => ERROR; }; IF indirect THEN { <> MimP5U.MoreCode[cl, NilTest[unboundVar, endLabel ¬ MimP5U.AllocLabel[]]]; sourceType ¬ MimP5U.ReferentType[sourceType]; deref ¬ SmartDeref[unboundVar, sourceType, align]; IF typeDiscrim THEN { <> tagExp ¬ MimP5U.ApplyOp[ oper: MimP5U.CedarOpNode[referentType], args: MimP5U.MakeNodeList[unboundVar], bits: bitsPerWord]; IF nCases > 1 THEN <> tagExp ¬ MimP5S.Temporize[cl: cl, n: tagExp]; }; } ELSE { <> deref ¬ SmartField[deref, sourceType, 0]; }; TreeOps.ScanList[caseListTree, EachCase]; IF casesActive THEN AddCase[NIL, endCaseTree, NIL]; RETURN [MimP5U.MaybeBlock[cl, MakeBalancedCond[caseListHead, maxBits, minBits]]]; }; NilTest: PROC [exp: Node, label: Label] RETURNS [Node] = { nilTest: Node ¬ MimP5U.EqualTest[exp, MimP5U.MakeConstCard[0, exp.bits]]; RETURN [MimP5U.NodeIf[nilTest, MimP5U.MakeGoTo[label], NIL]]; }; MakeBalancedCond: PROC [armHead: IntCodeDefs.CaseList, maxBits, minBits: INT] RETURNS [Node] = { cl: CodeList ¬ NIL; result: Node ¬ NIL; IF maxBits > minBits THEN <> FOR each: IntCodeDefs.CaseList ¬ armHead, each.rest WHILE each # NIL DO body: Node ¬ each.body; IF body # NIL AND body.bits # maxBits THEN <> each.body ¬ MimP5U.ZeroExtend[body, maxBits]; FOR eachTest: NodeList ¬ each.tests, eachTest.rest WHILE eachTest # NIL DO test: Node = eachTest.first; IF test # NIL AND test.bits # 1 THEN eachTest.first ¬ MimP5U.ForceBool[test]; ENDLOOP; ENDLOOP; FOR each: IntCodeDefs.CaseList ¬ armHead, each.rest WHILE each # NIL DO tests: NodeList ¬ each.tests; WHILE tests # NIL DO testCmp: Node ¬ tests.first; test: Node ¬ NIL; IF NOT IntCodeUtils.SideEffectFree[testCmp, FALSE] THEN EXIT; test ¬ GetCompareTarget[testCmp]; IF CacheWorthy[test] THEN { <> armList: IntCodeDefs.CaseList ¬ each; testList: NodeList ¬ tests; testBits: INT = test.bits; var: Var ¬ NIL; DO otherCmp: Node ¬ NIL; other: Node ¬ NIL; testList ¬ testList.rest; IF testList = NIL THEN { armList ¬ armList.rest; IF armList = NIL THEN EXIT; testList ¬ armList.tests; IF testList = NIL THEN EXIT; }; otherCmp ¬ testList.first; IF NOT IntCodeUtils.SideEffectFree[otherCmp, FALSE] THEN EXIT; other ¬ GetCompareTarget[otherCmp]; IF other # NIL AND IntCodeUtils.SimplyEqual[test, other] THEN { <> IF cl = NIL THEN cl ¬ MimP5U.NewCodeList[]; IF var = NIL THEN { <> tempSei: ISEIndex = MimP5U.MakeTemp[cl, testBits].sei; temp: Tree.Link = [symbol[tempSei]]; var ¬ NARROW[MimP5.Exp[temp]]; var.flags[constant] ¬ TRUE; other ¬ MimP5U.Assign[var, test]; IF tests = armHead.tests THEN { <> MimP5U.MoreCode[cl, other]; other ¬ var; } ELSE { <> other.bits ¬ testBits; }; SetCompareTarget[testCmp, other]; }; SetCompareTarget[otherCmp, var]; }; ENDLOOP; EXIT; }; tests ¬ tests.rest; ENDLOOP; ENDLOOP; result ¬ z.NEW[NodeRep.cond ¬ [bits: maxBits, details: cond[armHead]]]; IF cl # NIL THEN result ¬ MimP5U.MaybeBlock[cl, result]; RETURN [result]; }; GetCompareTarget: PROC [n: Node, left: BOOL ¬ TRUE] RETURNS [Node] = { WITH n SELECT FROM app: REF NodeRep.apply => WITH app.proc SELECT FROM opNode: REF NodeRep.oper => WITH opNode.oper SELECT FROM cmp: REF IntCodeDefs.OperRep => IF left THEN RETURN [app.args.first] ELSE RETURN [app.args.rest.first]; ENDCASE; ENDCASE; ENDCASE; RETURN [NIL]; }; SetCompareTarget: PROC [n: Node, new: Node, left: BOOL ¬ TRUE] = { WITH n SELECT FROM app: REF NodeRep.apply => WITH app.proc SELECT FROM opNode: REF NodeRep.oper => WITH opNode.oper SELECT FROM cmp: REF IntCodeDefs.OperRep => { IF left THEN app.args.first ¬ new ELSE app.args.rest.first ¬ new; RETURN; }; ENDCASE; ENDCASE; ENDCASE; }; CacheWorthy: PROC [n: Node] RETURNS [BOOL] = { IF n # NIL AND n.bits = bitsPerWord THEN WITH n SELECT FROM c: REF NodeRep.const => IF c.kind = refLiteral THEN RETURN [TRUE]; v: Var => WITH v.location SELECT FROM local: REF LocationRep.localVar => {}; ENDCASE => RETURN [TRUE]; ENDCASE => RETURN [TRUE]; RETURN [FALSE]; }; <<>> NarrowExp: PUBLIC PROC [tree: Tree.Index] RETURNS [result: Node ¬ NIL] = { son1: Tree.Link = tb[tree].son[1]; exp: Node ¬ MimP5.Exp[son1]; indirect: BOOL = tb[tree].attr1; opType: Type = MimP5U.OperandType[son1]; counted: BOOL = indirect AND (SymbolOps.RCType[SymbolOps.own, opType] = simple); sourceType: Type ¬ IF indirect THEN MimP5U.ReferentType[opType] ELSE opType; uSource: CSEIndex ¬ Clarify[sourceType]; endLabel: Label ¬ NIL; deref: Node ¬ exp; son2: Tree.Link = tb[tree].son[2]; treeType: Type = IF son2 # Tree.Null THEN MimP5U.TypeForTree[son2] ELSE LOOPHOLE[tb[tree].info, Type]; targetType: Type = IF indirect THEN MimP5U.ReferentType[treeType] ELSE treeType; uTarget: CSEIndex = Clarify[targetType]; cl: CodeList = MimP5U.NewCodeList[]; SELECT TRUE FROM counted AND SymbolOps.TypeForm[SymbolOps.own, uSource] = any => { <> root: Type = SymbolOps.TypeRoot[SymbolOps.own, targetType]; typeNode: Node = MimP5U.NodeForType[root]; uSource ¬ Clarify[sourceType ¬ root]; <> result ¬ MimP5U.ApplyOp[ oper: MimP5U.CedarOpNode[narrow], args: MimP5U.MakeNodeList2[exp, typeNode], bits: bitsPerRef]; IF uSource = uTarget THEN RETURN [MimP5U.MaybeBlock[cl, result]]; <> exp ¬ MimP5S.Temporize[cl: cl, n: result]; <> MimP5U.MoreCode[cl, NilTest[exp, endLabel ¬ MimP5U.AllocLabel[]]]; deref ¬ SmartDeref[exp, uSource, MimData.worstAlignment]; }; indirect => { <> align: Symbols.Alignment = SELECT TRUE FROM counted => MimData.worstAlignment, wordPadDeref => minReferentAlignment, ENDCASE => MimP5U.AlignmentFromType[sourceType, FALSE]; IF NOT IsLocalVar[exp] THEN exp ¬ MimP5S.Temporize[cl: cl, n: exp]; MimP5U.MoreCode[cl, NilTest[exp, endLabel ¬ MimP5U.AllocLabel[]]]; deref ¬ SmartDeref[exp, uSource, align]; }; ENDCASE => { IF NOT IsLocalVar[exp] THEN exp ¬ MimP5S.Temporize[cl: cl, n: exp]; deref ¬ SmartField[exp, uSource, 0]; }; SELECT TRUE FROM SymbolOps.TypeForm[SymbolOps.own, uTarget] = record AND SymbolOps.TypeForm[SymbolOps.own, uSource] = record => { typeTest: Node ¬ TagPredicate[deref, sourceType, targetType]; oops: Node ¬ MimP5U.ApplyOp[ oper: MimP5U.MesaOpNode[error], args: MimP5U.MakeArgList[ MimP5U.MesaOpNode[op: narrowFault, bits: Target.bitsPerSignal]], bits: exp.bits]; IF endLabel = NIL THEN { result ¬ MimP5U.MaybeBlock[cl, MimP5U.NodeIf[typeTest, exp, oops]]; } ELSE { MimP5U.MoreCode[cl, MimP5U.NodeIf[typeTest, MimP5U.MakeGoTo[endLabel], NIL]]; oops.bits ¬ 0; MimP5U.MoreCode[cl, oops]; MimP5U.InsertLabel[cl, endLabel]; result ¬ MimP5U.MaybeBlock[cl, exp]; }; }; ENDCASE => ERROR; <> }; <<>> TypeRel: PUBLIC PROC [tree: Tree.Index] RETURNS [test: Node ¬ NIL] = { <> sourceType: Type ¬ MimP5U.OperandType[tb[tree].son[1]]; exp: Node ¬ MimP5.Exp[tb[tree].son[1]]; deref: Node ¬ exp; derefBits: INT ¬ deref.bits; derefOff: INT ¬ 0; indirect: BOOL = tb[tree].attr1; refAny: BOOL = tb[tree].attr2; -- RRA: what is this really? uSource: CSEIndex ¬ Clarify[sourceType]; targetType: Type ¬ IF tb[tree].son[2] # Tree.Null THEN MimP5U.TypeForTree[tb[tree].son[2]] ELSE LOOPHOLE[tb[tree].info, Type]; uTarget: CSEIndex ¬ Clarify[targetType]; counted: BOOL = indirect AND (SymbolOps.RCType[SymbolOps.own, uSource] = simple); <> align: Symbols.Alignment ¬ IF counted THEN MimData.worstAlignment ELSE MimP5U.AlignmentFromType[sourceType]; typeExp: Node ¬ NIL; cl: CodeList ¬ NIL; IF NOT IsLocalVar[exp] THEN { <> cl ¬ MimP5U.NewCodeList[]; exp ¬ MimP5S.Temporize[cl: cl, n: exp]; }; IF indirect THEN { <> sourceType ¬ MimP5U.ReferentType[sourceType]; uSource ¬ Clarify[sourceType]; targetType ¬ MimP5U.ReferentType[targetType]; uTarget ¬ Clarify[targetType]; derefBits ¬ MimP5U.BitsForType[uTarget]; deref ¬ SmartDeref[exp, uSource, align]; } ELSE { deref ¬ SmartField[exp, sourceType, 0]; }; IF counted AND SymbolOps.TypeForm[SymbolOps.own, uSource] = any THEN { <> typeExp ¬ MimP5U.ApplyOp[ oper: MimP5U.CedarOpNode[referentType], args: MimP5U.MakeNodeList[exp], bits: bitsPerWord]; }; test ¬ TypePredicate[sourceType, targetType, deref, typeExp]; IF test = NIL THEN RETURN [MimCode.trueNode]; IF indirect OR refAny THEN <> test ¬ MimP5U.NodeOr[IsNil[exp], test]; IF cl # NIL THEN test ¬ MimP5U.MaybeBlock[cl, test]; }; <<>> GetCanonicalType: PUBLIC PROC [tree: Tree.Index] RETURNS [l: Node] = { oper: Node; IF tb[tree].attr2 THEN oper ¬ MimP5U.CedarOpNode[referentType] ELSE { type: CSEIndex ¬ MimP5U.OperandType[tb[tree].son[1]]; SELECT SymbolOps.XferMode[SymbolOps.own, type] FROM proc => oper ¬ NIL; -- MimP5U.CedarOpNode[procType]; signal, error => oper ¬ NIL; -- MimP5U.CedarOpNode[signalType]; ENDCASE}; l ¬ MimP5U.ApplyOp[oper: oper, args: MimP5U.MakeArgList[MimP5.Exp[tb[tree].son[1]]], bits: bitsPerWord]; }; <> TypePredicate: PROC [source: Type, dest: Type, var: Node, typeExp: Node ¬ NIL] RETURNS [node: Node ¬ NIL] = { <> referentTest: Node ¬ NIL; IF typeExp # NIL THEN { <> root: Type = SymbolOps.TypeRoot[SymbolOps.own, dest]; IF SymbolOps.TypeForm[SymbolOps.own, root] = any THEN <> RETURN [NIL] ELSE { typeNode: Node ¬ MimP5U.NodeForType[root]; referentTest ¬ MimP5U.EqualTest[typeNode, typeExp]; IF SymbolOps.EqTypes[SymbolOps.own, root, dest] THEN RETURN [referentTest]; source ¬ root; <> }; }; node ¬ TagPredicate[var, source, dest]; IF referentTest # NIL THEN node ¬ MimP5U.NodeAnd[referentTest, node]; }; TagPredicate: PROC [var: Node, type, target: Type] RETURNS [Node] = { <> uTarget: CSEIndex = Clarify[target]; link: Type = SymbolOps.TypeLink[SymbolOps.own, target]; <> uLink: CSEIndex = Clarify[link]; <> uType: CSEIndex ¬ Clarify[type]; <> uTypeBits: BitCount ¬ MimP5U.BitsForType[uType]; overTestNode: Node ¬ NIL; testNode: Node ¬ NIL; uu: CSEIndex; IF EquivTypes[uType, uTarget] THEN { <> RETURN [MimCode.trueNode]; }; IF NOT SymbolOps.EqTypes[SymbolOps.own, uLink, uType] THEN { <> IF NOT SymbolOps.EqTypes[SymbolOps.own, SymbolOps.TypeRoot[SymbolOps.own, uLink], SymbolOps.TypeRoot[SymbolOps.own, uType]] THEN ERROR; <> overTestNode ¬ TagPredicate[var, type, link]; type ¬ link; uType ¬ uLink; }; <> uu ¬ Clarify[seb[SymbolOps.VariantField[SymbolOps.own, uType]].idType]; WITH u: seb[uu] SELECT FROM union => { offset: BitAddress; bits: INT; tagSei: ISEIndex = u.tagSei; tagVal: CARD = MimP5U.VariantTag[target, u.caseCtx]; [offset, bits] ¬ MimP5U.RecField[tagSei]; testNode ¬ MimP5U.EqualTest[ MimP5U.TakeField[var, offset, bits], MimP5U.MakeConstCard[tagVal]]; IF overTestNode # NIL THEN testNode ¬ MimP5U.NodeAnd[overTestNode, testNode]; RETURN [testNode]; }; ENDCASE => ERROR; }; EquivTypes: PROC [type1, type2: CSEIndex] RETURNS [BOOL] = { RETURN [Types.Equivalent[[SymbolOps.own, type1], [SymbolOps.own, type2]]]; }; IsNil: PROC [exp: Node] RETURNS [Node] = { RETURN [MimP5U.ApplyOp[ oper: MimP5U.CompareOp[eq, [address, FALSE, exp.bits]], args: MimP5U.MakeArgList2[exp, MimP5U.MakeConstCard[0, exp.bits]], bits: 1]]; }; IsLocalVar: PROC [node: Node] RETURNS [BOOL] = { WITH node SELECT FROM v: Var => WITH v.location SELECT FROM loc: LocalVarLocation => RETURN [TRUE]; ENDCASE; ENDCASE; RETURN [FALSE]; }; Clarify: PUBLIC PROC [type: Type] RETURNS [CSEIndex] = { <> DO sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type]; WITH t: seb[sei] SELECT FROM opaque => { nSei: CSEIndex ¬ Types.OpaqueValue[ [SymbolOps.own, sei], SymbolOps.own].sei; IF nSei # sei THEN {type ¬ nSei; LOOP}; }; ENDCASE; RETURN [sei]; ENDLOOP; }; Normalize: PUBLIC PROC [type: Type] RETURNS [CSEIndex] = { <> DO sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type]; WITH t: seb[sei] SELECT FROM opaque => { nSei: CSEIndex ¬ Types.OpaqueValue[ [SymbolOps.own, sei], SymbolOps.own].sei; IF nSei # sei THEN {type ¬ nSei; LOOP}; }; subrange => { type ¬ t.rangeType; LOOP; }; ENDCASE; RETURN [sei]; ENDLOOP; }; <<>> <> <<>> tb: Tree.Base ¬ NIL; -- tree base (local copy) seb: Symbols.Base ¬ NIL; -- semantic entry base (local copy) bb: Symbols.Base ¬ NIL; -- body entry base (local copy) ltb: Literals.Base ¬ NIL; -- literal base (local copy) stb: Literals.Base ¬ NIL; -- string base (local copy) ExpressionNotify: Alloc.Notifier = { <> seb ¬ base[Symbols.seType]; bb ¬ base[Symbols.bodyType]; tb ¬ base[Tree.treeType]; ltb ¬ base[Literals.ltType]; stb ¬ base[Literals.stType]; idTab ¬ IntCodeUtils.NewIdTab[]; }; idTab: IntCodeUtils.IdTab ¬ NIL; recentExp: PUBLIC Tree.Link; -- for debugging MimCode.RegisterNotifier[ExpressionNotify]; }.