-- file Pass4Xb.Mesa
-- last written by Satterthwaite, January 10, 1980 4:16 PM
DIRECTORY
AltoDefs: FROM "altodefs" USING [maxcharcode, maxinteger, maxword],
ComData: FROM "comdata"
USING [
bodyIndex, nTypeCodes, switches, typeMap, typeMapId,
typeINTEGER, typeSTRING],
InlineDefs: FROM "inlinedefs" USING [BITAND],
LiteralOps: FROM "literalops"
USING [FindDescriptor, FindLocalString, StringReference],
Log: FROM "log" USING [ErrorTree, WarningTree],
P4: FROM "p4"
USING [
Repr, none, signed, unsigned, both, long, other, RegCount, MaxRegs,
AddrOp, All, Assignment, BiasForType, Binding, Call, CaseDriver,
ComparableType, Construct, DeclItem, Dollar, FoldExpr, Index,
LiteralRep, MakeTreeLiteral, MiscXfer, PadRecord, Reloc, RelTest,
RepForType, Rhs, RowConstruct, Subst, TreeLiteralValue, TypeExp,
TypeForTree, Union, WordsForType],
Pass4: FROM "pass4"
USING [implicitBias, implicitRep, implicitType, tFALSE, tTRUE],
Symbols: FROM "symbols"
USING [bodyType, ctxType, seType,
SEIndex, ISEIndex, CSEIndex, codeCHARACTER, codeINTEGER, lG, typeANY],
SymbolOps: FROM "symbolops"
USING [
Cardinality, ConstantId, FindExtension, TypeForm,
UnderType, WordsForType, XferMode],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree" USING [Index, Link, Map, NodeName, Null, treeType],
TreeOps: FROM "treeops"
USING [
FreeNode, FreeTree, GetNode, IdentityMap, ListLength,
MakeNode, PopTree, PushLit, PushNode, PushTree,
SetAttr, SetInfo, SetShared, Shared, TestTree, UpdateList];
Pass4Xb: PROGRAM
IMPORTS
InlineDefs, Log, LiteralOps, P4, SymbolOps, TreeOps,
dataPtr: ComData, passPtr: Pass4
EXPORTS P4 =
BEGIN
OPEN SymbolOps, P4, TreeOps;
CommonRep: PROCEDURE [Repr, Repr] RETURNS [Repr] =
LOOPHOLE[InlineDefs.BITAND];
-- pervasive definitions from Symbols
ISEIndex: TYPE = Symbols.ISEIndex;
CSEIndex: TYPE = Symbols.CSEIndex;
tb: Table.Base; -- tree base address (local copy)
seb: Table.Base; -- se table base address (local copy)
ctxb: Table.Base; -- context table base address (local copy)
bb: Table.Base; -- body table base address (local copy)
ExpBNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[Symbols.seType]; ctxb ← base[Symbols.ctxType];
bb ← base[Symbols.bodyType];
END;
-- intermediate result bookkeeping
ValueDescriptor: TYPE = RECORD[
bias: INTEGER, -- bias in representation (scalars only)
nRegs: RegCount, -- estimate of register requirement
rep: Repr]; -- signed/unsigned (scalars only)
VStackLimit: CARDINAL = 32;
vStack: ARRAY [0 .. VStackLimit] OF ValueDescriptor;
vI: CARDINAL; -- index into vStack
VStackOverflow: ERROR = CODE;
VPush: PUBLIC PROCEDURE [bias: INTEGER, rep: Repr, nRegs: RegCount] =
BEGIN
IF (vI ← vI+1) >= VStackLimit THEN ERROR VStackOverflow;
vStack[vI] ← ValueDescriptor[bias:bias, rep:rep, nRegs:nRegs];
END;
VPop: PUBLIC PROCEDURE =
BEGIN
IF vI = 0 THEN ERROR;
vI ← vI-1;
END;
VBias: PUBLIC PROCEDURE RETURNS [INTEGER] =
BEGIN RETURN [vStack[vI].bias] END;
VRep: PUBLIC PROCEDURE RETURNS [Repr] =
BEGIN RETURN [vStack[vI].rep] END;
VRegs: PUBLIC PROCEDURE RETURNS [RegCount] =
BEGIN RETURN [vStack[vI].nRegs] END;
Pass4XInit: PUBLIC PROCEDURE = BEGIN vI ← 0; RETURN END;
OperandType: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [CSEIndex] =
BEGIN
RETURN [WITH t SELECT FROM
symbol => UnderType[seb[index].idType],
literal =>
IF info.litTag = string THEN dataPtr.typeSTRING ELSE dataPtr.typeINTEGER,
subtree =>
IF t = Tree.Null THEN passPtr.implicitType ELSE tb[index].info,
ENDCASE => Symbols.typeANY]
END;
ForceType: PUBLIC PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] =
BEGIN
PushTree[t];
IF (~TestTree[t, mwconst] AND ~TestTree[t, cast]) OR Shared[t]
THEN PushNode[cast, 1];
SetInfo[type]; RETURN [PopTree[]]
END;
ChopType: PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] =
BEGIN
PushTree[t]; PushNode[chop, 1]; SetInfo[type]; RETURN [PopTree[]]
END;
-- literals
TreeLiteral: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
BEGIN
RETURN [WITH t SELECT FROM
literal => info.litTag = word,
subtree =>
SELECT tb[index].name FROM
cast => TreeLiteral[tb[index].son[1]],
ENDCASE => FALSE,
ENDCASE => FALSE]
END;
StructuredLiteral: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
BEGIN
RETURN [WITH t SELECT FROM
literal => info.litTag = word,
subtree =>
SELECT tb[index].name FROM
mwconst => TRUE,
cast => StructuredLiteral[tb[index].son[1]],
ENDCASE => FALSE,
ENDCASE => FALSE]
END;
MakeStructuredLiteral: PUBLIC PROCEDURE [val: WORD, type: CSEIndex] RETURNS [t: Tree.Link] =
BEGIN
t ← MakeTreeLiteral[val];
SELECT seb[type].typeTag FROM
basic, enumerated, subrange, mode => NULL;
ENDCASE => t ← ForceType[t, type];
RETURN
END;
-- register accounting
RegsForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [RegCount] =
BEGIN
n: RegCount = IF seb[type].mark4
THEN SymbolOps.WordsForType[type]
ELSE 0;
RETURN [IF n = 2 THEN 2 ELSE 1]
END;
ComputeRegs: PROCEDURE [node: Tree.Index] RETURNS [RegCount] =
BEGIN
n1: RegCount = vStack[vI-1].nRegs;
n2: RegCount = vStack[vI].nRegs;
k: RegCount = RegsForType[tb[node].info];
RETURN [MIN[MAX[n1, n2+k], MaxRegs]]
END;
ComputeIndexRegs: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [RegCount] =
BEGIN
n1: RegCount = vStack[vI-1].nRegs;
n2: RegCount = vStack[vI].nRegs;
k: RegCount = RegsForType[OperandType[tb[node].son[1]]];
RETURN [MIN[MAX[RegsForType[tb[node].info], n1, n2+k], MaxRegs]]
END;
AdjustRegs: PROCEDURE [node: Tree.Index, commuteOp: Tree.NodeName] RETURNS [RegCount] =
BEGIN
n1: RegCount = vStack[vI-1].nRegs;
n2: RegCount = vStack[vI].nRegs;
k: RegCount = RegsForType[tb[node].info];
n: CARDINAL;
IF n1 >= n2
THEN n ← n2 + k
ELSE
BEGIN
v: ValueDescriptor;
t: Tree.Link ← tb[node].son[1];
tb[node].son[1] ← tb[node].son[2]; tb[node].son[2] ← t;
tb[node].name ← commuteOp;
v ← vStack[vI]; vStack[vI] ← vStack[vI-1]; vStack[vI-1] ← v;
n ← n1 + k;
END;
RETURN [MIN[MAX[n1, n2, n], MaxRegs]]
END;
-- operators
Fold: PROCEDURE [node: Tree.Index, rep: Repr] RETURNS [Tree.Link] =
BEGIN
fullRep: Repr = IF tb[node].attr2 THEN long + rep ELSE rep;
RETURN [FoldExpr[node, fullRep]]
END;
Substx: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
type: CSEIndex = tb[node].info;
subNode: Tree.Index;
val ← Subst[node]; node ← GetNode[val];
IF TestTree[tb[node].son[2], result]
THEN
BEGIN
subNode ← GetNode[tb[node].son[2]];
SELECT ListLength[tb[subNode].son[1]] FROM
0 => ERROR;
1 => val ← ForceType[tb[subNode].son[1], type];
ENDCASE =>
BEGIN
PushTree[Tree.Null]; PushTree[tb[subNode].son[1]];
PushNode[construct, 2]; SetInfo[type]; val ← PopTree[];
END;
tb[subNode].son[1] ← Tree.Null; FreeNode[node];
END;
VPush[BiasForType[type], RepForType[type], MaxRegs];
RETURN
END;
UMinus: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
tb[node].son[1] ← Exp[tb[node].son[1], signed];
SELECT vStack[vI].rep FROM
both => vStack[vI].rep ← signed;
none =>
BEGIN
Log.WarningTree[mixedRepresentation, val]; vStack[vI].rep ← signed;
END;
ENDCASE => NULL;
IF ~StructuredLiteral[tb[node].son[1]]
THEN BEGIN tb[node].attr3 ← TRUE; val ← [subtree[index: node]] END
ELSE val ← Fold[node, vStack[vI].rep];
IF vStack[vI].rep = unsigned THEN vStack[vI].rep ← signed;
vStack[vI].bias ← -VBias[];
RETURN
END;
Abs: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
tb[node].son[1] ← RValue[tb[node].son[1], 0, signed];
val ← [subtree[index: node]];
SELECT vStack[vI].rep FROM
unsigned, both =>
BEGIN
Log.WarningTree[unsignedCompare, val];
val ← tb[node].son[1]; tb[node].son[1] ← Tree.Null; FreeNode[node];
END;
other => tb[node].attr3 ← TRUE;
none =>
BEGIN
Log.ErrorTree[mixedRepresentation, val]; vStack[vI].rep ← both;
END;
ENDCASE =>
BEGIN
tb[node].attr3 ← TRUE; vStack[vI].rep ← both;
IF StructuredLiteral[tb[node].son[1]] THEN val ← Fold[node, signed];
END;
RETURN
END;
AddOp: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
op: Tree.NodeName = tb[node].name;
type: CSEIndex = tb[node].info;
bias, shift: INTEGER;
rep: Repr;
nRegs: RegCount;
son[1] ← Exp[son[1], target]; son[2] ← Exp[son[2], target];
val ← [subtree[index: node]];
rep ← CommonRep[vStack[vI-1].rep, vStack[vI].rep];
SELECT rep FROM
both => rep ← IF target=none OR target=other THEN signed ELSE target;
none =>
IF target = none
THEN
BEGIN Log.WarningTree[mixedRepresentation, val]; rep ← both END
ELSE rep ← target;
ENDCASE => NULL;
IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]]
THEN
BEGIN
val ← Fold[node, rep];
rep ← LiteralRep[val, rep]; bias ← 0; nRegs ← RegsForType[type];
END
ELSE
BEGIN
nRegs ← IF op=plus THEN AdjustRegs[node, plus] ELSE ComputeRegs[node];
bias ← vStack[vI-1].bias; shift ← vStack[vI].bias;
attr3 ← rep # unsigned;
SELECT TRUE FROM
TreeLiteral[son[2]] =>
BEGIN val ← son[1];
shift ← shift + TreeLiteralValue[son[2]];
son[1] ← Tree.Null; FreeNode[node];
END;
(op = plus AND TreeLiteral[son[1]]) =>
BEGIN val ← son[2];
shift ← shift + TreeLiteralValue[son[1]];
son[2] ← Tree.Null; FreeNode[node];
END;
ENDCASE;
bias ← bias + (IF op=plus THEN shift ELSE -shift);
END;
VPop[]; VPop[]; VPush[bias, rep, nRegs];
IF type # dataPtr.typeINTEGER AND OperandType[val] # type
THEN val ← ForceType[val, type];
RETURN
END;
Mult: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
rep: Repr;
const1, const2: BOOLEAN;
v1, v2: WORD;
bias: INTEGER;
nRegs: RegCount;
t: Tree.Link;
son[1] ← Exp[son[1], target]; son[2] ← Exp[son[2], target];
val ← [subtree[index: node]];
rep ← CommonRep[vStack[vI-1].rep, vStack[vI].rep];
SELECT rep FROM
both => rep ← IF target=none OR target=other THEN signed ELSE target;
none =>
IF target = none
THEN
BEGIN Log.WarningTree[mixedRepresentation, val]; rep ← both END
ELSE rep ← target;
ENDCASE => NULL;
IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]]
THEN
BEGIN
nRegs ← RegsForType[info];
val ← Fold[node, rep]; rep ← LiteralRep[val, rep]; bias ← 0;
END
ELSE
BEGIN
nRegs ← AdjustRegs[node, times];
const1 ← TreeLiteral[son[1]]; const2 ← TreeLiteral[son[2]];
IF const1 OR ~const2
THEN son[1] ← AdjustBias[son[1], -vStack[vI-1].bias];
IF ~const1 OR const2
THEN son[2] ← AdjustBias[son[2], -vStack[vI].bias];
IF const1 THEN v1 ← TreeLiteralValue[son[1]];
IF const2 THEN v2 ← TreeLiteralValue[son[2]];
attr3 ← rep # unsigned;
bias ← SELECT TRUE FROM
const1 => v1*vStack[vI].bias,
const2 => vStack[vI-1].bias*v2,
ENDCASE => 0;
IF const1 -- AND ~const2
THEN BEGIN t ← son[2]; son[2] ← son[1]; son[1] ← t END;
IF const1 OR const2
THEN
SELECT (IF const1 THEN v1 ELSE v2) FROM
0 =>
BEGIN
val ← son[2]; son[2] ← Tree.Null; FreeNode[node]; rep ← both;
END;
1 =>
BEGIN
val ← son[1]; son[1] ← Tree.Null; FreeNode[node];
rep ← vStack[IF const1 THEN vI ELSE vI-1].rep;
END;
-1 =>
BEGIN PushTree[son[1]]; son[1] ← Tree.Null; FreeNode[node];
PushNode[uminus, 1]; SetInfo[dataPtr.typeINTEGER];
SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, TRUE];
val ← PopTree[];
END;
ENDCASE;
END;
VPop[]; VPop[]; VPush[bias, rep, nRegs];
RETURN
END;
DivMod: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
rep: Repr;
nRegs: RegCount;
son[1] ← RValue[son[1], 0, target]; son[2] ← RValue[son[2], 0, target];
val ← [subtree[index: node]];
rep ← CommonRep[vStack[vI-1].rep, vStack[vI].rep];
SELECT rep FROM
both => NULL; -- preserved by div and mod
none =>
IF target = none
THEN BEGIN Log.ErrorTree[mixedRepresentation, val]; rep ← both END
ELSE rep ← target;
ENDCASE => NULL;
IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]]
THEN
BEGIN
nRegs ← RegsForType[info];
val ← Fold[node, rep]; rep ← LiteralRep[val, rep];
END
ELSE
BEGIN
nRegs ← ComputeRegs[node];
attr3 ← CommonRep[rep, unsigned] = none;
IF name = div AND TreeLiteral[son[2]]
THEN
SELECT TreeLiteralValue[son[2]] FROM
= 1 =>
BEGIN val ← son[1]; son[1] ← Tree.Null; FreeNode[node] END;
>=2 => IF rep = unsigned THEN rep ← both;
ENDCASE;
END;
VPop[]; VPop[]; VPush[0, rep, nRegs]; RETURN
END;
RelOp: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
rep, rep1, rep2: Repr;
nRegs: RegCount;
d1, d2: INTEGER;
uc: BOOLEAN;
ZeroWarning: ARRAY Tree.NodeName [relE..relLE] OF [0..2] = [0, 0, 2, 2, 1, 1];
CommutedOp: ARRAY Tree.NodeName [relE..relLE] OF Tree.NodeName =
[relE, relN, relG, relLE, relL, relGE];
son[1] ← Exp[son[1], none]; son[2] ← Exp[son[2], none];
val ← [subtree[index: node]];
IF ~ComparableSons[node] THEN Log.ErrorTree[sizeClash, son[2]];
rep1 ← vStack[vI-1].rep; d1 ← vStack[vI-1].bias;
rep2 ← vStack[vI].rep; d2 ← vStack[vI].bias;
rep ← CommonRep[rep1, rep2];
IF rep = none
THEN
SELECT name FROM
relE, relN => Log.WarningTree[mixedRepresentation, val];
ENDCASE => Log.ErrorTree[mixedRepresentation, val];
SELECT name FROM
relE, relN => uc ← FALSE;
ENDCASE =>
BEGIN
IF rep1 = unsigned OR rep2 = unsigned
THEN
BEGIN
son[1] ← AdjustBias[son[1], -d1]; d1 ← 0;
son[2] ← AdjustBias[son[2], -d2]; d2 ← 0;
END;
uc ← CommonRep[rep, unsigned] # none;
END;
IF d1 # d2
THEN
IF (~uc AND TreeLiteral[son[2]]) OR (uc AND d2 > d1)
THEN son[2] ← AdjustBias[son[2], d1-d2]
ELSE son[1] ← AdjustBias[son[1], d2-d1];
IF CommonRep[rep, signed+other] = none
THEN
BEGIN
SELECT ZeroWarning[name] FROM
1 =>
IF TreeLiteral[son[1]] AND TreeLiteralValue[son[1]] = 0
THEN GO TO warn;
2 =>
IF TreeLiteral[son[2]] AND TreeLiteralValue[son[2]] = 0
THEN GO TO warn;
ENDCASE;
EXITS
warn => Log.WarningTree[unsignedCompare, val];
END;
IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]]
THEN BEGIN val ← Fold[node, rep]; nRegs ← 1 END
ELSE
BEGIN
nRegs ← AdjustRegs[node, CommutedOp[name]]; attr3 ← rep # unsigned;
END;
VPop[]; VPop[]; VPush[0, both, nRegs];
RETURN
END;
ComparableSons: PROCEDURE [node: Tree.Index] RETURNS [BOOLEAN] =
BEGIN OPEN tb[node];
-- compatibility version
type1: CSEIndex = OperandType[son[1]];
n1: CARDINAL = P4.WordsForType[type1];
type2: CSEIndex = OperandType[son[2]];
n2: CARDINAL = P4.WordsForType[type2];
IF n1 = 0 OR n2 = 0 THEN RETURN [FALSE];
SELECT TRUE FROM
(n1 = n2) => NULL;
(seb[type1].typeTag = record AND seb[type2].typeTag = record) =>
IF n1 < n2 -- account for lost discrimination
THEN son[2] ← ChopType[son[2], type1]
ELSE son[1] ← ChopType[son[1], type2];
ENDCASE => RETURN [FALSE];
RETURN [ComparableType[type1] OR ComparableType[type2]]
END;
In: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
bias: INTEGER;
rep: Repr;
nRegs: RegCount;
void, const: BOOLEAN;
subNode: Tree.Index;
son[1] ← Exp[son[1], none]; bias ← VBias[]; rep ← VRep[];
-- IF rep = unsigned THEN
BEGIN son[1] ← AdjustBias[son[1], -bias]; bias ← 0 END;
void ← FALSE; val ← [subtree[index: node]];
son[2] ← NormalizeRange[son[2]]; subNode ← GetNode[son[2]];
IF (const ← Interval[subNode, bias, none].const) AND ~tb[node].attr2
THEN [] ← ConstantInterval[subNode
! EmptyInterval => BEGIN void ← TRUE; RESUME END];
rep ← CommonRep[rep, VRep[]];
IF rep = none THEN Log.ErrorTree[mixedRepresentation, val];
tb[subNode].attr3 ← attr3 ← rep # unsigned;
SELECT TRUE FROM
void AND son[1] # Tree.Null =>
BEGIN FreeNode[node]; val ← passPtr.tFALSE; nRegs ← 1 END;
const AND StructuredLiteral[son[1]] =>
BEGIN val ← Fold[node, rep]; nRegs ← 1 END;
ENDCASE => nRegs ← ComputeRegs[node];
VPop[]; VPop[]; VPush[0, both, nRegs]; RETURN
END;
NormalizeRange: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [val: Tree.Link] =
BEGIN
next: Tree.Link;
FOR val ← t, next
DO
WITH val SELECT FROM
symbol =>
BEGIN
lBound: INTEGER = BiasForType[UnderType[index]];
THROUGH [1..2]
DO
PushTree[MakeTreeLiteral[ABS[lBound]]];
IF lBound < 0 THEN PushNode[uminus, 1];
ENDLOOP;
PushTree[MakeTreeLiteral[Cardinality[index] - 1]];
PushNode[plus, 2]; SetInfo[dataPtr.typeINTEGER];
next ← MakeNode[intCC, 2];
END;
subtree =>
BEGIN
node: Tree.Index = index;
SELECT tb[node].name FROM
subrangeTC, cdot =>
BEGIN next ← tb[node].son[2];
tb[node].son[2] ← Tree.Null; FreeNode[node];
END;
IN [intOO .. intCC] => EXIT;
ENDCASE => ERROR;
END;
ENDCASE => ERROR;
ENDLOOP;
RETURN
END;
Interval: PUBLIC PROCEDURE [node: Tree.Index, bias: INTEGER, target: Repr]
RETURNS [const: BOOLEAN] =
BEGIN OPEN tb[node];
rep: Repr;
nRegs: RegCount;
son[1] ← RValue[son[1], bias, target]; nRegs ← VRegs[];
son[2] ← RValue[son[2], bias, target]; nRegs ← MAX[VRegs[], nRegs];
rep ← CommonRep[vStack[vI-1].rep, vStack[vI].rep];
VPop[]; VPop[]; VPush[bias, rep, nRegs];
const ← StructuredLiteral[son[1]] AND StructuredLiteral[son[2]]; RETURN
END;
EmptyInterval: PUBLIC SIGNAL = CODE;
ConstantInterval: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [origin, range: INTEGER] =
BEGIN OPEN tb[node];
uBound: INTEGER;
rep: Repr;
empty: BOOLEAN;
rep ← VRep[]; empty ← FALSE;
origin ← TreeLiteralValue[son[1]]; uBound ← TreeLiteralValue[son[2]];
SELECT name FROM
intOO, intOC =>
BEGIN
IF RelTest[son[1], son[2], relGE, rep] THEN empty ← TRUE;
origin ← origin + 1;
son[1] ← FreeTree[son[1]];
name ← IF name = intOO THEN intCO ELSE intCC;
son[1] ← MakeTreeLiteral[origin];
END;
ENDCASE;
SELECT name FROM
intCC => IF RelTest[son[1], son[2], relG, rep] THEN empty ← TRUE;
intCO =>
BEGIN
IF RelTest[son[1], son[2], relGE, rep] THEN empty ← TRUE;
uBound ← uBound - 1;
son[2] ← FreeTree[son[2]];
name ← intCC; son[2] ← MakeTreeLiteral[uBound];
END;
ENDCASE => ERROR;
IF ~empty
THEN range ← uBound - origin
ELSE BEGIN SIGNAL EmptyInterval; range ← 0 END;
RETURN
END;
BoolOp: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
b: Tree.Link = IF (name = and) THEN passPtr.tTRUE ELSE passPtr.tFALSE;
n1, n2, nRegs: RegCount;
son[1] ← Exp[son[1], none]; n1 ← VRegs[];
son[2] ← Exp[son[2], none]; n2 ← VRegs[];
IF TreeLiteral[son[1]]
THEN
BEGIN
IF son[1] = b
THEN BEGIN val ← son[2]; son[2] ← Tree.Null; nRegs ← n2 END
ELSE
BEGIN
val ← IF (name = and) THEN passPtr.tFALSE ELSE passPtr.tTRUE;
nRegs ← 1
END;
FreeNode[node];
END
ELSE
IF son[2] # b
THEN BEGIN val ← [subtree[index: node]]; nRegs ← MAX[n1, n2] END
ELSE
BEGIN
val ← son[1]; son[1] ← Tree.Null; nRegs ← n1; FreeNode[node];
END;
VPop[]; VPop[]; VPush[0, both, nRegs];
RETURN
END;
CheckAlt: PROCEDURE [t: Tree.Link, target: CSEIndex] RETURNS [Tree.Link] =
BEGIN
type: CSEIndex = OperandType[t];
IF P4.WordsForType[type] # P4.WordsForType[target] THEN
IF seb[type].typeTag = record AND seb[target].typeTag = record
THEN t ← PadRecord[t, target]
ELSE Log.ErrorTree[sizeClash, t];
RETURN [t]
END;
IfExp: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
select: Tree.Link;
rep: Repr;
nRegs: RegCount;
bias: INTEGER = BiasForType[info];
son[1] ← RValue[son[1], 0, none]; nRegs ← VRegs[]; VPop[];
IF TreeLiteral[son[1]]
THEN
BEGIN
IF son[1] # passPtr.tFALSE
THEN BEGIN select ← son[2]; son[2] ← Tree.Null END
ELSE BEGIN select ← son[3]; son[3] ← Tree.Null END;
FreeNode[node];
val ← Exp[select, target];
END
ELSE
BEGIN
son[2] ← CheckAlt[RValue[son[2], bias, target], info];
rep ← vStack[vI].rep; nRegs ← MAX[VRegs[], nRegs]; VPop[];
son[3] ← CheckAlt[RValue[son[3], bias, target], info];
val ← [subtree[index: node]];
rep ← CommonRep[vStack[vI].rep, rep];
IF rep = none THEN
IF target = none
THEN
BEGIN Log.WarningTree[mixedRepresentation, val]; rep ← both END
ELSE rep ← target;
vStack[vI].rep ← rep; vStack[vI].nRegs ← MAX[VRegs[], nRegs];
END;
RETURN
END;
CaseExp: PROCEDURE [node: Tree.Index, target: Repr, caseBias: INTEGER]
RETURNS [val: Tree.Link] =
BEGIN
type: CSEIndex = tb[node].info;
bias: INTEGER = BiasForType[type];
rep: Repr;
const: BOOLEAN;
Selection: Tree.Map =
BEGIN
v ← CheckAlt[RValue[t, bias, target], type];
rep ← CommonRep[rep, vStack[vI].rep]; VPop[];
const ← const AND StructuredLiteral[v];
RETURN
END;
rep ← both+other; const ← TRUE;
PushTree[CaseDriver[node, Selection, caseBias]]; SetAttr[1, const];
val ← PopTree[];
IF rep = none THEN
IF target = none
THEN BEGIN Log.WarningTree[mixedRepresentation, val]; rep ← both END
ELSE rep ← target;
VPush[bias, rep, MaxRegs];
RETURN
END;
BindExp: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [Tree.Link] =
BEGIN
BoundExp: PROCEDURE [t: Tree.Link, labelBias: INTEGER] RETURNS [Tree.Link] =
BEGIN RETURN [CaseExp[GetNode[t], target, labelBias]] END;
RETURN [Binding[node, casex, BoundExp]]
END;
MinMax: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
const, zeroTest: BOOLEAN;
rep: Repr;
nRegs: RegCount;
k: RegCount = RegsForType[info];
Item: Tree.Map =
BEGIN
v ← RValue[t, 0, target];
IF ~StructuredLiteral[v]
THEN const ← FALSE
ELSE
IF TreeLiteral[v] AND TreeLiteralValue[v] = 0 THEN zeroTest ← TRUE;
rep ← CommonRep[rep, vStack[vI].rep];
nRegs ← MIN[MAX[nRegs, VRegs[]+k], MaxRegs]; VPop[]; RETURN
END;
IF ListLength[son[1]] = 1
THEN
BEGIN
val ← Exp[son[1], target]; son[1] ← Tree.Null; FreeNode[node];
END
ELSE
BEGIN
const ← TRUE; zeroTest ← FALSE; rep ← both+other; nRegs ← 0;
son[1] ← UpdateList[son[1], Item]; val ← [subtree[index: node]];
IF zeroTest AND CommonRep[rep, unsigned] # none
THEN Log.WarningTree[unsignedCompare, val];
SELECT rep FROM
both => rep ← IF target = none THEN both ELSE target;
none =>
IF target = none
THEN
BEGIN Log.ErrorTree[mixedRepresentation, val]; rep ← both END
ELSE rep ← target;
ENDCASE => NULL;
IF const
THEN
BEGIN
val ← Fold[node, rep]; rep ← LiteralRep[val, rep]; nRegs ← k;
END
ELSE attr3 ← rep # unsigned;
VPush[0, rep, nRegs];
END;
RETURN
END;
Lengthen: PROCEDURE [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
v: ARRAY [0..2) OF WORD;
rep: Repr;
nRegs: RegCount;
son[1] ← RValue[son[1], 0, IF target=both THEN unsigned ELSE target];
attr1 ← SELECT TypeForm[OperandType[son[1]]] FROM
pointer, arraydesc => TRUE,
ENDCASE => FALSE;
IF (rep ← VRep[]) = none
THEN BEGIN Log.ErrorTree[mixedRepresentation, son[1]]; rep ← both END;
attr3 ← CommonRep[rep, unsigned] = none;
nRegs ← MAX[VRegs[], RegsForType[info]];
IF ~TreeLiteral[son[1]] OR (attr1 AND TreeLiteralValue[son[1]] # 0--NIL--)
THEN val ← [subtree[index: node]]
ELSE
BEGIN
v[0] ← TreeLiteralValue[son[1]];
v[1] ← IF ~attr3 OR InlineDefs.BITAND[v[0], 1B5] = 0 THEN 0 ELSE 177777B;
PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[v]]];
PushNode[mwconst, 1]; SetInfo[info];
val ← PopTree[]; FreeNode[node];
END;
VPop[]; VPush[0, IF rep = unsigned AND ~attr1 THEN both ELSE rep, nRegs];
RETURN
END;
Loophole: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
type: CSEIndex = info;
rep: Repr = RepForType[type];
val ← Exp[son[1], rep];
IF son[2] # Tree.Null THEN TypeExp[son[2]];
IF P4.WordsForType[OperandType[val]] # P4.WordsForType[type]
THEN Log.ErrorTree[sizeClash, son[1]];
val ← ForceType[val, type];
son[1] ← Tree.Null; FreeNode[node];
vStack[vI].rep ← rep; RETURN
END;
EndPoint: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN OPEN tb[node];
type, next: CSEIndex;
first: BOOLEAN = (name=first);
MaxInteger: WORD = AltoDefs.maxinteger;
MaxWord: WORD = AltoDefs.maxword;
v: WORD;
vv: ARRAY [0..2) OF WORD;
TypeExp[son[1]];
FOR type ← UnderType[TypeForTree[son[1]]], next
DO
WITH seb[type] SELECT FROM
basic =>
BEGIN
v ← SELECT code FROM
Symbols.codeINTEGER => IF first THEN MaxInteger+1 ELSE MaxInteger,
Symbols.codeCHARACTER => IF first THEN 0 ELSE AltoDefs.maxcharcode,
ENDCASE => IF first THEN 0 ELSE MaxWord;
GO TO short
END;
enumerated =>
BEGIN
v ← IF first THEN 0 ELSE Cardinality[type]-1; GO TO short
END;
relative => next ← UnderType[offsetType];
subrange =>
BEGIN
v ← IF first THEN origin ELSE origin+range; GO TO short
END;
long =>
BEGIN
vv ← IF UnderType[rangeType] = dataPtr.typeINTEGER
THEN IF first THEN [0, MaxInteger+1] ELSE [MaxWord, MaxInteger]
ELSE IF first THEN [0, 0] ELSE [MaxWord, MaxWord];
GO TO long
END;
ENDCASE => ERROR;
REPEAT
short => val ← MakeTreeLiteral[v];
long =>
BEGIN
PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[vv]]];
PushNode[mwconst, 1]; SetInfo[type]; val ← PopTree[];
END;
ENDLOOP;
FreeNode[node]; VPush[0, RepForType[type], RegsForType[type]]; RETURN
END;
TypeCode: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
BEGIN
type: Symbols.SEIndex;
i: CARDINAL;
TypeExp[tb[node].son[1]]; type ← TypeForTree[tb[node].son[1]];
tb[node].son[1] ← Tree.Null; FreeNode[node];
FOR i IN [0 .. dataPtr.nTypeCodes)
DO IF type = dataPtr.typeMap[i] THEN EXIT ENDLOOP;
PushTree[[symbol[dataPtr.typeMapId]]]; PushTree[MakeTreeLiteral[i]];
PushNode[index, 2]; SetInfo[Symbols.typeANY]; SetAttr[2, FALSE];
RETURN [RValue[PopTree[], 0, other]]
END;
AdjustBias: PUBLIC PROCEDURE [t: Tree.Link, delta: INTEGER] RETURNS [Tree.Link] =
BEGIN
op: Tree.NodeName;
type: CSEIndex;
IF delta = 0 THEN RETURN [t];
IF TestTree[t, safen]
THEN
BEGIN
subNode: Tree.Index = GetNode[t];
tb[subNode].son[1] ← AdjustBias[tb[subNode].son[1], delta];
RETURN [t]
END;
IF t = Tree.Null THEN passPtr.implicitBias ← passPtr.implicitBias + delta;
type ← OperandType[t];
IF TreeLiteral[t]
THEN RETURN [MakeStructuredLiteral[TreeLiteralValue[t]-delta, type]];
IF delta > 0
THEN op ← minus
ELSE BEGIN op ← plus; delta ← -delta END;
PushTree[t]; PushTree[MakeTreeLiteral[delta]];
PushNode[op, 2]; SetInfo[type]; SetAttr[1, FALSE]; SetAttr[2, FALSE];
RETURN [PopTree[]]
END;
RValue: PUBLIC PROCEDURE [exp: Tree.Link, bias: INTEGER, target: Repr] RETURNS [val: Tree.Link] =
BEGIN
d: INTEGER;
val ← Exp[exp, target]; d ← bias - vStack[vI].bias;
IF d # 0
THEN BEGIN val ← AdjustBias[val, d]; vStack[vI].bias ← bias END;
RETURN
END;
Exp: PUBLIC PROCEDURE [exp: Tree.Link, target: Repr] RETURNS [val: Tree.Link] =
BEGIN
rep: Repr;
WITH expr: exp SELECT FROM
symbol =>
BEGIN
sei: ISEIndex = expr.index;
type: CSEIndex;
IF ~seb[sei].mark4
THEN DeclItem[Tree.Link[subtree[index: seb[sei].idValue]]];
type ← UnderType[seb[sei].idType]; rep ← RepForType[type];
IF ~seb[sei].constant
THEN val ← expr
ELSE
SELECT XferMode[type] FROM
procedure, signal, error, program =>
val ← IF ConstantId[sei] AND ~seb[sei].extended
THEN MakeStructuredLiteral[seb[sei].idValue, type]
ELSE expr;
ENDCASE =>
IF seb[sei].extended
THEN
BEGIN
val ← IdentityMap[FindExtension[sei].tree];
WITH val SELECT FROM
subtree => tb[index].info ← type;
ENDCASE;
val ← Exp[val, target]; rep ← vStack[vI].rep; VPop[];
END
ELSE
BEGIN
val ← MakeStructuredLiteral[seb[sei].idValue, type];
rep ← LiteralRep[val, rep];
END;
VPush[BiasForType[type], rep, RegsForType[type]];
END;
literal =>
BEGIN
WITH expr.info SELECT FROM
word => rep ← LiteralRep[expr, unsigned];
string =>
BEGIN LiteralOps.StringReference[index]; rep ← unsigned END;
ENDCASE => rep ← none;
VPush[0, rep, 1]; val ← expr;
END;
subtree =>
IF expr = Tree.Null
THEN
BEGIN val ← Tree.Null;
VPush[passPtr.implicitBias, passPtr.implicitRep, MaxRegs];
END
ELSE
BEGIN
node: Tree.Index = expr.index;
SELECT tb[node].name FROM
dot =>
BEGIN OPEN tb[node];
nRegs: RegCount;
son[1] ← RValue[son[1], 0, unsigned];
nRegs ← MAX[RegsForType[info], VRegs[]]; VPop[];
son[2] ← Exp[son[2], target]; vStack[vI].nRegs ← nRegs;
attr1 ← dataPtr.switches['n]; val ← expr;
END;
dollar => val ← Dollar[node];
cdot =>
BEGIN
val ← Exp[tb[node].son[2], target];
tb[node].son[2] ← Tree.Null; FreeNode[node];
END;
uparrow =>
BEGIN OPEN tb[node];
nRegs: RegCount;
son[1] ← RValue[son[1], 0, unsigned];
nRegs ← MAX[RegsForType[info], VRegs[]]; VPop[];
VPush[BiasForType[info], RepForType[info], nRegs];
attr1 ← dataPtr.switches['n]; val ← expr;
END;
callx, portcallx, signalx, errorx, startx, joinx =>
val ← Call[node];
substx => val ← Substx[node];
index, dindex => val ← Index[node];
seqindex =>
BEGIN OPEN tb[node];
nRegs: RegCount;
son[1] ← RValue[son[1], 0, unsigned];
son[2] ← RValue[son[2], 0, unsigned];
nRegs ← ComputeIndexRegs[node];
VPop[]; VPop[]; VPush[0, both, nRegs];
attr1 ← dataPtr.switches['n]; attr3 ← dataPtr.switches['b];
val ← expr;
END;
reloc => val ← Reloc[node];
construct => val ← Construct[node];
union => val ← Union[node];
rowcons => val ← RowConstruct[node];
all => val ← All[node];
uminus => val ← UMinus[node];
abs => val ← Abs[node];
plus, minus => val ← AddOp[node, target];
times => val ← Mult[node, target];
div, mod => val ← DivMod[node, target];
relE, relN, relL, relGE, relG, relLE => val ← RelOp[node];
in, notin => val ← In[node];
not =>
BEGIN
IF ~TreeLiteral[tb[node].son[1] ← Exp[tb[node].son[1], none]]
THEN val ← expr
ELSE
BEGIN
val ← IF tb[node].son[1] # passPtr.tFALSE
THEN passPtr.tFALSE
ELSE passPtr.tTRUE;
FreeNode[node]; vStack[vI].nRegs ← 1;
END;
END;
or, and => val ← BoolOp[node];
ifx => val ← IfExp[node, target];
casex => val ← CaseExp[node, target, 0];
bindx => val ← BindExp[node, target];
assignx => val ← Assignment[node];
min, max => val ← MinMax[node, target];
mwconst =>
BEGIN
rep: Repr;
val ← expr; rep ← LiteralRep[val, RepForType[tb[node].info]];
VPush[0, rep, RegsForType[tb[node].info]];
END;
clit =>
BEGIN
val ← tb[node].son[1]; FreeNode[node]; VPush[0, both, 1];
END;
llit =>
BEGIN
IF bb[dataPtr.bodyIndex].level > Symbols.lG THEN
WITH e: tb[node].son[1] SELECT FROM
literal =>
WITH e.info SELECT FROM
string => index ← LiteralOps.FindLocalString[index];
ENDCASE;
ENDCASE;
val ← Exp[tb[node].son[1], none];
tb[node].son[1] ← Tree.Null; FreeNode[node];
END;
new, fork => val ← MiscXfer[node];
syserrorx =>
BEGIN
val ← expr; VPush[0, RepForType[tb[node].info], MaxRegs];
END;
lengthen => val ← Lengthen[node, target];
float =>
BEGIN OPEN tb[node];
son[1] ← RValue[son[1], 0, none]; val ← expr;
vStack[vI].rep ← other;
END;
safen =>
BEGIN
tb[node].son[1] ← Exp[tb[node].son[1], target]; val ← expr;
END;
loophole => val ← Loophole[node];
cast =>
BEGIN OPEN tb[node];
rep: Repr = RepForType[info];
son[1] ← Exp[son[1], rep]; vStack[vI].rep ← rep; val ← expr;
IF P4.WordsForType[OperandType[son[1]]] # P4.WordsForType[info]
THEN name ← chop;
vStack[vI].rep ← rep; val ← expr;
END;
check =>
BEGIN
rep: Repr = RepForType[tb[node].info];
val ← Rhs[tb[node].son[1], tb[node].info];
vStack[vI].rep ← rep;
tb[node].son[1] ← Tree.Null; FreeNode[node];
END;
openx =>
BEGIN OPEN tb[node];
type: CSEIndex = OperandType[son[1]];
IF attr1
THEN val ← son[1]
ELSE
BEGIN son[1] ← NeutralExp[son[1]];
IF Shared[son[1]] -- must generate an unshared node
THEN son[1] ← ForceType[son[1], type];
SetShared[son[1], TRUE]; attr1 ← TRUE;
val ← expr;
END;
VPush[0, other, RegsForType[type]];
END;
size =>
BEGIN
TypeExp[tb[node].son[1]];
val ← MakeTreeLiteral[P4.WordsForType[
UnderType[TypeForTree[tb[node].son[1]]]]];
FreeNode[node]; VPush[0, both, 1];
END;
first, last => val ← EndPoint[node];
typecode => val ← TypeCode[node];
apply => BEGIN VPush[0, none, 0]; val ← [subtree[node]] END;
ENDCASE => val ← AddrOp[node];
END;
ENDCASE => ERROR;
RETURN
END;
NeutralExp: PUBLIC PROCEDURE [exp: Tree.Link] RETURNS [val: Tree.Link] =
BEGIN val ← RValue[exp, 0, none]; VPop[]; RETURN END;
END.