DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [bitsPerChar, bitsPerWord],
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],
FOpCodes: TYPE USING [
qADD, qALLOC, qBLT, qBLTL, qBLZL, qDSUB, qDUP, qGADRB, qLADRB, qLCO,
qLI, qLP, qMUL, qOR, qPUSH, qSUB, qSHIFT, qWS, qWSD, qWSF],
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, InsertLabel, MakeTreeLiteral, NextVar, LabelAlloc, OperandType,
Out0, Out1, Out2, OutJump, PushLitVal, RecordConstant, TreeLiteral, TreeLiteralValue,
TypeForTree, WordAligned, WordsForOperand],
PrincOps: TYPE USING [AllocationVectorSize, FieldDescriptor, sStringInit],
PrincOpsUtils: TYPE USING [BITOR, BITSHIFT],
Stack: TYPE USING [
Also, Decr, Dump, Forget, Incr, Mark, Pop, TempStore, Top],
Symbols: TYPE USING [
Base, ArraySEIndex, BitAddress, BitCount, ContextLevel, CSEIndex, CTXIndex,
ISEIndex, ISENull, lG, lZ, RecordSEIndex, SEIndex, seType, typeANY],
SymbolOps: TYPE USING [
BitsPerElement, Cardinality, FirstCtxSe, FnField, NextSe, RCType, RecField,
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, 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 = 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 = 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 = 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 = 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 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];
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 = 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 = 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;


RowCons: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions]
RETURNS [Lexeme] =
BEGIN -- array (expression) construction
r, rr: VarIndex;
aSei: ArraySEIndex = 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.


®Constructor.mesa
last modified by Sweet, January 21, 1981  10:49 PM
last modified by Satterthwaite, May 5, 1983 11:12 am
Last Edited by: Maxwell, August 11, 1983 9:19 am
imported definitions
state data and common code for construction
would have used swap but pointer got dumped when evaluating field
test for other special cases here
main drivers
wordsFilled > e2Offset => cd.remaining has been incremented
public entries
�Ê#õ˜Jš
œ™Jš
œ2™2Jš
œ4™4J™0J˜š
Ïk	˜	Jšœ�œ
�œ˜Jšœ�œ
�œ˜.Jšœ�œ
�œ!˜1šœ
�œ
�œ˜J˜HJ˜I—Jšœ	�œ
�œ˜$Jšœ
�œ
�œ.˜Bšœ
�œ
�œ˜J˜DJ˜;—Jšœ�œ
�œ˜&Jšœ
�œ
�œ˜.šœ�œ
�œ˜J˜=J˜<—šœ�œ
�œ˜J˜=J˜CJ˜DJ˜>J˜—šœ�œ
�œ˜J˜QJ˜UJ˜+—Jšœ
�œ
�œ6˜JJš	œ�œ
�œ�œ�œ˜,šœ�œ
�œ˜J˜;—šœ	�œ
�œ˜J˜KJ˜D—šœ�œ
�œ˜J˜KJ˜3—Jšœ�œ
�œ:˜Jšœ	�œ
�œ˜J˜@J˜——šœ
�˜š�œ
˜J˜0J˜6—Jš�œ˜Jš
�˜Jš�œ˜J˜Jš
œ™J˜Jšœ�œ˜*Jšœ�œ˜*J˜Jšœ�œ˜*Jšœ�œ˜&Jšœ
�œ˜"Jšœ�œ˜*Jšœ
�œ˜"Jšœ
�œ˜"Jšœ
�œ˜"J˜$J˜J˜Jšœ�œ˜,Jšœ	�œ˜ Jšœ%Ïc!˜FJ˜J˜Jšœž˜7Jšœž#˜AJšœž˜7Jšœž˜9J˜šœ�œ˜*Jš�œž6˜=J˜J˜J˜J˜Jš�œ
˜J˜—Jš
œ+™+J˜Jš	œ�œ�œ
�œ
�œ˜9Jšœ�œ�œ
˜!J˜Jšœ�œ˜J˜šÏnœ�œ�œ�œ
˜2Jš�œ˜$Jš
�˜J˜J˜š�œ�œ
�˜šœ�œ	�œ
�˜˜š�œ�œ�˜2Jš
�˜J˜:Jšœ
�œž˜6J˜*Jš�œ�œ
�œ˜0Jš
�˜Jš�œ
˜——Jšœ�œ
˜Jš�œ�œ
˜—Jšœ�œ
˜Jš�œ�œ
˜—J˜Jš�œ�œ
�œž˜Iš�œ�œ
˜Jš
�˜J˜
Jšœ9�œ˜@J˜Jš�œ
˜—Jš
�˜J˜&š�œ�œ
�˜˜Jš
�˜J˜Jšœ
�œ˜J˜*Jš�œ
˜—Jš�œ�œ
˜—J˜Jšœž˜6š�œ
�œ
�˜˜Jš
�˜š�œ�œ�œ�˜EJš�œ
�œ˜
—J˜)J˜Jš�œ
˜—Jšœ�œ˜.Jš�œ�œ
�œ˜—š
�˜˜	Jš
�˜Jšœ�œ%˜1J˜J˜Jšœ�œž˜BJšœ
�œ˜$Jš�œ
˜——Jš�œ
˜Jš�œ
˜J˜—šŸ
œ�œ�œ�œ�œ�˜IJš
�˜Jš�œ�œ�œ	�œ˜RJš�œ
˜J˜J˜—šŸ
œ�œ�œ
˜ Jš�œ�œ˜0Jš�œ
ž9˜?š�œ
�œ
�˜˜š�œ�œ
�œ�œ�œ�˜LJš
�˜J˜
Jšœ�œ˜!J˜J˜FJš
�˜—Jš�œ8˜<—˜Jš
�˜J˜FJšœ"ž˜:J˜Jšœž>˜NJš
�˜Jš�œ
˜—J˜;˜˜!Jšœ3�œ˜:——Jš�œ�œ
˜—š	�œ
�œ�œ �œ�˜<Jšœ	�œ
�œ˜+—š
�˜Jš
�˜J˜š�œ
�œ�˜ Jšœ�œ"˜4—š
�˜Jš
�˜Jšœ�œ˜2š�œ�˜J˜5—Jš�œ˜Jš�œ
˜—J˜J˜ Jšœ�œ˜-J˜7Jšœ
�œ
˜Jš�œ
˜—Jš�œ
˜J˜—š
Ÿœ�œ�œ�œ
�œ˜>Jš
�˜J˜J˜!J˜J˜ Jšœ
�œ
˜Jš�œ
˜J˜—šŸœ�œ˜Jš
�˜š�œ�˜Jš
�˜Jš�œ
�œ�œ
˜/š
�˜Jš
�˜J˜1š�œ�œ
�˜J˜.Jšœ�œ˜+Jš�œ�œ
˜—Jš�œ
˜—Jšœ
�œ
˜Jš�œ
˜—Jš�œ
˜J˜—šŸ
œ�œ˜Jš
�˜Jš�œ�œ˜)Jšœ
�œ
˜Jš�œ
˜J˜J˜—šŸ
œ�œF˜VJš
�˜J˜J˜J˜"Jšœ	�œ+˜8šœ
�œ�œ�œ�˜:Jšœ�œ�œ˜4—šœ�œ
�œ�œ
�˜@Jšœ�œ�œ�œ
˜D—J˜š�œ�˜š�œ
�œ
�˜J˜J˜Jš�œ
˜——Jš�œ�œ$˜6šœ�œ˜%Jš�œ˜š�œ�œ�œ˜;Jš�œ�œ˜+——š�œ�˜Jš
�˜J˜J˜š�œ
�œ
�˜˜
Jš
�˜Jšœ�œ�œ&˜;Jš�œ�œ(˜@š�œ#˜'š�œ˜"J˜2——š�œ�˜Jš
�˜J˜J˜J˜KJš
�˜—Jš�œ�œ
˜Jš
�˜Jš�œ
˜—˜	Jš
�˜J˜)JšœF�œ˜MJš�œ
˜—˜	Jš
�˜Jšœ�œ˜#J˜)Jš�œ
˜—Jš�œ�œ
˜—Jš
œA™AJ˜Jšœ
�œ
˜J˜JJ˜J˜2Jš
�˜—š�œ
�œ
�˜Jš
�˜J˜#J˜J˜Jš
�˜—š
�˜Jš
�˜J˜J˜*š	�œ�œ
�œ�œ
�˜.šœ	�œ
�˜Jš�œ
ž&˜,J˜#š�œ�œ
�˜J˜.Jšœ�œ˜+Jš�œ�œ
˜—Jšœ
�œ
˜Jš�œ
˜—Jš�œ
˜—J˜J˜2Jš�œ
˜—š�œ	�˜Jš
�˜J˜&J˜2˜"J˜9—Jš
�˜—Jš�œ6�œ˜AJšœ
�œ
˜Jš�œ
˜J˜J˜—š
Ÿœ�œ�œ�œ�œ˜AJš
�˜J˜˜Jš
�˜š�œ�˜Jšœ,�œ
˜2J˜-Jš�œ�œ
˜—Jš�œ
˜J˜—Jšœ!�˜'Jš�œ
˜J˜—˜Jš
�˜Jšœž˜!š	�œ�œ
�œ�œ
�˜(˜
Jš
�˜J˜š�œ�˜˜š�œ�œ�˜2J˜—Jš�œB˜F—˜Jš
�˜J˜+š�œG˜Iš�œ�˜$J˜——Jš�œ.˜2Jš�œ
˜—˜Jš
�˜Jš�œ�œ˜5J˜AJš�œ
˜—˜J˜-—˜	š�œ�œ�œ�˜?Jš
�˜J˜J˜5Jš
�˜—š
�˜Jš
�˜J˜5J˜&J˜ J˜J˜J˜Jš�œ
˜——Jš�œ"˜)—Jš�œ
˜—Jš�œ"˜)—Jš
�˜Jš�œ
˜J˜—šŸœ�œ˜Jš
�˜Jš�œ�œ
�œ˜2J˜ Jš�œ
˜J˜J˜—šŸœ�œ1˜CJš
�˜J˜š�œ
�œ
�˜šœ�˜šœ�œ�œ�œ˜DJ˜0——Jš
œ!™!Jš�œ˜$—Jš�œ
˜J˜—šŸ	œ�œ�œ˜4Jš
�˜J˜J˜"J˜š�œ�œ�œ�˜@J˜—J˜*J˜J˜2Jš�œ�œ˜6J˜J˜š�œ�œ�œ�˜?Jšœ
�˜—Jš�œ�œ˜(Jš�œ
˜J˜J˜—Jš
œ™˜šŸ
œ�œ˜J˜J˜Jšœ�œ�œ�œ˜3J˜J˜Jš�œ
ž2˜8J˜#Jšœ�œ,˜?J˜J˜šŸœ�œ˜%Jš
�˜J˜J˜Jšœ�œ
˜J˜6š�œ�˜Jš
�˜J˜J˜˜:Jšœ"�œ
˜2—š�œ�œ�˜0˜J˜=——š�œ
ž(˜+š�œ�˜ ˜Jš
�˜J˜J˜;Jš�œ
˜—J˜'Jš�œ�œ
˜—Jš�œ
˜—š�œ�˜ ˜J˜Q—J˜;J˜/J˜9J˜2Jš�œA˜H—Jš�œž˜—J˜)Jš�œž˜J˜—š�œ�˜š�œ�œ
�˜˜	Jš
�˜Jšœ�œ˜#J˜8Jš�œ
˜—Jš�œ˜——Jš�œ	�œ˜J˜%Jš�œž˜J˜J˜—šŸœ�œ%˜.Jš�œž˜$J˜#Jš�œ�œ˜2š�œ�˜Jš�œ
ž˜Jšœ�œ˜"Jšœ�œ˜Jšœ�œ�œ
˜$J˜šŸœ�œ˜Jš
�˜š�œ�œ
�˜˜
š�œ	�œ
�˜˜	Jš
�˜J˜7Jš
�œ�œ
�œ
�œ�œ
˜@J˜!Jš�œ
˜—Jš�œ˜——Jš�œ˜—J˜Jš�œ
˜J˜—J˜,J˜J˜J˜Jš	�œ�œ�œ�œ
�˜DJš�œ˜—Jšœ	�œ�œ�œ˜DJ˜š�œ�œ
ž0˜GJš�œž˜2—Jš
œ!˜!Jšœ
�œ
˜Jš
�˜—š
�˜Jš�œž˜!J˜"Jšœ�œ
˜J˜J˜4J˜šŸ
œ�œ˜$Jš
�˜š�œ
ž(˜+š�œ�˜˜Jš
�˜J˜J˜8Jš�œ
˜—J˜!Jš�œ�œ
˜—Jš�œ
˜—š�œ�˜J˜,˜J˜K—šœž˜J˜/—J˜*š�œ˜
Jš�œ�œ6˜K——J˜=J˜.Jš�œž˜J˜—Jšœ �œ˜<J˜LJšœ�œ
˜
Jšœ
�œ
˜š�œ�˜Jš
�˜Jšœ	�œ˜J˜;Jš
�˜—š
�˜Jš
�˜Jšœ	�œ
˜J˜Iš�œ�œ�œ
˜0J˜—J˜Jš�œ
˜—š�œ�œ�œ
˜1Jš
�˜Jšœ�œ˜!J˜Jšœ�œ˜!J˜
Jš
�˜—Jš�œ0˜4J˜1š�œ�˜Jš
�˜J˜+J˜>Jš�œ
˜—Jš�œ
˜—Jš�œ
˜J˜J˜—šŸœ�œ=˜QJš�œ
ž@˜FJ˜#J˜"J˜J˜J˜J˜J˜Jšœ�œ
˜
Jšœ
�œ
˜Jšœ�œ,˜;š�œ�œ
�˜˜Jš
�˜J˜š�œ�˜Jš
�˜J˜,J˜0˜J˜-Jšœ*�œ
˜:—š�œ�˜J˜O—Jš�œ
˜—Jš�œ
˜—Jš�œ�œ
˜—J˜&J˜Jšœ�œ!˜1J˜J˜)š�œ�˜Jš
�˜š�œ�œ�˜9Jš�œ
ž˜J˜1Jšœ�œ˜&Jšœ�œ˜6Jšœ�œ*˜>J˜)Jš�œ
˜—J˜J˜<Jš
�˜—š�œ
�œ�œ�˜>Jš�œ
ž"˜(J˜1Jšœ.ž˜C˜J˜A—š�œ�˜J˜O—J˜'J˜)Jš�œ
˜—Jš�œ�œB˜\Jš�œ
˜J˜J˜—šŸœ�œ/�œ˜OJš�œ�œ˜!Jš�œ
ž0˜6J˜#J˜#J˜"J˜4Jšœ�œ
˜J˜J˜ Jšœ$�œ˜DJ˜LJšœ�œ
˜
Jšœ�œ
˜Jšœ
�œ
˜J˜6š�œ�˜Jš
�˜Jšœ	�œ˜J˜;Jš
�˜—š
�˜Jš
�˜Jšœ	�œ
˜J˜5Jšœ�œ˜.J˜Jš�œ
˜—J˜Aš�œ�œ�œ
˜1Jš
�˜Jšœ�œ˜!J˜Jšœ�œ˜!J˜
Jš�œ
˜—Jš�œ�œ'˜;Jš�œ�œ
�œ
˜š�œ
ž(˜+š�œ�˜˜Jš
�˜J˜J˜9Jš�œ
˜—J˜#Jš�œ�œ
˜—Jš�œ
˜—š�œ�œ�œ˜Bš�œ�œ�˜#Jš
�˜J˜Jš�œ�œ'˜;J˜J˜&Jš
�˜——š�œ
�œ�˜Jš
�˜Jšœ
�œ˜'Jšœ�œ˜!Jšœ�œ
˜Jš�œ�œ˜3š�œ�˜š�œ
�œ
�˜J˜"J˜Jš�œ
˜——š�œ
�œ
�˜J˜%J˜(Jš�œ˜—š�œ�œ�˜%Jš
�œ�œ�œ�œ�œ˜Xš
�˜Jš
�˜J˜J˜3J˜š�œ
˜Jš�œ
˜———š�œ
�œ
�˜J˜˜Jš
�˜J˜(J˜(J˜/J˜.J˜J˜)J˜Jš�œ
˜—Jš�œ�œ
˜—Jš�œ�œ5˜SJš�œ.˜2J˜7˜Jšœ�œ�œ�œ˜<—š�œ�œ
ž˜0Jš
�˜J˜Jš�œ�œ�œ˜5Jš�œ
˜—J˜
Jš
�˜—š�œ
�œ�˜%Jš�œž.˜5J˜5J˜HJš
œ;™;Jš
�˜—š
�˜Jš�œ
ž
˜š�œ�˜Jšœ!ž˜>—š�œ�œ
ž˜3˜J˜M—J˜-Jš�œ:˜A—J˜Jš�œ
˜—š�œ�˜Jš
�˜Jšœ�œ˜*š�œ+�˜1Jš
�˜Jšœ�œ�œ(˜>Jšœ�œž ˜Iš�œ�œ
�œ�˜3Jš�œ
ž/˜5J˜1Jšœž˜(š�œ
�œ
�˜J˜4Jš�œ�œ
˜—Jš�œ
˜—Jšœ
�œž#˜7Jš�œ	�œ!˜0J˜J˜Jšœ*ž˜Cš	�œ�œ�œ
�œ�˜JJš�œ
ž˜#J˜1Jšœž˜(š�œ
�œ
�˜J˜4Jš�œ�œ
˜—Jš�œ
˜—Jšœ
�œž#˜7Jš�œ	�œ!˜0J˜Jš
�˜—š
�˜Jš
�˜J˜J˜!J˜"J˜>J˜*š�œ�˜Jš
�˜J˜#š�œ�œ
�˜(š�œ�œ
�˜J˜.Jšœ�œ˜+Jš�œ�œ
˜——Jšœ
�œ
˜Jš�œ
˜—J˜J˜/J˜<J˜0J˜LJš�œ
˜—š�œ�˜Jš
�˜Jšœ
�œ
�œ˜,J˜˜;Jšœ
�œ˜.—Jš�œ�œ#ž˜LJ˜>Jš�œ
˜—Jš�œ
˜—Jš
�˜Jš�œ
˜J˜J˜——Jš
œ™˜šŸœ�œ
�œ9�œ˜[Jš
�˜J˜J˜J˜J˜+Jšœ�œ˜&Jšœ3�œž
˜Tš�œH�˜NJ˜—Jš�œ.˜2Jšœ�œ�œ�œ˜NJ˜"J˜<J˜!Jš�œ�œ
�œ˜2J˜Jš�œ˜Jš�œ
˜J˜J˜—šŸ	œ�œ
�œ8˜NJš�œ˜Jš�œž+˜2J˜$Jšœ�œ˜&Jš	œ�œ�œ�œ�œ˜CJ˜J˜J˜J˜š�œ�œ�œ�˜CJšœ�œ�˜;Jš�œ
ž˜J˜+š�œ�˜Jš
�˜J˜'Jš�œ1�œ˜>Jš
�˜—Jš�œ
�œ˜ Jš�œ
˜—Jšœ3�œž˜YJ˜Aš�œ�œ�˜(Jš
�˜Jšœ�œ�œ�œ˜Nš�œ�œ
�˜šœ�œ�œ
�˜˜	Jš
�˜J˜:J˜'Jš�œ
˜—Jš�œ
˜—Jš�œ
˜—Jšœ!�œ˜:J˜<˜Jšœ�œ�œ	�œ˜R—Jš�œ
˜—Jš�œ�œ
�œ˜2š�œ�œ
ž	˜&Jš�œ�œ8�œ
˜RJš�œ
�œ'�œ�œ
˜J—J˜Jš�œ˜Jš�œ
˜J˜J˜—šŸœ�œ
�œ8˜LJš�œ˜Jš�œ
ž"˜(J˜J˜#J˜J˜Jšœ3�œž˜YJš�œ�œ˜'Jš�œB˜Fšœ�œ�œ"˜IJš�œ˜—J˜"J˜<J˜Jš�œ�œ
�œ˜2J˜Jš�œ˜Jš�œ
˜J˜J˜—šŸœ�œ
�œ˜ Jšœ�œ�œ!˜AJš�œ
ž(˜.J˜J˜J˜Jšœ�œ ˜,Jšœ�œž˜-š�œ�˜!Jš�œž˜ J˜&J˜5J˜&J˜ J˜Jš�œ
˜—J˜%Jš�œ
�œ)˜9J˜/J˜ š�œ�˜Jš
�˜J˜Jšœ%�œ˜,J˜<J˜)J˜Jš�œ
˜—Jš�œ�œ
�œ˜2J˜Jš�œ
˜J˜J˜—šŸœ�œ
�œ-˜JJš
�˜J˜J˜J˜J˜J˜Jšœ7ž˜IJ˜'š�œ�˜Jš
�˜Jšœ�œ˜4J˜š�œ�œ
�˜šœ�œ�œ
�˜Jšœ
�œ˜)Jš�œ
˜—Jš�œ
˜—Jšœ�œ˜J˜<J˜6Jš�œ
˜—Jš�œ�œ
�œ˜2J˜Jš�œ
˜J˜J˜—šŸœ�œ
�œ�œ˜6Jš
�˜Jšœ�œ˜Jšœ	�œ˜Jšœ	�œ˜0J˜&J˜.J˜%Jšœ�œ�œ�œ˜QJ˜J˜Jšœ�œ&˜8Jšœ�œ�œ�œ
�œ
�œ
˜=J˜šŸœ�œ˜Jš
�˜Jšœ�œ˜"š�œ�˜Jš
�˜J˜0J˜$Jšœ�œ
˜š�œ�˜Jš
�˜J˜.š�œ�œ
�˜˜Jš
�˜Jšœ�œ�œ
�œ	˜1J˜8Jš�œ
˜—Jš�œ�œ
˜—Jš
�˜—š
�˜Jš�œž˜&Jšœ�œ"˜FJ˜Jš�œ
˜—J˜<Jš�œ�œ1˜Fš�œ�˜!Jš
�˜J˜š�œ�œ
�˜J˜%š�œ˜
Jš
�˜J˜Jš�œ�œ/˜<J˜-Jš�œ
˜——Jš
�˜—š
�˜Jš
�˜J˜š�œ�œ
�˜J˜/š�œ˜
Jš
�˜J˜J˜.Jšœ�œ�œ�œ˜GJ˜J˜-Jš�œ
˜——Jš�œ
˜—Jš
�˜—Jš�œ˜Jš�œ
˜J˜—J˜&J˜J˜J˜Jšœ�œ"�œž
˜RJ˜J˜-J˜š�œ	�˜J˜Y—š
�˜Jš
�˜J˜XJ˜Jš�œ
˜—š�œ�œ�˜4Jš
�˜J˜J˜FJ˜š�œ�˜Jš
�˜J˜0š�œ�œ
�˜J˜LJš�œ�œ
˜—Jš�œ
˜—š�œ�˜#Jš
�˜J˜QJ˜š
�˜š�œ�˜$˜Jš
�˜J˜'J˜@Jš�œ
˜—J˜/Jš�œ�œ
˜—Jš�œ
˜—š�œ�˜$˜˜FJ˜——J˜3J˜=J˜1Jš�œ@˜G—Jš�œ
˜—Jš�œ�œ
�œ˜2J˜Jš�œ
˜—J˜Jš�œ˜Jš�œ
˜J˜—Jš�œ
˜J˜———…—‡:¬Ý