-- file Pass4Xa.Mesa
-- last written by Satterthwaite, January 17, 1980 3:15 PM
DIRECTORY
AltoDefs: FROM "altodefs"
USING [charlength, maxinteger, maxword, wordlength],
ComData: FROM "comdata"
USING [ownSymbols, switches, typeINTEGER, typeCHARACTER],
InlineDefs: FROM "inlinedefs" USING [BITAND, BITOR, BITSHIFT],
Literals: FROM "literals" USING [LitDescriptor, ltType],
LiteralOps: FROM "literalops" USING [FindDescriptor, MasterString],
Log: FROM "log" USING [Error, ErrorN, ErrorTree],
P4: FROM "p4"
USING [
Covering, Repr, none, signed, unsigned, both, other, RegCount, MaxRegs,
AdjustBias, BiasForType, BitsForType, CatchNest, ComputeIndexRegs,
Exp, ForceType, MakeStructuredLiteral, MakeTreeLiteral, OperandType,
RegsForType, RepForType, RValue, StructuredLiteral, TreeLiteral,
TreeLiteralDesc, TreeLiteralValue, TypeExp,
VBias, VPop, VPush, VRegs, VRep, WordsForType, ZeroP],
Symbols: FROM "symbols"
USING [ctxType, seType,
BitAddress, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
typeANY, lZ],
SymbolOps: FROM "symbolops"
USING [
Cardinality, FirstVisibleSe, FnField, NextSe, NormalType, RecordRoot,
UnderType],
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree"
USING [Index, Link, Map, Scan, Null, treeType],
TreeOps: FROM "treeops"
USING [
FreeNode, GetNode, ListLength, PopTree, PushTree, PushLit, PushNode,
ScanList, SetAttr, SetInfo, TestTree, UpdateList],
Types: FROM "types" USING [Assignable];
Pass4Xa: PROGRAM
IMPORTS
InlineDefs, Log, LiteralOps, P4, SymbolOps, SystemDefs, TreeOps, Types,
dataPtr: ComData
EXPORTS P4 =
BEGIN
OPEN SymbolOps, TreeOps, P4;
-- pervasive definitions from Symbols
SEIndex: TYPE = Symbols.SEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
CSEIndex: TYPE = Symbols.CSEIndex;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
BitAddress: TYPE = Symbols.BitAddress;
tb: Table.Base; -- tree base address (local copy)
ltb: Table.Base; -- literal base address (local copy)
seb: Table.Base; -- se table base address (local copy)
ctxb: Table.Base; -- context table base address (local copy)
ExpANotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
tb ← base[Tree.treeType]; ltb ← base[Literals.ltType];
seb ← base[Symbols.seType]; ctxb ← base[Symbols.ctxType];
END;
-- expression list manipulation
MakeRecord: PROCEDURE [record: RecordSEIndex, expList: Tree.Link]
RETURNS [val: Tree.Link, nRegs: RegCount] =
BEGIN
sei: ISEIndex;
const: BOOLEAN;
subNode: Tree.Index;
EvaluateField: Tree.Map =
BEGIN
type: CSEIndex = UnderType[seb[sei].idType];
IF t = Tree.Null
THEN
BEGIN
v ← Tree.Null;
IF BitsForType[type] # 0 THEN const ← FALSE;
END
ELSE
BEGIN
v ← WITH t SELECT FROM
subtree =>
SELECT tb[index].name FROM
construct => NestedConstruct[index, type],
union => Union[index, TRUE],
ENDCASE => Rhs[t, type],
ENDCASE => Rhs[t, type];
IF ~TreeLiteral[v]
THEN
WITH v SELECT FROM
subtree =>
SELECT tb[index].name FROM
mwconst => NULL;
union => IF ~tb[index].attr1 THEN const ← FALSE;
ENDCASE => const ← FALSE;
ENDCASE => const ← FALSE;
nRegs ← MAX[VRegs[], nRegs]; VPop[];
END;
sei ← NextSe[sei];
RETURN
END;
sei ← FirstVisibleSe[seb[record].fieldCtx]; const ← TRUE; nRegs ← 0;
val ← UpdateList[expList, EvaluateField];
IF TestTree[val, list]
THEN BEGIN subNode ← GetNode[val]; tb[subNode].attr1 ← const END;
RETURN
END;
NestedConstruct: PROCEDURE [node: Tree.Index, lType: CSEIndex] RETURNS [val: Tree.Link] =
BEGIN
rType: CSEIndex = tb[node].info;
val ← Construct[node, TRUE];
IF WordsForType[lType] > WordsForType[rType]
THEN val ← PadRecord[val, lType];
RETURN
END;
MakeArgRecord: PUBLIC PROCEDURE [record: RecordSEIndex, expList: Tree.Link]
RETURNS [val: Tree.Link] =
BEGIN
type: CSEIndex;
seb[record].lengthUsed ← TRUE;
SELECT TRUE FROM
(expList = Tree.Null) => val ← Tree.Null;
TestTree[expList, list] => val ← MakeRecord[record, expList].val;
ENDCASE =>
BEGIN
type ← UnderType[seb[FirstVisibleSe[seb[record].fieldCtx]].idType];
val ← Rhs[expList, type]; VPop[];
END;
RETURN
END;
-- construction of packed values (machine dependent)
WordLength: CARDINAL = AltoDefs.wordlength;
ByteLength: CARDINAL = AltoDefs.charlength;
FillMultiWord: PROCEDURE [words: DESCRIPTOR FOR ARRAY OF WORD,
origin: CARDINAL, t: Tree.Link] RETURNS [newOrigin: CARDINAL] =
BEGIN
desc: Literals.LitDescriptor;
i: CARDINAL;
desc ← TreeLiteralDesc[t];
FOR i IN [0 .. desc.length)
DO words[origin + i] ← ltb[desc.offset][i] ENDLOOP;
RETURN [origin + desc.length]
END;
PackRecord: PROCEDURE [record: RecordSEIndex, expList: Tree.Link] RETURNS [Tree.Link] =
BEGIN
n: CARDINAL = WordsForType[record];
root, type: RecordSEIndex;
list: Tree.Link;
sei: ISEIndex;
offset: CARDINAL;
words: DESCRIPTOR FOR ARRAY OF WORD;
i: CARDINAL;
more: BOOLEAN;
StoreBits: PROCEDURE [sei: ISEIndex, value: WORD] =
BEGIN
OPEN InlineDefs;
Masks: ARRAY [0..WordLength] OF WORD =
[0B, 1B, 3B, 7B, 17B, 37B, 77B, 177B, 377B, 777B,
1777B, 3777B, 7777B, 17777B, 37777B, 77777B, 177777B];
address: BitAddress;
size, w, shift: CARDINAL;
IF seb[root].argument
THEN [address, size] ← FnField[sei]
ELSE BEGIN address ← seb[sei].idValue; size ← seb[sei].idInfo END;
w ← address.wd;
shift ← (WordLength-offset) - (address.bd+size);
words[w] ← BITOR[words[w], BITSHIFT[BITAND[value, Masks[size]], shift]];
END;
PackField: Tree.Scan =
BEGIN
node: Tree.Index;
address: BitAddress;
typeId: ISEIndex;
subType: CSEIndex;
SELECT TRUE FROM
t = Tree.Null => NULL;
TreeLiteral[t] => StoreBits[sei, TreeLiteralValue[t]];
ENDCASE =>
BEGIN node ← GetNode[t];
SELECT tb[node].name FROM
mwconst =>
BEGIN
address ← IF seb[root].argument
THEN FnField[sei].offset
ELSE seb[sei].idValue;
[] ← FillMultiWord[words, address.wd, tb[node].son[1]];
END;
union =>
BEGIN
WITH tb[node].son[1] SELECT FROM
symbol => typeId ← index;
ENDCASE => ERROR;
subType ← UnderType[seb[sei].idType];
WITH seb[subType] SELECT FROM
union =>
IF controlled THEN StoreBits[tagSei, seb[typeId].idValue];
ENDCASE => ERROR;
type ← LOOPHOLE[UnderType[typeId], RecordSEIndex];
list ← tb[node].son[2]; more ← TRUE;
END;
ENDCASE => ERROR;
END;
sei ← NextSe[sei];
END;
words ← DESCRIPTOR[SystemDefs.AllocateHeapNode[n], n];
FOR i IN [0 .. n) DO words[i] ← 0 ENDLOOP;
root ← type ← RecordRoot[record];
offset ← IF seb[record].length < WordLength
THEN WordLength - seb[record].length
ELSE 0;
list ← expList; more ← TRUE;
WHILE more
DO
more ← FALSE;
sei ← FirstVisibleSe[seb[type].fieldCtx];
ScanList[list, PackField];
ENDLOOP;
PushLit[LiteralOps.FindDescriptor[words]];
PushNode[IF n=1 THEN cast ELSE mwconst, 1]; SetInfo[record];
SystemDefs.FreeHeapNode[BASE[words]];
RETURN [PopTree[]]
END;
PadRecord: PUBLIC PROCEDURE [t: Tree.Link, lType: CSEIndex] RETURNS [Tree.Link] =
BEGIN
IF StructuredLiteral[t]
THEN
BEGIN
words: DESCRIPTOR FOR ARRAY OF WORD;
w, nW: CARDINAL;
node: Tree.Index;
nW ← WordsForType[lType];
words ← DESCRIPTOR[SystemDefs.AllocateHeapNode[nW], nW];
FOR w IN [0 .. nW) DO words[w] ← 0 ENDLOOP;
IF TreeLiteral[t]
THEN words[0] ← TreeLiteralValue[t]
ELSE
BEGIN node ← GetNode[t];
SELECT tb[node].name FROM
mwconst => w ← FillMultiWord[words, 0, tb[node].son[1]];
ENDCASE => ERROR;
FreeNode[node];
END;
PushLit[LiteralOps.FindDescriptor[words]]; PushNode[mwconst, 1];
SystemDefs.FreeHeapNode[BASE[words]];
END
ELSE BEGIN PushTree[t]; PushNode[pad, 1] END;
SetInfo[lType];
RETURN [PopTree[]]
END;
ExtractValue: PROCEDURE [t: Tree.Link, addr: BitAddress, size: CARDINAL, type: CSEIndex]
RETURNS [val: Tree.Link] =
BEGIN
words: DESCRIPTOR FOR ARRAY OF WORD;
i: CARDINAL;
desc: Literals.LitDescriptor = TreeLiteralDesc[t];
n: CARDINAL = size/WordLength;
IF n > 1
THEN
BEGIN
IF addr.bd # 0 THEN Log.Error[unimplemented];
words ← DESCRIPTOR[SystemDefs.AllocateHeapNode[n], n];
FOR i IN [0 .. n) DO words[i] ← ltb[desc.offset][addr.wd+i] ENDLOOP;
PushLit[LiteralOps.FindDescriptor[words]];
PushNode[mwconst, 1]; SetInfo[type];
SystemDefs.FreeHeapNode[BASE[words]];
val ← PopTree[];
END
ELSE
val ← MakeStructuredLiteral[
InlineDefs.BITSHIFT[
InlineDefs.BITSHIFT[ltb[desc.offset][addr.wd], addr.bd],
-(WordLength - size)],
type];
RETURN
END;
UnpackField: PROCEDURE [t: Tree.Link, field: ISEIndex] RETURNS [val: Tree.Link] =
BEGIN
rType: CSEIndex = OperandType[t];
vType: CSEIndex = UnderType[seb[field].idType];
addr: BitAddress;
addr ← seb[field].idValue;
WITH r: seb[rType] SELECT FROM
record =>
IF r.length < WordLength
THEN addr.bd ← addr.bd + (WordLength - r.length);
ENDCASE => ERROR;
RETURN [ExtractValue[t, addr, seb[field].idInfo, vType]]
END;
UnpackElement: PROCEDURE [t: Tree.Link, i: CARDINAL] RETURNS [val: Tree.Link] =
BEGIN
aType: CSEIndex = OperandType[t];
cType: CSEIndex;
addr: BitAddress;
nB, nW: CARDINAL;
BytesPerWord: CARDINAL = WordLength/ByteLength;
WITH a: seb[aType] SELECT FROM
array =>
BEGIN
cType ← UnderType[a.componentType]; nB ← BitsForType[cType];
IF nB > ByteLength OR ~a.oldPacked
THEN
BEGIN
nW ← (nB+(WordLength-1))/WordLength;
addr ← [wd:i*nW, bd:0]; nB ← nW*WordLength;
END
ELSE
BEGIN
addr ← [wd:i/BytesPerWord, bd:(i MOD BytesPerWord)*ByteLength];
nB ← ByteLength;
END;
END;
ENDCASE => ERROR;
RETURN [ExtractValue[t, addr, nB, cType]]
END;
-- operators
Call: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
BEGIN OPEN tb[node];
type: CSEIndex;
son[1] ← Exp[son[1], none]; VPop[];
type ← OperandType[son[1]];
WITH seb[type] SELECT FROM
transfer =>
BEGIN
son[2] ← MakeArgRecord[inRecord, son[2]];
VPush[BiasForType[outRecord], RepForType[outRecord], MaxRegs];
END;
ENDCASE => ERROR;
IF nSons > 2 THEN CatchNest[son[3]];
RETURN [[subtree[index: node]]]
END;
MiscXfer: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
BEGIN
type: CSEIndex;
SELECT tb[node].name FROM
new =>
BEGIN
tb[node].son[1] ← RValue[tb[node].son[1], 0, none]; VPop[];
VPush[0, unsigned, MaxRegs];
END;
fork =>
BEGIN OPEN tb[node];
son[1] ← Exp[son[1], none]; VPop[];
type ← OperandType[son[1]];
WITH seb[type] SELECT FROM
transfer =>
BEGIN
son[2] ← MakeArgRecord[inRecord, son[2]];
VPush[0, other, MaxRegs];
END;
ENDCASE => ERROR;
END;
ENDCASE => ERROR;
IF tb[node].nSons > 2 THEN CatchNest[tb[node].son[3]];
RETURN [[subtree[index: node]]]
END;
Construct: PUBLIC PROCEDURE [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
type: RecordSEIndex = info;
record: RecordSEIndex = RecordRoot[type];
nRegs: RegCount;
k: RegCount = RegsForType[type];
[son[2], nRegs] ← MakeRecord[record, son[2]]; seb[type].lengthUsed ← TRUE;
SELECT TRUE FROM
TestTree[son[2], list] OR TestTree[son[2], union] =>
BEGIN
subNode: Tree.Index = GetNode[son[2]];
IF ~tb[subNode].attr1 -- ~all fields constant
THEN BEGIN val ← [subtree[index: node]]; nRegs ← MAX[nRegs, k] END
ELSE
BEGIN
val ← PackRecord[type, son[2]]; FreeNode[node]; nRegs ← k;
END;
VPush[0, other, nRegs];
END;
(son[2] = Tree.Null) => BEGIN val ← Tree.Null; VPush[0, other, 0] END;
ENDCASE => val ← CastUniList[node, type, nested];
RETURN
END;
Union: PUBLIC PROCEDURE [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
vSei: ISEIndex = WITH son[1] SELECT FROM symbol=>index, ENDCASE=>ERROR;
type: RecordSEIndex = LOOPHOLE[UnderType[vSei]];
tSei: CSEIndex = UnderType[info];
tagged: BOOLEAN =
WITH seb[tSei] SELECT FROM union => controlled, ENDCASE => FALSE;
nRegs: RegCount;
[son[2], nRegs] ← MakeRecord[type, son[2]]; seb[type].lengthUsed ← TRUE;
attr2 ← tagged;
SELECT TRUE FROM
TestTree[son[2], list] OR TestTree[son[2], union] =>
BEGIN
attr1 ← WITH son[2] SELECT FROM
subtree => tb[index].attr1,
ENDCASE => FALSE;
val ← [subtree[index: node]]; VPush[0, other, nRegs];
END;
(son[2] = Tree.Null) =>
BEGIN
attr1 ← TRUE; val ← [subtree[index: node]]; VPush[0, other, 1];
END;
ENDCASE =>
IF WordsForType[type] = 1 AND (~tagged OR seb[vSei].idValue = 0)
THEN val ← CastUniList[node, type, nested]
ELSE
BEGIN
attr1 ← StructuredLiteral[son[2]];
val ← [subtree[index: node]]; VPush[0, other, RegsForType[type]];
END;
RETURN
END;
CastUniList: PROCEDURE [node: Tree.Index, type: CSEIndex, nested: BOOLEAN]
RETURNS [val: Tree.Link] =
BEGIN
subNode: Tree.Index;
unSafe: BOOLEAN;
t: Tree.Link ← tb[node].son[2];
IF (unSafe ← TestTree[t, safen])
THEN
BEGIN
subNode ← GetNode[t]; t ← tb[subNode].son[1];
tb[subNode].son[1] ← Tree.Null; FreeNode[subNode];
END;
tb[node].son[2] ← Tree.Null; FreeNode[node];
val ← ForceType[t, type];
IF unSafe AND nested
THEN
BEGIN
PushTree[val]; PushNode[safen, 1]; SetInfo[type]; val ← PopTree[];
END;
VPush[BiasForType[type], RepForType[type], RegsForType[type]];
RETURN
END;
RowConstruct: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
aType: Symbols.ArraySEIndex = info;
cType: CSEIndex = UnderType[seb[aType].componentType];
n: CARDINAL = Cardinality[seb[aType].indexType];
const, strings, lstrings: BOOLEAN;
nRegs: RegCount;
l: CARDINAL;
EvalElement: Tree.Map =
BEGIN
IF t = Tree.Null
THEN BEGIN v ← Tree.Null; const ← strings ← lstrings ← FALSE END
ELSE
BEGIN
v ← Rhs[t, cType]; nRegs ← MAX[VRegs[], nRegs];
IF TreeLiteral[v]
THEN strings ← lstrings ← FALSE
ELSE
WITH v SELECT FROM
subtree =>
SELECT tb[index].name FROM
mwconst => strings ← lstrings ← FALSE;
ENDCASE => const ← strings ← lstrings ← FALSE;
literal =>
WITH info SELECT FROM
string =>
BEGIN const ← FALSE;
IF LiteralOps.MasterString[index] = index
THEN lstrings ← FALSE
ELSE strings ← FALSE;
END;
ENDCASE;
ENDCASE => const ← strings ← lstrings ← FALSE;
VPop[];
END;
RETURN
END;
w, nW: CARDINAL;
words: DESCRIPTOR FOR ARRAY OF WORD;
bitsLeft: CARDINAL;
bitCount: CARDINAL;
PackElement: Tree.Scan =
BEGIN
node: Tree.Index;
IF TreeLiteral[t]
THEN
BEGIN
bitsLeft ← bitsLeft - bitCount;
words[w] ← InlineDefs.BITOR[words[w],
InlineDefs.BITSHIFT[TreeLiteralValue[t], bitsLeft]];
IF bitsLeft < bitCount
THEN BEGIN w ← w+1; bitsLeft ← WordLength END;
END
ELSE
BEGIN node ← GetNode[t];
SELECT tb[node].name FROM
mwconst => w ← FillMultiWord[words, w, tb[node].son[1]];
ENDCASE => ERROR;
END;
END;
SELECT (l ← ListLength[son[2]]) FROM
= n => NULL;
> n => Log.ErrorN[listLong, l-n];
< n => Log.ErrorN[listShort, n-l];
ENDCASE;
const ← strings ← lstrings ← TRUE; nRegs ← 0;
son[2] ← UpdateList[son[2], EvalElement];
IF const AND l = n
THEN
BEGIN
nW ← WordsForType[aType];
words ← DESCRIPTOR[SystemDefs.AllocateHeapNode[nW], nW];
FOR w IN [0 .. nW) DO words[w] ← 0 ENDLOOP;
bitCount ←
IF seb[aType].oldPacked AND BitsForType[cType] <= ByteLength
THEN ByteLength ELSE WordLength;
w ← 0; bitsLeft ← WordLength;
ScanList[son[2], PackElement]; FreeNode[node];
PushLit[LiteralOps.FindDescriptor[words]];
PushNode[IF nW = 1 THEN cast ELSE mwconst, 1]; SetInfo[aType];
SystemDefs.FreeHeapNode[BASE[words]];
val ← PopTree[]; nRegs ← RegsForType[aType];
END
ELSE
BEGIN attr1 ← strings # lstrings; val ← [subtree[index: node]] END;
seb[aType].lengthUsed ← TRUE; VPush[0, other, nRegs]; RETURN
END;
All: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
BEGIN
OPEN tb[node];
aType: Symbols.ArraySEIndex = info;
cType: CSEIndex = UnderType[seb[aType].componentType];
IF son[1] # Tree.Null THEN
BEGIN
son[1] ← Rhs[son[1], cType];
IF OperandType[son[1]] # cType THEN son[1] ← ForceType[son[1], cType];
VPop[];
END;
VPush[0, other, RegsForType[aType]];
seb[aType].lengthUsed ← TRUE; RETURN [[subtree[index: node]]]
END;
Dollar: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
rep: Repr;
bias: INTEGER;
nRegs: RegCount;
k: RegCount = RegsForType[info];
son[1] ← Exp[son[1], none]; nRegs ← VRegs[]; VPop[];
son[2] ← Exp[son[2], none]; rep ← VRep[]; bias ← VBias[]; VPop[];
IF ~StructuredLiteral[son[1]]
THEN BEGIN val ← [subtree[index: node]]; nRegs ← MAX[nRegs, k] END
ELSE
WITH son[2] SELECT FROM
symbol =>
BEGIN
val ← UnpackField[son[1], index]; FreeNode[node]; nRegs ← k;
END;
ENDCASE => ERROR;
VPush[bias, rep, nRegs]; RETURN
END;
Index: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
aType, iType, cType: CSEIndex;
next: SEIndex;
nRegs: RegCount;
son[1] ← Exp[son[1], none];
FOR aType ← OperandType[son[1]], UnderType[next]
DO
WITH seb[aType] SELECT FROM
array =>
BEGIN
iType ← UnderType[indexType]; cType ← UnderType[componentType]; EXIT
END;
arraydesc => next ← describedType;
long => next ← rangeType;
ENDCASE => ERROR;
ENDLOOP;
IF name = dindex
THEN
BEGIN
son[2] ← RValue[son[2], BiasForType[iType], unsigned];
attr1 ← dataPtr.switches['n]; attr3 ← dataPtr.switches['b];
END
ELSE son[2] ← Rhs[son[2], iType, TRUE];
SELECT TRUE FROM
(TreeLiteral[son[2]] AND TestTree[son[1], all]) =>
BEGIN
subNode: Tree.Index = GetNode[son[1]];
val ← tb[subNode].son[1];
tb[subNode].son[1] ← Tree.Null; FreeNode[node];
nRegs ← RegsForType[cType];
END;
(TreeLiteral[son[2]] AND StructuredLiteral[son[1]]) =>
BEGIN
val ← UnpackElement[son[1], TreeLiteralValue[son[2]]]; FreeNode[node];
nRegs ← RegsForType[cType];
END;
ENDCASE =>
BEGIN val ← [subtree[index:node]]; nRegs ← ComputeIndexRegs[node] END;
VPop[]; VPop[]; VPush[BiasForType[cType], RepForType[cType], nRegs];
RETURN
END;
Reloc: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
nRegs: RegCount;
type: CSEIndex = tb[node].info;
tb[node].son[1] ← RValue[tb[node].son[1], 0, unsigned];
tb[node].son[2] ← RValue[tb[node].son[2], 0, unsigned];
nRegs ← ComputeIndexRegs[node]; VPop[]; VPop[];
IF ~tb[node].attr1 AND ZeroP[tb[node].son[1]]
THEN
BEGIN
subType: CSEIndex = OperandType[tb[node].son[2]];
rType: CSEIndex;
PushTree[tb[node].son[2]]; tb[node].son[2] ← Tree.Null;
WITH r: seb[subType] SELECT FROM
relative =>
BEGIN
rType ← UnderType[r.resultType];
IF tb[node].attr2 AND seb[UnderType[r.offsetType]].typeTag # long
THEN
BEGIN
PushNode[lengthen, 1];
SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, FALSE];
END
ELSE PushNode[cast, 1];
END;
ENDCASE => ERROR;
SetInfo[rType];
PushNode[uparrow, 1]; SetInfo[type];
SetAttr[1, dataPtr.switches['n]]; SetAttr[2, tb[node].attr2];
val ← PopTree[]; FreeNode[node];
END
ELSE val ← [subtree[node]];
VPush[BiasForType[type], RepForType[type], nRegs];
END;
Assignment: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
BEGIN OPEN tb[node];
lhsType: CSEIndex;
son[1] ← Exp[son[1], none]; lhsType ← OperandType[son[1]];
son[2] ← Rhs[son[2], lhsType]; VPop[];
RETURN [RewriteAssign[node, lhsType]]
END;
TargetRep: PUBLIC PROCEDURE [rep: Repr] RETURNS [Repr] =
BEGIN
RETURN [IF rep = both THEN signed ELSE rep]
END;
Rhs: PUBLIC PROCEDURE [
exp: Tree.Link, lType: CSEIndex, voidOK: BOOLEAN ← FALSE]
RETURNS [val: Tree.Link] =
BEGIN
lBias: INTEGER = BiasForType[lType];
lRep: Repr = RepForType[lType];
rType: CSEIndex ← OperandType[exp];
rRep: Repr;
nw: CARDINAL;
val ← RValue[exp, lBias, TargetRep[lRep]];
rRep ← VRep[];
IF ~Types.Assignable[
[dataPtr.ownSymbols, lType], [dataPtr.ownSymbols, rType]]
THEN Log.ErrorTree[typeClash, val];
nw ← WordsForType[lType];
IF ~(IF nw = 0 THEN voidOK ELSE WordsForType[rType] = nw) THEN
SELECT seb[lType].typeTag FROM
record => val ← PadRecord[val, lType];
union => NULL;
ENDCASE => Log.ErrorTree[sizeClash, val];
IF (lType = dataPtr.typeINTEGER AND rRep = unsigned) OR
((rType = dataPtr.typeINTEGER AND rRep = signed) AND lRep = unsigned)
THEN val ← CheckRange[val, CARDINAL[AltoDefs.maxinteger-lBias]+1, lType]
ELSE
SELECT seb[lType].typeTag FROM
subrange, enumerated, relative =>
SELECT Cover[lType, lRep, rType, rRep] FROM
full => NULL;
partial => val ← CheckRange[val, Cardinality[lType], lType];
ENDCASE => IF nw # 0 THEN val ← BoundsFault[val, lType];
basic =>
IF lType = dataPtr.typeCHARACTER AND
(rRep # both OR TreeLiteral[val])
THEN val ← CheckRange[val, Cardinality[lType], lType];
ENDCASE => NULL;
RETURN
END;
Cover: PUBLIC PROCEDURE [lType: CSEIndex, lRep: Repr, rType: CSEIndex, rRep: Repr]
RETURNS [Covering] =
BEGIN
lLb, lUb, rLb, rUb: LONG INTEGER;
[lLb, lUb] ← Bounds[lType, lRep];
[rLb, rUb] ← Bounds[rType, rRep];
RETURN [
IF lLb <= rLb
THEN IF lUb < rLb THEN none ELSE IF lUb < rUb THEN partial ELSE full
ELSE IF lLb <= rUb THEN partial ELSE none]
END;
Bounds: PROCEDURE [type: CSEIndex, rep: Repr] RETURNS [lb, ub: LONG INTEGER] =
BEGIN
WITH t: seb[type] SELECT FROM
subrange => BEGIN lb ← t.origin; ub ← lb + t.range END;
enumerated => BEGIN lb ← 0; ub ← t.nValues-1 END;
relative => [lb, ub] ← Bounds[UnderType[t.offsetType], rep];
ENDCASE =>
SELECT rep FROM
signed =>
BEGIN lb ← -AltoDefs.maxinteger-1; ub ← AltoDefs.maxinteger END;
both => BEGIN lb ← 0; ub ← AltoDefs.maxinteger END;
ENDCASE => BEGIN lb ← 0; ub ← AltoDefs.maxword END;
RETURN
END;
CheckRange: PROCEDURE [t: Tree.Link, bound: CARDINAL, type: CSEIndex]
RETURNS [val: Tree.Link] =
BEGIN
SELECT TRUE FROM
(bound = 0) => val ← t;
TreeLiteral[t] =>
val ← IF TreeLiteralValue[t] >= bound THEN BoundsFault[t,type] ELSE t;
dataPtr.switches['b] =>
BEGIN
PushTree[MakeTreeLiteral[bound]];
IF TestTree[t, safen]
THEN
BEGIN
node: Tree.Index = GetNode[t];
PushTree[tb[node].son[1]]; PushNode[check, -2]; SetInfo[type];
tb[node].son[1] ← PopTree[]; val ← t;
END
ELSE
BEGIN
PushTree[t];
PushNode[check, -2]; SetInfo[type]; val ← PopTree[];
END;
END;
ENDCASE => val ← t;
RETURN
END;
BoundsFault: PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] =
BEGIN
Log.ErrorTree[boundsFault, AdjustBias[t, -BiasForType[type]]];
PushTree[t]; PushTree[MakeTreeLiteral[0]];
PushNode[check, 2]; SetInfo[type];
RETURN [PopTree[]]
END;
PushAssignment: PUBLIC PROCEDURE [id, val: Tree.Link, type: CSEIndex] =
BEGIN
rewrite: BOOLEAN;
i, n: CARDINAL;
rewrite ← TRUE;
WITH val SELECT FROM
subtree =>
SELECT tb[index].name FROM
body, signalinit => rewrite ← FALSE;
ENDCASE => NULL;
ENDCASE => NULL;
ScanList[id, PushTree]; n ← ListLength[id]; PushTree[val];
FOR i IN [1 .. n]
DO
IF i = n
THEN PushNode[assign, 2]
ELSE BEGIN PushNode[assignx, 2]; SetInfo[type] END;
IF rewrite
THEN PushTree[RewriteAssign[GetNode[PopTree[]], type]]
ELSE SetAttr[1, FALSE];
ENDLOOP;
END;
RewriteAssign: PROCEDURE [node: Tree.Index, lType: CSEIndex] RETURNS [Tree.Link] =
BEGIN
IF (tb[node].attr1 ← seb[lType].typeTag = union)
THEN
BEGIN
WITH tb[node].son[1] SELECT FROM
subtree =>
BEGIN
subType: CSEIndex;
subNode: Tree.Index = index;
SELECT tb[subNode].name FROM
dot =>
BEGIN
subType ← OperandType[tb[subNode].son[1]];
PushTree[tb[subNode].son[1]]; PushNode[uparrow, 1];
SetInfo[WITH seb[subType] SELECT FROM
pointer => UnderType[refType],
ENDCASE => Symbols.typeANY];
tb[subNode].son[1] ← PopTree[];
tb[subNode].name ← dollar;
END;
dollar => NULL;
ENDCASE => NULL; -- flagged by code generators for now
END;
ENDCASE => NULL; -- flagged by code generators for now
END;
IF tb[node].name = assignx
THEN tb[node].info ← OperandType[tb[node].son[1]];
RETURN [[subtree[index: node]]]
END;
-- misc addressing operators
AddrOp: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
nRegs: RegCount;
SELECT tb[node].name FROM
addr => val ← Addr[node];
base =>
BEGIN
tb[node].son[1] ← Exp[tb[node].son[1], none]; nRegs ← VRegs[]; VPop[];
VPush[0, unsigned, nRegs]; val ← [subtree[index: node]];
END;
length =>
BEGIN
type: CSEIndex;
tb[node].son[1] ← Exp[tb[node].son[1], none];
type ← OperandType[tb[node].son[1]];
WITH seb[type] SELECT FROM
array =>
BEGIN
val ← MakeTreeLiteral[Cardinality[indexType]];
FreeNode[node]; nRegs ← 1;
END;
ENDCASE => BEGIN val ← [subtree[index: node]]; nRegs ← VRegs[] END;
VPop[]; VPush[0, both, nRegs];
END;
arraydesc =>
BEGIN
subNode: Tree.Index = GetNode[tb[node].son[1]];
type: CSEIndex = tb[node].info;
tb[subNode].son[1] ← RValue[tb[subNode].son[1], 0, unsigned];
nRegs ← VRegs[];
tb[subNode].son[2] ← RValue[tb[subNode].son[2], 0, none];
nRegs ← MAX[VRegs[], nRegs];
IF tb[subNode].son[3] # Tree.Null THEN TypeExp[tb[subNode].son[3]];
VPop[]; VPop[];
IF StructuredLiteral[tb[subNode].son[1]]
AND StructuredLiteral[tb[subNode].son[2]]
THEN
BEGIN
n: CARDINAL = WordsForType[type];
words: DESCRIPTOR FOR ARRAY OF WORD;
words ← DESCRIPTOR[SystemDefs.AllocateHeapNode[n], n];
[] ← FillMultiWord[
words,
FillMultiWord[words, 0, tb[subNode].son[1]],
tb[subNode].son[2]];
PushLit[LiteralOps.FindDescriptor[words]];
PushNode[mwconst, 1]; SetInfo[type];
SystemDefs.FreeHeapNode[BASE[words]];
val ← PopTree[]; FreeNode[node];
END
ELSE val ← [subtree[index: node]];
VPush[0, other, MAX[RegsForType[type], nRegs]];
END;
ENDCASE =>
BEGIN
Log.Error[unimplemented]; VPush[0, none, 0]; val ← [subtree[node]];
END;
RETURN
END;
Addr: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
subNode: Tree.Index;
t, v: Tree.Link;
type, next: CSEIndex;
nRegs: RegCount;
WordSize: CARDINAL = AltoDefs.wordlength;
son[1] ← Exp[son[1], none]; nRegs ← MAX[VRegs[], RegsForType[info]];
FOR t ← son[1], v
DO
WITH t SELECT FROM
symbol =>
BEGIN
IF ctxb[seb[index].idCtx].level = Symbols.lZ AND
(LOOPHOLE[seb[index].idValue, Symbols.BitAddress].bd # 0 OR
LOOPHOLE[seb[index].idInfo, CARDINAL] MOD WordSize # 0)
THEN GO TO fail;
GO TO pass;
END;
subtree =>
BEGIN subNode ← index;
SELECT tb[subNode].name FROM
dot, dollar => v ← tb[subNode].son[2];
index, dindex =>
FOR type ← NormalType[OperandType[tb[subNode].son[1]]], next
DO
WITH seb[type] SELECT FROM
array => IF oldPacked THEN GO TO fail ELSE GO TO pass;
arraydesc => next ← UnderType[describedType];
ENDCASE => ERROR;
ENDLOOP;
seqindex => GO TO fail;
uparrow, reloc => GO TO pass;
cast, chop => v ← tb[subNode].son[1];
ENDCASE => ERROR;
END;
ENDCASE => ERROR;
REPEAT
pass => NULL;
fail => Log.ErrorTree[nonAddressable, son[1]];
ENDLOOP;
val ← [subtree[index: node]];
IF TestTree[son[1], dot]
THEN
BEGIN subNode ← GetNode[son[1]];
IF TreeLiteral[tb[subNode].son[1]]
THEN
WITH tb[subNode].son[2] SELECT FROM
symbol =>
BEGIN
val ← MakeStructuredLiteral[
TreeLiteralValue[tb[subNode].son[1]] +
LOOPHOLE[seb[index].idValue, Symbols.BitAddress].wd,
info];
FreeNode[node];
END;
ENDCASE => ERROR;
END;
VPop[]; VPush[0, unsigned, nRegs]; RETURN
END;
END.