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;
imported definitions
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;
state data and common code for construction
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;
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:
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]];
test for other special cases here
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;
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: 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];
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];
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], 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;
public entries
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;