<<>> <> <> <> <> <> <> DIRECTORY Alloc USING [Base, Notifier], Basics USING [BITRSHIFT], IntCodeDefs USING [ArithClass, ArithPrecision, BlockNode, IndexedLocation, Location, LocationRep, Node, NodeList, NodeRep, nullVariableId, Var, WordConstNode], IntCodeUtils USING [NodeListTail, WordToCard], MimCode USING [BitAddress, BitCount, CodeList, curctxlvl, firstMappedAddress, RegisterNotifier, StoreOptions, VLoc, xtracting, xtractNode, xtractsei, z], MimP5 USING [All, Clarify, Construct, Exp, Normalize, RowCons, VariantConstruct], MimP5S USING [Category], MimP5Stuff USING [Vulnerable], MimP5U USING [AdjustLoc, AlignmentFromType, ApplyOp, ArithClassForType, Assign, AssignRC, BinaryArithOp, BitsForOperand, BitsForType, BoundsCheck, ConvertOpNode, Deref, Extend, FnField, IsZero, MakeBlock, MakeConstCard, MakeNodeList, MakeTemp, MakeVar, MaybeBlock, MesaOpNode, MoreCode, NewCodeList, NextVar, OperandType, ProcessSafens, RecField, RecOrFnProc, Simplify, TakeField, TakeFieldVar, ZeroExtend], SymbolOps USING [BitsPerElement, Cardinality, CtxLevel, DecodeInt, FirstCtxSe, NextSe, own], Symbols USING [Alignment, Base, CBTIndex, ContextLevel, CSEIndex, CTXIndex, ctxType, ISEIndex, ISENull, lG, RecordSEIndex, SEIndex, seType, Type, typeANY], Target: TYPE MachineParms USING [bitsPerAU, bitsPerByte, bitsPerLongWord, bitsPerRef, bitsPerStringBound, bitsPerWord, logBitsPerWord], Tree USING [Base, Index, Link, NodeName, NodePtr, Null, treeType], TreeOps USING [GetNode, GetSe, GetTag, NthSon, OpName, ReverseUpdateList, ScanList, UpdateList]; MimStore: PROGRAM IMPORTS Basics, IntCodeUtils, MimCode, MimP5, MimP5Stuff, MimP5U, SymbolOps, TreeOps EXPORTS MimP5S = { OPEN IntCodeDefs, MimCode, Target; <> <<>> Category: TYPE = MimP5S.Category; CBTIndex: TYPE = Symbols.CBTIndex; CTXIndex: TYPE = Symbols.CTXIndex; ISEIndex: TYPE = Symbols.ISEIndex; ISENull: ISEIndex = Symbols.ISENull; RecordSEIndex: TYPE = Symbols.RecordSEIndex; Type: TYPE = Symbols.Type; firstMappedBit: CARD = MimCode.firstMappedAddress*Target.bitsPerAU; firstMappedWord: CARD = firstMappedBit / Target.bitsPerWord; <> <<>> Assign: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] = { <> l ¬ ComAssign[ t1: tb[node].son[1], t2: tb[node].son[2], options: [expr: FALSE, init: tb[node].attr1, counted: tb[node].attr2]]; }; AssignExp: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] = { <> l ¬ ComAssign[ t1: tb[node].son[1], t2: tb[node].son[2], options: [expr: TRUE, init: tb[node].attr1, counted: tb[node].attr2]]; RETURN }; EvalToTemp: PUBLIC PROC [cl: CodeList, t: Tree.Link] RETURNS [Tree.Link] = { <> IF NOT WillEvalToConst[t, TRUE] THEN { nb: INT = MimP5U.BitsForOperand[t]; type: Symbols.Type = MimP5U.OperandType[t]; tempSei: ISEIndex = MimP5U.MakeTemp[cl, nb, NIL, type].sei; temp: Tree.Link = [symbol[tempSei]]; tempVar: Var = NARROW[MimP5.Exp[temp]]; MimP5U.MoreCode[cl, ComAssign[temp, t, [init: TRUE]]]; seb[tempSei].immutable ¬ TRUE; tempVar.flags[constant] ¬ TRUE; t ¬ temp; }; RETURN [t]; }; Temporize: PUBLIC PROC [cl: CodeList, n: Node, type: Type ¬ Symbols.typeANY] RETURNS [Var] = { nb: INT = n.bits; tempSei: ISEIndex = MimP5U.MakeTemp[cl, nb].sei; temp: Tree.Link = [symbol[tempSei]]; tempVar: Var = NARROW[MimP5.Exp[temp]]; IF tempVar.bits # nb THEN n ¬ EnsureLength[n, type, type, tempVar.bits]; MimP5U.MoreCode[cl, MimP5U.Assign[tempVar, n]]; seb[tempSei].immutable ¬ TRUE; tempVar.flags[constant] ¬ TRUE; RETURN [tempVar]; }; ComAssign: PUBLIC PROC [t1, t2: Tree.Link, options: StoreOptions] RETURNS [ret: Node] = { <> fullBits: INT = MimP5U.BitsForOperand[t1]; nbits: INT ¬ fullBits; dstType: Symbols.SEIndex = MimP5U.OperandType[t1]; srcType: Symbols.SEIndex = MimP5U.OperandType[t2]; padded: BOOL ¬ FALSE; lx: Node ¬ NIL; tail: NodeList ¬ NIL; lv: Var ¬ NIL; rv: Node ¬ NIL; simpleTest: BOOL ¬ FALSE; tryHarder: BOOL ¬ FALSE; opName: Tree.NodeName; srcTree: Tree.Link ¬ Tree.Null; DO <> opName ¬ TreeOps.OpName[t2]; SELECT opName FROM pad => { IF MimP5U.BitsForOperand[t2] <= bitsPerWord THEN EXIT; t2 ¬ TreeOps.NthSon[t2, 1]; padded ¬ TRUE; nbits ¬ MimP5U.BitsForOperand[t2]; }; cast, safen => t2 ¬ TreeOps.NthSon[t2, 1]; ENDCASE => EXIT; ENDLOOP; srcTree ¬ t2; DO WITH e: srcTree SELECT TreeOps.GetTag[srcTree] FROM subtree => IF tb[e.index].name = assignx THEN {srcTree ¬ tb[e.index].son[2]; LOOP}; ENDCASE; EXIT; ENDLOOP; IF srcTree # t2 THEN { <> recurseAssign: PROC [dst: Tree.Link] = { WITH e: dst SELECT TreeOps.GetTag[dst] FROM subtree => { tp: Tree.NodePtr = @tb[e.index]; IF tp.name = assignx THEN { node: Tree.Index = e.index; nopt: StoreOptions ¬ options; son1: Tree.Link = tp.son[1]; nopt.expr ¬ FALSE; nopt.init ¬ tp.attr1; nopt.counted ¬ tp.attr2; recurseAssign[tp.son[2]]; -- don't use tp after this! MimP5U.MoreCode[cl, ComAssign[son1, srcTree, nopt]]; }; }; ENDCASE; }; cl: CodeList ¬ MimP5U.NewCodeList[]; srcTree ¬ EvalToTemp[cl, srcTree]; recurseAssign[t2]; ret ¬ MimP5U.MaybeBlock[cl, ComAssign[t1, srcTree, options]]; RETURN; }; SELECT TRUE FROM GlobalLocation[t1] AND options.init => { options.skipZeros ¬ simpleTest ¬ TRUE; <> }; SimpleLocation[t1] AND opName = callx => { <> srcTree ¬ Tree.Null; -- for breakpoints }; MimP5Stuff.Vulnerable[t1, t2, TRUE] => { <> cl: CodeList ¬ MimP5U.NewCodeList[]; inner: PROC [t: Tree.Link] RETURNS [Tree.Link] = { WITH e: t SELECT TreeOps.GetTag[t] FROM subtree => SELECT tb[e.index].name FROM list => RETURN [TreeOps.UpdateList[t, inner]]; construct, union, rowcons => { tb[e.index].son[2] ¬ inner[tb[e.index].son[2]]; RETURN [t]; }; pad, cast, all => { tb[e.index].son[1] ¬ inner[tb[e.index].son[1]]; RETURN [t]; }; safen => { tb[e.index].son[1] ¬ inner[tb[e.index].son[1]]; RETURN [t]; }; ENDCASE; ENDCASE; IF MimP5Stuff.Vulnerable[t1, t, TRUE] THEN <> t ¬ EvalToTemp[cl, t]; RETURN [t]; }; temp: Tree.Link ¬ inner[t2]; nopt: StoreOptions ¬ options; nopt.expr ¬ FALSE; MimP5U.MoreCode[cl, ComAssign[t1, temp, nopt]]; IF options.expr THEN ret ¬ MimP5U.MaybeBlock[cl, MimP5.Exp[temp]] ELSE ret ¬ MimP5U.MakeBlock[cl, 0]; RETURN; }; ENDCASE; { SELECT opName FROM construct => { IF nbits > bitsPerWord AND AddressableDest[t1] THEN { ret ¬ MimP5.Construct[t1, TreeOps.GetNode[t2], options]; GO TO outgoing; }; rv ¬ MimP5.Construct[Tree.Null, TreeOps.GetNode[t2], []]; }; union => { ret ¬ MimP5.VariantConstruct[t1, t2, options]; GO TO outgoing; }; rowcons => { IF nbits > bitsPerWord AND AddressableDest[t1] THEN { ret ¬ MimP5.RowCons[t1, TreeOps.GetNode[t2], options]; GO TO outgoing; }; rv ¬ MimP5.RowCons[Tree.Null, TreeOps.GetNode[t2], []]; }; all => { ret ¬ MimP5.All[t1, TreeOps.GetNode[t2], options]; GO TO outgoing; }; ENDCASE => rv ¬ MimP5.Exp[t2]; WITH e: t1 SELECT TreeOps.GetTag[t1] FROM symbol => seb[e.index].idDecl ¬ 0; <> ENDCASE; lx ¬ MimP5.Exp[t1]; { <> x: Node ¬ lx; DO WITH x SELECT FROM block: BlockNode => { tail ¬ IntCodeUtils.NodeListTail[block.nodes]; x ¬ tail.first; }; var: Var => {lv ¬ var; EXIT}; ENDCASE => ERROR; <> ENDLOOP; }; IF options.skipZeros AND MimP5U.IsZero[rv] THEN { <> IF simpleTest THEN { IF options.expr THEN ret ¬ rv ELSE ret ¬ NIL; <> RETURN [ret]; }; }; IF padded THEN { IF lv # NIL THEN { bits: INT = lv.bits; SELECT bits FROM <= nbits => {}; <= bitsPerWord => lv ¬ MimP5U.TakeFieldVar[lv, bits-nbits, nbits]; ENDCASE => lv ¬ MimP5U.TakeFieldVar[lv, 0, nbits]; }; IF rv # NIL THEN { bits: INT = rv.bits; SELECT bits FROM <= nbits => {}; <= bitsPerWord => rv ¬ MimP5U.TakeField[rv, bits-nbits, nbits]; ENDCASE => rv ¬ MimP5U.TakeField[rv, 0, nbits]; }; }; IF lv # NIL AND rv # NIL THEN { <> lbits: INT = lv.bits; rbits: INT = rv.bits; SELECT lbits FROM < rbits => { <> start: INT = IF rbits <= bitsPerWord THEN rbits-lbits ELSE 0; IF options.expr THEN { <> cl: CodeList = MimP5U.NewCodeList[]; temp: Var = Temporize[cl, rv, srcType]; rv ¬ EnsureLength[temp, dstType, srcType, lbits]; MimP5U.MoreCode[cl, IF options.counted THEN MimP5U.AssignRC[lv, rv, dstType, options.init] ELSE MimP5U.Assign[lv, rv]]; ret ¬ MimP5U.MaybeBlock[cl, temp]; IF tail # NIL THEN {tail.first ¬ ret; lx.bits ¬ ret.bits; ret ¬ lx}; <> RETURN [ret]; }; <> rv ¬ MimP5U.TakeField[rv, start, lbits]; nbits ¬ lbits; }; > rbits => { <> rv ¬ ExtendValue[rv, dstType, srcType, lbits]; nbits ¬ lbits; }; ENDCASE; }; SELECT TRUE FROM options.expr => { cl: CodeList ¬ MimP5U.NewCodeList[]; res: Node ¬ NIL; { <> rCat: Category = GetCategory[rv]; lCat: Category = GetCategory[lv]; IF rCat < local THEN GO TO useRHS; IF lCat # other THEN IF rCat < lCat THEN GO TO useRHS ELSE GO TO useLHS; res ¬ Temporize[cl, rv, srcType]; rv ¬ res; IF lv.bits # rv.bits THEN rv ¬ EnsureLength[rv, dstType, srcType, lv.bits]; EXITS useRHS => res ¬ rv; useLHS => res ¬ lv; }; IF options.counted THEN ret ¬ MimP5U.AssignRC[lv, rv, dstType, options.init] ELSE ret ¬ MimP5U.Assign[lv, rv]; MimP5U.MoreCode[cl, ret]; ret ¬ MimP5U.MaybeBlock[cl, res]; nbits ¬ ret.bits; }; options.counted => ret ¬ MimP5U.AssignRC[lv, rv, dstType, options.init]; ENDCASE => ret ¬ MimP5U.Assign[lv, rv]; IF tail # NIL THEN { <> tail.first ¬ ret; ret ¬ lx; IF NOT options.expr THEN ret.bits ¬ 0; }; EXITS outgoing => {}; }; }; ManySafens: PROC [t: Tree.Link, nbits: CARDINAL] RETURNS [BOOL] = { nFields, nSafens: NAT ¬ 0; noAll: BOOL ¬ TRUE; CountSafens: PROC [t: Tree.Link] = { SELECT TreeOps.OpName[t] FROM rowcons, construct, union => TreeOps.ScanList[TreeOps.NthSon[t, 2], CountSafens]; all => { noAll ¬ FALSE; CountSafens[TreeOps.NthSon[t, 1]] }; cast, pad => CountSafens[TreeOps.NthSon[t, 1]]; safen => { nSafens ¬ nSafens+1; nFields ¬ nFields+1 }; ENDCASE => nFields ¬ nFields+1; }; CountSafens[t]; RETURN [IF nbits<16*bitsPerWord THEN (nSafens >= 2) ELSE (noAll AND 2*nSafens > nFields)] }; Extract: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = { cl: CodeList ¬ MimP5U.NewCodeList[]; [] ¬ ExtractToCl[cl, node]; RETURN [MimP5U.MakeBlock[cl]]; }; ExtractToCl: PROC [cl: CodeList, node: Tree.Index] RETURNS [Node] = { t1: Tree.Link = tb[node].son[1]; tsei: RecordSEIndex = LOOPHOLE[MimP5U.OperandType[t1]]; t2: Tree.Link = tb[node].son[2]; vType: Type = MimP5U.OperandType[t2]; sn: Node ¬ MimP5.Exp[t2]; IF NOT SimpleLocation[t2] THEN sn ¬ MimP5U.MakeTemp[cl, sn.bits, sn, vType].var; ExtractFrom[cl, t1, tsei, sn]; RETURN [sn]; }; ExtractExp: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = { cl: CodeList ¬ MimP5U.NewCodeList[]; sn: Node = ExtractToCl[cl, node]; RETURN [MimP5U.MaybeBlock[cl, sn]]; }; ExtractFrom: PROC [cl: CodeList, t1: Tree.Link, tsei: RecordSEIndex, sourceNode: Node] = { saveExtractState: RECORD [xtracting: BOOL, xtractNode: Node, xtractsei: Symbols.ISEIndex] = [MimCode.xtracting, MimCode.xtractNode, MimCode.xtractsei]; fa: MimP5U.RecOrFnProc = IF seb[tsei].argument THEN MimP5U.FnField ELSE MimP5U.RecField; startsei: ISEIndex = SymbolOps.FirstCtxSe[SymbolOps.own, seb[tsei].fieldCtx]; sei: ISEIndex ¬ startsei; isei: ISEIndex ¬ startsei; node: Tree.Index = TreeOps.GetNode[t1]; totalBits: INT; SExtract: PROC [node: Tree.Index] = { t1: Tree.Link = tb[node].son[1]; tsei: RecordSEIndex = LOOPHOLE[MimP5U.OperandType[t1]]; ExtractFrom[cl, t1, tsei, MimP5.Exp[tb[node].son[2]]]; }; ExtractItem: PROC [t: Tree.Link] RETURNS [v: Tree.Link] = { posn: BitAddress; size: INT; v ¬ t; [posn, size] ¬ fa[sei]; IF t # Tree.Null THEN { subNode: Tree.Index = TreeOps.GetNode[t]; vl: VLoc ¬ [disp: posn, size: size]; IF fa # MimP5U.FnField AND totalBits <= bitsPerWord THEN vl ¬ MimP5U.AdjustLoc[vl: vl, rSei: tsei, fSei: sei, tBits: totalBits]; MimCode.xtractNode ¬ MimP5U.TakeField[sourceNode, vl.disp, vl.size]; MimCode.xtractsei ¬ sei; SELECT tb[subNode].name FROM assign => MimP5U.MoreCode[cl, Assign[subNode]]; extract => SExtract[subNode]; ENDCASE => ERROR; }; { <> ssei: ISEIndex ¬ startsei; psei: ISEIndex ¬ MimP5U.NextVar[ssei]; rsei: ISEIndex ¬ psei; UNTIL psei = sei DO rsei ¬ psei; psei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, psei]]; ENDLOOP; sei ¬ rsei; }; }; xlist: Tree.Link ¬ tb[node].son[1]; UNTIL (isei ¬ SymbolOps.NextSe[SymbolOps.own, sei]) = ISENull DO isei ¬ MimP5U.NextVar[isei]; IF isei = ISENull THEN EXIT; sei ¬ isei; ENDLOOP; totalBits ¬ sourceNode.bits; MimCode.xtracting ¬ TRUE; tb[node].son[1] ¬ TreeOps.ReverseUpdateList[xlist, ExtractItem]; [MimCode.xtracting, MimCode.xtractNode, MimCode.xtractsei] ¬ saveExtractState; }; EnsureLength: PROC [rv: Node, dstType, srcType: Type, bits: INT] RETURNS [Node] = { rbits: INT = rv.bits; SELECT rbits FROM > bits => { <> start: INT ¬ IF rbits <= bitsPerWord THEN rbits-bits ELSE 0; rv ¬ MimP5U.TakeField[rv, start, bits]; }; < bits => { <> rv ¬ ExtendValue[rv, dstType, srcType, bits]; }; ENDCASE; RETURN [rv]; }; GlobalLocation: PROC [t: Tree.Link] RETURNS [BOOL] = { DO WITH e: t SELECT TreeOps.GetTag[t] FROM symbol => { sei: ISEIndex ¬ e.index; ctx: CTXIndex ¬ seb[sei].idCtx; level: Symbols.ContextLevel ¬ SymbolOps.CtxLevel[SymbolOps.own, ctx]; SELECT level FROM Symbols.lG => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; }; subtree => { tp: Tree.NodePtr = @tb[e.index]; SELECT tp.name FROM dollar, cast => {t ¬ tp.son[1]; LOOP}; ENDCASE; }; ENDCASE; RETURN [FALSE]; ENDLOOP; }; SimpleLocation: PROC [t: Tree.Link] RETURNS [BOOL] = { DO WITH t SELECT TreeOps.GetTag[t] FROM symbol => { sei: ISEIndex ¬ index; ctx: CTXIndex ¬ seb[sei].idCtx; level: Symbols.ContextLevel ¬ SymbolOps.CtxLevel[SymbolOps.own, ctx]; SELECT level FROM Symbols.lG, MimCode.curctxlvl => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; }; subtree => { tp: Tree.NodePtr = @tb[index]; SELECT tp.name FROM dot, uparrow, dollar, cast => {t ¬ tp.son[1]; LOOP}; ENDCASE; }; ENDCASE; RETURN [FALSE]; ENDLOOP; }; AddressableDest: PROC [t: Tree.Link] RETURNS [BOOL] = { <> offset: CARD ¬ 0; DO WITH t SELECT TreeOps.GetTag[t] FROM symbol => { sei: ISEIndex = index; ctx: CTXIndex = seb[sei].idCtx; level: Symbols.ContextLevel = SymbolOps.CtxLevel[SymbolOps.own, ctx]; IF level < Symbols.lG THEN RETURN [FALSE]; offset ¬ offset + MimP5U.RecField[sei].offset; }; subtree => { tp: Tree.NodePtr = @tb[index]; SELECT tp.name FROM uparrow, reloc => {}; index => { arrayType: Symbols.CSEIndex = MimP5U.OperandType[tp.son[1]]; WITH a: seb[arrayType] SELECT FROM array => { grain: CARD = SymbolOps.BitsPerElement[SymbolOps.own, a.componentType, a.packed]; IF grain < bitsPerWord THEN RETURN [FALSE]; }; ENDCASE => ERROR; }; dindex => { arrayDType: Symbols.CSEIndex = MimP5.Normalize[MimP5U.OperandType[tp.son[1]]]; arrayType: Symbols.CSEIndex = WITH seb[arrayDType] SELECT FROM arraydesc => MimP5.Clarify[describedType], ENDCASE => ERROR; WITH a: seb[arrayType] SELECT FROM array => { grain: CARD = SymbolOps.BitsPerElement[SymbolOps.own, a.componentType, a.packed]; IF grain < bitsPerWord THEN RETURN [FALSE]; }; ENDCASE => ERROR; }; seqindex => { seqType: Symbols.CSEIndex = MimP5U.OperandType[tp.son[1]]; WITH ss: seb[seqType] SELECT FROM sequence => { grain: CARD = SymbolOps.BitsPerElement[SymbolOps.own, ss.componentType, ss.packed]; IF grain < bitsPerWord THEN RETURN [FALSE]; }; ENDCASE => RETURN [FALSE]; }; dot => { sei: ISEIndex = TreeOps.GetSe[tp.son[2]]; offset ¬ offset + MimP5U.RecField[sei].offset; }; dollar => { sei: ISEIndex = TreeOps.GetSe[tp.son[2]]; offset ¬ offset + MimP5U.RecField[sei].offset; t ¬ tp.son[1]; LOOP; }; cast => {t ¬ tp.son[1]; LOOP}; ENDCASE => RETURN [FALSE]; }; ENDCASE => RETURN [FALSE]; IF offset MOD bitsPerWord = 0 THEN RETURN [TRUE]; RETURN [FALSE]; ENDLOOP; }; GetCategory: PUBLIC SAFE PROC [n: Node] RETURNS [Category] = CHECKED { DO WITH n SELECT FROM const: REF NodeRep.const => RETURN [constant]; nv: Var => WITH nv.location SELECT FROM nvLoc: REF LocationRep.localVar => IF nv.flags[constant] THEN RETURN [constLocal] ELSE RETURN [local]; nvGlob: REF LocationRep.globalVar => IF nv.flags[constant] THEN RETURN [constGlobal] ELSE RETURN [global]; nvField: REF LocationRep.field => n ¬ nvField.base; ENDCASE => EXIT; ENDCASE => EXIT; ENDLOOP; RETURN [other]; }; WillEvalToConst: PUBLIC PROC [t: Tree.Link, noLocals: BOOL] RETURNS [BOOL] = { tt: Tree.Link ¬ t; DO WITH e: tt SELECT TreeOps.GetTag[tt] FROM subtree => { tp: Tree.NodePtr = @tb[e.index]; start: NAT ¬ 1; stop: NAT ¬ tp.nSons; SELECT tp.name FROM construct, rowcons => start ¬ 2; all, union, cast, pad, list, lengthen, shorten => {}; mwconst => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; IF start = stop THEN {tt ¬ tp.son[start]; LOOP}; FOR i: NAT IN [start..stop] DO IF NOT WillEvalToConst[tp.son[i], noLocals] THEN RETURN [FALSE]; ENDLOOP; RETURN [TRUE]; }; symbol => { IF seb[e.index].immutable THEN { IF noLocals THEN { ctx: CTXIndex ¬ seb[e.index].idCtx; IF ctxb[ctx].level > Symbols.lG THEN RETURN [FALSE]; IF seb[e.index].idDecl # 2 THEN RETURN [FALSE]; <> }; RETURN [TRUE]; }; RETURN [FALSE]; }; literal => RETURN [TRUE]; string => RETURN [TRUE]; ENDCASE; ENDLOOP; }; <> <<>> <> Index: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = { <> arrayType: Symbols.CSEIndex = MimP5U.OperandType[tb[node].son[1]]; grain: BitCount ¬ 0; tBits: BitCount ¬ 0; packed: BOOL; indexRange: INT; ind: IndexedLocation; cl: CodeList ¬ MimP5U.NewCodeList[]; an: Node ¬ MimP5.Exp[MimP5U.ProcessSafens[cl, tb[node].son[1]]]; index: Node = MimP5.Exp[MimP5U.ProcessSafens[cl, tb[node].son[2]]]; WITH a: seb[arrayType] SELECT FROM array => { grain ¬ SymbolOps.BitsPerElement[SymbolOps.own, a.componentType, a.packed]; packed ¬ grain < bitsPerWord; indexRange ¬ SymbolOps.Cardinality[SymbolOps.own, a.indexType]; tBits ¬ indexRange*grain; WITH index SELECT FROM wc2: WordConstNode => {}; ENDCASE => GO TO bailOut; WITH an SELECT FROM const: WordConstNode => { <> unsignedClass: IntCodeDefs.ArithClass = [unsigned, FALSE, Target.bitsPerLongWord]; wc: Node = MimP5U.MakeConstCard[IntCodeUtils.WordToCard[const.word]]; shift: Node = MimP5U.BinaryArithOp[ sub, unsignedClass, MimP5U.MakeConstCard[tBits-grain], MimP5U.BinaryArithOp[ mul, unsignedClass, MimP5U.MakeConstCard[grain], index]]; power: Node = MimP5U.BinaryArithOp[pow, unsignedClass, MimP5U.MakeConstCard[2], shift]; mod: Node = MimP5U.BinaryArithOp[mod, unsignedClass, const, power]; RETURN [MimP5U.TakeField[mod, mod.bits-grain, grain]]; }; ENDCASE; EXITS bailOut => {}; }; ENDCASE => ERROR; IF packed AND tBits IN (0..bitsPerWord) AND tBits < an.bits THEN an ¬ MimP5U.TakeField[an, an.bits-tBits, tBits]; ind ¬ z.NEW[LocationRep.indexed ¬ [indexed[base: an, index: index]]]; RETURN [MimP5U.MaybeBlock[cl, MimP5U.MakeVar[bits: grain, id: nullVariableId, loc: ind]]]; }; DIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = { <> arrayDType: Symbols.CSEIndex = MimP5.Normalize[MimP5U.OperandType[tb[node].son[1]]]; arrayType: Symbols.CSEIndex = WITH seb[arrayDType] SELECT FROM arraydesc => MimP5.Clarify[describedType], ENDCASE => ERROR; align: Symbols.Alignment ¬ MimP5U.AlignmentFromType[arrayType]; grain: BitCount ¬ 0; nilck: BOOL = tb[node].attr1; bndck: BOOL = tb[node].attr3; cl: CodeList ¬ MimP5U.NewCodeList[]; desc: Node ¬ MimP5.Exp[MimP5U.ProcessSafens[cl, tb[node].son[1]]]; base: Node ¬ NIL; index: Node ¬ MimP5.Exp[MimP5U.ProcessSafens[cl, tb[node].son[2]]]; WITH a: seb[arrayType] SELECT FROM array => grain ¬ SymbolOps.BitsPerElement[SymbolOps.own, a.componentType, a.packed]; ENDCASE => ERROR; IF bndck THEN desc ¬ MimP5U.Simplify[cl, desc]; <> base ¬ MimP5U.TakeField[desc, 0, bitsPerRef]; IF nilck THEN { <> aBits: CARD = MimP5U.BitsForType[arrayType]; IF aBits >= firstMappedBit THEN base ¬ MimP5U.ApplyOp[ oper: MimP5U.MesaOpNode[nilck], args: MimP5U.MakeNodeList[base], bits: bitsPerRef]; }; IF bndck THEN { bound: Node = MimP5U.TakeField[desc, bitsPerRef, bitsPerWord]; index ¬ MimP5U.BoundsCheck[index, bound]; }; { ind: Location = z.NEW[LocationRep.indexed ¬ [indexed[ base: MimP5U.Deref[base, 0, align], index: index]]]; RETURN [MimP5U.MaybeBlock[cl, MimP5U.MakeVar[bits: grain, id: nullVariableId, loc: ind]]]; }; }; WordOffset: PROC [sei: ISEIndex] RETURNS [INT] = { val: INT = SymbolOps.DecodeInt[seb[sei].idValue]; RETURN [Basics.BITRSHIFT[val, Target.logBitsPerWord]]; }; SeqIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = { t1: Tree.Link ¬ tb[node].son[1]; seqType: Symbols.CSEIndex = MimP5U.OperandType[t1]; isString: BOOL ¬ FALSE; grain: BitCount; bndck: BOOL = tb[node].attr3; index, elements, tag: Node; ind: Location; cl: CodeList ¬ MimP5U.NewCodeList[]; tb[node].son[1] ¬ t1 ¬ MimP5U.ProcessSafens[cl, t1]; WITH ss: seb[seqType] SELECT FROM array => { isString ¬ TRUE; grain ¬ Target.bitsPerByte; }; sequence => { grain ¬ SymbolOps.BitsPerElement[SymbolOps.own, ss.componentType, ss.packed]; IF bndck THEN { <> <<(see MimExpr.DotOrUparrow)>> tt: Tree.Link ¬ t1; wordOffset: CARD = WordOffset[ss.tagSei]; DO SELECT TreeOps.OpName[tt] FROM dollar => {tt ¬ TreeOps.NthSon[tt, 1]; LOOP}; dot, uparrow => IF wordOffset < firstMappedWord THEN tb[TreeOps.GetNode[tt]].attr1 ¬ FALSE; ENDCASE; EXIT; ENDLOOP; }; }; ENDCASE => ERROR; elements ¬ MimP5.Exp[t1]; IF isString THEN { tag ¬ MimP5U.TakeField[elements, -bitsPerStringBound, bitsPerStringBound]; } ELSE { <> tag ¬ elements; elements ¬ MimP5U.TakeField[tag, tag.bits, 0]; }; index ¬ MimP5.Exp[tb[node].son[2]]; IF bndck THEN { <> addr: Node ¬ NIL; offset: INT ¬ 0; index ¬ MimP5U.Simplify[cl, index]; <> WITH tag SELECT FROM eVar: Var => WITH eVar.location SELECT FROM field: REF LocationRep.field => WITH field.base SELECT FROM fVar: Var => WITH fVar.location SELECT FROM deref: REF LocationRep.deref => {offset ¬ field.start; addr ¬ deref.addr}; ENDCASE; ENDCASE; deref: REF LocationRep.deref => addr ¬ deref.addr; ENDCASE; ENDCASE; IF addr # NIL THEN { <> IF GetCategory[addr] <= local THEN GO TO takeBoundsCheck; <> addr ¬ Temporize[cl, addr]; <> tag ¬ MimP5U.Deref[addr, tag.bits, MimP5U.AlignmentFromType[seqType]]; IF offset # 0 THEN tag ¬ MimP5U.TakeField[tag, offset, tag.bits]; elements ¬ MimP5U.TakeField[tag, tag.bits, 0]; <> GO TO takeBoundsCheck; }; <> tag ¬ MimP5U.Simplify[cl, tag]; elements ¬ MimP5U.TakeField[tag, tag.bits, 0]; GO TO takeBoundsCheck; EXITS takeBoundsCheck => index ¬ MimP5U.BoundsCheck[index, tag]; }; ind ¬ z.NEW[LocationRep.indexed ¬ [indexed[base: elements, index: index]]]; RETURN [MimP5U.MaybeBlock[cl, MimP5U.MakeVar[bits: grain, id: nullVariableId, loc: ind]]]; }; ExtendValue: PUBLIC PROC [node: Node, dstType, srcType: Symbols.Type, bits: INT] RETURNS [Node] = { <> nBits: INT = node.bits; srcAc: ArithClass ¬ MimP5U.ArithClassForType[srcType]; IF bits > Target.bitsPerWord*2 THEN RETURN [MimP5U.ZeroExtend[node, bits]]; IF srcAc.kind # lastExtension AND bits <= IntCodeDefs.ArithPrecision.LAST THEN { dstAc: ArithClass ¬ MimP5U.ArithClassForType[dstType]; IF dstAc.precision # bits THEN dstAc.precision ¬ bits; IF dstAc.kind = lastExtension THEN dstAc.kind ¬ srcAc.kind; <> SELECT INT[srcAc.precision] FROM < nBits => srcAc.precision ¬ nBits; > nBits => { <> srcAc.precision ¬ nBits; IF srcAc.kind = signed THEN srcAc.kind ¬ unsigned; IF dstAc.kind = signed THEN dstAc.kind ¬ unsigned; }; ENDCASE; IF srcAc # dstAc THEN node ¬ MimP5U.ApplyOp[ MimP5U.ConvertOpNode[from: srcAc, to: dstAc], MimP5U.MakeNodeList[node], bits]; } ELSE <> IF nBits < bits THEN node ¬ MimP5U.Extend[node, bits, srcType]; RETURN [node]; }; <> <<>> tb: Tree.Base ¬ NIL; -- tree base (local copy) seb: Symbols.Base ¬ NIL; -- semantic entry base (local copy) ctxb: Symbols.Base ¬ NIL; -- context entry base (local copy) StoreNotify: PUBLIC Alloc.Notifier = { <> seb ¬ base[Symbols.seType]; ctxb ¬ base[Symbols.ctxType]; tb ¬ base[Tree.treeType]; }; MimCode.RegisterNotifier[StoreNotify]; }.