> MainConstruct: PROC [maint: Tree.Link, rSei: CSEIndex, fa: MimP5U.RecOrFnProc, total: VLoc, fieldSei: ISEIndex ¬ ISENull] = { <> AssignField: PROC [root: Tree.Link] = { offset: VLoc ¬ [lastStart, 0]; rep: BitAddress; res: BitCount; [rep, res] ¬ fa[fieldSei]; IF res # 0 THEN { fieldType: CSEIndex = MimP5.Clarify[seb[fieldSei].idType]; rootName: Tree.NodeName; lim: INT; offset.disp ¬ tOffset.disp + rep; offset.size ¬ res; IF adjustOffset THEN offset ¬ MimP5U.AdjustLoc[vl: offset, rSei: rcSei, fSei: fieldSei, tBits: totalBits]; IF offset.disp >= limit THEN { <> res ¬ 0; -- useful for breakpoints GO TO doneWithField; }; DO <> rootName ¬ TreeOps.OpName[root]; SELECT rootName FROM pad => { son: Tree.Link = TreeOps.NthSon[root, 1]; sonBits: INT = MimP5U.BitsForOperand[son]; IF sonBits < bitsPerWord THEN EXIT; root ¬ son; offset.size ¬ sonBits; }; cast => root ¬ TreeOps.NthSon[root, 1]; ENDCASE => EXIT; ENDLOOP; IF offset.disp < minDisp THEN minDisp ¬ offset.disp; lim ¬ offset.disp+offset.size; IF lim > maxDisp THEN maxDisp ¬ lim; SELECT rootName FROM construct => MainConstruct[ TreeOps.NthSon[root, 2], MimP5U.OperandType[root], MimP5U.RecField, offset, ISENull]; union => UnionConstruct[TreeOps.GetNode[root], rcSei, tOffset]; rowcons => Row[TreeOps.GetNode[root], offset]; all => [] ¬ AllConstruct[TreeOps.GetNode[root], offset]; ENDCASE => { expr: Node ¬ IF root = Tree.Null THEN IntCodeStuff.GenDummy[offset.size] ELSE MimP5.Exp[root]; ConsAssign[fieldType, offset, expr]; }; EXITS doneWithField => {}; }; lastStart ¬ offset.disp; fieldSei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, fieldSei]]; }; tOffset: VLoc ¬ total; totalBits: INT = total.size; lastStart: INT ¬ total.disp; rcSei: RecordSEIndex ¬ ToRecordSE[rSei]; recBits: INT ¬ MIN[MimP5U.BitsForType[rcSei], totalBits]; skipZeros: BOOL ¬ cd.options.skipZeros; limit: BitAddress ¬ total.disp+totalBits; minDisp: BitAddress ¬ limit; maxDisp: BitAddress ¬ total.disp; wholeThing: BOOL ¬ fieldSei = ISENull; adjustOffset: BOOL ¬ fa # MimP5U.FnField AND totalBits <= bitsPerWord AND ModInWord[total.disp] = 0; IF wholeThing THEN { IF recBits < totalBits AND totalBits <= bitsPerWord THEN { <> delta: INT ¬ totalBits-recBits; ConsAssign[typeANY, [disp: total.disp, size: delta], MimCode.nC0]; minDisp ¬ tOffset.disp; tOffset.disp ¬ tOffset.disp + delta; maxDisp ¬ tOffset.disp; tOffset.size ¬ recBits; adjustOffset ¬ FALSE; }; rcSei ¬ SymbolOps.RecordRoot[SymbolOps.own, rcSei]; fieldSei ¬ MimP5U.NextVar[SymbolOps.FirstCtxSe[SymbolOps.own, seb[rcSei].fieldCtx]]; }; TreeOps.ScanList[maint, AssignField]; IF wholeThing AND NOT skipZeros THEN { <> WHILE minDisp > total.disp DO delta: INT = minDisp - total.disp; mod: NAT ¬ ModInWord[minDisp]; IF mod = 0 THEN mod ¬ bitsPerWord; IF delta < mod THEN mod ¬ delta; minDisp ¬ minDisp - mod; ConsAssign[typeANY, [disp: minDisp, size: mod], MimCode.nC0]; ENDLOOP; <> WHILE maxDisp < limit DO delta: INT = limit - maxDisp; mod: NAT = ModInWord[maxDisp]; rem: NAT ¬ bitsPerWord - mod; IF delta < rem THEN rem ¬ delta; ConsAssign[typeANY, [disp: maxDisp, size: rem], MimCode.nC0]; maxDisp ¬ maxDisp + rem; ENDLOOP; }; }; IdValue: PROC [ise: ISEIndex] RETURNS [MimCode.BitAddress] = { <> RETURN [SymbolOps.DecodeCard[seb[ise].idValue]]; }; Row: PROC [node: Tree.Index, total: VLoc] = { <> skipZeros: BOOL ¬ cd.options.skipZeros; AssignElement: PROC [t: Tree.Link] = { opName: Tree.NodeName ¬ none; nextLoc: VLoc; root: Tree.Link = t; nextLoc.disp ¬ offset.disp + offset.size; nextLoc.size ¬ grain; IF t # Tree.Null THEN { DO <> opName ¬ TreeOps.OpName[t]; SELECT opName FROM pad => { son: Tree.Link = TreeOps.NthSon[t, 1]; sonBits: INT = MimP5U.BitsForOperand[son]; IF sonBits < bitsPerWord THEN EXIT; t ¬ son; offset.size ¬ sonBits; }; cast => t ¬ TreeOps.NthSon[t, 1]; ENDCASE => EXIT; ENDLOOP; SELECT opName FROM rowcons => Row[TreeOps.GetNode[t], offset]; construct => MainConstruct[ TreeOps.NthSon[t, 2], MimP5U.OperandType[t], MimP5U.RecField, offset, ISENull]; all => [] ¬ AllConstruct[TreeOps.GetNode[t], offset]; ENDCASE => ConsAssign[cSei, offset, MimP5.Exp[t]]; }; offset ¬ nextLoc; }; aSei: ArraySEIndex = ToArraySE[TreeType[node]]; cSei: CSEIndex = MimP5.Clarify[seb[aSei].componentType]; totalBits: BitCount = total.size; totalLim: BitCount = total.disp+totalBits; grain: BitCount = SymbolOps.BitsPerElement[ SymbolOps.own, seb[aSei].componentType, seb[aSei].packed]; offset: VLoc ¬ [total.disp, grain]; arrayElems: CARD ¬ SymbolOps.Cardinality[SymbolOps.own, seb[aSei].indexType]; arrayBits: INT ¬ arrayElems*grain; IF totalBits <= bitsPerWord AND totalBits > arrayBits THEN { <> offset.size ¬ totalBits - arrayBits; ConsAssign[typeANY, offset, MimCode.nC0]; offset.disp ¬ offset.disp + offset.size; offset.size ¬ grain; }; TreeOps.ScanList[tb[node].son[2], AssignElement]; IF totalBits > bitsPerWord AND totalBits > arrayBits THEN { <> <> <> offset.size ¬ totalBits - arrayBits; offset.disp ¬ totalLim - offset.size; ConsAssign[typeANY, offset, MimCode.nC0]; }; }; UnionConstruct: PROC [node: Tree.Index, rootSei: RecordSEIndex, total: VLoc] = { <> tOffset: VLoc = total; offset: VLoc ¬ total; fieldSei: ISEIndex; vCtx: CTXIndex; uSei: CSEIndex = MimP5.Clarify[TreeType[node]]; rcSei: RecordSEIndex; tSei: ISEIndex; tagged: BOOL; tagValue: CARD; tBits: CARDINAL = tOffset.size; WITH u: seb[uSei] SELECT FROM union => { tagged ¬ u.controlled; IF tagged THEN { tagAddr: BitAddress = IdValue[u.tagSei]; tagSize: BitCount = LOOPHOLE[seb[u.tagSei].idInfo]; offset.disp ¬ offset.disp + tagAddr; offset.size ¬ tagSize; IF tBits <= bitsPerWord THEN { huh: BOOL ¬ TRUE; <> }; }; }; ENDCASE => ERROR; tSei ¬ TreeOps.GetSe[tb[node].son[1]]; tagValue ¬ SymbolOps.DecodeCard[seb[tSei].idValue]; rcSei ¬ ToRecordSE[tSei]; vCtx ¬ seb[rcSei].fieldCtx; fieldSei ¬ MimP5U.NextVar[SymbolOps.FirstCtxSe[SymbolOps.own, vCtx]]; IF tagged THEN { IF fieldSei # ISENull AND seb[fieldSei].idCtx # vCtx THEN { <> fillSize: CARD = SymbolOps.DecodeCard[seb[fieldSei].idInfo]; tagValue ¬ Basics.BITLSHIFT[tagValue, fillSize]; offset.size ¬ offset.size + fillSize; fieldSei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, fieldSei]]; }; ConsAssign[typeANY, offset, MimP5U.MakeConstCard[tagValue]]; } ELSE IF fieldSei # ISENull AND seb[fieldSei].idCtx # vCtx THEN { <> fillSize: [0..bitsPerWord) = SymbolOps.DecodeCard[seb[fieldSei].idInfo]; fillAddr: BitAddress = IdValue[fieldSei]; -- can't be full word offset.disp ¬ offset.disp + fillAddr; offset.size ¬ fillSize; IF tBits <= bitsPerWord THEN offset ¬ MimP5U.AdjustLoc[vl: offset, rSei: rootSei, fSei: fieldSei, tBits: tBits]; ConsAssign[typeANY, offset, MimCode.nC0]; fieldSei ¬ MimP5U.NextVar[SymbolOps.NextSe[SymbolOps.own, fieldSei]]; }; IF fieldSei # ISENull THEN MainConstruct[tb[node].son[2], rootSei, MimP5U.RecField, total, fieldSei]; }; IsTreeOfZeros: PROC [t: Tree.Link] RETURNS [BOOL] = { tt: Tree.Link ¬ t; DO IF tt = Tree.Null THEN RETURN [TRUE]; WITH e: tt SELECT TreeOps.GetTag[tt] FROM literal => { lti: Literals.LTIndex = e.index; IF LiteralOps.IsShort[lti] AND LiteralOps.ValueBits[lti] = 0 THEN GO TO zero; GO TO nonzero; -- eventually do better here? }; subtree => { tp: Tree.NodePtr = @tb[e.index]; start: NAT ¬ 1; stop: NAT ¬ tp.nSons; SELECT tp.name FROM construct, rowcons, all, union, cast, pad, list, lengthen, shorten, mwconst => {}; nil => GO TO zero; ENDCASE => GO TO nonzero; IF start = stop THEN {tt ¬ tp.son[start]; LOOP}; FOR i: NAT IN [start..stop] DO IF NOT IsTreeOfZeros[tp.son[i]] THEN GO TO nonzero; ENDLOOP; GO TO zero; }; ENDCASE; GO TO nonzero; ENDLOOP; EXITS nonzero => RETURN [FALSE]; zero => RETURN [TRUE]; }; AllConstruct: PROC [node: Tree.Index, total: VLoc] = { aSei: ArraySEIndex = ToArraySE[TreeType[node]]; offset: VLoc ¬ total; totalBits: BitCount = total.size; grain: BitCount = SymbolOps.BitsPerElement[ SymbolOps.own, seb[aSei].componentType, seb[aSei].packed]; fillBits: CARDINAL ¬ 0; fillStart: CARD ¬ 0; eCount: CARD ¬ SymbolOps.Cardinality[SymbolOps.own, seb[aSei].indexType]; aBits: BitCount ¬ totalBits; packed: BOOL ¬ grain < bitsPerWord; skipZeros: BOOL ¬ cd.options.skipZeros; son1: Tree.Link = tb[node].son[1]; val: Node ¬ MimCode.nC0; IF skipZeros AND IsTreeOfZeros[son1] THEN RETURN; IF son1 # Tree.Null THEN val ¬ MimP5.Exp[son1]; val ¬ AssureSize[val, grain]; IF MimP5U.IsZero[val] THEN { IF skipZeros THEN RETURN; IF cd.options.init AND cd.options.counted THEN RETURN; IF totalBits <= bitsPerLongWord THEN { ConsAssign[aSei, total, MimCode.nC0]; RETURN; }; }; IF packed AND eCount # 0 THEN { <> remBits: NAT ¬ 0; factor: CARD ¬ 1; g: [0..bitsPerWord] = grain; perWord: NAT = MIN[eCount, bitsPerWord/g]; aBits ¬ eCount*grain; fillBits ¬ totalBits - aBits; FOR i: NAT IN [1..perWord) DO factor ¬ 1 + Basics.BITLSHIFT[factor, grain]; ENDLOOP; val ¬ MimP5U.BinaryArithOp[mul, unsignedClass, MimP5U.MakeConstCard[factor], AssureSize[val, bitsPerWord]]; eCount ¬ aBits / bitsPerWord; remBits ¬ aBits MOD bitsPerWord; aBits ¬ eCount*bitsPerWord; SELECT TRUE FROM totalBits <= bitsPerWord => {ConsAssign[aSei, total, val]; RETURN}; remBits = 0 AND eCount >= allConstructorTrigger => {}; MimP5Stuff.IsCard[val], MimP5Stuff.IsSimpleVar[val] => {}; ENDCASE => val ¬ MimP5S.Temporize[cl: cd.cl, n: val]; <> <<>> <> SELECT eCount FROM < allConstructorTrigger => { disp: INT ¬ total.disp; FOR i: NAT IN [0..NAT[eCount]) DO ConsAssign[aSei, [disp, bitsPerWord], val]; disp ¬ disp + bitsPerWord; ENDLOOP; }; ENDCASE => ConsAssign[aSei, [total.disp, aBits], MimP5U.ApplyOp[ oper: MimP5U.MesaOpNode[all], args: MimP5U.MakeArgList2[val, MimP5U.MakeConstCard[eCount]], bits: aBits]]; total.disp ¬ total.disp + aBits; total.size ¬ totalBits - aBits; IF remBits # 0 THEN { <> val ¬ AssureSize[val, remBits]; ConsAssign[aSei, [total.disp, remBits], val]; total.disp ¬ total.disp + remBits; total.size ¬ total.size - remBits; }; IF total.size > 0 THEN <> ConsAssign[aSei, total, MimP5U.MakeConstCard[0, total.size]]; RETURN; }; SELECT eCount FROM 0 => {}; 1 => { <> ConsAssign[aSei, offset, val]; }; ENDCASE => { IF eCount < allConstructorTrigger AND val.bits <= bitsPerWord THEN { disp: INT ¬ total.disp; bits: INT ¬ val.bits; csei: CSEIndex = MimP5.Clarify[seb[aSei].componentType]; SELECT TRUE FROM MimP5Stuff.IsCard[val], MimP5Stuff.IsSimpleVar[val] => {}; ENDCASE => val ¬ MimP5S.Temporize[cl: cd.cl, n: val]; <> FOR i: NAT IN [0..NAT[eCount]) DO ConsAssign[csei, [disp, bits], val]; disp ¬ disp + bitsPerWord; ENDLOOP; } ELSE { rhs: Node ¬ MimP5U.ApplyOp[ oper: MimP5U.MesaOpNode[all], args: MimP5U.MakeArgList2[val, MimP5U.MakeConstCard[eCount]], bits: aBits]; ConsAssign[aSei, offset, rhs]; }; }; IF fillBits # 0 AND NOT skipZeros THEN { offset.disp ¬ total.disp + fillStart; offset.size ¬ fillBits; ConsAssign[typeANY, offset, MimCode.nC0]; }; }; <> All: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [l: Node] = { <> aSei: ArraySEIndex = ToArraySE[TreeType[node]]; cl: CodeList ¬ MimP5U.NewCodeList[]; aBits: BitCount ¬ MimP5U.BitsForType[aSei]; saveCd: ConsDestination = cd; assumeTemp: BOOL ¬ FALSE; IF t = Tree.Null THEN { var: Var; sei: ISEIndex; [var: var, sei: sei] ¬ MimP5U.MakeTemp[cl: cl, bits: aBits]; t ¬ [symbol[sei]]; options ¬ [expr: TRUE]; assumeTemp ¬ TRUE; }; cd ¬ [options: options, ignoreSafen: IgnoreSafen[t]]; <<+ many defaults>> tb[node].son[1] ¬ MimP5U.ProcessSafens[cl, tb[node].son[1], cd.ignoreSafen]; SetConsDest[t, cl]; { dest: Node = cd.destNode; dstBits: INT ¬ dest.bits; AllConstruct[node, [disp: 0, size: dstBits]]; IF options.expr THEN MimP5U.MoreCode[cl, dest] ELSE dstBits ¬ 0; l ¬ MimP5Stuff.MakeConsBlock[cl, dest, dstBits, assumeTemp]; }; cd ¬ saveCd; }; Construct: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [l: Node] = { <> tsei: RecordSEIndex = ToRecordSE[TreeType[node]]; nbits: BitCount ¬ MimP5U.BitsForType[tsei]; saveCd: ConsDestination = cd; son2: Tree.Link ¬ tb[node].son[2]; fa: MimP5U.RecOrFnProc = IF seb[tsei].argument THEN MimP5U.FnField ELSE MimP5U.RecField; cl: CodeList ¬ MimP5U.NewCodeList[]; assumeTemp: BOOL ¬ FALSE; IF useExtraSafens AND t # Tree.Null AND nbits > bitsPerWord AND NOT options.init THEN ExtraSafens[cl, t, son2]; IF t = Tree.Null THEN { var: Var; sei: ISEIndex; [var: var, sei: sei] ¬ MimP5U.MakeTemp[cl: cl, bits: nbits, type: tsei]; t ¬ [symbol[sei]]; options ¬ [expr: TRUE]; assumeTemp ¬ TRUE; }; cd ¬ [options: options, ignoreSafen: IgnoreSafen[t]]; -- + many defaults son2 ¬ tb[node].son[2] ¬ MimP5U.ProcessSafens[cl, son2, cd.ignoreSafen]; SetConsDest[t, cl]; { dest: Node = cd.destNode; destBits: INT ¬ dest.bits; total: VLoc ¬ [disp: 0, size: destBits]; MainConstruct[maint: son2, rSei: tsei, fa: fa, total: total, fieldSei: ISENull]; IF options.expr THEN MimP5U.MoreCode[cl, dest] ELSE destBits ¬ 0; l ¬ MimP5Stuff.MakeConsBlock[cl, dest, destBits, assumeTemp]; }; cd ¬ saveCd; }; ListCons: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = { pSei: CSEIndex = MimP5.Clarify[TreeType[node]]; rSei: CSEIndex = MimP5.Clarify[SymbolOps.ReferentType[SymbolOps.own, pSei]]; long: BOOL = tb[node].attr2; counted: BOOL = tb[node].attr3; pWords: CARD = MimP5U.WordsForSei[pSei]; pBits: CARD = pWords*bitsPerWord; zoneTree: Tree.Link = tb[node].son[1]; catchTree: Tree.Link ¬ Tree.Null; zoneNode: Node = IF zoneTree = Tree.Null THEN NIL ELSE MimP5.Exp[zoneTree]; recWords: INT = MimP5U.WordsForSei[rSei]; -- include rest ptr recBits: INT = bitsPerWord*recWords; elemWords: INT = recWords-pWords; -- does not include rest ptr elemBits: INT = bitsPerWord*elemWords; cl: CodeList ¬ MimP5U.NewCodeList[]; headTemp: Var ¬ NIL; tailTemp: Var ¬ NIL; tailRest: Var ¬ NIL; tailFirst: Var ¬ NIL; EachElem: Tree.Scan = { sizeNode: Node ¬ MimP5U.MakeConstInt[recWords*unitsPerWord]; allocNode: Node ¬ IF counted THEN MimP5.CountedAllocate[ zone: zoneNode, type: rSei, catch: catchTree, size: sizeNode] ELSE MimP5.ZoneOp[zone: zoneNode, which: alloc, args: MimP5U.MakeNodeList[sizeNode], catch: catchTree]; IF headTemp = NIL THEN { <> headTemp ¬ MimP5S.Temporize[cl: cl, n: allocNode]; tailTemp ¬ MimP5U.MakeTemp[cl: cl, bits: pBits, init: headTemp].var; tailRest ¬ MimP5U.TakeFieldVar[ MimP5U.Deref[tailTemp, recBits, MimData.worstAlignment], elemBits, pBits]; <> } ELSE { <> ptrAssn: Node ¬ IF counted THEN MimP5U.AssignRC[lhs: tailRest, rhs: allocNode, type: pSei, init: TRUE] ELSE MimP5U.Assign[lhs: tailRest, rhs: allocNode]; MimP5U.MoreCode[cl, ptrAssn]; MimP5U.MoreCode[cl, MimP5U.Assign[lhs: tailTemp, rhs: tailRest]]; }; IF t # Tree.Null THEN { <> saveCd: ConsDestination = cd; IF tailFirst = NIL THEN tailFirst ¬ MimP5U.TakeFieldVar[ MimP5U.Deref[tailTemp, recBits, MimData.worstAlignment], 0, elemBits]; <> cd ¬ [options: [init: TRUE, counted: counted], ignoreSafen: FALSE]; -- + defaults cd.cl ¬ cl; cd.destNode ¬ tailFirst; MainConstruct[maint: t, rSei: rSei, fa: MimP5U.RecField, total: [0, recBits]]; cd ¬ saveCd; }; }; TreeOps.ScanList[tb[node].son[2], EachElem]; IF headTemp = NIL THEN MimP5U.MoreCode[cl, MimP5U.MakeConstInt[0, pBits]] ELSE MimP5U.MoreCode[cl, headTemp]; RETURN [MimP5U.MakeBlock[cl, pBits]]; }; <<>> RowCons: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [l: Node] = { <> aSei: ArraySEIndex = ToArraySE[TreeType[node]]; aBits: BitCount ¬ MimP5U.BitsForType[aSei]; saveCd: ConsDestination = cd; grain: BitCount = SymbolOps.BitsPerElement[ SymbolOps.own, seb[aSei].componentType, seb[aSei].packed]; list: Tree.Link ¬ tb[node].son[2]; cl: CodeList ¬ MimP5U.NewCodeList[]; assumeTemp: BOOL ¬ FALSE; IF useExtraSafens AND t # Tree.Null AND aBits > bitsPerWord AND NOT options.init THEN ExtraSafens[cl, t, list]; IF t = Tree.Null THEN { var: Var; sei: ISEIndex; [var: var, sei: sei] ¬ MimP5U.MakeTemp[cl: cl, bits: aBits]; t ¬ [symbol[sei]]; options ¬ [expr: TRUE]; assumeTemp ¬ TRUE; }; cd ¬ [options: options, ignoreSafen: IgnoreSafen[t]]; <<+ many defaults>> tb[node].son[1] ¬ MimP5U.ProcessSafens[cl, tb[node].son[1], cd.ignoreSafen]; SetConsDest[t, cl]; { dest: Node = cd.destNode; destBits: INT ¬ cd.destNode.bits; Row[node, [disp: 0, size: destBits]]; IF options.expr THEN MimP5U.MoreCode[cl, dest] ELSE destBits ¬ 0; l ¬ MimP5Stuff.MakeConsBlock[cl, dest, destBits, assumeTemp]; }; cd ¬ saveCd; }; VariantConstruct: PUBLIC PROC [t1: Tree.Link, t2: Tree.Link, options: StoreOptions] RETURNS [Node] = { <> cl: CodeList ¬ MimP5U.NewCodeList[]; saveCd: ConsDestination = cd; bits: INT ¬ 0; t1 ¬ TreeOps.NthSon[t1, 1]; cd ¬ [options: options, ignoreSafen: TreeOps.GetTag[t1] = symbol]; -- + many defaults SetConsDest[t1, cl]; t2 ¬ MimP5U.ProcessSafens[cl, t2, cd.ignoreSafen]; { recSei: RecordSEIndex = ToRecordSE[MimP5U.OperandType[t1]]; rootSei: RecordSEIndex = SymbolOps.RecordRoot[SymbolOps.own, recSei]; dest: Node = cd.destNode; destBits: INT = cd.destNode.bits; rBits: INT = MimP5U.BitsForType[recSei]; offset: VLoc ¬ [disp: 0, size: destBits]; IF destBits <= bitsPerWord AND rBits < destBits THEN offset ¬ [disp: destBits-rBits, size: rBits]; UnionConstruct[TreeOps.GetNode[t2], rootSei, offset]; IF options.expr THEN {MimP5U.MoreCode[cl, dest]; bits ¬ destBits}; }; cd ¬ saveCd; RETURN [MimP5U.MakeBlock[cl, bits]]; }; New: PUBLIC PROC [node: Tree.Index] RETURNS [Node] = { saveCd: ConsDestination = cd; long: BOOL = tb[node].attr2; counted: BOOL = tb[node].attr3; pLength: CARD = MimP5U.WordsForSei[TreeType[node]]; pBits: CARD = pLength*bitsPerWord; zoneTree: Tree.Link = tb[node].son[1]; typeTree: Tree.Link = tb[node].son[2]; initTree: Tree.Link ¬ tb[node].son[3]; overType: SEIndex = MimP5U.TypeForTree[typeTree]; type: CSEIndex = MimP5.Clarify[overType]; catchTree: Tree.Link = IF tb[node].nSons = 4 THEN tb[node].son[4] ELSE Tree.Null; tag: ISEIndex ¬ ISENull; computedType: BOOL = (TreeOps.OpName[typeTree] = apply); baseUnits: INT ¬ MimP5U.WordsForSei[type] * unitsPerWord; sizeNode: Node ¬ MimP5U.MakeConstInt[baseUnits]; allocNode: Node ¬ NIL; cl: CodeList ¬ MimP5U.NewCodeList[]; zoneNode: Node = IF zoneTree = Tree.Null THEN NIL ELSE MimP5.Exp[zoneTree]; nElemsType: Symbols.Type; nElemsNode: Node ¬ NIL; initTree ¬ MimP5U.ProcessSafens[cl, initTree]; <> IF computedType THEN { <> elemUnits: Node ¬ NIL; subNode: Tree.Index = TreeOps.GetNode[typeTree]; vSei: ISEIndex = SymbolOps.VariantField[SymbolOps.own, type]; bitsPerItem: INT; constElems: BOOL ¬ FALSE; nElemsType ¬ MimP5U.OperandType[tb[subNode].son[2]]; nElemsNode ¬ MimP5U.Simplify[cl, MimP5.Exp[tb[subNode].son[2]]]; WITH nElemsNode SELECT FROM const: ConstNode => constElems ¬ TRUE; ENDCASE; IF vSei # ISENull THEN { vType: CSEIndex = MimP5.Clarify[seb[vSei].idType]; WITH v: seb[vType] SELECT FROM sequence => { tag ¬ IF v.controlled THEN v.tagSei ELSE ISENull; bitsPerItem ¬ SymbolOps.BitsPerElement[ SymbolOps.own, v.componentType, v.packed]; }; ENDCASE => ERROR; } ELSE { <> tag ¬ SymbolOps.NextSe[SymbolOps.own, SymbolOps.FirstCtxSe[SymbolOps.own, seb[ToRecordSE[type]].fieldCtx]]; bitsPerItem ¬ bitsPerChar; }; IF bitsPerItem >= bitsPerWord THEN { <> unitsPerElem: INT ¬ (bitsPerItem+bitsPerAU-1)/bitsPerAU; elemUnits ¬ MimP5U.BinaryArithOp[mul, unsignedClass, MimP5U.MakeConstInt[unitsPerElem], nElemsNode]; } ELSE { <> elemsPerWord: NAT ¬ bitsPerWord/bitsPerItem; elemWords: Node ¬ MimP5U.BinaryArithOp[div, unsignedClass, MimP5U.BinaryArithOp[add, unsignedClass, nElemsNode, MimP5U.MakeConstInt[elemsPerWord-1]], MimP5U.MakeConstInt[elemsPerWord]]; elemUnits ¬ MimP5U.BinaryArithOp[mul, unsignedClass, MimP5U.MakeConstInt[unitsPerWord], elemWords]; }; IF NOT constElems THEN <> elemUnits ¬ MimP5S.Temporize[cl: cl, n: elemUnits]; sizeNode ¬ MimP5U.BinaryArithOp[add, unsignedClass, sizeNode, elemUnits]; }; IF counted THEN allocNode ¬ MimP5.CountedAllocate[ zone: zoneNode, type: overType, catch: catchTree, size: sizeNode] ELSE allocNode ¬ MimP5.ZoneOp[ zone: zoneNode, which: alloc, args: MimP5U.MakeNodeList[sizeNode], catch: catchTree]; <<>> IF nElemsNode = NIL AND initTree = Tree.Null THEN { <> MimP5U.MoreCode[cl, allocNode]; } ELSE { <> tempPtr: Var = MimP5S.Temporize[cl: cl, n: allocNode]; tempRec: Var = MimP5U.Deref[tempPtr, 0, MimData.worstAlignment]; nLoc: VLoc ¬ [disp: 0, size: baseUnits*bitsPerAU]; IF nElemsNode # NIL AND tag # ISENull THEN { <> offset: BitAddress; bits: INT; [offset: offset, size: bits] ¬ MimP5U.RecField[tag]; SELECT nElemsNode.bits FROM < bits => nElemsNode ¬ MimP5U.Extend[nElemsNode, bits, nElemsType]; > bits => nElemsNode ¬ MimP5U.TakeField[nElemsNode, nElemsNode.bits-bits, bits]; ENDCASE; MimP5U.MoreCode[cl, MimP5U.Assign[ lhs: MimP5U.TakeFieldVar[tempRec, offset, bits], rhs: nElemsNode]]; IF offset < nLoc.size THEN nLoc.size ¬ offset; <> }; IF initTree # Tree.Null THEN { <> res: Node ¬ NIL; cd ¬ [options: [init: TRUE, counted: counted, skipZeros: counted], ignoreSafen: FALSE]; -- + defaults cd.cl ¬ cl; cd.destNode ¬ tempRec; SELECT TreeOps.OpName[initTree] FROM construct => MainConstruct[ maint: TreeOps.NthSon[initTree, 2], rSei: MimP5U.OperandType[initTree], fa: MimP5U.RecField, total: nLoc]; rowcons => Row[TreeOps.GetNode[initTree], nLoc]; all => [] ¬ AllConstruct[TreeOps.GetNode[initTree], nLoc]; ENDCASE => ConsAssign[type, nLoc, MimP5.Exp[initTree]]; MimP5U.MoreCode[cl, tempPtr]; res ¬ MimP5Stuff.MakeConsBlock[cl, cd.destNode, pBits, TRUE]; cd ¬ saveCd; RETURN [res]; }; MimP5U.MoreCode[cl, tempPtr]; }; RETURN [MimP5U.MakeBlock[cl, pBits]]; }; ToRecordSE: PROC [sei: SEIndex] RETURNS [RecordSEIndex] = { sei ¬ MimP5.Clarify[sei]; WITH cse: seb[sei] SELECT FROM cons => WITH cse SELECT FROM record => RETURN [LOOPHOLE[sei, RecordSEIndex]]; ENDCASE; ENDCASE; ERROR; }; <<>> ToArraySE: PROC [sei: SEIndex] RETURNS [ArraySEIndex] = { sei ¬ MimP5.Clarify[sei]; WITH cse: seb[sei] SELECT FROM cons => WITH cse SELECT FROM array => RETURN [LOOPHOLE[sei, Symbols.ArraySEIndex]]; ENDCASE; ENDCASE; ERROR; }; ModInWord: PROC [i: INT] RETURNS [ [0..bitsPerWord) ] = INLINE { IF bitsPerWord # NAT[BITS[INT]] THEN RETURN [Basics.LowHalf[LOOPHOLE[i, CARD]] MOD bitsPerWord] ELSE RETURN [LOOPHOLE[i, CARD] MOD bitsPerWord]; }; ExtraSafens: PROC [cl: CodeList, dst: Tree.Link, src: Tree.Link] = { WITH s: src SELECT TreeOps.GetTag[src] FROM subtree => { spt: Tree.NodePtr = @tb[s.index]; SELECT spt.name FROM construct, rowcons, union => ExtraSafens[cl, dst, spt.son[2]]; list => FOR i: NAT IN [1..spt.nSons] DO son: Tree.Link = tb[s.index].son[i]; WITH ss: son SELECT TreeOps.GetTag[son] FROM subtree => SELECT tb[ss.index].name FROM construct, rowcons, union => { ExtraSafens[cl, dst, tb[ss.index].son[2]]; LOOP; }; ENDCASE; ENDCASE; IF Conflicts[dst, son] THEN { <> type: Symbols.Type = MimP5U.OperandType[son]; bits: BitCount ¬ MimP5U.BitsForType[type]; init: Node = MimP5.Exp[son]; sei: ISEIndex = MimP5U.MakeTemp[cl: cl, bits: bits, init: init, type: type].sei; tb[s.index].son[i] ¬ [symbol[sei]]; }; ENDLOOP; ENDCASE; }; ENDCASE; }; Conflicts: PROC [dst: Tree.Link, src: Tree.Link] RETURNS [BOOL] = { DO WITH s: src SELECT TreeOps.GetTag[src] FROM subtree => { spt: Tree.NodePtr = @tb[s.index]; SELECT spt.name FROM nil, void, clit, llit, mwconst, atom, typecode, stringinit, textlit, signalinit, procinit, thread, none, self, gcrt => RETURN [FALSE]; ENDCASE; IF spt.nSons = 1 THEN {src ¬ spt.son[1]; LOOP}; FOR i: NAT IN [1..spt.nSons] DO IF Conflicts[dst, spt.son[i]] THEN RETURN [TRUE]; ENDLOOP; }; symbol => { sep: Symbols.ISEPointer = @seb[s.index]; IF sep.immutable OR sep.constant THEN RETURN [FALSE]; EXIT; }; ENDCASE; RETURN [FALSE]; ENDLOOP; DO IF dst = src THEN RETURN [TRUE]; WITH d: dst SELECT TreeOps.GetTag[dst] FROM subtree => { dpt: Tree.NodePtr = @tb[d.index]; SELECT dpt.name FROM cast, dot, uparrow, index, seqindex, reloc, arraydesc, lengthen, shorten, openx => { dst ¬ dpt.son[1]; LOOP; }; dollar => { dst ¬ dpt.son[2]; LOOP; }; ENDCASE; }; ENDCASE; RETURN [FALSE]; ENDLOOP; }; <> <<>> tb: Tree.Base ¬ NIL; -- tree base (local copy) seb: Symbols.Base ¬ NIL; -- semantic entry base (local copy) ConstructorNotify: Alloc.Notifier = { <> seb ¬ base[Symbols.seType]; tb ¬ base[Tree.treeType]; }; MimCode.RegisterNotifier[ConstructorNotify]; }.