<> <> <> <> <> <> DIRECTORY Alloc USING [Notifier], Basics USING [bitsPerChar, bitsPerWord], Code USING [CodeNotImplemented, curctxlvl], CodeDefs USING [Base, BoVarIndex, Byte, codeType, ConsDestination, Lexeme, LabelCCIndex, MaxParmsInStack, NullLex, StoreOptions, TempStateRecord, VarComponent, VarIndex, VarNull], ComData USING [switches, tC0], Counting USING [Allocate, FillCounted, LoadSystemZone, VarVarAssignCounted], FOpCodes USING [qADD, qALLOC, qBLT, qBLTL, qBLZL, qDSUB, qDUP, qGADRB, qLADRB, qLCO, qLI, qLP, qMUL, qOR, qPUSH, qSUB, qSHIFT, qWS, qWSD, qWSF], LiteralOps USING [MasterString], Literals USING [Base, MSTIndex, stType], P5 USING [ConstructOnStack, Exp, GenTempLex, MoveToCodeWord, MultiZero, P5Error, PopTempState, PushRhs, PushTempState, SAssign, StoreMod, SysCall, WriteCodeWord, ZoneOp], P5L USING [AdjustComponent, ComponentForLex, ComponentForSE, CopyToTemp, CopyVarItem, EasilyLoadable, FieldOfComponent, GenAdd, GenVarItem, LoadAddress, LoadComponent, LoadVar, MakeBo, ModComponent, OVarItem, ReleaseVarItem, ReusableCopies, TOSAddrLex, TOSLex, VarForLex, VarVarAssign, Words], P5U USING [ComputeFrameSize, InsertLabel, MakeTreeLiteral, NextVar, NilTree, LabelAlloc, OperandType, Out0, Out1, Out2, OutJump, PushLitVal, RecordConstant, TreeLiteral, TreeLiteralValue, TypeForTree, WordAligned, WordsForOperand], PrincOps USING [AllocationVectorSize, FieldDescriptor, sStringInit], PrincOpsUtils USING [BITOR, BITSHIFT], Stack USING [Also, Decr, Dump, Forget, Incr, Mark, Pop, TempStore, Top], Symbols USING [Base, ArraySEIndex, BitAddress, BitCount, ContextLevel, CSEIndex, CTXIndex, ISEIndex, ISENull, lG, lZ, RecordSEIndex, SEIndex, seType, typeANY], SymbolOps USING [BitsPerElement, Cardinality, FirstCtxSe, FnField, NextSe, RCType, RecField, RecordRoot, ReferentType, UnderType, VariantField, WordsForType], Tree USING [Base, Index, Link, Map, NodeName, Null, Scan, treeType], TreeOps USING [FreeNode, FreeTree, GetNode, GetSe, ListLength, MakeList, NthSon, OpName, PushTree, ReverseUpdateList, ScanList, UpdateList]; Constructor: PROGRAM IMPORTS MPtr: ComData, CPtr: Code, Counting, LiteralOps, P5, P5L, P5U, PrincOpsUtils, Stack, SymbolOps, TreeOps EXPORTS CodeDefs, P5 = BEGIN OPEN CodeDefs, SymbolOps; <> wordlength: CARDINAL = Basics.bitsPerWord; 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; <> OffsetRef: TYPE = POINTER TO READONLY VarComponent.frame; ConstructionError: SIGNAL = CODE; cd: PUBLIC ConsDestination; SetConsDest: PROC [r: VarIndex, exp: BOOL _ FALSE] RETURNS [rVal: VarIndex _ VarNull] = BEGIN bor: BoVarIndex; base: VarComponent; WITH cb[r] SELECT FROM o => WITH vv: var SELECT FROM frame => IF vv.level = lG OR vv.level = CPtr.curctxlvl THEN BEGIN cd.bd _ vv.bd; cd.fOffset _ vv.wd; cd.fLevel _ vv.level; cd.inFrame _ TRUE; cd.pLength _ 1; -- in case loaded cd.wSize _ vv.wSize; cd.bSize _ vv.bSize; IF exp THEN rVal _ r ELSE P5L.ReleaseVarItem[r]; RETURN END; frameup, linkup => NULL; ENDCASE => ERROR; bo, bdo, ind => NULL; ENDCASE => ERROR; bor _ P5L.MakeBo[r]; IF bor = VarNull THEN SIGNAL ConstructionError; -- should be caught above IF exp THEN BEGIN r1: VarIndex; [first: r1, next: rVal] _ P5L.ReusableCopies[bor, store, FALSE]; bor _ P5L.MakeBo[r1]; END; BEGIN offset: VarComponent = cb[bor].offset; WITH vv: offset SELECT FROM frame => BEGIN cd.bd _ vv.bd; cd.pDelta _ -INTEGER[vv.wd]; cd.wSize _ vv.wSize; cd.bSize _ vv.bSize; END; ENDCASE => ERROR; base _ cb[bor].base; P5L.ReleaseVarItem[bor]; -- we're finished with it now WITH vv: base SELECT FROM frame => BEGIN IF vv.bSize # 0 OR ~(vv.level = lG OR vv.level = CPtr.curctxlvl) THEN GO TO loadIt; cd.pLevel _ vv.level; cd.pOffset _ vv.wd; cd.pLength _ vv.wSize; END; link => {cd.pLink _ TRUE; cd.pOffset _ vv.wd}; ENDCASE => GO TO loadIt; EXITS loadIt => BEGIN wS: CARDINAL = P5L.Words[base.wSize, base.bSize]; P5L.LoadComponent[base]; cd.pSti _ Stack.Top[wS]; Stack.Also[n: wS, inLink: FALSE, tLevel: lZ, tOffset: 0]; --forget cd.pLoaded _ TRUE; cd.pLength _ wS; END; END; 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; GetPointer: PROC [owd: CARDINAL] RETURNS [aVar: VarComponent, newOwd: CARDINAL] = BEGIN -- exit invariant: cd.pLoaded => newOwd + cd.pDelta = owd SELECT TRUE FROM cd.pLoaded => IF cd.inFrame AND INTEGER[owd] < cd.pDelta AND (cd.fOffset+owd) IN Byte THEN BEGIN PopPointer[]; cd.pLink _ FALSE; cd.pLevel _ lZ; cd.pDelta _ owd; newOwd _ 0; aVar _ [wSize: 1, space: faddr[wd: cd.fOffset+owd, level: cd.fLevel]]; END ELSE aVar _ [wSize: cd.pLength, space: stack[sti: cd.pSti]]; cd.inFrame => BEGIN aVar _ [wSize: 1, space: faddr[wd: cd.fOffset+owd, level: cd.fLevel]]; cd.pLength _ 1; cd.pDelta _ owd; -- to be right if loaded newOwd _ 0; cd.pLevel _ lZ; --forget copy of old pointer in frame (can do better some day) RETURN END; cd.pLink => aVar _ [wSize: 1, space: link[wd: cd.pOffset]]; cd.pLevel # lZ => aVar _ [wSize: cd.pLength, space: frame[wd: cd.pOffset, level: cd.pLevel, immutable: TRUE]]; ENDCASE => ERROR; IF INTEGER[owd] IN [cd.pDelta .. cd.pDelta + Byte.LAST] THEN newOwd _ CARDINAL[INTEGER[owd] - cd.pDelta] ELSE BEGIN P5L.LoadComponent[aVar]; IF INTEGER[owd] > cd.pDelta THEN P5L.GenAdd[INTEGER[owd] - cd.pDelta, cd.pLength # 1] ELSE BEGIN P5U.Out1[FOpCodes.qLI, CARDINAL[cd.pDelta] - owd]; IF cd.pLength # 1 THEN {P5U.Out1[FOpCodes.qLI, 0]; P5U.Out0[FOpCodes.qDSUB]} ELSE P5U.Out0[FOpCodes.qSUB]; END; cd.pDelta _ owd; cd.pSti _ Stack.Top[cd.pLength]; newOwd _ 0; cd.pLink _ FALSE; cd.pLevel _ lZ; aVar _ [wSize: cd.pLength, space: stack[sti: cd.pSti]]; cd.pLoaded _ TRUE; END; END; LoadPointer: PROC [owd: CARDINAL] RETURNS [newOwd: CARDINAL] = BEGIN aVar: VarComponent; [aVar, newOwd] _ GetPointer[owd]; P5L.LoadComponent[aVar]; cd.pSti _ Stack.Top[cd.pLength]; cd.pLoaded _ TRUE; END; DumpPointer: PROC = BEGIN IF cd.pLoaded THEN BEGIN IF cd.pLink OR cd.pLevel # lZ THEN PopPointer[] ELSE BEGIN aVar: VarComponent = Stack.TempStore[cd.pLength]; WITH aVar SELECT FROM frame => {cd.pLevel _ level; cd.pOffset _ wd}; link => {cd.pLink _ TRUE; cd.pOffset _ wd}; ENDCASE => ERROR; END; cd.pLoaded _ FALSE; END; END; PopPointer: PROC = BEGIN IF cd.pLoaded THEN Stack.Pop[cd.pLength]; cd.pLoaded _ FALSE; END; ConsAssign: PROC [type: CSEIndex, atO: OffsetRef, t: Tree.Link, l: Lexeme _ NullLex] = BEGIN dest: VarIndex; source: VarIndex; offset: VarComponent.frame _ atO^; counted: BOOL = CountedAssign[type, P5U.TreeLiteral[t]]; useFrame: BOOL = cd.inFrame AND offset.wSize IN [1..2] AND offset.bSize = 0 AND (cd.fOffset+offset.wd) IN Byte; useSwapped: BOOL = ~useFrame AND cd.pLength = 1 AND ~counted AND (offset.wSize = 0 OR (offset.bSize = 0 AND offset.wSize IN [1..2])); offset.bd _ offset.bd + cd.bd; IF cd.pLoaded THEN SELECT TRUE FROM useFrame => PopPointer[]; ~useSwapped => DumpPointer[]; ENDCASE; IF useSwapped THEN offset.wd _ LoadPointer[offset.wd]; source _ P5L.VarForLex[IF l # NullLex THEN l ELSE P5.Exp[IF offset.wSize = 0 AND TreeOps.OpName[t] = mod THEN P5.StoreMod[t, offset.bSize] ELSE t]]; IF useSwapped THEN BEGIN base: VarComponent; P5L.LoadVar[source]; WITH cb[cd.pSti] SELECT FROM onStack => BEGIN WSOp: ARRAY [1..2] OF Byte = [FOpCodes.qWS, FOpCodes.qWSD]; IF offset.bSize = 0 THEN P5U.Out1[WSOp[offset.wSize], offset.wd] ELSE P5U.Out2[FOpCodes.qWSF, offset.wd, LOOPHOLE[PrincOps.FieldDescriptor[ offset: 0, posn: offset.bd, size: offset.bSize]]]; IF cd.remaining # 0 THEN BEGIN P5U.Out0[FOpCodes.qPUSH]; cd.pSti _ Stack.Top[]; Stack.Also[n: 1, inLink: cd.pLink, tOffset: cd.pOffset, tLevel: cd.pLevel]; END ELSE cd.pLoaded _ FALSE; RETURN END; inTemp => BEGIN cd.pLevel _ tLevel; cd.pOffset _ tOffset; base _ [wSize: 1, space: frame[wd: tOffset, level: tLevel, immutable: TRUE]]; END; inLink => BEGIN cd.pLink _ TRUE; cd.pOffset _ link; base _ [wSize: 1, space: link[wd: link]]; END; ENDCASE => ERROR; <> Stack.Forget[cd.pSti]; cd.pLoaded _ FALSE; source _ P5L.VarForLex[P5L.TOSLex[P5L.Words[offset.wSize, offset.bSize]]]; dest _ P5L.GenVarItem[bo]; cb[dest] _ [body: bo[base: base, offset: offset]]; END ELSE IF useFrame THEN BEGIN offset.wd _ offset.wd + cd.fOffset; offset.level _ cd.fLevel; dest _ P5L.OVarItem[offset]; END ELSE BEGIN base: VarComponent; [base, offset.wd] _ GetPointer[offset.wd]; IF cd.remaining # 0 THEN WITH base SELECT FROM stack => IF ~cd.inFrame THEN BEGIN -- this is our only copy, save it away base _ Stack.TempStore[cd.pLength]; WITH base SELECT FROM frame => {cd.pLevel _ level; cd.pOffset _ wd}; link => {cd.pLink _ TRUE; cd.pOffset _ wd}; ENDCASE => ERROR; cd.pLoaded _ FALSE; END; ENDCASE; dest _ P5L.GenVarItem[bo]; cb[dest] _ [body: bo[base: base, offset: offset]]; END; IF counted THEN BEGIN subOptions: StoreOptions _ cd.options; subOptions.composite _ (RCType[type] = composite); [] _ Counting.VarVarAssignCounted[ to: dest, from: source, options: subOptions, type: type]; END ELSE [] _ P5L.VarVarAssign[to: dest, from: source, isexp: FALSE]; cd.pLoaded _ FALSE; 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; CountDups: Tree.Map = BEGIN v _ t; -- normal case (see safen) IF t # Tree.Null THEN WITH t SELECT FROM subtree => BEGIN node: Tree.Index = index; SELECT tb[node].name FROM rowcons, construct => IF tb[node].name = rowcons AND tb[node].attr1 THEN cd.remaining _ cd.remaining+1 ELSE tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups]; all => BEGIN aSei: Symbols.ArraySEIndex = LOOPHOLE[UnderType[tb[node].info]]; IF BitsPerElement[seb[aSei].componentType, seb[aSei].packed] < wordlength AND tb[node].son[1] # Tree.Null THEN cd.remaining _ cd.remaining+1 ELSE tb[node].son[1] _ CountDups[tb[node].son[1]]; END; union => BEGIN IF tb[node].attr2 THEN cd.remaining _ cd.remaining+1; tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups]; END; cast, pad => tb[node].son[1] _ CountDups[tb[node].son[1]]; safen => IF cd.ignoreSafen AND (cd.options.init OR ~tb[node].attr1) THEN BEGIN v _ CountDups[tb[node].son[1]]; tb[node].son[1] _ Tree.Null; TreeOps.FreeNode[node]; END ELSE BEGIN r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]]; sei: ISEIndex = P5L.CopyToTemp[r].sei; seb[sei].idType _ tb[node].info; v _ [symbol[sei]]; cd.remaining _ cd.remaining+1; TreeOps.FreeNode[node]; END; ENDCASE => cd.remaining _ cd.remaining+1; END; ENDCASE => cd.remaining _ cd.remaining+1; RETURN END; ConstructCountDown: PROC = BEGIN IF cd.remaining = 0 THEN SIGNAL ConstructionError; cd.remaining _ cd.remaining - 1; END; ConstantFill: PROC [type: CSEIndex, atO: OffsetRef, t: Tree.Link] = BEGIN ConstructCountDown[]; SELECT TRUE FROM MPtr.switches['m] AND P5.MultiZero[t] AND cd.pLength = 2 AND ~CountedAssign[type, TRUE] => FillZeros[atO, P5L.Words[atO.wSize, atO.bSize]]; <> ENDCASE => ConsAssign[type, atO, t]; END; FillZeros: PROC [atO: OffsetRef, nwords: CARDINAL] = BEGIN base: VarComponent; offset: VarComponent.frame _ atO^; dest: VarIndex; IF cd.remaining # 0 AND ~(cd.pLength = 2 AND offset.wd = 0) THEN DumpPointer[]; [base, offset.wd] _ GetPointer[offset.wd]; dest _ P5L.GenVarItem[bo]; cb[dest] _ [body: bo[base: base, offset: offset]]; IF ~P5L.LoadAddress[dest] THEN P5U.Out0[FOpCodes.qLP]; P5U.PushLitVal[nwords]; P5U.Out0[FOpCodes.qBLZL]; IF cd.remaining # 0 AND (cd.pLength = 2 AND offset.wd = 0) THEN cd.pLoaded _ TRUE ELSE {Stack.Pop[2]; cd.pLoaded _ FALSE}; END; <
> MainConstruct: PROC [ maint: Tree.Link, rSei: CSEIndex, fa: PROC [ISEIndex] RETURNS [BitAddress, CARDINAL], atO: OffsetRef, fieldSei: ISEIndex _ ISENull] = BEGIN -- workhorse subroutine for construction in memory tOffset: VarComponent.frame = atO^; totalBits: CARDINAL = tOffset.wSize*wordlength + tOffset.bSize; rcSei: RecordSEIndex; AssignField: PROC [root: Tree.Link] = BEGIN offset: VarComponent.frame; rep: BitAddress; res: CARDINAL; fieldType: CSEIndex = UnderType[seb[fieldSei].idType]; IF root # Tree.Null THEN BEGIN [rep, res] _ fa[fieldSei]; offset _ tOffset; P5L.FieldOfComponent[var: @offset, wd: rep.wd, bd: rep.bd, wSize: res/wordlength, bSize: res MOD wordlength]; IF fa # FnField AND totalBits <= wordlength THEN P5L.AdjustComponent[ var: @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.wSize _ P5U.WordsForOperand[root]; offset.bSize _ 0; 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, atO]; rowcons => Row[TreeOps.GetNode[root], @offset]; all => [] _ AllConstruct[TreeOps.GetNode[root], @offset]; mwconst => ConstantFill[fieldType, @offset, root]; ENDCASE => {ConstructCountDown[]; ConsAssign[fieldType, @offset, 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, atO: OffsetRef] = BEGIN -- handles ARRAY construction aSei: ArraySEIndex = LOOPHOLE[UnderType[tb[node].info]]; IF seb[aSei].typeTag # array THEN P5.P5Error[580]; IF tb[node].attr1 THEN BEGIN -- row of string literals c: CARDINAL = P5.MoveToCodeWord[]; n: CARDINAL _ 0; localText, globalText: BOOL _ FALSE; TextItem: PROC [t: Tree.Link] = BEGIN WITH e:t SELECT FROM literal => WITH e.index SELECT FROM string => BEGIN msti: Literals.MSTIndex = LiteralOps.MasterString[sti]; IF stb[msti].local THEN localText _ TRUE ELSE globalText _ TRUE; P5.WriteCodeWord[stb[msti].info]; END; ENDCASE => P5.P5Error[577]; ENDCASE => P5.P5Error[578]; n _ n+1; END; TreeOps.ScanList[tb[node].son[2], TextItem]; ConstructCountDown[]; Stack.Dump[]; Stack.Mark[]; P5U.Out1[FOpCodes.qLCO, c]; P5U.PushLitVal[n]; P5U.RecordConstant[c, n]; IF localText AND globalText OR cd.remaining # 0 AND ~cd.inFrame THEN SIGNAL CPtr.CodeNotImplemented; P5U.Out1[IF localText THEN FOpCodes.qLADRB ELSE FOpCodes.qGADRB, 0]; [] _ LoadPointer[atO.wd]; IF cd.pLength # 1 THEN -- does a long pointer to array of short strings SIGNAL CPtr.CodeNotImplemented; -- make any sense? P5.SysCall[PrincOps.sStringInit]; cd.pLoaded _ FALSE; END ELSE BEGIN -- not all string literals offset: VarComponent.frame _ atO^; eWSize: CARDINAL; eBSize: [0..wordlength); 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.wSize _ P5U.WordsForOperand[t]; offset.bSize _ 0; 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]; mwconst => ConstantFill[cSei, @offset, t]; ENDCASE => IF t # Tree.Null THEN {ConstructCountDown[]; ConsAssign[cSei, @offset, t]}; P5L.ModComponent[var: @offset, wd: eWSize, bd: offset.bSize]; offset.wSize _ eWSize; offset.bSize _ eBSize; END; -- of AssignElement totalBits: BitCount = atO.wSize.LONG*wordlength + atO.bSize; grain: BitCount = BitsPerElement[seb[aSei].componentType, seb[aSei].packed]; packed: BOOL; fillBits: CARDINAL; IF grain >= wordlength THEN BEGIN packed _ FALSE; fillBits _ 0; eBSize _ 0; eWSize _ WordsForType[seb[aSei].componentType]; END ELSE BEGIN packed _ TRUE; fillBits _ totalBits - Cardinality[UnderType[seb[aSei].indexType]]*grain; IF fillBits # 0 AND totalBits > wordlength THEN cd.remaining _ cd.remaining+1; eWSize _ 0; eBSize _ grain; END; IF fillBits # 0 AND totalBits <= wordlength THEN BEGIN bs: CARDINAL = eBSize + fillBits; offset.wSize _ bs / wordlength; offset.bSize _ bs MOD wordlength; fillBits _ 0; END ELSE {offset.wSize _ eWSize; offset.bSize _ eBSize}; TreeOps.ScanList[tb[node].son[2], AssignElement]; IF fillBits # 0 THEN BEGIN offset.wSize _ 0; offset.bSize _ fillBits; ConstructCountDown[]; ConsAssign[typeANY, @offset, MPtr.tC0]; END; END; END; UnionConstruct: PROC [node: Tree.Index, rootSei: RecordSEIndex, atO: OffsetRef] = BEGIN -- construct a union part, atO^ is offset of beginning of record tOffset: VarComponent.frame = atO^; offset: VarComponent.frame _ atO^; fieldSei: ISEIndex; vCtx: CTXIndex; uSei: CSEIndex = UnderType[tb[node].info]; rcSei: RecordSEIndex; tSei: ISEIndex; tagged: BOOL; tagValue: CARDINAL; tBits: CARDINAL = tOffset.wSize*wordlength + tOffset.bSize; WITH u: seb[uSei] SELECT FROM union => BEGIN tagged _ u.controlled; IF tagged THEN BEGIN tagAddr: BitAddress = seb[u.tagSei].idValue; tagSize: [0..wordlength] = seb[u.tagSei].idInfo; P5L.FieldOfComponent[ var: @offset, wd: tagAddr.wd, bd: tagAddr.bd, wSize: tagSize/wordlength, bSize: tagSize MOD wordlength]; IF tBits <= wordlength THEN P5L.AdjustComponent[var: @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: [0..wordlength) = seb[fieldSei].idInfo; b: CARDINAL = offset.bSize + fillSize; tagValue _ PrincOpsUtils.BITSHIFT[tagValue, fillSize]; offset.bSize _ b MOD wordlength; offset.wSize _ b/wordlength; fieldSei _ P5U.NextVar[NextSe[fieldSei]]; END; ConstructCountDown[]; ConsAssign[typeANY, @offset, P5U.MakeTreeLiteral[tagValue]]; END ELSE IF fieldSei # ISENull AND seb[fieldSei].idCtx # vCtx THEN BEGIN -- no tag, but a fill field anyway fillSize: [0..wordlength) = seb[fieldSei].idInfo; fillAddr: BitAddress = seb[fieldSei].idValue; -- can't be full word P5L.FieldOfComponent[ var: @offset, wd: fillAddr.wd, bd: fillAddr.bd, bSize: fillSize]; IF tBits <= wordlength THEN P5L.AdjustComponent[var: @offset, rSei: rootSei, fSei: fieldSei, tBits: tBits]; ConsAssign[typeANY, @offset, MPtr.tC0]; fieldSei _ P5U.NextVar[NextSe[fieldSei]]; END; IF fieldSei # ISENull THEN MainConstruct[tb[node].son[2], rootSei, RecField, atO, fieldSei]; END; AllConstruct: PROC [node: Tree.Index, atO: OffsetRef, replCount: CARDINAL _ 1] RETURNS [wordsFilled: CARDINAL] = BEGIN -- reexamine when packed arrays of packed arrays aSei: ArraySEIndex = LOOPHOLE[UnderType[tb[node].info]]; tOffset: VarComponent.frame = atO^; offset: VarComponent.frame _ atO^; csei: CSEIndex = UnderType[seb[aSei].componentType]; eWSize: CARDINAL; eBSize: [0..wordlength); t1: Tree.Link _ tb[node].son[1]; totalBits: BitCount = tOffset.wSize.LONG*wordlength + tOffset.bSize; grain: BitCount = BitsPerElement[seb[aSei].componentType, seb[aSei].packed]; packed: BOOL; fillBits, eCount: CARDINAL; e2Offset: CARDINAL; wordsFilled _ P5L.Words[tOffset.wSize, tOffset.bSize]; IF grain >= wordlength THEN BEGIN packed _ FALSE; fillBits _ 0; eBSize _ 0; eWSize _ WordsForType[seb[aSei].componentType]; END ELSE BEGIN packed _ TRUE; eCount _ Cardinality[UnderType[seb[aSei].indexType]]; fillBits _ totalBits - eCount*CARDINAL[grain]; eWSize _ 0; eBSize _ grain; END; P5L.FieldOfComponent[var: @offset, wSize: eWSize, bSize: eBSize]; IF fillBits # 0 AND totalBits <= wordlength THEN BEGIN bs: CARDINAL = eBSize + fillBits; offset.wSize _ bs / wordlength; offset.bSize _ bs MOD wordlength; fillBits _ 0; END; IF fillBits = 0 THEN wordsFilled _ wordsFilled * replCount; IF t1 = Tree.Null THEN RETURN; DO -- until we get to something interesting SELECT TreeOps.OpName[t1] FROM pad => BEGIN t1 _ TreeOps.NthSon[t1, 1]; offset.wSize _ P5U.WordsForOperand[t1]; offset.bSize _ 0; END; cast => t1 _ TreeOps.NthSon[t1, 1]; ENDCASE => EXIT; ENDLOOP; IF MPtr.switches['m] AND (P5.MultiZero[t1, 1] AND wordsFilled > 1) AND ~CountedAssign[csei, TRUE] THEN BEGIN ConstructCountDown[]; IF fillBits # 0 THEN wordsFilled _ wordsFilled * replCount; FillZeros[atO, wordsFilled]; e2Offset _ wordsFilled; fillBits _ 0; END ELSE IF packed THEN BEGIN ePerWord: CARDINAL = wordlength/eBSize; fold: BOOL = P5U.TreeLiteral[t1]; v: WORD; IF fillBits # 0 THEN cd.remaining _ cd.remaining+1; IF cd.pLoaded THEN SELECT TRUE FROM (cd.pLength > 1) => DumpPointer[]; cd.inFrame => PopPointer[]; ENDCASE; SELECT TRUE FROM fold => v _ P5U.TreeLiteralValue[t1]; (eBSize = 1) => {v _ 1; P5.PushRhs[t1]}; ENDCASE => P5.PushRhs[t1]; THROUGH (0..MIN[ePerWord, eCount]) DO IF fold OR eBSize = 1 THEN v _ PrincOpsUtils.BITOR[PrincOpsUtils.BITSHIFT[v, eBSize], v] ELSE BEGIN P5U.Out0[FOpCodes.qDUP]; P5U.PushLitVal[eBSize]; P5U.Out0[FOpCodes.qSHIFT]; P5U.Out0[FOpCodes.qOR]; END; ENDLOOP; SELECT TRUE FROM fold => P5U.PushLitVal[v]; (eBSize = 1) => BEGIN tlabel: LabelCCIndex = P5U.LabelAlloc[]; elabel: LabelCCIndex = P5U.LabelAlloc[]; P5U.PushLitVal[0]; P5U.OutJump[JumpE, tlabel]; P5U.PushLitVal[v]; P5U.OutJump[Jump, elabel]; P5U.InsertLabel[tlabel]; Stack.Decr[1]; P5U.Out0[FOpCodes.qPUSH]; P5U.InsertLabel[elabel]; END; ENDCASE => NULL; IF totalBits < wordlength THEN P5L.FieldOfComponent[var: @offset, bSize: totalBits] ELSE {offset.wSize _ 1; offset.bSize _ 0}; ConsAssign[typeANY, @offset, Tree.Null, P5L.TOSLex[1]]; P5L.ModComponent[var: @offset, bd: IF eCount > ePerWord THEN wordlength ELSE offset.bSize]; IF wordsFilled <= 1 THEN -- all in one word case BEGIN ConstructCountDown[]; IF cd.remaining = 0 AND cd.pLoaded THEN PopPointer[]; END; e2Offset _ 1; END ELSE IF TreeOps.OpName[t1] = all THEN BEGIN -- ~packed, set all elements in recursive call eCount _ Cardinality[UnderType[seb[aSei].indexType]]; e2Offset _ AllConstruct[TreeOps.GetNode[t1], @offset, replCount*eCount]; < e2Offset => cd.remaining has been incremented>> END ELSE BEGIN -- ~packed IF wordsFilled > eWSize THEN cd.remaining _ cd.remaining + 1; -- so only pointer isn't lost SELECT TreeOps.OpName[t1] FROM -- set first element construct => MainConstruct[TreeOps.NthSon[t1, 2], P5U.OperandType[t1], RecField, @offset]; rowcons => Row[TreeOps.GetNode[t1], @offset]; ENDCASE => {ConstructCountDown[]; ConsAssign[csei, @offset, t1]}; e2Offset _ eWSize; END; IF wordsFilled > e2Offset THEN BEGIN bWords: CARDINAL = wordsFilled - e2Offset; IF ~CountedAssign[csei, P5U.TreeLiteral[t1]] THEN BEGIN BltOp: ARRAY [1..2] OF Byte = [FOpCodes.qBLT, FOpCodes.qBLTL]; owd: CARDINAL _ LoadPointer[tOffset.wd]; -- load address of first element IF ~(cd.inFrame OR cd.pLink OR cd.pLevel # lZ) THEN BEGIN -- we need to load at least twice, save in temp tvar: VarComponent = Stack.TempStore[cd.pLength]; P5L.LoadComponent[tvar]; -- load it back WITH vv: tvar SELECT FROM frame => {cd.pLevel _ vv.level; cd.pOffset _ vv.wd}; ENDCASE => ERROR; END; cd.pLoaded _ FALSE; -- cd.pSti was maybe invalid anyway IF owd # 0 THEN P5L.GenAdd[owd, cd.pLength # 1]; ConstructCountDown[]; P5U.Out1[FOpCodes.qLI, bWords]; owd _ LoadPointer[tOffset.wd + e2Offset]; -- load address of second IF (cd.remaining # 0 AND ~(cd.inFrame OR cd.pLink OR cd.pLevel # lZ)) THEN BEGIN -- still needed, save in temp tvar: VarComponent = Stack.TempStore[cd.pLength]; P5L.LoadComponent[tvar]; -- load it back WITH vv: tvar SELECT FROM frame => {cd.pLevel _ vv.level; cd.pOffset _ vv.wd}; ENDCASE => ERROR; END; cd.pLoaded _ FALSE; -- cd.pSti was maybe invalid anyway IF owd # 0 THEN P5L.GenAdd[owd, cd.pLength # 1]; P5U.Out0[BltOp[cd.pLength]]; END ELSE BEGIN aVar: VarComponent; r: VarIndex = P5L.GenVarItem[bo]; rr: VarIndex = P5L.GenVarItem[bo]; offset _ tOffset; offset.wSize _ e2Offset; offset.bSize _ 0; [aVar, offset.wd] _ GetPointer[offset.wd]; IF cd.pLoaded THEN BEGIN aVar _ Stack.TempStore[cd.pLength]; IF cd.remaining # 0 AND ~cd.inFrame THEN WITH aVar SELECT FROM frame => {cd.pLevel _ level; cd.pOffset _ wd}; link => {cd.pLink _ TRUE; cd.pOffset _ wd}; ENDCASE => ERROR; cd.pLoaded _ FALSE; END; ConstructCountDown[]; cb[r] _ [body: bo[base: aVar, offset: offset]]; P5L.ModComponent[@offset, e2Offset]; offset.wSize _ bWords; cb[rr] _ [body: bo[base: aVar, offset: offset]]; Counting.FillCounted[source: r, space: rr, type: csei, options: cd.options]; END; IF fillBits # 0 THEN BEGIN usedBits: CARDINAL = eCount*CARDINAL[grain]; offset _ tOffset; P5L.FieldOfComponent[var: @offset, wd: usedBits/wordlength, bd: usedBits MOD wordlength, bSize: fillBits]; IF replCount > 1 THEN cd.remaining _ cd.remaining + 1; -- caller replicates ConstructCountDown[]; ConsAssign[typeANY, @offset, MPtr.tC0]; END; END; RETURN END; <> All: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [Lexeme] = BEGIN r, rr: VarIndex; saveCd: ConsDestination = cd; offset: VarComponent.frame; aSei: Symbols.ArraySEIndex = LOOPHOLE[UnderType[tb[node].info]]; aWords: CARDINAL = WordsForType[aSei]; cd _ [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + defaults IF BitsPerElement[seb[aSei].componentType, seb[aSei].packed] < wordlength THEN cd.remaining _ 1 ELSE tb[node].son[1] _ CountDups[tb[node].son[1]]; r _ P5L.VarForLex[IF t = Tree.Null THEN P5.GenTempLex[aWords] ELSE P5.Exp[t]]; rr _ SetConsDest[r, options.expr]; offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]]; [] _ AllConstruct[node, @offset]; IF cd.remaining # 0 THEN SIGNAL ConstructionError; cd _ saveCd; RETURN [[bdo[rr]]] END; Construct: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [Lexeme] = BEGIN -- generate code for constructor expression tsei: RecordSEIndex = LOOPHOLE[UnderType[tb[node].info]]; nwords: CARDINAL = WordsForType[tsei]; maxStackWords: NAT = (IF options.expr THEN MaxParmsInStack ELSE 2); r, rr: VarIndex; saveCd: ConsDestination = cd; offset: VarComponent.frame; packedDest: VarIndex _ VarNull; IF (~options.expr OR t = Tree.Null) AND nwords <= maxStackWords AND P5U.WordAligned[tsei] AND VanillaCons[tb[node].son[2]] THEN BEGIN -- can build in stack P5.ConstructOnStack[tb[node].son[2], tsei]; IF ~options.expr THEN BEGIN rr _ P5L.VarForLex[P5L.TOSLex[nwords]]; RETURN [P5L.VarVarAssign[P5L.VarForLex[P5.Exp[t]], rr, FALSE]] END ELSE RETURN [P5L.TOSLex[nwords]] END; cd _ [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups]; IF cd.remaining # 0 OR options.expr THEN BEGIN r _ P5L.VarForLex[IF t = Tree.Null THEN P5.GenTempLex[nwords] ELSE P5.Exp[t]]; WITH cc: cb[r] SELECT FROM ind => WITH cc SELECT FROM packed => BEGIN var: VarComponent = P5L.ComponentForLex[P5.GenTempLex[1]]; packedDest _ r; r _ P5L.OVarItem[var]; END; ENDCASE; ENDCASE; rr _ SetConsDest[r, options.expr OR packedDest # VarNull]; offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]]; MainConstruct[ tb[node].son[2], tsei, IF seb[tsei].argument THEN FnField ELSE RecField, @offset]; END; IF cd.remaining # 0 THEN SIGNAL ConstructionError; IF packedDest # VarNull THEN -- not RC IF options.expr THEN [] _ P5L.VarVarAssign[packedDest, P5L.CopyVarItem[rr], FALSE] ELSE BEGIN [] _ P5L.VarVarAssign[packedDest, rr, FALSE]; rr _ VarNull END; cd _ saveCd; RETURN [[bdo[rr]]] END; ListCons: PUBLIC PROC[node: Tree.Index] RETURNS[Lexeme] = { pSei: CSEIndex = UnderType[tb[node].info]; rSei: CSEIndex = UnderType[SymbolOps.ReferentType[pSei]]; long: BOOL = tb[node].attr2; counted: BOOL = tb[node].attr3; pLength: CARDINAL = WordsForType[pSei]; zoneTree: Tree.Link; zoneVar: Lexeme.se; nwords: CARDINAL = WordsForType[rSei]; k: CARDINAL _ TreeOps.ListLength[tb[node].son[2]]; destVar: Lexeme.se _ P5.GenTempLex[pLength]; restVar: Lexeme.se _ (IF k > 1 THEN P5.GenTempLex[pLength] ELSE NullLex); rest: Tree.Link _ P5U.NilTree[pSei]; PushSize: PROC = {P5U.PushLitVal[nwords]}; ConsItem: Tree.Map = { r: VarIndex; saveCd: ConsDestination = cd; saveTempList: TempStateRecord = P5.PushTempState[]; list: Tree.Link; listNode: Tree.Index; offset: VarComponent.frame; cd _ [options: [init: TRUE, counted: counted], ignoreSafen: FALSE]; -- + many defaults TreeOps.PushTree[t]; TreeOps.PushTree[rest]; list _ TreeOps.UpdateList[TreeOps.MakeList[2], CountDups]; listNode _ NARROW[list, Tree.Link.subtree].index; IF counted THEN Counting.Allocate[zone: zoneTree, type: rSei, catch: Tree.Null, pushSize: NIL] ELSE { P5.ZoneOp[zone: zoneTree, index: 0, pushArg: PushSize, catch: Tree.Null, long: long]; Stack.Incr[pLength]}; P5.SAssign[destVar.lexsei]; offset _ [wSize: nwords, space: frame[wd: 0]]; r _ P5L.GenVarItem[bo]; cb[r] _ [body: bo[base: P5L.ComponentForLex[destVar], offset: offset]]; [] _ SetConsDest[r, FALSE]; MainConstruct[list, rSei, RecField, @offset]; IF (k _ k-1) # 0 THEN { sTemp: Lexeme.se = destVar; rest _ [symbol[destVar.lexsei]]; destVar _ restVar; restVar _ sTemp}; v _ tb[listNode].son[1]; tb[listNode].son[1] _ Tree.Null; [] _ TreeOps.FreeTree[list]; cd _ saveCd; P5.PopTempState[saveTempList]}; Stack.Dump[]; IF tb[node].son[1] = Tree.Null THEN { zoneVar _ P5.GenTempLex[pLength]; Counting.LoadSystemZone[]; P5.SAssign[zoneVar.lexsei]; zoneTree _ [symbol[zoneVar.lexsei]]} ELSE zoneTree _ tb[node].son[1]; tb[node].son[2] _ TreeOps.ReverseUpdateList[tb[node].son[2], ConsItem]; RETURN [destVar]}; RowCons: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] RETURNS [Lexeme] = BEGIN -- array (expression) construction r, rr: VarIndex; aSei: ArraySEIndex = LOOPHOLE[UnderType[tb[node].info]]; saveCd: ConsDestination = cd; offset: VarComponent.frame; cd _ [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults IF tb[node].attr1 THEN cd.remaining _ 1 ELSE tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups]; r _ P5L.VarForLex[IF t = Tree.Null THEN P5.GenTempLex[WordsForType[aSei]] ELSE P5.Exp[t]]; rr _ SetConsDest[r, options.expr]; offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]]; Row[node, @offset]; IF cd.remaining # 0 THEN SIGNAL ConstructionError; cd _ saveCd; RETURN [[bdo[rr]]] END; TransferConstruct: PUBLIC PROC [ nparms: CARDINAL, resident: BOOL, t: Tree.Link, tsei: CSEIndex] = BEGIN -- generate code for construct statement lex: Lexeme; saveCd: ConsDestination = cd; offset: VarComponent.frame; fs: CARDINAL _ P5U.ComputeFrameSize[nparms]; cd _ [ignoreSafen: FALSE]; -- + many defaults IF TreeOps.OpName[t] = safen THEN BEGIN -- CountDups would free t node: Tree.Index = TreeOps.GetNode[t]; r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]]; sei: ISEIndex = P5L.CopyToTemp[r].sei; seb[sei].idType _ tb[node].info; t _ [symbol[sei]]; END; t _ TreeOps.UpdateList[t, CountDups]; IF resident THEN fs _ fs + PrincOps.AllocationVectorSize; P5U.PushLitVal[fs]; P5U.Out0[FOpCodes.qALLOC]; cd.remaining _ cd.remaining + 1; IF cd.remaining # 1 THEN BEGIN lex _ P5L.TOSAddrLex[nparms]; [] _ SetConsDest[P5L.VarForLex[lex], FALSE]; offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]]; MainConstruct[t, tsei, FnField, @offset]; [] _ LoadPointer[0]; END; IF cd.remaining # 1 THEN SIGNAL ConstructionError; cd _ saveCd; END; VariantConstruct: PUBLIC PROC [t1, t2: Tree.Link, options: StoreOptions] = BEGIN r: VarIndex; saveCd: ConsDestination = cd; offset: VarComponent.frame; rootSei: RecordSEIndex; t1 _ TreeOps.NthSon[t1, 1]; cd _ [options: options, ignoreSafen: t1.tag = symbol]; -- + many defaults t2 _ TreeOps.UpdateList[t2, CountDups]; IF cd.remaining # 0 THEN BEGIN rootSei _ RecordRoot[LOOPHOLE[P5U.OperandType[t1]]]; r _ P5L.VarForLex[P5.Exp[t1]]; WITH cc: cb[r] SELECT FROM ind => WITH cc SELECT FROM packed => SIGNAL CPtr.CodeNotImplemented; ENDCASE; ENDCASE; [] _ SetConsDest[r, FALSE]; offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]]; UnionConstruct[TreeOps.GetNode[t2], rootSei, @offset]; END; IF cd.remaining # 0 THEN SIGNAL ConstructionError; cd _ saveCd; END; New: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] = BEGIN long: BOOL = tb[node].attr2; counted: BOOL = tb[node].attr3; pLength: CARDINAL = WordsForType[tb[node].info]; typeTree: Tree.Link = tb[node].son[2]; overType: SEIndex = P5U.TypeForTree[typeTree]; type: CSEIndex = UnderType[overType]; catchTree: Tree.Link = IF tb[node].nSons = 4 THEN tb[node].son[4] ELSE Tree.Null; tag: ISEIndex _ ISENull; seqLength: VarComponent; computedType: BOOL = (TreeOps.OpName[typeTree] = apply); sizePusher: PROC = IF computedType THEN PushNewSize ELSE NIL; PushNewSize: PROC = BEGIN nw: CARDINAL = WordsForType[type]; IF computedType THEN BEGIN subNode: Tree.Index = TreeOps.GetNode[typeTree]; vSei: ISEIndex = VariantField[type]; bitsPerItem, n: CARDINAL; IF vSei # ISENull THEN BEGIN vType: CSEIndex = UnderType[seb[vSei].idType]; WITH v: seb[vType] SELECT FROM sequence => BEGIN tag _ IF v.controlled THEN v.tagSei ELSE ISENull; bitsPerItem _ BitsPerElement[v.componentType, v.packed]; END; ENDCASE => ERROR; END ELSE BEGIN -- must be StringBody, fudge it tag _ NextSe[FirstCtxSe[seb[LOOPHOLE[type, RecordSEIndex]].fieldCtx]]; bitsPerItem _ charlength; END; seqLength _ P5L.ComponentForLex[P5.Exp[tb[subNode].son[2]]]; IF tag # ISENull THEN seqLength _ P5L.EasilyLoadable[seqLength, load]; IF bitsPerItem >= wordlength THEN BEGIN n _ bitsPerItem/wordlength; WITH s: seqLength SELECT FROM const => P5U.PushLitVal[nw + n*s.d1]; ENDCASE => BEGIN P5L.LoadComponent[seqLength]; IF n # 1 THEN {P5U.PushLitVal[n]; P5U.Out0[FOpCodes.qMUL]}; P5U.PushLitVal[nw]; P5U.Out0[FOpCodes.qADD]; END; END ELSE BEGIN n _ wordlength/bitsPerItem; WITH s: seqLength SELECT FROM const => P5U.PushLitVal[nw + ((s.d1+(n-1))/n)]; ENDCASE => BEGIN P5L.LoadComponent[seqLength]; P5U.PushLitVal[n-1]; P5U.Out0[FOpCodes.qADD]; P5U.PushLitVal[SELECT n FROM 2 => -1, 4 => -2, 8 => -3, ENDCASE => -4]; P5U.Out0[FOpCodes.qSHIFT]; P5U.PushLitVal[nw]; P5U.Out0[FOpCodes.qADD]; END; END; END ELSE P5U.PushLitVal[nw]; END; zoneTree: Tree.Link = tb[node].son[1]; initTree: Tree.Link; saveCd: ConsDestination = cd; cd _ [options: [init: TRUE, counted: counted], ignoreSafen: FALSE]; -- + defaults cd.remaining _ 1; tb[node].son[3] _ CountDups[tb[node].son[3]]; IF counted THEN Counting.Allocate[zone: zoneTree, type: overType, catch: catchTree, pushSize: sizePusher] ELSE BEGIN P5.ZoneOp[zone: zoneTree, index: 0, pushArg: PushNewSize, catch: catchTree, long: long]; Stack.Incr[pLength]; END; IF tag # ISENull OR tb[node].son[3] # Tree.Null THEN BEGIN ptrVar: VarIndex; ptrVar _ P5L.TOSAddrLex[size: WordsForType[type], long: long].lexbdoi; [] _ SetConsDest[ptrVar]; IF tag # ISENull THEN BEGIN offset: VarComponent _ P5L.ComponentForSE[tag]; WITH o: offset SELECT FROM frame => ConsAssign[typeANY, @o, Tree.Null, [bdo[P5L.OVarItem[seqLength]]]]; ENDCASE => ERROR; END; IF tb[node].son[3] # Tree.Null THEN BEGIN offset: VarComponent.frame _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]]; initTree _ tb[node].son[3]; DO SELECT TreeOps.OpName[initTree] FROM pad => BEGIN initTree _ TreeOps.NthSon[initTree, 1]; offset.wSize _ P5U.WordsForOperand[initTree]; offset.bSize _ 0; END; cast => initTree _ TreeOps.NthSon[initTree, 1]; ENDCASE => EXIT; ENDLOOP; SELECT TreeOps.OpName[initTree] FROM construct => MainConstruct[TreeOps.NthSon[initTree, 2], P5U.OperandType[initTree], RecField, @offset]; rowcons => Row[TreeOps.GetNode[initTree], @offset]; all => [] _ AllConstruct[TreeOps.GetNode[initTree], @offset]; mwconst => ConstantFill[type, @offset, initTree]; ENDCASE => {ConstructCountDown[]; ConsAssign[type, @offset, initTree]}; END; IF cd.remaining # 1 THEN SIGNAL ConstructionError; [] _ LoadPointer[0]; END; cd _ saveCd; RETURN [P5L.TOSLex[pLength]] END; END.