-- Address.mesa, modified by Sweet, January 18, 1980 3:49 PM
DIRECTORY
AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength],
Code: FROM "code",
CodeDefs: FROM "codedefs" USING [
BoVarIndex, IndVarIndex, Lexeme, VarComponent, VarIndex, VarNull],
ComData: FROM "comdata" USING [typeINTEGER],
ControlDefs: FROM "controldefs" USING [framelink, globalbase, localbase],
FOpCodes: FROM "fopcodes" USING [qBNDCK, qNILCK, qNILCKL],
InlineDefs: FROM "inlinedefs" USING [LongNumber],
Literals: FROM "literals" USING [LTIndex],
OpCodeParams: FROM "opcodeparams",
P5: FROM "p5" USING [Exp, P5Error],
P5L: FROM "p5l" USING [
ComponentForLex, CopyVarItem, EasilyLoadable,
FieldOfVar, FieldOfVarOnly, GenVarItem,
LoadBoth, LoadComponent, LoadVar, MakeBo, MakeComponent, ModComponent,
ReleaseVarItem, TOSComponent, VarForLex, Words],
P5S: FROM "p5s",
P5U: FROM "p5u" USING [OperandType, Out0, TreeLiteral, TreeLiteralValue],
Stack: FROM "stack" USING [Mark],
SymbolOps: FROM "symbolops" USING [
BitsForType, Cardinality, NormalType, UnderType, WordsForType],
Symbols: FROM "symbols" USING [
BitAddress, ContextLevel, CSEIndex, CTXIndex, ctxType, HTIndex, ISEIndex,
lG, lZ, SEIndex, seType],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree" USING [Index, Link, Null, treeType],
TreeOps: FROM "treeops" USING [
FreeNode, PopTree, PushNode, PushTree, SetAttr, SetInfo];
Address: PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, P5U, CodeDefs, P5L, P5,
Stack, SymbolOps, TreeOps
EXPORTS CodeDefs, P5S =
BEGIN
OPEN CodeDefs;
-- imported definitions
BYTE: TYPE = AltoDefs.BYTE;
wordlength: CARDINAL = AltoDefs.wordlength;
charlength: CARDINAL = AltoDefs.charlength;
framelink: CARDINAL = ControlDefs.framelink;
globalbase: CARDINAL = ControlDefs.globalbase;
localbase: CARDINAL = ControlDefs.localbase;
BitAddress: TYPE = Symbols.BitAddress;
ContextLevel: TYPE = Symbols.ContextLevel;
CTXIndex: TYPE = Symbols.CTXIndex;
HTIndex: TYPE = Symbols.HTIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
CSEIndex: TYPE = Symbols.CSEIndex;
lG: ContextLevel = Symbols.lG;
lZ: ContextLevel = Symbols.lZ;
SEIndex: TYPE = Symbols.SEIndex;
LTIndex: TYPE = Literals.LTIndex;
tb: Table.Base; -- tree base (local copy)
seb: Table.Base; -- semantic entry base (local copy)
ctxb: Table.Base; -- context entry base (local copy)
cb: Table.Base; -- code base (local copy)
AddressNotify: PUBLIC Table.Notifier =
BEGIN -- called by Code whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
cb ← tb ← base[Tree.treeType];
RETURN
END;
Index: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for array indexing
elementWords: CARDINAL ← SymbolOps.WordsForType[tb[node].info];
grain, ePerWord: CARDINAL;
ar: VarIndex;
bar: BoVarIndex;
er: IndVarIndex;
arraytype: CSEIndex;
delta: INTEGER;
treeInserted, packed: BOOLEAN ← FALSE;
t1, t2: Tree.Link;
base, index, offset: VarComponent;
indexMax, owd: CARDINAL;
t1 ← tb[node].son[1];
t2 ← tb[node].son[2];
arraytype ← P5U.OperandType[t1];
WITH a:seb[arraytype] SELECT FROM
array =>
BEGIN
indexMax ← SymbolOps.Cardinality[a.indexType];
IF a.oldPacked THEN
BEGIN
SELECT SymbolOps.BitsForType[a.componentType] FROM
1 => grain ← 1;
2 => grain ← 2;
3,4 => grain ← 4;
5,6,7,8 => grain ← 8;
ENDCASE => GO TO not;
grain ← 8; -- *************** until after 6.0c bootstrap
ePerWord ← 16/grain;
packed ← TRUE;
EXITS
not => packed ← FALSE;
END
ELSE packed ← FALSE;
END;
ENDCASE => ERROR;
ar ← P5L.VarForLex[P5.Exp[t1]];
bar ← P5L.MakeBo[ar];
IF bar = VarNull THEN
SIGNAL CPtr.CodeNotImplemented; -- no packed arrays of arrays
base ← cb[bar].base; offset ← cb[bar].offset;
WITH oo: offset SELECT FROM
frame =>
BEGIN
IF oo.level # lZ THEN ERROR;
IF packed THEN
BEGIN
IF oo.bd MOD grain # 0 THEN ERROR;
oo.wd ← (oo.wd*ePerWord) + oo.bd / grain;
-- above converts wd to element count vs word count
oo.bd ← 0; 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
IF oo.bd MOD grain # 0 THEN ERROR;
oo.wd ← (oo.wd*ePerWord) + oo.bd / grain;
-- above converts wd to element count vs word count
oo.bd ← 0; 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, treeInserted] ←
CheckAdditivity[t2, elementWords, owd];
P5L.ModComponent[var: @offset, wd: INTEGER[elementWords] * delta];
index ← P5L.ComponentForLex[P5.Exp[t2]];
WITH ii: index SELECT FROM
const =>
BEGIN
co: InlineDefs.LongNumber;
co.lc ← LONG[elementWords] * ii.d1;
IF co.highbits # 0 THEN GO TO tooBig;
IF packed THEN
BEGIN
newwd: CARDINAL;
newbd: [0..wordlength);
IF LONG[owd] + co.lc > LONG[LAST[CARDINAL]] THEN
GO TO tooBig;
owd ← owd + co.lowbits;
newwd ← owd / ePerWord; newbd ← (owd MOD ePerWord) * grain;
WITH oo: offset SELECT FROM
frame => BEGIN oo.wd ← newwd; oo.bd ← newbd; END;
code => BEGIN oo.wd ← newwd; oo.bd ← newbd; END;
ENDCASE;
END
ELSE
BEGIN
IF LONG[owd] + co.lc > LONG[LAST[CARDINAL]] THEN
GO TO tooBig;
P5L.ModComponent[var: @offset, wd: co.lowbits];
END;
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: NULL, packinfo: NULL]];
IF packed THEN
BEGIN
cb[er].simple ← SymbolOps.WordsForType[arraytype] <= 256;
cb[er].packinfo ← packed [grain: grain];
END
ELSE
BEGIN
longBase: BOOLEAN ← P5L.Words[base.wSize, base.bSize] > 1;
cb[er].simple ←
~longBase OR
(indexMax # 0 AND LONG[elementWords]*LONG[indexMax] < 200000B);
cb[er].packinfo ← notPacked[elementWords];
END;
IF treeInserted THEN WITH t2 SELECT FROM
subtree =>
BEGIN tb[index].son[1] ← Tree.Null; TreeOps.FreeNode[index]; END;
ENDCASE => P5.P5Error[323];
RETURN [[bdo[er]]];
END;
CheckAdditivity: PROCEDURE [t: Tree.Link, elementWords, current: CARDINAL]
RETURNS [rt: Tree.Link, delta: INTEGER, insertedtree: BOOLEAN] =
BEGIN OPEN Tree, TreeOps;
node: Tree.Index;
p: BOOLEAN;
cDelta: CARDINAL;
rt ← t;
delta ← 0;
insertedtree ← FALSE;
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 LONG[cDelta]*LONG[elementWords] >
LONG[LAST[CARDINAL] - current] THEN
GO TO tooBig;
delta ← cDelta; -- ok if > LAST[INTEGER] as used later
IF p THEN
rt ← tb[node].son[2]
ELSE
BEGIN
PushTree[tb[node].son[2]]; PushNode[uminus, 1];
SetInfo[MPtr.typeINTEGER];
SetAttr[1, FALSE]; rt ← PopTree[];
insertedtree ← TRUE;
END;
END
ELSE IF P5U.TreeLiteral[tb[node].son[2]] THEN
BEGIN
cDelta ← P5U.TreeLiteralValue[tb[node].son[2]];
IF p THEN
IF LONG[cDelta]*LONG[elementWords] >
LONG[LAST[CARDINAL] - current] THEN
GO TO tooBig
ELSE delta ← cDelta -- ok if > LAST[INTEGER] as used later
ELSE
IF LONG[cDelta]*LONG[elementWords] > LONG[current] THEN
GO TO tooBig
ELSE delta ← -INTEGER[cDelta];
rt ← tb[node].son[1];
END;
EXITS
tooBig => delta ← 0;
END;
ENDCASE;
RETURN
END;
DIndex: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for indexing from an array descriptor
er: IndVarIndex;
rBase: VarIndex;
nilck: BOOLEAN ← tb[node].attr1;
long: BOOLEAN = tb[node].attr2;
bndck: BOOLEAN ← tb[node].attr3;
elementWords: CARDINAL ← SymbolOps.WordsForType[tb[node].info];
treeInserted: BOOLEAN ← FALSE;
packed: BOOLEAN;
pLength: CARDINAL = IF long THEN 2 ELSE 1;
arraytype, arraydtype: CSEIndex;
t1, t2: Tree.Link;
delta, grain, owd: CARDINAL;
base, bound, index: VarComponent;
offset: frame VarComponent;
t1 ← tb[node].son[1];
t2 ← tb[node].son[2];
arraydtype ← SymbolOps.NormalType[P5U.OperandType[t1]];
WITH seb[arraydtype] SELECT FROM
arraydesc => arraytype ← SymbolOps.UnderType[describedType];
ENDCASE;
WITH a:seb[arraytype] SELECT FROM
array =>
IF a.oldPacked THEN
BEGIN
SELECT SymbolOps.BitsForType[a.componentType] FROM
1 => grain ← 1;
2 => grain ← 2;
3,4 => grain ← 4;
5,6,7,8 => grain ← 8;
ENDCASE => GO TO not;
grain ← 8; -- *************** until after 6.0c bootstrap
packed ← TRUE;
EXITS
not => packed ← FALSE;
END
ELSE packed ← FALSE;
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[t1]];
IF bndck THEN
BEGIN
rBound: VarIndex ← P5L.CopyVarItem[rBase];
P5L.FieldOfVar[r: rBound, wd: pLength, wSize: 1];
P5L.FieldOfVar[r: rBase, wSize: pLength];
bound ← P5L.MakeComponent[rBound];
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;
[t2, delta, treeInserted] ← CheckAdditivity[t2, 1, 0];
offset.wd ← owd ← elementWords * delta; -- elementWords = 1 if packed
index ← P5L.ComponentForLex[P5.Exp[t2]];
IF bndck THEN
BEGIN
P5L.LoadBoth[@index, @bound, FALSE];
P5U.Out0[FOpCodes.qBNDCK];
index ← P5L.TOSComponent[1];
END
ELSE WITH index SELECT FROM
const =>
BEGIN
bar: VarIndex;
co: InlineDefs.LongNumber;
co.lc ← elementWords * d1;
IF co.highbits # 0 THEN GO TO tooBig;
bar ← P5L.GenVarItem[bo];
IF packed THEN
BEGIN
ePerWord: CARDINAL = wordlength / grain;
IF LONG[owd] + co.lc > LONG[LAST[CARDINAL]] THEN
GO TO tooBig;
owd ← owd + co.lowbits;
offset.wd ← owd / ePerWord;
offset.bd ← (owd MOD ePerWord) * grain;
END
ELSE
BEGIN
IF LONG[owd] + co.lc > LONG[LAST[CARDINAL]] THEN
GO TO tooBig;
P5L.ModComponent[var: @offset, wd: co.lowbits];
END;
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: NULL,
packinfo: NULL]];
IF packed THEN
BEGIN
cb[er].simple ← FALSE;
cb[er].packinfo ← packed [grain: grain];
END
ELSE
BEGIN
cb[er].simple ← ~long;
cb[er].packinfo ← notPacked[elementWords];
END;
IF treeInserted THEN WITH t2 SELECT FROM
subtree =>
BEGIN tb[index].son[1] ← Tree.Null; TreeOps.FreeNode[index]; END;
ENDCASE => P5.P5Error[323];
RETURN[[bdo[er]]];
END;
SeqIndex: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
easy: BOOLEAN ← FALSE;
nilck: BOOLEAN ← tb[node].attr1;
long: BOOLEAN ← tb[node].attr2;
bndck: BOOLEAN ← tb[node].attr3;
t1: Tree.Link ← tb[node].son[1];
t2: Tree.Link ← tb[node].son[2];
base, index: VarComponent;
rBound: VarIndex;
er: VarIndex;
delta: INTEGER;
treeInserted: BOOLEAN ← FALSE;
StringHeaderSize: CARDINAL = 2;
CharsPerWord: CARDINAL = 2;
byteOffset: CARDINAL = StringHeaderSize*CharsPerWord;
IF long AND bndck THEN Stack.Mark[];
base ← P5L.ComponentForLex[P5.Exp[t1]];
IF bndck THEN
BEGIN
base ← P5L.EasilyLoadable[base, load];
rBound ← P5L.GenVarItem[bo];
cb[rBound] ←
[body: bo[base: base, offset: [wSize: 1, space: frame[wd: 1]]]];
END;
IF nilck THEN
BEGIN
P5L.LoadComponent[base];
P5U.Out0[IF long THEN FOpCodes.qNILCKL ELSE FOpCodes.qNILCK];
base ← P5L.TOSComponent[IF long THEN 2 ELSE 1];
END;
[t2, delta, treeInserted] ← CheckAdditivity[t2, 1, byteOffset];
index ← P5L.ComponentForLex[P5.Exp[t2]];
IF bndck THEN
BEGIN
P5L.LoadComponent[index];
P5L.LoadVar[rBound];
P5U.Out0[FOpCodes.qBNDCK];
index ← P5L.TOSComponent[1];
END
ELSE WITH index SELECT FROM
const =>
BEGIN
co: CARDINAL = d1 + CARDINAL[byteOffset + delta];
bar: VarIndex = P5L.GenVarItem[bo];
cb[bar] ← [body: bo[base: base, offset:
[bSize: charlength, space:
frame[wd: co/CharsPerWord,
bd: (co MOD CharsPerWord)*charlength]]]];
RETURN [[bdo[bar]]];
END;
ENDCASE;
er ← P5L.GenVarItem[ind];
cb[er] ← [body: ind[
base: base,
index: index,
offset: [bSize: 8, space: frame[wd: 4+delta]],
simple: FALSE,
packinfo: packed[grain: 8]]];
IF treeInserted THEN WITH t2 SELECT FROM
subtree =>
BEGIN tb[index].son[1] ← Tree.Null; TreeOps.FreeNode[index]; END;
ENDCASE => P5.P5Error[323];
RETURN[[bdo[er]]];
END;
END...