-- file Pass4Xb.mesa
-- last written by Satterthwaite, September 17, 1982 4:15 pm
DIRECTORY
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [
definitionsOnly, switches, typeCARDINAL, typeINT, typeSTRING, zone],
Heap: TYPE USING [FreeNode, MakeNode],
LiteralOps: TYPE USING [
MasterString, ValueDescriptor, FindDescriptor, FindLocalString, StringReference],
Log: TYPE USING [ErrorTree, WarningTree],
P4: TYPE USING [
Repr, none, signed, unsigned, both, long, other, RegCount, MaxRegs,
checked, currentLevel,
AddrOp, All, Assignment, BiasForType, BindCase, BindType, BoolValue, Call,
CanonicalType, CaseDriver, CatchNest, CheckRange, CommonRep, ComparableType,
ConstantInterval, Construct, DeclItem, Dollar, EmptyInterval, Extract,
FoldExpr, Index, Interval, IntToReal, LiteralRep, LongToShort,
MakeTreeLiteral, MarkString, MiscXfer, Narrow, New, NormalizeRange,
PadRecord, Reloc, RepForType, Rhs, RowConstruct, SeqIndex, ShortToLong,
Subst, TreeLiteralValue, TypeExp, TypeOp, Union, WordsForType],
Pass4: TYPE USING [implicitBias, implicitRep, implicitType, tFALSE, tTRUE],
Symbols: TYPE USING [
Base, SEIndex, ISEIndex, CSEIndex, lG, typeANY, seType],
SymbolOps: TYPE USING [
Cardinality, ConstantId, FindExtension, NormalType, RCType, TypeForm,
UnderType, WordsForType, XferMode],
SymLiteralOps: TYPE USING [AtomRef, TextRef],
Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, treeType],
TreeOps: TYPE USING [
FreeNode, GetHash, GetNode, IdentityMap, ListLength, OpName, PopTree,
PushLit, PushNode, PushTree, SetAttr, SetInfo, SetShared, Shared, UpdateList];
Pass4Xb: PROGRAM
IMPORTS
Heap, Log, LiteralOps, P4, SymbolOps, SymLiteralOps, TreeOps,
dataPtr: ComData, passPtr: Pass4
EXPORTS P4 = {
OPEN SymbolOps, P4, TreeOps;
-- pervasive definitions from Symbols
ISEIndex: TYPE = Symbols.ISEIndex;
CSEIndex: TYPE = Symbols.CSEIndex;
tb: Tree.Base; -- tree base address (local copy)
seb: Symbols.Base; -- se table base address (local copy)
zone: UNCOUNTED ZONE ← NIL;
ExpBNotify: PUBLIC Alloc.Notifier = {
-- called by allocator whenever table area is repacked
tb ← base[Tree.treeType]; seb ← base[Symbols.seType]};
-- 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)
VStack: TYPE = RECORD [SEQUENCE length: NAT OF ValueDescriptor];
vStack: LONG POINTER TO VStack ← NIL;
vI: INTEGER; -- index into vStack
VPush: PUBLIC PROC [bias: INTEGER, rep: Repr, nRegs: RegCount] = {
vI ← vI + 1;
WHILE vI >= vStack.length DO
newLength: NAT = vStack.length + 16;
newStack: LONG POINTER TO VStack = zone.NEW[VStack[newLength]];
FOR i: INTEGER IN [0 .. vI) DO newStack[i] ← vStack[i] ENDLOOP;
zone.FREE[@vStack];
vStack ← newStack;
ENDLOOP;
vStack[vI] ← [bias:bias, rep:rep, nRegs:nRegs]};
VPop: PUBLIC PROC = {IF vI < 0 THEN ERROR; vI ← vI-1};
VBias: PUBLIC PROC RETURNS [INTEGER] = {RETURN [vStack[vI].bias]};
VRep: PUBLIC PROC RETURNS [Repr] = {RETURN [vStack[vI].rep]};
VRegs: PUBLIC PROC RETURNS [RegCount] = {RETURN [vStack[vI].nRegs]};
ExpInit: PUBLIC PROC [scratchZone: UNCOUNTED ZONE] = {
zone ← scratchZone;
vStack ← zone.NEW[VStack[32]];
vI ← -1};
ExpReset: PUBLIC PROC = {
IF vStack # NIL THEN zone.FREE[@vStack];
zone ← NIL};
OperandType: PUBLIC PROC [t: Tree.Link] RETURNS [CSEIndex] = {
RETURN [WITH t SELECT FROM
symbol => UnderType[seb[index].idType],
literal => IF info.litTag = string THEN dataPtr.typeSTRING ELSE dataPtr.typeINT,
subtree => IF t = Tree.Null THEN passPtr.implicitType ELSE tb[index].info,
ENDCASE => Symbols.typeANY]};
ForceType: PUBLIC PROC [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = {
PushTree[t];
IF (OpName[t] # mwconst AND OpName[t] # cast) OR Shared[t] THEN PushNode[cast, 1];
SetInfo[type]; RETURN [PopTree[]]};
ChopType: PROC [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = {
PushTree[t]; PushNode[chop, 1]; SetInfo[type]; RETURN [PopTree[]]};
-- literals
TreeLiteral: PUBLIC PROC [t: Tree.Link] RETURNS [BOOLEAN] = {
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]};
StructuredLiteral: PUBLIC PROC [t: Tree.Link] RETURNS [BOOLEAN] = {
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]};
MakeStructuredLiteral: PUBLIC PROC [val: WORD, type: CSEIndex]
RETURNS [t: Tree.Link] = {
t ← MakeTreeLiteral[val];
SELECT seb[type].typeTag FROM
basic, enumerated, subrange, mode => NULL;
ENDCASE => t ← ForceType[t, type];
RETURN};
-- register accounting
RegsForType: PUBLIC PROC [type: CSEIndex] RETURNS [RegCount] = {
n: RegCount = IF seb[type].mark4 THEN SymbolOps.WordsForType[type] ELSE 0;
RETURN [IF n = 2 THEN 2 ELSE 1]};
ComputeRegs: PROC [node: Tree.Index] RETURNS [RegCount] = {
n1: RegCount = vStack[vI-1].nRegs;
n2: RegCount = vStack[vI].nRegs;
k: RegCount = RegsForType[tb[node].info];
RETURN [MIN[MAX[n1, n2+k], MaxRegs]]};
ComputeIndexRegs: PUBLIC PROC [node: Tree.Index] RETURNS [RegCount] = {
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]]};
AdjustRegs: PROC [node: Tree.Index, commuteOp: Tree.NodeName]
RETURNS [RegCount] = {
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 {
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};
RETURN [MIN[MAX[n1, n2, n], MaxRegs]]};
-- operators
Fold: PROC [node: Tree.Index, rep: Repr] RETURNS [Tree.Link] = {
fullRep: Repr = IF tb[node].attr2 THEN long + rep ELSE rep;
RETURN [FoldExpr[node, fullRep]]};
Substx: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
type: CSEIndex = tb[node].info;
subNode: Tree.Index;
val ← Subst[node]; node ← GetNode[val];
IF OpName[tb[node].son[2]] = result THEN {
subNode ← GetNode[tb[node].son[2]];
SELECT ListLength[tb[subNode].son[1]] FROM
0 => ERROR;
1 => {
tb[subNode].son[1] ← Unsafen[tb[subNode].son[1]];
val ← IF tb[subNode].attr3
THEN tb[subNode].son[1]
ELSE ForceType[tb[subNode].son[1], type]};
ENDCASE => {
PushTree[Tree.Null]; PushTree[tb[subNode].son[1]];
PushNode[construct, 2]; SetInfo[type]; val ← PopTree[]};
tb[subNode].son[1] ← Tree.Null; FreeNode[node]};
VPush[BiasForType[type], RepForType[type], MaxRegs];
RETURN};
Unsafen: Tree.Map = {
IF OpName[t] = safen THEN {
node: Tree.Index = GetNode[t];
v ← tb[node].son[1]; tb[node].son[1] ← Tree.Null; FreeNode[node]}
ELSE v ← t;
RETURN};
UMinus: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
tb[node].son[1] ← Exp[tb[node].son[1], signed];
SELECT vStack[vI].rep FROM
both => vStack[vI].rep ← signed;
none => {Log.WarningTree[mixedRepresentation, val]; vStack[vI].rep ← signed};
ENDCASE => NULL;
IF ~StructuredLiteral[tb[node].son[1]] THEN {
tb[node].attr3 ← TRUE; val ← [subtree[index: node]]}
ELSE val ← Fold[node, vStack[vI].rep];
IF vStack[vI].rep = unsigned THEN vStack[vI].rep ← signed;
vStack[vI].bias ← -VBias[];
RETURN};
Abs: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
rep: Repr;
tb[node].son[1] ← RValue[tb[node].son[1], 0, signed];
val ← [subtree[index: node]]; rep ← vStack[vI].rep;
SELECT rep FROM
unsigned, both => {
Log.WarningTree[unsignedCompare, val];
val ← tb[node].son[1]; tb[node].son[1] ← Tree.Null; FreeNode[node]};
none => {Log.ErrorTree[mixedRepresentation, val]; vStack[vI].rep ← both};
ENDCASE => {
tb[node].attr3 ← TRUE;
IF StructuredLiteral[tb[node].son[1]] THEN val ← Fold[node, rep];
IF rep # other THEN vStack[vI].rep ← both};
RETURN};
EnumOp: PROC [node: Tree.Index, target: Repr] RETURNS [Tree.Link] = {
t: Tree.Link;
type: CSEIndex = tb[node].info;
nType: CSEIndex = NormalType[type];
long: BOOLEAN = seb[type].typeTag = long;
d: INTEGER ← 0;
DO
d ← IF tb[node].name = pred THEN d-1 ELSE d+1;
t ← tb[node].son[1]; tb[node].son[1] ← Tree.Null; FreeNode[node];
SELECT OpName[t] FROM
pred, succ => NULL;
ENDCASE => EXIT;
node ← GetNode[t];
ENDLOOP;
PushTree[t]; PushTree[MakeTreeLiteral[ABS[d]]];
IF long THEN {PushNode[lengthen, 1]; SetInfo[type]};
PushNode[IF d < 0 THEN minus ELSE plus, 2];
SetInfo[type]; SetAttr[1, FALSE]; SetAttr[2, long];
RETURN [IF seb[nType].typeTag = enumerated
THEN CheckRange[
RValue[PopTree[], BiasForType[nType], target], Cardinality[nType], nType]
ELSE AddOp[GetNode[PopTree[]], target]]};
ArithRep: PROC [rep, target: Repr] RETURNS [Repr] = {
RETURN [SELECT rep FROM
both, none =>
SELECT target FROM both, none, other => signed, ENDCASE => target,
ENDCASE => rep]};
BiasedFold: PROC [node: Tree.Index, rep: Repr] RETURNS [Tree.Link] = {
fullRep: Repr = IF tb[node].attr2 THEN long + rep ELSE rep;
tb[node].son[1] ← AdjustBias[tb[node].son[1], -vStack[vI-1].bias];
tb[node].son[2] ← AdjustBias[tb[node].son[2], -vStack[vI].bias];
RETURN [FoldExpr[node, fullRep]]};
AddOp: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
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 ← ArithRep[rep, target];
none =>
IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep ← both}
ELSE rep ← IF target = both THEN signed ELSE target;
ENDCASE => NULL;
IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1 THEN {
val ← BiasedFold[node, rep];
rep ← LiteralRep[val, rep]; bias ← 0; nRegs ← RegsForType[type]}
ELSE {
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]] => {
val ← son[1]; shift ← shift + TreeLiteralValue[son[2]];
son[1] ← Tree.Null; FreeNode[node]};
(op = plus AND TreeLiteral[son[1]]) => {
val ← son[2]; shift ← shift + TreeLiteralValue[son[1]];
son[2] ← Tree.Null; FreeNode[node]};
ENDCASE;
bias ← bias + (IF op=plus THEN shift ELSE -shift)};
VPop[]; VPop[]; VPush[bias, rep, nRegs];
IF type # dataPtr.typeINT AND OperandType[val] # type THEN val ← ForceType[val, type];
RETURN};
Mult: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
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 ← ArithRep[rep, target];
none =>
IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep ← both}
ELSE rep ← IF target = both THEN signed ELSE target;
ENDCASE => NULL;
IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1 THEN {
nRegs ← RegsForType[info];
val ← BiasedFold[node, rep]; rep ← LiteralRep[val, rep]; bias ← 0}
ELSE {
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 StructuredLiteral[son[1]] -- AND ~const2 -- THEN {
t ← son[2]; son[2] ← son[1]; son[1] ← t};
IF const1 OR const2 THEN
SELECT (IF const1 THEN v1 ELSE v2) FROM
0 => {val ← son[2]; son[2] ← Tree.Null; FreeNode[node]; rep ← both};
1 => {
val ← son[1]; son[1] ← Tree.Null; FreeNode[node];
rep ← vStack[IF const1 THEN vI ELSE vI-1].rep};
-1 => {
PushTree[son[1]]; son[1] ← Tree.Null; FreeNode[node];
PushNode[uminus, 1]; SetInfo[dataPtr.typeINT];
SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, TRUE];
val ← PopTree[]};
ENDCASE};
VPop[]; VPop[]; VPush[bias, rep, nRegs];
RETURN};
DivMod: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
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 {Log.ErrorTree[mixedRepresentation, val]; rep ← both}
ELSE rep ← target;
ENDCASE => NULL;
IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1 THEN {
nRegs ← RegsForType[info]; val ← Fold[node, rep]; rep ← LiteralRep[val, rep]}
ELSE {
nRegs ← ComputeRegs[node];
attr3 ← CommonRep[rep, unsigned] = none;
IF name = div AND TreeLiteral[son[2]] THEN
SELECT TreeLiteralValue[son[2]] FROM
= 1 => {val ← son[1]; son[1] ← Tree.Null; FreeNode[node]};
>=2 => IF rep = unsigned THEN rep ← both;
ENDCASE};
VPop[]; VPop[]; VPush[0, rep, nRegs]; RETURN};
RelOp: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
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 => {
IF rep1 = unsigned OR rep2 = unsigned THEN {
son[1] ← AdjustBias[son[1], -d1]; d1 ← 0;
son[2] ← AdjustBias[son[2], -d2]; d2 ← 0};
uc ← CommonRep[rep, unsigned] # none};
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 {
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]};
IF StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1 THEN {
val ← Fold[node, rep]; nRegs ← 1}
ELSE {nRegs ← AdjustRegs[node, CommutedOp[name]]; attr3 ← rep # unsigned};
VPop[]; VPop[]; VPush[0, both, nRegs];
RETURN};
ComparableSons: PROC [node: Tree.Index] RETURNS [BOOLEAN] = {
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 THEN -- account for lost discrimination
son[2] ← ChopType[son[2], type1]
ELSE son[1] ← ChopType[son[1], type2];
ENDCASE => RETURN [FALSE];
RETURN [ComparableType[type1] OR ComparableType[type2]]};
In: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
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
{son[1] ← AdjustBias[son[1], -bias]; bias ← 0};
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 => {void ← TRUE; RESUME}];
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 => {
FreeNode[node]; val ← passPtr.tFALSE; nRegs ← 1};
const AND StructuredLiteral[son[1]] AND ~attr1 => {
val ← Fold[node, rep]; nRegs ← 1};
ENDCASE => nRegs ← ComputeRegs[node];
VPop[]; VPop[]; VPush[0, both, nRegs]; RETURN};
BoolOp: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
b: Tree.Link = IF (name = and) THEN passPtr.tTRUE ELSE passPtr.tFALSE;
n1, n2, nRegs: RegCount;
son[1] ← BoolValue[son[1]]; n1 ← VRegs[];
son[2] ← BoolValue[son[2]]; n2 ← VRegs[];
IF TreeLiteral[son[1]] THEN {
IF son[1] = b THEN {val ← son[2]; son[2] ← Tree.Null; nRegs ← n2}
ELSE {
val ← IF (name = and) THEN passPtr.tFALSE ELSE passPtr.tTRUE;
nRegs ← 1};
FreeNode[node]}
ELSE
IF son[2] # b THEN {val ← [subtree[index: node]]; nRegs ← MAX[n1, n2]}
ELSE {val ← son[1]; son[1] ← Tree.Null; nRegs ← n1; FreeNode[node]};
VPop[]; VPop[]; VPush[0, both, nRegs];
RETURN};
CheckAlt: PROC [t: Tree.Link, target: CSEIndex] RETURNS [Tree.Link] = {
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]};
IfExp: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
OPEN tb[node];
select: Tree.Link;
rep: Repr;
nRegs: RegCount;
bias: INTEGER = BiasForType[info];
son[1] ← BoolValue[son[1]]; nRegs ← VRegs[]; VPop[];
IF TreeLiteral[son[1]] THEN {
IF son[1] # passPtr.tFALSE THEN {select ← son[2]; son[2] ← Tree.Null}
ELSE {select ← son[3]; son[3] ← Tree.Null};
FreeNode[node];
val ← Exp[select, target]}
ELSE {
son[2] ← CheckAlt[RValue[son[2], bias, target], info];
rep ← VRep[]; nRegs ← MAX[VRegs[], nRegs]; VPop[];
son[3] ← CheckAlt[RValue[son[3], bias, target], info];
val ← [subtree[index: node]];
rep ← CommonRep[VRep[], rep];
IF rep = none THEN
IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep ← both}
ELSE rep ← target;
vStack[vI].rep ← rep; vStack[vI].nRegs ← MAX[VRegs[], nRegs]};
RETURN};
CaseExp: PROC [node: Tree.Index, target: Repr, caseBias: INTEGER] RETURNS [val: Tree.Link] = {
op: Tree.NodeName = tb[node].name;
type: CSEIndex = tb[node].info;
bias: INTEGER = BiasForType[type];
rep: Repr;
const: BOOLEAN;
Selection: Tree.Map = {
v ← CheckAlt[RValue[t, bias, target], type];
rep ← CommonRep[rep, VRep[]]; VPop[];
const ← const AND StructuredLiteral[v];
RETURN};
rep ← both+other; const ← TRUE;
val ← CaseDriver[node, Selection, caseBias];
IF OpName[val] = op THEN {PushTree[val]; SetAttr[1, const]; val ← PopTree[]};
IF rep = none THEN
IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep ← both}
ELSE rep ← target;
VPush[bias, rep, MaxRegs];
RETURN};
BindCaseExp: PROC [node: Tree.Index, target: Repr] RETURNS [Tree.Link] = {
BoundExp: PROC [t: Tree.Link, labelBias: INTEGER] RETURNS [Tree.Link] = {
RETURN [CaseExp[GetNode[t], target, labelBias]]};
RETURN [BindCase[node, casex, BoundExp]]};
BindTypeExp: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
type: CSEIndex = tb[node].info;
bias: INTEGER = BiasForType[type];
rep: Repr;
const: BOOLEAN;
Selection: Tree.Map = {
v ← CheckAlt[RValue[t, bias, target], type];
rep ← CommonRep[rep, VRep[]]; VPop[];
const ← const AND StructuredLiteral[v];
RETURN};
rep ← both+other; const ← TRUE;
val ← BindType[node, Selection];
IF rep = none THEN
IF target = none THEN {Log.WarningTree[mixedRepresentation, val]; rep ← both}
ELSE rep ← target;
VPush[bias, rep, MaxRegs];
RETURN};
MinMax: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
OPEN tb[node];
const, zeroTest: BOOLEAN;
rep: Repr;
nRegs: RegCount;
k: RegCount = RegsForType[info];
Item: Tree.Map = {
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, VRep[]];
nRegs ← MIN[MAX[nRegs, VRegs[]+k], MaxRegs]; VPop[]; RETURN};
IF ListLength[son[1]] = 1 THEN {
val ← Exp[son[1], target]; son[1] ← Tree.Null; FreeNode[node]}
ELSE {
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 {Log.ErrorTree[mixedRepresentation, val]; rep ← both}
ELSE rep ← target;
ENDCASE => NULL;
IF const AND ~attr1 THEN {
val ← Fold[node, rep]; rep ← LiteralRep[val, rep]; nRegs ← k}
ELSE attr3 ← rep # unsigned;
VPush[0, rep, nRegs]};
RETURN};
Nil: PROC [node: Tree.Index] RETURNS [Tree.Link] = {
type: CSEIndex = tb[node].info;
n: CARDINAL;
d: LiteralOps.ValueDescriptor;
IF tb[node].son[1] # Tree.Null THEN TypeExp[tb[node].son[1]];
n ← P4.WordsForType[type];
d ← DESCRIPTOR[Heap.MakeNode[dataPtr.zone, n], n];
FOR i: CARDINAL IN [0..n) DO d[i] ← 0 ENDLOOP;
PushLit[LiteralOps.FindDescriptor[d]];
IF n > 1 THEN {PushNode[mwconst, 1]; SetInfo[type]};
FreeNode[node]; Heap.FreeNode[dataPtr.zone, BASE[d]];
VPush[BiasForType[type], RepForType[type], RegsForType[type]];
RETURN [ForceType[PopTree[], type]]};
Lengthen: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
OPEN tb[node];
rep: Repr;
nRegs: RegCount;
son[1] ← RValue[son[1], 0, IF target=both THEN unsigned ELSE target];
attr1 ← SELECT TypeForm[CanonicalType[OperandType[son[1]]]] FROM
ref, arraydesc => TRUE,
ENDCASE => FALSE;
IF (rep ← VRep[]) = none THEN {Log.ErrorTree[mixedRepresentation, son[1]]; rep ← both};
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 {val ← ShortToLong[node, rep]; rep ← LiteralRep[val, rep]};
VPop[]; VPush[0, IF rep = unsigned AND ~attr1 THEN both ELSE rep, nRegs];
RETURN};
Shorten: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
OPEN tb[node];
rep: Repr;
nRegs: RegCount;
son[1] ← RValue[son[1], 0, IF target=both THEN unsigned ELSE target];
nRegs ← VRegs[]; rep ← VRep[]; VPop[];
IF CommonRep[target, unsigned] # none THEN rep ← unsigned;
attr1 ← checked OR dataPtr.switches['b];
IF CommonRep[rep, unsigned] = none THEN attr3 ← TRUE
ELSE {attr3 ← FALSE; info ← dataPtr.typeCARDINAL};
IF ~StructuredLiteral[son[1]] THEN val ← [subtree[index: node]]
ELSE {val ← LongToShort[node, rep]; rep ← LiteralRep[val, rep]};
VPush[0, rep, nRegs]; RETURN};
Loophole: PROC [node: Tree.Index, target: Repr] RETURNS [val: Tree.Link] = {
OPEN tb[node];
type: CSEIndex = info;
rep: Repr = IF tb[node].son[2] # Tree.Null OR target = none
THEN RepForType[type]
ELSE target;
son[1] ← Exp[son[1], rep];
IF son[2] # Tree.Null THEN TypeExp[son[2]];
IF P4.WordsForType[OperandType[son[1]]] # P4.WordsForType[type] THEN
Log.ErrorTree[sizeClash, son[1]];
IF RCType[type] # none THEN val ← [subtree[index: node]]
ELSE {
val ← ForceType[son[1], type];
son[1] ← Tree.Null; FreeNode[node]};
vStack[vI].rep ← rep; RETURN};
AdjustBias: PUBLIC PROC [t: Tree.Link, delta: INTEGER] RETURNS [Tree.Link] = {
op: Tree.NodeName;
type: CSEIndex;
IF delta = 0 THEN RETURN [t];
IF OpName[t] = safen THEN {
subNode: Tree.Index = GetNode[t];
tb[subNode].son[1] ← AdjustBias[tb[subNode].son[1], delta];
RETURN [t]};
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 {op ← plus; delta ← -delta};
PushTree[t]; PushTree[MakeTreeLiteral[delta]];
PushNode[op, 2]; SetInfo[type]; SetAttr[1, FALSE]; SetAttr[2, FALSE];
RETURN [PopTree[]]};
RValue: PUBLIC PROC [exp: Tree.Link, bias: INTEGER, target: Repr]
RETURNS [val: Tree.Link] = {
d: INTEGER;
val ← Exp[exp, target]; d ← bias - vStack[vI].bias;
IF d # 0 THEN {val ← AdjustBias[val, d]; vStack[vI].bias ← bias};
RETURN};
Exp: PUBLIC PROC [exp: Tree.Link, target: Repr] RETURNS [val: Tree.Link] = {
rep: Repr;
WITH expr: exp SELECT FROM
symbol => {
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
proc, 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 {
val ← IdentityMap[FindExtension[sei].tree];
WITH val SELECT FROM
subtree => tb[index].info ← type;
ENDCASE;
val ← Exp[val, target]; rep ← VRep[]; VPop[]}
ELSE {
val ← MakeStructuredLiteral[seb[sei].idValue, type];
rep ← LiteralRep[val, rep]};
VPush[BiasForType[type], rep, RegsForType[type]]};
literal => {
WITH expr.info SELECT FROM
word => rep ← LiteralRep[expr, unsigned];
string => {
LiteralOps.StringReference[index];
MarkString[local: index # LiteralOps.MasterString[index]];
rep ← unsigned};
ENDCASE => rep ← none;
VPush[0, rep, 1]; val ← expr};
subtree =>
IF expr = Tree.Null THEN {
val ← Tree.Null; VPush[passPtr.implicitBias, passPtr.implicitRep, MaxRegs]}
ELSE {
node: Tree.Index = expr.index;
SELECT tb[node].name FROM
dot => {
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 ← ~attr3 AND (checked OR dataPtr.switches['n]);
val ← expr};
dollar => val ← Dollar[node];
cdot => {
val ← Exp[tb[node].son[2], target];
tb[node].son[2] ← Tree.Null; FreeNode[node]};
uparrow => {
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 ← ~attr3 AND (checked OR dataPtr.switches['n]);
val ← expr};
callx, portcallx, signalx, errorx, startx, joinx => val ← Call[node];
substx => val ← Substx[node];
index, dindex => val ← Index[node];
seqindex => val ← SeqIndex[node];
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];
pred, succ => val ← EnumOp[node, target];
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 => {
tb[node].son[1] ← BoolValue[tb[node].son[1]];
IF ~TreeLiteral[tb[node].son[1]] THEN val ← expr
ELSE {
val ← IF tb[node].son[1] # passPtr.tFALSE
THEN passPtr.tFALSE
ELSE passPtr.tTRUE;
FreeNode[node]; vStack[vI].nRegs ← 1}};
or, and => val ← BoolOp[node];
ifx => val ← IfExp[node, target];
casex => val ← CaseExp[node, target, 0];
bindx => val ← IF tb[node].attr3
THEN BindTypeExp[node, target]
ELSE BindCaseExp[node, target];
assignx => val ← Assignment[node];
extractx => val ← Extract[node];
min, max => val ← MinMax[node, target];
mwconst => {
rep: Repr;
val ← expr; rep ← LiteralRep[val, RepForType[tb[node].info]];
VPush[0, rep, RegsForType[tb[node].info]]};
clit => {val ← tb[node].son[1]; FreeNode[node]; VPush[0, both, 1]};
llit => {
IF currentLevel > 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]};
textlit => {
nRegs: RegCount = RegsForType[tb[node].info];
IF dataPtr.definitionsOnly THEN val ← expr
ELSE {
val ← WITH e: tb[node].son[1] SELECT FROM
literal =>
WITH e.info SELECT FROM
string => SymLiteralOps.TextRef[index],
ENDCASE => ERROR,
ENDCASE => ERROR;
FreeNode[node]};
VPush[0, unsigned, nRegs]};
atom => {
IF dataPtr.definitionsOnly THEN val ← expr
ELSE {
val ← SymLiteralOps.AtomRef[GetHash[tb[node].son[1]]];
FreeNode[node]};
VPush[0, unsigned, 2]};
new => val ← New[node];
nil => val ← Nil[node];
create, fork => val ← MiscXfer[node];
syserrorx => {val ← expr; VPush[0, RepForType[tb[node].info], MaxRegs]};
lengthen => val ← Lengthen[node, target];
shorten => val ← Shorten[node, target];
float => {
tb[node].son[1] ← RValue[tb[node].son[1], 0, signed];
IF StructuredLiteral[tb[node].son[1]] AND vStack[vI].rep # unsigned THEN
val ← IntToReal[node]
ELSE {val ← expr; vStack[vI].nRegs ← MaxRegs};
vStack[vI].rep ← other};
safen, proccheck => {
tb[node].son[1] ← Exp[tb[node].son[1], target]; val ← expr};
loophole => val ← Loophole[node, target];
cast => {
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};
check => {
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]};
narrow => val ← Narrow[node];
istype => {
OPEN tb[node];
son[1] ← RValue[son[1], 0, RepForType[OperandType[son[1]]]]; VPop[];
TypeExp[son[2]];
IF nSons > 2 THEN CatchNest[son[3]];
IF attr2 OR attr3 THEN {val ← expr; VPush[0, both, MaxRegs]}
ELSE {FreeNode[node]; val ← passPtr.tTRUE; VPush[0, both, 1]}};
openx => {
OPEN tb[node];
type: CSEIndex = OperandType[son[1]];
IF attr1 THEN val ← son[1]
ELSE {
son[1] ← NeutralExp[son[1]];
IF Shared[son[1]] THEN -- must generate an unshared node
son[1] ← ForceType[son[1], type];
SetShared[son[1], TRUE]; attr1 ← TRUE;
val ← expr};
VPush[0, other, RegsForType[type]]};
stringinit => {
MarkString[];
tb[node].son[2] ← P4.Rhs[tb[node].son[2], dataPtr.typeCARDINAL];
VPop[];
val ← expr; VPush[0, unsigned, MaxRegs]};
size, first, last, typecode => val ← TypeOp[node];
apply => {VPush[0, none, 0]; val ← expr};
ENDCASE => val ← AddrOp[node]};
ENDCASE => ERROR;
RETURN};
NeutralExp: PUBLIC PROC [exp: Tree.Link] RETURNS [val: Tree.Link] = {
val ← RValue[exp, 0, none]; VPop[]; RETURN};
}.