
<<Address.mesa, >>
<<last modified by Sweet,  August 29, 1980  2:04 PM>>
<<last modified by Satterthwaite, April 18, 1986 2:30:33 pm PST>>

DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [LongMult],
Code: TYPE USING [CodeNotImplemented],
CodeDefs: TYPE USING [
Base, BoVarIndex, codeType, IndVarIndex, Lexeme, OpWordCount,
VarComponent, VarIndex, VarNull],
ComData: TYPE USING [typeINT],
FOpCodes: TYPE USING [qBNDCK, qNILCK, qNILCKL],
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 Basics, MPtr: ComData, CPtr: Code, 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] =
Basics.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 SymbolOps.UnderType[tb[node].info] = MPtr.typeINT THEN GO TO signedIndex;
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.typeINT];  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
signedIndex => NULL; -- make arithmetic happen before lengthening
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: VarComponent.frame;
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.

