<> <> <> <> <> <> DIRECTORY Alloc, Basics, Code, CodeDefs, ComData, FOpCodes, IntCodeDefs, Literals, P5, P5U, PrincOps, PrincOpsUtils, Symbols, SymbolOps, Tree, TreeOps; Constructor: PROGRAM IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, P5, P5U, PrincOpsUtils, SymbolOps, TreeOps EXPORTS CodeDefs, P5 = BEGIN OPEN CodeDefs, SymbolOps; <> WordSize: CARDINAL = CodeDefs.WordSize; charlength: CARDINAL = Basics.bitsPerChar; ArraySEIndex: TYPE = Symbols.ArraySEIndex; BitAddress: TYPE = Symbols.BitAddress; BitCount: TYPE = Symbols.BitCount; ContextLevel: TYPE = Symbols.ContextLevel; CSEIndex: TYPE = Symbols.CSEIndex; CTXIndex: TYPE = Symbols.CTXIndex; ISEIndex: TYPE = Symbols.ISEIndex; ISENull: ISEIndex = Symbols.ISENull; lZ: ContextLevel = Symbols.lZ; lG: ContextLevel = Symbols.lG; RecordSEIndex: TYPE = Symbols.RecordSEIndex; SEIndex: TYPE = Symbols.SEIndex; typeANY: CSEIndex = Symbols.typeANY; -- don't-care type for ConsAssign tb: Tree.Base; -- tree base (local copy) seb: Symbols.Base; -- semantic entry base (local copy) cb: CodeDefs.Base; -- code base (local copy) stb: Literals.Base; -- string base (local copy) ConstructorNotify: PUBLIC Alloc.Notifier = BEGIN -- called by allocator whenever table area is repacked seb _ base[Symbols.seType]; stb _ base[Literals.stType]; tb _ base[Tree.treeType]; cb _ base[codeType]; END; <> ConstructionError: SIGNAL = CODE; cd: PUBLIC ConsDestination; SetConsDest: PROC [t: Tree.Link, cl: CodeList] = BEGIN n: Node; tv: Var; cd.cl _ cl; WITH tt: t SELECT FROM symbol => { ctx: CTXIndex _ seb[tt.index].idCtx; level: ContextLevel _ SymbolOps.CtxLevel[ctx]; SELECT level FROM lG, CPtr.curctxlvl => { cd.destNode _ P5.Exp[t]; RETURN}; ENDCASE => NULL; }; ENDCASE => NULL; n _ P5.Exp[t]; tv _ P5U.MakeTemp[cl: cl, bits: PtrSize, init: P5U.ApplyOp[oper: P5U.MesaOpNode[addr], args: P5U.MakeNodeList[n], bits: PtrSize]].var; cd.destNode _ P5U.Deref[tv, n.bits]; END; CountedAssign: PROC [type: CSEIndex, const: BOOL] RETURNS [BOOL] = INLINE BEGIN RETURN [cd.options.counted AND RCType[type]#none AND ~(const AND cd.options.init)] END; AssureSize: PROC [n: Node, size: IntCodeDefs.Count] RETURNS [Node] = { SELECT size FROM > n.bits => RETURN[P5U.ZeroExtend[n: n, to: size]]; < n.bits => RETURN[P5U.TakeField[n: n, vl: [disp: 0, size: size]]]; ENDCASE => RETURN[n]}; ConsAssign: PROC [type: CSEIndex, offset: VLoc, n: Node] = BEGIN field: Var _ P5U.TakeField[n: cd.destNode, vl: offset]; P5U.DoAssign[cl: cd.cl, lhs: field, rhs: AssureSize[n, offset.size]]; END; VanillaCons: PROC [t: Tree.Link] RETURNS [vanilla: BOOL _ TRUE] = BEGIN CheckItem: Tree.Scan = BEGIN SELECT TreeOps.OpName[t] FROM rowcons, construct, all, union => vanilla _ FALSE; cast, pad => CheckItem[TreeOps.NthSon[t, 1]]; ENDCASE => NULL; END; TreeOps.ScanList[t, CheckItem]; RETURN END; <
> MainConstruct: PROC [ maint: Tree.Link, rSei: CSEIndex, fa: PROC [ISEIndex] RETURNS [BitAddress, CARDINAL], total: VLoc, fieldSei: ISEIndex _ ISENull] = BEGIN -- workhorse subroutine for construction in memory tOffset: VLoc = total; totalBits: CARDINAL = total.size; rcSei: RecordSEIndex; AssignField: PROC [root: Tree.Link] = BEGIN offset: VLoc; rep: BitAddress; res: BitCount; fieldType: CSEIndex = UnderType[seb[fieldSei].idType]; IF root # Tree.Null THEN BEGIN [rep, res] _ fa[fieldSei]; offset _ P5U.TakeVField[vl: tOffset, disp: P5U.Bits[rep], size: res]; IF fa # FnField AND totalBits <= WordSize THEN offset _ P5U.AdjustLoc[vl: offset, rSei: rcSei, fSei: fieldSei, tBits: totalBits]; DO -- until we get to something interesting SELECT TreeOps.OpName[root] FROM pad => BEGIN root _ TreeOps.NthSon[root, 1]; offset.size _ P5U.WordsForOperand[root]*WordSize; END; cast => root _ TreeOps.NthSon[root, 1]; ENDCASE => EXIT; ENDLOOP; SELECT TreeOps.OpName[root] FROM construct => MainConstruct[TreeOps.NthSon[root, 2], P5U.OperandType[root], RecField, offset]; union => UnionConstruct[TreeOps.GetNode[root], rcSei, tOffset]; rowcons => Row[TreeOps.GetNode[root], offset]; all => [] _ AllConstruct[TreeOps.GetNode[root], offset]; ENDCASE => {ConsAssign[fieldType, offset, P5.Exp[root]]}; END; -- IF root # Tree.Null fieldSei _ P5U.NextVar[NextSe[fieldSei]]; END; -- of AssignField IF fieldSei = ISENull THEN WITH seb[rSei] SELECT FROM record => BEGIN rcSei _ RecordRoot[LOOPHOLE[rSei]]; fieldSei _ P5U.NextVar[FirstCtxSe[seb[rcSei].fieldCtx]]; END; ENDCASE => P5.P5Error[589] ELSE rcSei _ LOOPHOLE[rSei]; TreeOps.ScanList[maint, AssignField]; END; -- of MainConstruct Row: PROC [node: Tree.Index, total: VLoc] = BEGIN -- handles ARRAY construction aSei: ArraySEIndex = LOOPHOLE[SymbolOps.UnderType[tb[node].info]]; offset: VLoc _ total; eSize: BitCount; cSei: CSEIndex = UnderType[seb[aSei].componentType]; AssignElement: PROC [t: Tree.Link] = BEGIN DO -- until we get to something interesting SELECT TreeOps.OpName[t] FROM pad => BEGIN t _ TreeOps.NthSon[t, 1]; offset.size _ P5U.WordsForOperand[t]*WordSize; END; cast => t _ TreeOps.NthSon[t, 1]; ENDCASE => EXIT; ENDLOOP; SELECT TreeOps.OpName[t] FROM rowcons => Row[TreeOps.GetNode[t], offset]; construct => MainConstruct[TreeOps.NthSon[t, 2], P5U.OperandType[t], RecField, offset]; all => -- convert this later [] _ AllConstruct[TreeOps.GetNode[t], offset]; ENDCASE => IF t # Tree.Null THEN ConsAssign[cSei, offset, P5.Exp[t]]; offset _ P5U.TakeVField[vl: offset, disp: eSize, size: eSize]; END; -- of AssignElement totalBits: BitCount = total.size; grain: BitCount = BitsPerElement[seb[aSei].componentType, seb[aSei].packed]; packed: BOOL; fillBits: CARDINAL; IF seb[aSei].typeTag # array THEN P5.P5Error[580]; IF grain >= WordSize THEN BEGIN packed _ FALSE; fillBits _ 0; eSize _ BitsForType[seb[aSei].componentType]; END ELSE BEGIN packed _ TRUE; fillBits _ totalBits - Cardinality[UnderType[seb[aSei].indexType]]*grain; eSize _ grain; END; IF fillBits # 0 AND totalBits <= WordSize THEN BEGIN offset.size _ eSize + fillBits; fillBits _ 0; END ELSE offset.size _ eSize; TreeOps.ScanList[tb[node].son[2], AssignElement]; IF fillBits # 0 THEN BEGIN offset.size _ fillBits; ConsAssign[typeANY, offset, CPtr.nC0]; END; END; UnionConstruct: PROC [node: Tree.Index, rootSei: RecordSEIndex, total: VLoc] = BEGIN -- construct a union part, total is offset of beginning of record tOffset: VLoc = total; offset: VLoc _ total; fieldSei: ISEIndex; vCtx: CTXIndex; uSei: CSEIndex = SymbolOps.UnderType[tb[node].info]; rcSei: RecordSEIndex; tSei: ISEIndex; tagged: BOOL; tagValue: CARDINAL; tBits: CARDINAL = tOffset.size; WITH u: seb[uSei] SELECT FROM union => BEGIN tagged _ u.controlled; IF tagged THEN BEGIN tagAddr: BitAddress = seb[u.tagSei].idValue; tagSize: BitCount = LONG[LOOPHOLE[seb[u.tagSei].idInfo, CARDINAL]]; offset _ P5U.TakeVField[vl: offset, disp: P5U.Bits[tagAddr], size: tagSize]; IF tBits <= WordSize THEN offset _ P5U.AdjustLoc[vl: offset, rSei: rootSei, fSei: u.tagSei, tBits: tBits]; END; END; ENDCASE => ERROR; tSei _ TreeOps.GetSe[tb[node].son[1]]; tagValue _ seb[tSei].idValue; rcSei _ LOOPHOLE[UnderType[tSei], RecordSEIndex]; vCtx _ seb[rcSei].fieldCtx; fieldSei _ P5U.NextVar[FirstCtxSe[vCtx]]; IF tagged THEN BEGIN IF fieldSei # ISENull AND seb[fieldSei].idCtx # vCtx THEN BEGIN -- a dummy fill field fillSize: CARDINAL = seb[fieldSei].idInfo; tagValue _ PrincOpsUtils.BITSHIFT[tagValue, fillSize]; offset.size _ offset.size + fillSize; fieldSei _ P5U.NextVar[NextSe[fieldSei]]; END; ConsAssign[typeANY, offset, P5U.MakeNodeLiteral[tagValue]]; END ELSE IF fieldSei # ISENull AND seb[fieldSei].idCtx # vCtx THEN BEGIN -- no tag, but a fill field anyway fillSize: [0..WordSize) = seb[fieldSei].idInfo; fillAddr: BitAddress = seb[fieldSei].idValue; -- can't be full word offset _ P5U.TakeVField[ vl: offset, disp: P5U.Bits[fillAddr], size: fillSize]; IF tBits <= WordSize THEN offset _ P5U.AdjustLoc[vl: offset, rSei: rootSei, fSei: fieldSei, tBits: tBits]; ConsAssign[typeANY, offset, CPtr.nC0]; fieldSei _ P5U.NextVar[NextSe[fieldSei]]; END; IF fieldSei # ISENull THEN MainConstruct[tb[node].son[2], rootSei, RecField, total, fieldSei]; END; AllConstruct: PROC [node: Tree.Index, total: VLoc] = BEGIN aSei: ArraySEIndex = LOOPHOLE[SymbolOps.UnderType[tb[node].info]]; tOffset: VLoc = total; offset: VLoc; val: Node; csei: CSEIndex = UnderType[seb[aSei].componentType]; eSize: BitCount; t1: Tree.Link _ tb[node].son[1]; totalBits: BitCount = tOffset.size; aBits: BitCount; grain: BitCount = BitsPerElement[seb[aSei].componentType, seb[aSei].packed]; packed: BOOL; fillBits, eCount: CARDINAL; IF grain >= WordSize THEN BEGIN packed _ FALSE; fillBits _ 0; eSize _ BitsForType[seb[aSei].componentType]; aBits _ totalBits; END ELSE BEGIN packed _ TRUE; eCount _ Cardinality[UnderType[seb[aSei].indexType]]; aBits _ eCount*CARDINAL[grain]; fillBits _ totalBits - aBits; eSize _ grain; END; offset _ P5U.TakeVField[vl: tOffset, disp: 0, size: aBits]; IF fillBits # 0 AND totalBits <= WordSize THEN BEGIN offset.size _ eSize + fillBits; fillBits _ 0; END; val _ AssureSize[P5.Exp[t1], grain]; ConsAssign[aSei, offset, z.NEW [NodeRep.all _ [bits: aBits, details: all[count: P5U.MakeNodeLiteral[eCount], value: val]]]]; IF fillBits # 0 THEN { offset _ P5U.TakeVField[vl: offset, disp: aBits, size: fillBits]; ConsAssign[typeANY, offset, CPtr.nC0]}; RETURN END; <> All: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [l: Node] = BEGIN -- generate code for constructor expression aSei: Symbols.ArraySEIndex = LOOPHOLE[SymbolOps.UnderType[tb[node].info]]; cl: CodeList _ P5U.NewCodeList[]; aBits: BitCount = BitsForType[aSei]; saveCd: ConsDestination = cd; IF t = Tree.Null THEN { var: Var; sei: ISEIndex; [var: var, sei: sei] _ P5U.MakeTemp[cl: cl, bits: aBits]; t _ [symbol[sei]]; options.init _ TRUE; options.expr _ TRUE}; cd _ [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults tb[node].son[1] _ P5U.ProcessSafens[cl, tb[node].son[1], cd.ignoreSafen]; SetConsDest[t, cl]; AllConstruct[node, [disp: 0, size: cd.destNode.bits]]; IF options.expr THEN P5U.MoreCode[cl, cd.destNode]; l _ P5U.MakeBlock[cl]; IF options.expr THEN l.bits _ aBits; cd _ saveCd; END; Construct: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [l: Node] = BEGIN -- generate code for constructor expression tsei: RecordSEIndex = LOOPHOLE[SymbolOps.UnderType[tb[node].info]]; cl: CodeList _ P5U.NewCodeList[]; nbits: BitCount = BitsForType[tsei]; saveCd: ConsDestination = cd; IF t = Tree.Null THEN { var: Var; sei: ISEIndex; [var: var, sei: sei] _ P5U.MakeTemp[cl: cl, bits: nbits]; t _ [symbol[sei]]; options.init _ TRUE; options.expr _ TRUE}; cd _ [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults tb[node].son[2] _ P5U.ProcessSafens[cl, tb[node].son[2], cd.ignoreSafen]; SetConsDest[t, cl]; MainConstruct[ tb[node].son[2], tsei, IF seb[tsei].argument THEN FnField ELSE RecField, [disp: 0, size: cd.destNode.bits]]; IF options.expr THEN P5U.MoreCode[cl, cd.destNode]; l _ P5U.MakeBlock[cl]; IF options.expr THEN l.bits _ cd.destNode.bits; cd _ saveCd; END; ListCons: PUBLIC PROC[node: Tree.Index] RETURNS[Node _ NIL] = { <> <> <> <> <> <> <> <> <> <> < 1 THEN P5.GenTempLex[pLength] ELSE NullLex);>> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<[] _ SetConsDest[r, FALSE];>> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> }; <<>> RowCons: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [l: Node] = BEGIN -- array (expression) construction aSei: Symbols.ArraySEIndex = LOOPHOLE[SymbolOps.UnderType[tb[node].info]]; cl: CodeList _ P5U.NewCodeList[]; aBits: BitCount = BitsForType[aSei]; saveCd: ConsDestination = cd; IF t = Tree.Null THEN { var: Var; sei: ISEIndex; [var: var, sei: sei] _ P5U.MakeTemp[cl: cl, bits: aBits]; t _ [symbol[sei]]; options.init _ TRUE; options.expr _ TRUE}; cd _ [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults tb[node].son[1] _ P5U.ProcessSafens[cl, tb[node].son[1], cd.ignoreSafen]; SetConsDest[t, cl]; Row[node, [disp: 0, size: cd.destNode.bits]]; IF options.expr THEN P5U.MoreCode[cl, cd.destNode]; l _ P5U.MakeBlock[cl]; IF options.expr THEN l.bits _ aBits; cd _ saveCd; END; VariantConstruct: PUBLIC PROC [t1, t2: Tree.Link, options: StoreOptions] RETURNS [l: Node] = BEGIN -- array (expression) construction rootSei: RecordSEIndex; cl: CodeList _ P5U.NewCodeList[]; saveCd: ConsDestination = cd; offset: VLoc; t1 _ TreeOps.NthSon[t1, 1]; SetConsDest[t1, cl]; cd _ [options: options, ignoreSafen: t1.tag = symbol]; -- + many defaults t2 _ P5U.ProcessSafens[cl, t2, cd.ignoreSafen]; rootSei _ RecordRoot[LOOPHOLE[P5U.OperandType[t1]]]; offset _ [disp: 0, size: cd.destNode.bits]; UnionConstruct[TreeOps.GetNode[t2], rootSei, offset]; l _ P5U.MakeBlock[cl]; cd _ saveCd; END; New: PUBLIC PROC [node: Tree.Index] RETURNS [Node _ NIL] = BEGIN <> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <>> <> <> <> <> < ERROR;>> <> <> <> <> <> <> <> <> <= wordlength THEN>> <> <> <> < P5U.PushLitVal[nw + n*s.d1];>> <>> <> <> <> <> <> <> <> <> <> <> < P5U.PushLitVal[nw + ((s.d1+(n-1))/n)];>> <>> <> <> <> < -1, 4 => -2, 8 => -3, ENDCASE => -4];>> <> <> <> <> <> <> <> <<>> <> <> <<>> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <<[] _ SetConsDest[ptrVar];>> <> <> <> <> < ConsAssign[typeANY, @o, Tree.Null, [bdo[P5L.OVarItem[seqLength]]]];>> < ERROR;>> <> <> <> <> <> <> <> <>> <> <> < Row[TreeOps.GetNode[initTree], @offset];>> < [] _ AllConstruct[TreeOps.GetNode[initTree], @offset];>> < ConstantFill[type, @offset, initTree];>> < {ConstructCountDown[]; ConsAssign[type, @offset, initTree]};>> <> <> <<[] _ LoadPointer[0];>> <> <> <> END; <<>> END.