-- Address.mesa,
-- last modified by Sweet, August 29, 1980 2:04 PM
-- last modified by Satterthwaite, February 24, 1983 3:33 pm
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [CodeNotImplemented],
CodeDefs: TYPE USING [
Base, BoVarIndex, codeType, IndVarIndex, Lexeme, OpWordCount,
VarComponent, VarIndex, VarNull],
ComData: TYPE USING [typeINTEGER],
FOpCodes: TYPE USING [qBNDCK, qNILCK, qNILCKL],
Inline: TYPE USING [LongMult],
P5: TYPE USING [AdjustNilCheck, Exp, PushRhs],
P5L: TYPE USING [
ComponentForLex, ComponentForSE, FieldOfVar, FieldOfVarOnly, GenVarItem,
LoadBoth, LoadComponent, LoadVar, MakeBo, MakeComponent, ModComponent,
ReleaseVarItem, ReusableCopies, TOSComponent, VarForLex, Words],
P5S: TYPE USING [],
P5U: TYPE USING [OperandType, Out0, TreeLiteral, TreeLiteralValue],
SymbolOps: TYPE USING [BitsPerElement, Cardinality, NormalType, UnderType],
Symbols: TYPE USING [
Base, BitCount, ByteLength, CSEIndex, ISEIndex, lZ, seType,
PackedBitCount, WordCount, WordLength],
Tree: TYPE USING [Base, Index, Link, treeType],
TreeOps: TYPE USING [PopTree, PushNode, PushTree, SetAttr, SetInfo];
Address: PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, Inline, P5U, P5L, P5, SymbolOps, TreeOps
EXPORTS CodeDefs, P5S =
BEGIN
OPEN CodeDefs;
-- imported definitions
BitCount: TYPE = Symbols.BitCount;
PackedBitCount: TYPE = Symbols.PackedBitCount;
WordCount: TYPE = Symbols.WordCount;
wordLength: CARDINAL = Symbols.WordLength;
CSEIndex: TYPE = Symbols.CSEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
tb: Tree.Base; -- tree base (local copy)
seb: Symbols.Base; -- semantic entry base (local copy)
cb: CodeDefs.Base; -- code base (local copy)
AddressNotify: PUBLIC Alloc.Notifier =
BEGIN -- called by Code whenever table area is repacked
seb ← base[Symbols.seType];
tb ← base[Tree.treeType];
cb ← base[codeType];
END;
-- utilities
LongMult: PROC [CARDINAL, CARDINAL] RETURNS [LONG CARDINAL] =
Inline.LongMult;
WordOffset: PROC [sei: ISEIndex] RETURNS [CARDINAL] =
BEGIN
var: VarComponent = P5L.ComponentForSE[sei];
RETURN [WITH vv: var SELECT FROM
frame => P5L.Words[w: vv.wd, b: vv.bd],
ENDCASE => ERROR]
END;
-- in a packed ind VarItem, the wd of the offset is scaled
-- and measured in units of element size
ScaleComponent: PROC [var: POINTER TO VarComponent, grain: PackedBitCount] =
BEGIN
ePerWord: [0..wordLength] = wordLength/grain;
WITH vv: var↑ SELECT FROM
frame =>
BEGIN
vv.wd ← (vv.wd*ePerWord) + vv.bd/grain;
vv.bd ← vv.bd MOD grain;
END;
code =>
BEGIN -- this gets cross jumped
vv.wd ← (vv.wd*ePerWord) + vv.bd/grain;
vv.bd ← vv.bd MOD grain;
END;
ENDCASE => ERROR;
END;
UnscaleComponent: PROC [var: POINTER TO VarComponent, grain: PackedBitCount] =
BEGIN
ePerWord: [0..wordLength] = wordLength/grain;
WITH vv: var↑ SELECT FROM
frame =>
BEGIN
newBd: CARDINAL = vv.bd + (vv.wd MOD ePerWord)*grain;
vv.wd ← vv.wd/ePerWord + newBd/wordLength;
vv.bd ← newBd MOD wordLength;
END;
code =>
BEGIN -- this gets cross jumped
newBd: CARDINAL = vv.bd + (vv.wd MOD ePerWord)*grain;
vv.wd ← vv.wd/ePerWord + newBd/wordLength;
vv.bd ← newBd MOD wordLength;
END;
ENDCASE => ERROR;
END;
-- operations
Index: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for array indexing
arrayType: CSEIndex = P5U.OperandType[tb[node].son[1]];
grain, tBits: BitCount;
packed: BOOL;
elementWords: OpWordCount;
indexRange: LONG CARDINAL;
owd: CARDINAL;
delta: INTEGER;
t2: Tree.Link;
base, index, offset: VarComponent;
er: IndVarIndex;
bar: BoVarIndex ← P5L.MakeBo[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
IF bar = VarNull THEN
SIGNAL CPtr.CodeNotImplemented; -- no packed arrays of arrays
base ← cb[bar].base; offset ← cb[bar].offset;
WITH a: seb[arrayType] SELECT FROM
array =>
BEGIN
grain ← SymbolOps.BitsPerElement[a.componentType, a.packed];
packed ← grain < wordLength;
elementWords ← IF packed THEN 1 ELSE OpWordCount[grain/wordLength];
indexRange ← SymbolOps.Cardinality[a.indexType];
END;
ENDCASE => ERROR;
IF packed AND (tBits ← indexRange*grain) IN (0..wordLength) THEN
BEGIN
fieldSize: CARDINAL = offset.wSize*wordLength + offset.bSize;
IF tBits < fieldSize THEN
P5L.ModComponent[var: @offset, wd: 0, bd: fieldSize-tBits];
END;
WITH oo: offset SELECT FROM
frame =>
BEGIN
IF oo.level # Symbols.lZ THEN ERROR;
IF packed THEN
BEGIN
ScaleComponent[@offset, PackedBitCount[grain]];
offset.wSize ← 0; offset.bSize ← grain;
END
ELSE
BEGIN
IF oo.bd # 0 OR offset.bSize # 0 THEN
ERROR; -- arrays start on word boundaries and are words long
offset.wSize ← elementWords;
END;
owd ← oo.wd;
END;
code =>
BEGIN -- this gets cross jumped
IF packed THEN
BEGIN
ScaleComponent[@offset, PackedBitCount[grain]];
offset.wSize ← 0; offset.bSize ← grain;
END
ELSE
BEGIN
IF oo.bd # 0 OR offset.bSize # 0 THEN
ERROR; -- arrays start on word boundaries and are words long
offset.wSize ← elementWords;
END;
owd ← oo.wd;
END;
ENDCASE => ERROR;
[t2, delta] ← CheckAdditivity[tb[node].son[2], elementWords, owd];
P5L.ModComponent[var: @offset, wd: INTEGER[elementWords] * delta];
index ← P5L.ComponentForLex[P5.Exp[t2]];
WITH ii: index SELECT FROM
const =>
BEGIN
co: LONG CARDINAL = LongMult[elementWords, ii.d1];
IF co + owd.LONG > OpWordCount.LAST THEN GO TO tooBig;
P5L.ModComponent[var: @offset, wd: co];
IF packed THEN UnscaleComponent[@offset, PackedBitCount[grain]];
cb[bar].offset ← offset;
RETURN [[bdo[bar]]]
EXITS
tooBig => NULL;
END;
ENDCASE;
P5L.ReleaseVarItem[bar];
er ← LOOPHOLE[P5L.GenVarItem[ind]];
cb[er] ← [body: ind[base: base, index: index, offset: offset,
simple: TRASH, packinfo: TRASH]];
IF packed THEN
BEGIN
cb[er].simple ← indexRange # 0 AND grain*(owd+indexRange) <= 4096;
cb[er].packinfo ← packed[grain: PackedBitCount[grain]];
END
ELSE
BEGIN
cb[er].simple ←
(P5L.Words[base.wSize, base.bSize] = 1) OR
(indexRange # 0 AND elementWords*indexRange <= OpWordCount.LAST.LONG+1);
cb[er].packinfo ← notPacked[elementWords];
END;
RETURN [[bdo[er]]]
END;
CheckAdditivity: PROC [t: Tree.Link, elementWords: OpWordCount, current: LONG CARDINAL]
RETURNS [rt: Tree.Link, delta: INTEGER ← 0] =
BEGIN
node: Tree.Index;
p: BOOL;
cDelta: CARDINAL;
rt ← t;
WITH t SELECT FROM
subtree =>
BEGIN node ← index;
IF (p ← (tb[node].name = plus)) OR tb[node].name = minus THEN
IF P5U.TreeLiteral[tb[node].son[1]] THEN
BEGIN
cDelta ← P5U.TreeLiteralValue[tb[node].son[1]];
IF LongMult[cDelta, elementWords] > OpWordCount.LAST.LONG - current THEN
GO TO tooBig;
delta ← cDelta; -- ok if > INTEGER.LAST as used later
IF ~p THEN
BEGIN OPEN TreeOps;
PushTree[tb[node].son[2]]; PushNode[uminus, 1];
SetInfo[MPtr.typeINTEGER]; SetAttr[1, FALSE];
tb[node].son[2] ← PopTree[]; tb[node].name ← plus;
END;
rt ← tb[node].son[2]
END
ELSE IF P5U.TreeLiteral[tb[node].son[2]] THEN
BEGIN
cDelta ← P5U.TreeLiteralValue[tb[node].son[2]];
IF p THEN
IF LongMult[cDelta, elementWords] > OpWordCount.LAST.LONG - current THEN
GO TO tooBig
ELSE delta ← cDelta -- ok if > INTEGER.LAST as used later
ELSE
IF LongMult[cDelta, elementWords] > current THEN
GO TO tooBig
ELSE delta ← -INTEGER[cDelta];
rt ← tb[node].son[1];
END;
EXITS
tooBig => NULL;
END;
ENDCASE;
RETURN
END;
DIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for indexing from an array descriptor
arrayDType: CSEIndex = SymbolOps.NormalType[P5U.OperandType[tb[node].son[1]]];
arrayType: CSEIndex = WITH seb[arrayDType] SELECT FROM
arraydesc => SymbolOps.UnderType[describedType],
ENDCASE => ERROR;
grain: BitCount;
packed: BOOL;
elementWords: OpWordCount;
nilck: BOOL = tb[node].attr1;
long: BOOL = tb[node].attr2;
pLength: CARDINAL = IF long THEN 2 ELSE 1;
bndck: BOOL = tb[node].attr3;
owd: CARDINAL;
delta: CARDINAL ← 0;
t2: Tree.Link;
rBase, rBound: VarIndex;
base, bound, index: VarComponent;
offset: frame VarComponent;
er: IndVarIndex;
WITH a:seb[arrayType] SELECT FROM
array =>
BEGIN
grain ← SymbolOps.BitsPerElement[a.componentType, a.packed];
packed ← grain < wordLength;
elementWords ← IF packed THEN 1 ELSE OpWordCount[grain/wordLength];
END
ENDCASE => ERROR;
IF packed THEN offset ← [bSize: grain, space: frame[wd: 0]]
ELSE offset ← [wSize: elementWords, space: frame[wd: 0]];
rBase ← P5L.VarForLex[P5.Exp[tb[node].son[1]]];
IF bndck THEN
BEGIN
IF nilck THEN [first: rBase, next: rBound] ← P5L.ReusableCopies[rBase, load, TRUE]
ELSE [first: rBound, next: rBase] ← P5L.ReusableCopies[rBase, load, TRUE];
P5L.FieldOfVar[r: rBound, wd: pLength, wSize: 1];
P5L.FieldOfVar[r: rBase, wSize: pLength];
END
ELSE P5L.FieldOfVarOnly[r: rBase, wSize: pLength];
base ← P5L.MakeComponent[rBase];
IF nilck THEN
BEGIN
P5L.LoadComponent[base];
P5U.Out0[IF long THEN FOpCodes.qNILCKL ELSE FOpCodes.qNILCK];
base ← P5L.TOSComponent[pLength];
END;
IF bndck THEN t2 ← tb[node].son[2]
ELSE [t2, delta] ← CheckAdditivity[tb[node].son[2], elementWords, 0];
offset.wd ← owd ← elementWords*delta; -- elementWords = 1 if packed
index ← P5L.ComponentForLex[P5.Exp[t2]];
IF bndck THEN
BEGIN
bound ← P5L.MakeComponent[rBound];
P5L.LoadBoth[@index, @bound, FALSE];
P5U.Out0[FOpCodes.qBNDCK];
index ← P5L.TOSComponent[1];
END
ELSE WITH ii: index SELECT FROM
const =>
BEGIN
bar: VarIndex;
co: LONG CARDINAL = LongMult[elementWords, ii.d1];
IF co + owd.LONG > OpWordCount.LAST THEN GO TO tooBig;
P5L.ModComponent[var: @offset, wd: co];
IF packed THEN UnscaleComponent[@offset, PackedBitCount[grain]];
bar ← P5L.GenVarItem[bo];
cb[bar] ← [body: bo[base: base, offset: offset]];
RETURN [[bdo[bar]]]
EXITS
tooBig => NULL;
END;
ENDCASE;
er ← LOOPHOLE[P5L.GenVarItem[ind]];
cb[er] ← [body: ind[base: base, index: index, offset: offset,
simple: TRASH, packinfo: TRASH]];
IF packed
THEN {cb[er].simple ← FALSE; cb[er].packinfo ← packed[grain: PackedBitCount[grain]]}
ELSE {cb[er].simple ← ~long; cb[er].packinfo ← notPacked[elementWords]};
RETURN [[bdo[er]]]
END;
SeqIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
seqType: CSEIndex = P5U.OperandType[tb[node].son[1]];
isString: BOOL ← FALSE;
grain: BitCount;
packed: BOOL;
elementWords: OpWordCount;
indexRange: LONG CARDINAL;
long: BOOL = tb[node].attr2;
bndck: BOOL = tb[node].attr3;
owd: CARDINAL;
rBound, bor: BoVarIndex;
base, offset, index: VarComponent;
er: IndVarIndex;
WITH ss: seb[seqType] SELECT FROM
array =>
BEGIN
isString ← packed ← TRUE; grain ← Symbols.ByteLength;
elementWords ← 1;
indexRange ← SymbolOps.Cardinality[ss.indexType];
END;
sequence =>
BEGIN
grain ← SymbolOps.BitsPerElement[ss.componentType, ss.packed];
packed ← grain < wordLength;
elementWords ← IF packed THEN 1 ELSE OpWordCount[grain/wordLength];
indexRange ← SymbolOps.Cardinality[seb[ss.tagSei].idType];
IF bndck THEN P5.AdjustNilCheck[tb[node].son[1], WordOffset[ss.tagSei]];
END;
ENDCASE => ERROR;
bor ← P5L.MakeBo[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
IF bor = VarNull THEN
SIGNAL CPtr.CodeNotImplemented; -- no packed arrays of sequences
IF bndck THEN
BEGIN
[first: LOOPHOLE[bor, VarIndex], next: LOOPHOLE[rBound, VarIndex]] ←
P5L.ReusableCopies[bor, load, FALSE];
P5L.LoadComponent[cb[bor].base];
cb[bor].base ← P5L.TOSComponent[IF long THEN 2 ELSE 1];
END;
IF isString THEN
BEGIN
IF bndck THEN WITH vv: cb[rBound].offset SELECT FROM
frame => {vv.wd ← vv.wd - 1; vv.wSize ← 1}; -- maxlength precedes text
ENDCASE => ERROR;
END
ELSE P5L.FieldOfVar[
r: bor, wd: cb[bor].offset.wSize, bd: cb[bor].offset.bSize]; -- skip tag
base ← cb[bor].base; offset ← cb[bor].offset;
IF packed THEN {offset.bSize ← grain; offset.wSize ← 0}
ELSE {offset.wSize ← elementWords; offset.bSize ← 0};
WITH vv: offset SELECT FROM
frame =>
BEGIN
IF packed THEN ScaleComponent[@offset, PackedBitCount[grain]];
owd ← vv.wd;
END;
ENDCASE => ERROR;
IF bndck THEN
BEGIN
P5.PushRhs[tb[node].son[2]];
P5L.LoadVar[rBound];
P5U.Out0[FOpCodes.qBNDCK];
index ← P5L.TOSComponent[1];
END
ELSE
BEGIN
t2: Tree.Link;
delta: INTEGER;
[t2, delta] ← CheckAdditivity[tb[node].son[2], elementWords, owd];
P5L.ModComponent[var: @offset, wd: INTEGER[elementWords] * delta];
index ← P5L.ComponentForLex[P5.Exp[t2]];
END;
WITH ii: index SELECT FROM
const =>
BEGIN
co: LONG CARDINAL = LongMult[elementWords, ii.d1];
IF co + owd.LONG > OpWordCount.LAST THEN GO TO tooBig;
P5L.ModComponent[var: @offset, wd: co];
IF packed THEN UnscaleComponent[@offset, PackedBitCount[grain]];
cb[bor].offset ← offset;
RETURN [[bdo[bor]]]
EXITS
tooBig => NULL;
END;
ENDCASE;
P5L.ReleaseVarItem[bor];
er ← LOOPHOLE[P5L.GenVarItem[ind]];
cb[er] ← [body: ind[base: base, index: index, offset: offset,
simple: TRASH, packinfo: TRASH]];
IF packed THEN
BEGIN
cb[er].simple ← indexRange # 0 AND grain*(owd+indexRange) <= 4096;
cb[er].packinfo ← packed[grain: PackedBitCount[grain]];
END
ELSE
BEGIN
cb[er].simple ←
(P5L.Words[base.wSize, base.bSize] = 1) OR
(indexRange # 0 AND elementWords*indexRange <= OpWordCount.LAST.LONG+1);
cb[er].packinfo ← notPacked[elementWords];
END;
RETURN [[bdo[er]]]
END;
END.