-- Constructor.mesa
-- last modified by Sweet, January 21, 1981 10:49 PM
-- last modified by Satterthwaite, June 15, 1982 8:45 am
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [CodeNotImplemented, curctxlvl],
CodeDefs: TYPE USING [
Base, BoVarIndex, Byte, codeType, ConsDestination, Lexeme, LabelCCIndex,
MaxParmsInStack, NullLex, StoreOptions, VarComponent, VarIndex, VarNull],
ComData: TYPE USING [switches, tC0],
Counting: TYPE USING [Allocate, FillCounted, VarVarAssignCounted],
Environment: TYPE USING [bitsPerCharacter, bitsPerWord],
FOpCodes: TYPE USING [
qADD, qALLOC, qBLT, qBLTL, qBLZL, qDSUB, qDUP, qGADRB, qLADRB, qLCO,
qLI, qLP, qMUL, qOR, qPUSH, qSUB, qSHIFT, qWS, qWSD, qWSF],
Inline: TYPE USING [BITOR, BITSHIFT],
LiteralOps: TYPE USING [MasterString],
Literals: TYPE USING [Base, MSTIndex, stType],
P5: TYPE USING [
ConstructOnStack, Exp, GenTempLex, MoveToCodeWord, MultiZero,
P5Error, PushRhs, StoreMod, SysCall, WriteCodeWord, ZoneOp],
P5L: TYPE USING [
AdjustComponent, ComponentForLex, ComponentForSE, CopyToTemp,
CopyVarItem, EasilyLoadable, FieldOfComponent, GenAdd, GenVarItem,
LoadAddress, LoadComponent, LoadVar, MakeBo, ModComponent, OVarItem,
ReleaseVarItem, ReusableCopies, TOSAddrLex, TOSLex, VarForLex,
VarVarAssign, Words],
P5U: TYPE USING [
ComputeFrameSize, FieldAddress, InsertLabel, MakeTreeLiteral, NextVar,
LabelAlloc, OperandType, Out0, Out1, Out2, OutJump, PushLitVal, RecordConstant,
TreeLiteral, TreeLiteralValue, TypeForTree, WordAligned, WordsForOperand],
PrincOps: TYPE USING [AllocationVectorSize, FieldDescriptor],
SDDefs: TYPE USING [sStringInit],
Stack: TYPE USING [
Also, Decr, Dump, Forget, Incr, Mark, Pop, TempStore, Top],
Symbols: TYPE USING [
Base, ArraySEIndex, BitAddress, ContextLevel, CSEIndex, CTXIndex,
ISEIndex, ISENull, lG, lZ, RecordSEIndex, SEIndex, seType, typeANY],
SymbolOps: TYPE USING [
BitsPerElement, Cardinality, FirstCtxSe, FnField, NextSe, RCType, RecordRoot,
UnderType, VariantField, WordsForType],
Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, Scan, treeType],
TreeOps: TYPE USING [
FreeNode, GetNode, GetSe, NthSon, OpName, ScanList, UpdateList];
Constructor: PROGRAM
IMPORTS
MPtr: ComData, CPtr: Code, Counting, Inline, LiteralOps,
P5, P5L, P5U, Stack, SymbolOps, TreeOps
EXPORTS CodeDefs, P5 =
BEGIN
OPEN CodeDefs, SymbolOps;
-- imported definitions
wordlength: CARDINAL = Environment.bitsPerWord;
charlength: CARDINAL = Environment.bitsPerCharacter;
ArraySEIndex: TYPE = Symbols.ArraySEIndex;
BitAddress: TYPE = Symbols.BitAddress;
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;
-- state data and common code for construction
OffsetRef: TYPE = POINTER TO READONLY frame VarComponent;
ConstructionError: SIGNAL = CODE;
cd: PUBLIC ConsDestination;
SetConsDest: PROC [r: VarIndex, exp: BOOLEAN ← 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: BOOLEAN] RETURNS [BOOLEAN] = 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 + LAST[Byte]] 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: frame VarComponent ← atO↑;
counted: BOOLEAN = CountedAssign[type, P5U.TreeLiteral[t]];
useFrame: BOOLEAN = cd.inFrame AND offset.wSize IN [1..2] AND
offset.bSize = 0 AND (cd.fOffset+offset.wd) IN Byte;
useSwapped: BOOLEAN = ~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;
-- would have used swap but pointer got dumped when evaluating field
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: BOOLEAN ← 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 = 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 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]];
-- test for other special cases here
ENDCASE => ConsAssign[type, atO, t];
END;
FillZeros: PROC [atO: OffsetRef, nwords: CARDINAL] =
BEGIN
base: VarComponent;
offset: frame VarComponent ← 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;
-- main drivers
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: frame VarComponent = atO↑;
totalBits: CARDINAL = tOffset.wSize*wordlength + tOffset.bSize;
rcSei: RecordSEIndex;
AssignField: PROC [root: Tree.Link] =
BEGIN
offset: frame VarComponent;
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], P5U.FieldAddress, @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 = 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: BOOLEAN ← FALSE;
TextItem: PROC [t: Tree.Link] =
BEGIN
WITH e:t SELECT FROM
literal =>
WITH e.info SELECT FROM
string =>
BEGIN
msti: Literals.MSTIndex = LiteralOps.MasterString[index];
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[SDDefs.sStringInit];
cd.pLoaded ← FALSE;
END
ELSE
BEGIN -- not all string literals
offset: frame VarComponent ← 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], P5U.FieldAddress, @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: CARDINAL = atO.wSize*wordlength + atO.bSize;
-- totalBits could overflow, but that would be a very large constructor
grain: CARDINAL = BitsPerElement[seb[aSei].componentType, seb[aSei].packed];
packed: BOOLEAN;
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: frame VarComponent = atO↑;
offset: frame VarComponent ← atO↑;
fieldSei: ISEIndex;
vCtx: CTXIndex;
uSei: CSEIndex = tb[node].info;
rcSei: RecordSEIndex;
tSei: ISEIndex;
tagged: BOOLEAN;
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 ← Inline.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, P5U.FieldAddress, 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 = tb[node].info;
tOffset: frame VarComponent = atO↑;
offset: frame VarComponent ← atO↑;
csei: CSEIndex = UnderType[seb[aSei].componentType];
eWSize: CARDINAL;
eBSize: [0..wordlength);
t1: Tree.Link ← tb[node].son[1];
totalBits: CARDINAL = tOffset.wSize*wordlength + tOffset.bSize;
-- totalBits could overflow, should probably use LONG CARD
grain: CARDINAL = BitsPerElement[seb[aSei].componentType, seb[aSei].packed];
packed: BOOLEAN;
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*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[];
FillZeros[atO, wordsFilled];
e2Offset ← wordsFilled; fillBits ← 0;
END
ELSE IF packed THEN
BEGIN
ePerWord: CARDINAL = wordlength/grain;
fold: BOOLEAN = 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];
(grain = 1) => {v ← 1; P5.PushRhs[t1]};
ENDCASE => P5.PushRhs[t1];
THROUGH (0..MIN[ePerWord, eCount]) DO
IF fold OR grain = 1 THEN v ← Inline.BITOR[Inline.BITSHIFT[v, grain], v]
ELSE
BEGIN
P5U.Out0[FOpCodes.qDUP];
P5U.PushLitVal[grain]; P5U.Out0[FOpCodes.qSHIFT];
P5U.Out0[FOpCodes.qOR];
END;
ENDLOOP;
SELECT TRUE FROM
fold => P5U.PushLitVal[v];
(grain = 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 P5L.FieldOfComponent[var: @offset, wSize: 1];
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];
-- wordsFilled > 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],
P5U.FieldAddress, @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 * 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;
-- public entries
All: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] =
BEGIN
r: VarIndex;
saveCd: ConsDestination = cd; -- necessary in an inline
offset: frame VarComponent;
aSei: Symbols.ArraySEIndex = tb[node].info;
cd ← [options: options, ignoreSafen: t.tag = symbol]; -- + many 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[P5.Exp[t]];
[] ← SetConsDest[r, FALSE];
offset ← [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
[] ← AllConstruct[node, @offset];
IF cd.remaining # 0 THEN SIGNAL ConstructionError;
cd ← saveCd;
END;
AllExp: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions]
RETURNS [Lexeme] =
BEGIN
r, rr: VarIndex;
saveCd: ConsDestination = cd;
offset: frame VarComponent;
aSei: Symbols.ArraySEIndex = 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, TRUE];
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] =
BEGIN
tsei: RecordSEIndex = tb[node].info;
r, rr: VarIndex;
saveCd: ConsDestination = cd;
offset: frame VarComponent;
fa: PROC [ISEIndex] RETURNS [BitAddress, CARDINAL] =
IF seb[tsei].argument THEN FnField ELSE P5U.FieldAddress;
packedDest: VarIndex ← VarNull;
cd ← [options: options, ignoreSafen: t.tag = symbol]; -- + many defaults
tb[node].son[2] ← TreeOps.UpdateList[tb[node].son[2], CountDups];
IF cd.remaining # 0 THEN
BEGIN
r ← P5L.VarForLex[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, packedDest # VarNull];
offset ← [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
MainConstruct[tb[node].son[2], tsei, fa, @offset];
END;
IF cd.remaining # 0 THEN SIGNAL ConstructionError;
IF packedDest # VarNull THEN -- not RC
[] ← P5L.VarVarAssign[packedDest, rr, FALSE];
cd ← saveCd;
END;
ConstructExp: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions]
RETURNS [Lexeme] =
BEGIN -- generate code for constructor expression
r, rr: VarIndex;
tsei: RecordSEIndex = tb[node].info;
nwords: CARDINAL = WordsForType[tsei];
wa: BOOLEAN = P5U.WordAligned[tsei];
fa: PROC [ISEIndex] RETURNS [BitAddress, CARDINAL] =
IF seb[tsei].argument THEN FnField ELSE P5U.FieldAddress;
saveCd: ConsDestination = cd;
offset: frame VarComponent;
packedDest: VarIndex ← VarNull;
IF t = Tree.Null AND wa AND nwords <= MaxParmsInStack AND
VanillaCons[tb[node].son[2]] THEN
BEGIN -- can build in stack
P5.ConstructOnStack[tb[node].son[2], tsei];
RETURN [P5L.TOSLex[nwords]]
END;
cd ← [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + defaults
tb[node].son[2] ← TreeOps.UpdateList[tb[node].son[2], CountDups];
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, TRUE];
offset ← [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
MainConstruct[tb[node].son[2], tsei, fa, @offset];
IF cd.remaining # 0 THEN SIGNAL ConstructionError;
IF packedDest # VarNull THEN -- not RC
[] ← P5L.VarVarAssign[packedDest, P5L.CopyVarItem[rr], FALSE];
cd ← saveCd;
RETURN [[bdo[rr]]]
END;
RowCons: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] =
BEGIN -- array initialization
aSei: ArraySEIndex = tb[node].info;
saveCd: ConsDestination = cd; -- necessary in an inline
offset: frame VarComponent;
cd ← [options: options, ignoreSafen: 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];
[] ← SetConsDest[P5L.VarForLex[P5.Exp[t]], FALSE];
offset ← [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
Row[node, @offset];
IF cd.remaining # 0 THEN SIGNAL ConstructionError;
cd ← saveCd;
END;
RowConsExp: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions]
RETURNS [Lexeme] =
BEGIN -- array (expression) construction
r, rr: VarIndex;
aSei: ArraySEIndex = tb[node].info;
aWords: CARDINAL = WordsForType[aSei];
saveCd: ConsDestination = cd;
offset: frame VarComponent;
cd ← [ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults
tb[node].son[2] ← TreeOps.UpdateList[tb[node].son[2], CountDups];
r ← P5L.VarForLex[IF t = Tree.Null THEN P5.GenTempLex[aWords]
ELSE P5.Exp[t]];
rr ← SetConsDest[r, TRUE];
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: BOOLEAN, t: Tree.Link, tsei: CSEIndex] =
BEGIN -- generate code for construct statement
lex: Lexeme;
saveCd: ConsDestination = cd;
offset: frame VarComponent;
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: frame VarComponent;
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: BOOLEAN = tb[node].attr2;
counted: BOOLEAN = 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: BOOLEAN = (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: frame VarComponent ← [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],
P5U.FieldAddress, @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.