Constructor.mesa
last modified by Sweet, 19-Nov-81 9:56:15
last modified by JGS, 19-Nov-81 8:46:02
last modified by Satterthwaite, April 14, 1986 9:54:39 am PST
DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [bitsPerChar, BITOR, BITSHIFT],
Code: TYPE USING [CodeNotImplemented, curctxlvl],
CodeDefs: TYPE USING [
Base, BoVarIndex, BYTE, codeType, ConsDestination, LabelCCIndex, Lexeme,
MaxParmsInStack, NullLex, StackLocRec, StoreOptions, TempStateRecord,
VarComponent, VarIndex, VarNull, wordlength],
ComData: TYPE USING [tC0],
Counting: TYPE USING [Allocate, FillCounted, LoadSystemZone, VarVarAssignCounted],
FOpCodes: TYPE USING [
qADD, qAF, qBLT, qBLTL, qBLZL, qDSUB, qDUP, qGA, qIOR, qLA,
qLCO, qLI, qLP, qMUL, qREC, qREC2, qSHIFT, qSUB, qWS,
qWSCDL, qWSCIDL, qWSD, qWSDL, qWSF, qWSL, qWSLF],
LiteralOps: TYPE USING [MasterString, StringIndex],
Literals: TYPE USING [Base, MSTIndex, stType],
P5: TYPE USING [
ConstructOnStack, Exp, GenTempLex, MoveToCodeWord, MultiZero, P5Error,
PushRhs, PopTempState, PushTempState, SAssign, 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, LabelAlloc, MakeTreeLiteral, NextVar, NilTree,
OperandType, Out0, Out1, Out2, OutJump, PushLitVal, RecordConstant,
TreeLiteral, TreeLiteralValue, TypeForTree, WordAligned, WordsForOperand],
PrincOps: TYPE USING [AVHeapSize, FieldDescriptor, LocalOverhead, sStringInit],
Stack: TYPE USING [
Also, ComponentForBackup, Decr, Dump, Forget, Incr, Loc, Mark, Pop,
TempStore, Top],
Symbols: TYPE USING [
Base, ArraySEIndex, BitAddress, BitCount, ContextLevel, CSEIndex, CTXIndex,
ISEIndex, ISENull,
lG, lZ, RecordSEIndex, RefClass, SEIndex, seType, typeANY],
SymbolOps: TYPE USING [
BitsPerElement, Cardinality, FirstCtxSe, FnField, NextSe, RCType, RecField,
RecordRoot, ReferentType, UnderType, VariantField, WordsForType],
Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, Scan, treeType],
TreeOps: TYPE USING [
FreeNode, FreeTree, GetNode, GetSe, ListLength, MakeList, NthSon, OpName,
PushTree, ReverseUpdateList, ScanList, UpdateList];
Constructor: PROGRAM
IMPORTS
Basics, MPtr: ComData, CPtr: Code, Counting, LiteralOps,
P5, P5L, P5U, Stack, SymbolOps, TreeOps
EXPORTS CodeDefs, P5 =
BEGIN
OPEN CodeDefs, SymbolOps;
imported definitions
ArraySEIndex: TYPE = Symbols.ArraySEIndex;
BitAddress: TYPE = Symbols.BitAddress;
BitCount: TYPE = Symbols.BitCount;
CSEIndex: TYPE = Symbols.CSEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
lG: Symbols.ContextLevel = Symbols.lG;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
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 AND ~cd.options.counted) 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.pBackup ← [frame[tOffset: vv.wd, tLevel: vv.level]];
cd.pLength ← vv.wSize;
END;
faddr =>
IF vv.level = lG AND cd.options.counted THEN
BEGIN
P5L.LoadComponent[base];
P5U.Out0[FOpCodes.qLP];
cd.pLength ← 2;
cd.pSti ← Stack.Top[cd.pLength];
Stack.Also[n: cd.pLength, place: [none[]]]; --forget
cd.pLoaded ← TRUE;
END
ELSE GO TO loadIt;
link => {cd.pBackup ← [link[vv.wd]]; cd.pLength ← 1};
const => IF vv.wSize # 1 THEN GO TO loadIt
ELSE {cd.pBackup ← [const[vv.d1]]; cd.pLength ← 1};
ENDCASE => GO TO loadIt;
EXITS
loadIt =>
BEGIN
P5L.LoadComponent[base];
cd.pLength ← P5L.Words[base.wSize, base.bSize];
cd.pSti ← Stack.Top[cd.pLength];
Stack.Also[n: cd.pLength, place: [none[]]]; --forget
cd.pLoaded ← TRUE;
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, maxNew: 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 THEN
BEGIN
PopPointer[];
cd.pBackup ← [none[]];
cd.pDelta ← owd; newOwd ← 0;
aVar ← [wSize: 1, space: faddr[wd: cd.fOffset+owd, level: cd.fLevel]];
END
ELSE IF INTEGER[owd] < cd.pDelta AND cd.pzBackup # [none[]] THEN
BEGIN
PopPointer[];
cd.pBackup ← cd.pzBackup; cd.pDelta ← 0;
aVar ← Stack.ComponentForBackup[cd.pBackup];
aVar.wSize ← cd.pLength;
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.pBackup ← [none[]]; --forget copy of old pointer in frame (can do better some day)
RETURN
END;
ENDCASE => {
IF INTEGER[owd] < cd.pDelta AND cd.pzBackup # [none[]] THEN {
cd.pBackup ← cd.pzBackup; cd.pDelta ← 0};
aVar ← Stack.ComponentForBackup[cd.pBackup];
aVar.wSize ← cd.pLength};
IF INTEGER[owd] IN [cd.pDelta .. INTEGER[cd.pDelta+maxNew]] THEN
newOwd ← CARDINAL[INTEGER[owd] - cd.pDelta]
ELSE
BEGIN
IF cd.pDelta = 0 AND cd.pzBackup = [none[]] THEN {
IF cd.pBackup = [none[]] THEN {
aVar ← Stack.TempStore[cd.pLength]; SetCDBackup[aVar]};
cd.pzBackup ← cd.pBackup};
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.pBackup ← [none[]];
aVar ← [wSize: cd.pLength, space: stack[sti: cd.pSti]];
cd.pLoaded ← TRUE;
END;
END;
LoadPointer: PROC [owd, maxNew: CARDINAL] RETURNS [newOwd: CARDINAL] =
BEGIN
aVar: VarComponent;
[aVar, newOwd] ← GetPointer[owd, maxNew];
P5L.LoadComponent[aVar];
cd.pSti ← Stack.Top[cd.pLength];
cd.pLoaded ← TRUE;
END;
DumpPointer: PROC =
BEGIN
IF cd.pLoaded THEN
BEGIN
IF cd.pBackup.where # none OR cd.inFrame THEN Stack.Pop[cd.pLength]
ELSE
BEGIN
aVar: VarComponent = Stack.TempStore[cd.pLength];
SetCDBackup[aVar];
END;
cd.pLoaded ← FALSE;
END;
END;
SavePointer: PROC =
BEGIN
IF cd.pLoaded AND cd.remaining # 0 AND cd.pBackup.where = none THEN
BEGIN
aVar: VarComponent = Stack.TempStore[cd.pLength];
SetCDBackup[aVar];
IF cd.pDelta = 0 THEN cd.pzBackup ← cd.pBackup;
P5L.LoadComponent[aVar];
END;
END;
PopPointer: PROC =
BEGIN
IF cd.pLoaded THEN Stack.Pop[cd.pLength];
cd.pLoaded ← FALSE;
END;
LoadPointerCopy: PROC [atO: OffsetRef, delta: CARDINAL] =
BEGIN
base: VarComponent;
pDelta: INTEGER;
offset: VarComponent.frame ← atO^;
dest: VarIndex ← P5L.GenVarItem[bo];
[base, pDelta] ← GetPointer[cd.pDelta, 0];
P5L.ModComponent[var: @offset, wd: delta-(cd.pDelta+pDelta)];
cb[dest] ← [body: bo[base: base, offset: offset]];
[] ← P5L.LoadAddress[dest];
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
(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, BYTE.LAST];
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;
loc: StackLocRec;
P5L.LoadVar[source];
loc ← Stack.Loc[cd.pSti];
WITH ll: loc SELECT FROM
onStack =>
BEGIN
WSOp: ARRAY [1..2] OF ARRAY [1..2] OF BYTE = [
[FOpCodes.qWS, FOpCodes.qWSD], [FOpCodes.qWSL, FOpCodes.qWSDL]];
WSFOp: ARRAY [1..2] OF BYTE = [FOpCodes.qWSF, FOpCodes.qWSLF];
WSCOp: ARRAY BOOL OF BYTE = [
TRUE: FOpCodes.qWSCIDL, FALSE: FOpCodes.qWSCDL];
RecOp: ARRAY [1..2] OF BYTE = [FOpCodes.qREC, FOpCodes.qREC2];
IF offset.bSize = 0 THEN
P5U.Out1[IF counted
THEN WSCOp[cd.options.init]
ELSE WSOp[cd.pLength][offset.wSize], offset.wd]
ELSE P5U.Out2[WSFOp[cd.pLength], offset.wd,
LOOPHOLE[ PrincOps.FieldDescriptor[
offset: 0, posn: offset.bd, size: offset.bSize]]];
IF cd.remaining # 0 THEN
BEGIN
P5U.Out0[RecOp[cd.pLength]];
cd.pSti ← Stack.Top[cd.pLength];
Stack.Also[n: cd.pLength, place: cd.pBackup];
END
ELSE cd.pLoaded ← FALSE;
RETURN
END;
contig =>
BEGIN
cd.pBackup ← ll.place;
WITH bb: ll.place SELECT FROM
frame => base ← [wSize: cd.pLength, space:
frame[wd: bb.tOffset, level: bb.tLevel, immutable: TRUE]];
link => base ← [wSize: 1, space: link[bb.link]];
const => base ← [wSize: 1, space: const[bb.value]];
faddr => base ← [wSize: cd.pLength, space:
faddr[wd: bb.tOffset, level: bb.tLevel]];
ENDCASE => ERROR;
END;
ENDCASE => ERROR;
would have used swap but pointer got dumped when evaluating field
Stack.Forget[cd.pSti, cd.pLength];
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, BYTE.LAST];
IF cd.pLoaded AND cd.remaining # 0 THEN {
DumpPointer[];
base ← Stack.ComponentForBackup[cd.pBackup, cd.pLength]};
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
(cd.pLength = 2 AND P5.MultiZero[t] 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
offset: VarComponent.frame ← atO^;
loc: StackLocRec;
[] ← LoadPointer[offset.wd, 0];
loc ← Stack.Loc[cd.pSti];
WITH ll: loc SELECT FROM
onStack =>
BEGIN
IF cd.pLength # 2 THEN
BEGIN
SavePointer[];
P5U.Out0[FOpCodes.qLP];
END;
P5U.PushLitVal[nwords];
P5U.Out0[FOpCodes.qBLZL];
IF cd.remaining # 0 AND cd.pLength = 2 THEN
BEGIN
cd.pSti ← Stack.Top[cd.pLength];
Stack.Also[n: cd.pLength, place: cd.pBackup];
END
ELSE {Stack.Pop[2]; cd.pLoaded ← FALSE};
END;
ENDCASE => ERROR;
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
msti: Literals.MSTIndex = LiteralOps.MasterString[
LiteralOps.StringIndex[NARROW[t, Tree.Link.literal].index]];
IF stb[msti].local THEN localText ← TRUE ELSE globalText ← TRUE;
P5.WriteCodeWord[stb[msti].info];
n ← n+1;
END;
IF cd.pLoaded THEN {SavePointer[]; PopPointer[]};
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.qLA ELSE FOpCodes.qGA, 0];
LoadPointerCopy[atO, 0];
IF cd.pLength # 1 THEN -- does a long pointer to array of short strings
SIGNAL CPtr.CodeNotImplemented; -- make any sense?
P5.SysCall[PrincOps.sStringInit];
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: Symbols.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 ← Basics.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 (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 AND ~fold THEN DumpPointer[];
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 ← Basics.BITOR[Basics.BITSHIFT[v, eBSize], v]
ELSE
BEGIN
P5U.Out0[FOpCodes.qDUP];
P5U.PushLitVal[eBSize]; P5U.Out0[FOpCodes.qSHIFT];
P5U.Out0[FOpCodes.qIOR];
END;
ENDLOOP;
SELECT TRUE FROM
fold => NULL;
(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.qREC];
P5U.InsertLabel[elabel];
END;
ENDCASE => NULL;
IF totalBits < wordlength THEN P5L.FieldOfComponent[var: @offset, bSize: totalBits]
ELSE P5L.FieldOfComponent[var: @offset, wSize: 1];
IF fold THEN ConsAssign[typeANY, @offset, P5U.MakeTreeLiteral[v]]
ELSE 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 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;
offset ← tOffset;
IF ~CountedAssign[csei, P5U.TreeLiteral[t1]] THEN
BEGIN
BltOp: ARRAY [1..2] OF BYTE = [FOpCodes.qBLT, FOpCodes.qBLTL];
SavePointer[];
ConstructCountDown[];
LoadPointerCopy[@offset, 0]; -- load address of first element
P5U.Out1[FOpCodes.qLI, bWords];
LoadPointerCopy[@offset, e2Offset]; -- load address of second
P5U.Out0[BltOp[cd.pLength]];
END
ELSE
BEGIN
aVar: VarComponent;
r: VarIndex = P5L.GenVarItem[bo];
rr: VarIndex = P5L.GenVarItem[bo];
offset.wSize ← e2Offset; offset.bSize ← 0;
[aVar, offset.wd] ← GetPointer[offset.wd, BYTE.LAST];
IF cd.pLoaded THEN
BEGIN
aVar ← Stack.TempStore[cd.pLength];
IF cd.remaining # 0 AND ~cd.inFrame THEN
SetCDBackup[aVar];
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;
SetCDBackup: PROC [tvar: VarComponent] =
BEGIN
WITH vv: tvar SELECT FROM
frame => cd.pBackup ← [frame[tLevel: vv.level, tOffset: vv.wd]];
link => cd.pBackup ← [link[vv.wd]];
faddr => cd.pBackup ← [faddr[tLevel: vv.level, tOffset: vv.wd]];
const => cd.pBackup ← [const[vv.d1]];
ENDCASE => ERROR;
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[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]];
aWords: CARDINAL = WordsForType[aSei];
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[aWords]
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 + PrincOps.LocalOverhead.SIZE];
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.AVHeapSize;
P5U.PushLitVal[fs]; P5U.Out0[FOpCodes.qAF];
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, 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: Symbols.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 ← Basics.bitsPerChar;
END;
seqLength ← P5L.ComponentForLex[P5.Exp[tb[subNode].son[2]]];
IF tag # ISENull THEN seqLength ← P5L.EasilyLoadable[
seqLength,
IF tb[node].son[3] # Tree.Null THEN store ELSE 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, 0];
END;
cd ← saveCd;
RETURN [P5L.TOSLex[pLength]]
END;
END.