[ivy]<Satterthwaite>Mimosa>Pass4Ops.mesa!6

Pass4Ops.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, June 25, 1986 9:46:15 am PDT
Russ Atkinson (RRA) March 6, 1985 10:54:56 pm PST
DIRECTORY
Alloc: TYPE USING [Notifier],
Literals: TYPE USING [Base, Byte, LitDescriptor, ltType],
LiteralOps: TYPE USING [DescriptorValue, Find, Value],
Log: TYPE USING [ErrorTree],
P4: TYPE USING [RelOp, Repr, none, unsigned, both, other, CommonRep],
Pass4: TYPE USING [tFALSE, tTRUE],
Real: TYPE USING [Abs, RealException, Negate, PairToReal],
Target: TYPE MachineParms USING [bitsPerLongWord, bitsPerWord, maxWord],
Tree: TYPE USING [Base, Index, Info, Link, Map, NodeName, Null, Scan, treeType],
TreeOps: TYPE USING [FreeNode, GetNode, GetTag, PopTree, PushLit, PushNode, ScanList, SetInfo, UpdateList];
Pass4Ops: PROGRAM
IMPORTS LiteralOps, Log, P4, Real, TreeOps, passPtr: Pass4
EXPORTS P4 = {
OPEN TreeOps;
LS: TYPE = INT;
LU: TYPE = CARD;
RelOp: TYPE = P4.RelOp;
Repr: TYPE = P4.Repr;
tb: Tree.Base;-- tree base address (local copy)
ltb: Literals.Base;-- literal table base address (local copy)
OpsNotify: PUBLIC Alloc.Notifier = {
called by allocator whenever table area is repacked
tb ← base[Tree.treeType]; ltb ← base[Literals.ltType]};
literals
TreeLiteral: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
RETURN[WITH t SELECT GetTag[t] FROM
literal => TRUE,
subtree =>
SELECT tb[index].name FROM
cast => TreeLiteral[tb[index].son[1]],
ENDCASE => FALSE,
ENDCASE => FALSE]
};
TreeLiteralValue: PUBLIC PROC[t: Tree.Link] RETURNS[CARD] = {
WITH e: t SELECT GetTag[t] FROM
literal => RETURN[LiteralOps.Value[e.index]];
subtree => {
node: Tree.Index = e.index;
SELECT tb[node].name FROM
cast => RETURN[TreeLiteralValue[tb[node].son[1]]];
ENDCASE};
ENDCASE;
ERROR};
MakeTreeLiteral: PUBLIC PROC[val: CARD] RETURNS[Tree.Link] = {
RETURN[[literal[LiteralOps.Find[val]]]]};
StructuredLiteral: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
RETURN[WITH t SELECT GetTag[t] FROM
literal => TRUE,
subtree =>
SELECT tb[index].name FROM
mwconst => TRUE,
cast => StructuredLiteral[tb[index].son[1]],
ENDCASE => FALSE,
ENDCASE => FALSE]
};
TreeLiteralDesc: PUBLIC PROC[t: Tree.Link] RETURNS[Literals.LitDescriptor] = {
WITH t SELECT GetTag[t] FROM
literal => RETURN[LiteralOps.DescriptorValue[index]];
subtree => {
node: Tree.Index = index;
SELECT tb[node].name FROM
mwconst, cast => RETURN[TreeLiteralDesc[tb[node].son[1]]];
ENDCASE};
ENDCASE;
ERROR};
LongLit: TYPE = LONG UNSPECIFIED;
LongLiteralValue: PROC[t: Tree.Link] RETURNS[LongLit] = {
WITH t SELECT GetTag[t] FROM
literal => RETURN[LiteralOps.Value[index]];
subtree => {
node: Tree.Index = index;
SELECT tb[node].name FROM
mwconst, cast => RETURN[LongLiteralValue[tb[node].son[1]]];
ENDCASE};
ENDCASE;
ERROR};
MakeLongLiteral: PROC[val: LongLit, type: Tree.Info] RETURNS[Tree.Link] = {
PushLit[LiteralOps.Find[val]];
PushNode[mwconst, 1]; SetInfo[type];
RETURN[PopTree[]]};
LiteralRep: PUBLIC PROC[t: Tree.Link, rep: Repr] RETURNS[Repr] = {
desc: Literals.LitDescriptor;
RETURN[SELECT TRUE FROM
rep = P4.other, rep = P4.none => rep,
TreeLiteral[t] =>
IF TreeLiteralValue[t] > Target.maxWord/2-- test sign bit
THEN IF rep = P4.both THEN P4.unsigned ELSE rep
ELSE P4.both,
StructuredLiteral[t] =>
IF (desc←TreeLiteralDesc[t]).length = Target.bitsPerLongWord/Target.bitsPerWord
THEN
IF ltb[desc.offset][0] > Literals.Byte.LAST/2-- assumes big-endian
THEN IF rep = P4.both THEN P4.unsigned ELSE rep
ELSE P4.both
ELSE P4.other,
ENDCASE => rep]
};
BoolTest: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
RETURN[TreeLiteralValue[t] # 0]};
IntToReal: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
v: LS = LongLiteralValue[tb[node].son[1]];
overflow: BOOL ← FALSE;
r: REAL = Real.PairToReal[v, 0
! Real.RealException => {overflow ← TRUE; RESUME}];
IF overflow THEN {val ← [subtree[node]]; Log.ErrorTree[overflow, val]}
ELSE {val ← MakeLongLiteral[r, tb[node].info]; FreeNode[node]};
RETURN};
signWord: WORD = CARDINAL.LAST;
ShortToLong: PUBLIC PROC[node: Tree.Index, rep: Repr] RETURNS[val: Tree.Link] = {
assumes that host and target extend sign the same way
w: WORD = TreeLiteralValue[tb[node].son[1]];
v: LongLit = (IF P4.CommonRep[rep, P4.unsigned] # P4.none OR w <= maxSS
THEN CARDINAL[w].LONG
ELSE INTEGER[w].LONG);
PushLit[LiteralOps.Find[v]];
PushNode[mwconst, 1]; SetInfo[tb[node].info]; FreeNode[node];
RETURN[PopTree[]]};
LongToShort: PUBLIC PROC[node: Tree.Index, rep: Repr] RETURNS[val: Tree.Link] = {
v: LongLit = LongLiteralValue[tb[node].son[1]];
IF P4.CommonRep[rep, P4.unsigned] # P4.none THEN {
IF CARD[v] > maxSU THEN GO TO Overflow}
ELSE IF (INT[v] > maxSS) OR (INT[v] < minSS) THEN
GO TO Overflow;
val ← MakeTreeLiteral[WORD[v]]; FreeNode[node];
EXITS
Overflow => {val ← [subtree[node]]; Log.ErrorTree[boundsFault, tb[node].son[1]]}
};
ZeroP: PUBLIC PROC[t: Tree.Link] RETURNS[zero: BOOL] = {
IF ~StructuredLiteral[t] THEN zero ← FALSE
ELSE {
desc: Literals.LitDescriptor = TreeLiteralDesc[t];
zero ← TRUE;
FOR i: CARDINAL IN [0..desc.length) WHILE (zero←(ltb[desc.offset][i] = 0)) DO
NULL ENDLOOP};
RETURN};
dispatch
Mode: TYPE = {ss, su, ls, lu, other};
ModeMap: ARRAY Repr OF Mode = [
ss, ss, su, ss, ls, ls, lu, ls,
other, ss, su, ss, other, ls, lu, ls];
InOp: TYPE = Tree.NodeName [in .. notin];
IntOp: TYPE = Tree.NodeName [intOO .. intCC];
Test: ARRAY Mode OF PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = [
TestSS, TestSU, TestLS, TestLU, TestOther];
UnaryOp: ARRAY Mode OF PROC[node: Tree.Index] RETURNS[Tree.Link] = [
UnarySS, UnarySU, UnaryLS, UnaryLU, UnaryOther];
BinaryOp: ARRAY Mode OF PROC[node: Tree.Index] RETURNS[Tree.Link] = [
BinarySS, BinarySU, BinaryLS, BinaryLU, OpError];
FoldExpr: PUBLIC PROC[node: Tree.Index, rep: Repr] RETURNS[val: Tree.Link] = {
SELECT tb[node].name FROM
plus, minus, times, div, mod => val ← BinaryOp[ModeMap[rep]][node];
abs, uminus => val ← UnaryOp[ModeMap[rep]][node];
relE, relN, relL, relGE, relG, relLE => {
val ← IF RelTest [
l: tb[node].son[1], r: tb[node].son[2],
op: tb[node].name,
rep: rep]
THEN passPtr.tTRUE
ELSE passPtr.tFALSE;
FreeNode[node]};
in, notin => {
val ← IF
IntervalTest [l: tb[node].son[1], r: tb[node].son[2], rep: rep]
=
(tb[node].name = in)
THEN passPtr.tTRUE
ELSE passPtr.tFALSE;
FreeNode[node]};
min, max => {
VoidItem: Tree.Map = {RETURN[IF t=val THEN Tree.Null ELSE t]};
val ← Choose[
list: tb[node].son[1],
test: IF tb[node].name = min THEN relL ELSE relG,
rep: rep];
tb[node].son[1] ← UpdateList[tb[node].son[1], VoidItem];
FreeNode[node]};
ENDCASE => ERROR
};
RelTest: PUBLIC PROC[l, r: Tree.Link, op: RelOp, rep: Repr] RETURNS[BOOL] = {
OpMap: ARRAY RelOp OF RECORD [map: RelOp, sense: BOOL] = [
[relE, TRUE], [relE, FALSE], [relL, TRUE], [relL, FALSE],
[relG, TRUE], [relG, FALSE]];
RETURN[Test[ModeMap[rep]][l, r, OpMap[op].map] = OpMap[op].sense]};
IntervalTest: PUBLIC PROC[l, r: Tree.Link, rep: Repr] RETURNS[BOOL] = {
InTest: ARRAY IntOp OF RECORD [lb, ub: RelOp] = [
[relG, relL], [relG, relLE], [relGE, relL], [relGE, relLE]];
subNode: Tree.Index = GetNode[r];
op: IntOp = tb[subNode].name;
RETURN[
RelTest[l, tb[subNode].son[1], InTest[op].lb, rep]
AND
RelTest[l, tb[subNode].son[2], InTest[op].ub, rep] ]
};
Choose: PROC[list: Tree.Link, test: RelOp, rep: Repr] RETURNS[val: Tree.Link] = INLINE {
started: BOOL ← FALSE;
Item: Tree.Scan = {
SELECT TRUE FROM
~started => {started ← TRUE; val ← t};
RelTest[t, val, test, rep] => val ← t;
ENDCASE};
ScanList[list, Item]; RETURN};
operations
minSS: INTEGER = INTEGER.FIRST;
maxSS: INTEGER = INTEGER.LAST;
TestSS: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
v1: INTEGER = TreeLiteralValue[t1];
v2: INTEGER = TreeLiteralValue[t2];
RETURN[SELECT op FROM
relE => v1 = v2,
relL => v1 < v2,
relG => v1 > v2,
ENDCASE => ERROR]
};
UnarySS: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
v: INTEGER;
v1: INTEGER = TreeLiteralValue[tb[node].son[1]];
SELECT tb[node].name FROM
uminus => IF v1 # minSS THEN v ← -v1 ELSE GO TO Overflow;
abs => IF v1 # minSS THEN v ← IF v1 < 0 THEN -v1 ELSE v1 ELSE GO TO Overflow;
ENDCASE => ERROR;
t ← MakeTreeLiteral[v]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← TRUE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}
};
BinarySS: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
v: INTEGER;
v1: INTEGER = TreeLiteralValue[tb[node].son[1]];
v2: INTEGER = TreeLiteralValue[tb[node].son[2]];
SELECT tb[node].name FROM
plus =>
IF (IF v1 >= 0 THEN v2 <= maxSS-v1 ELSE v2 >= minSS-v1) THEN v ← v1 + v2
ELSE GO TO Overflow;
minus =>
IF (IF v1 >= 0 THEN v1-maxSS <= v2 ELSE v1-minSS >= v2) THEN v ← v1 - v2
ELSE GO TO Overflow;
times =>
IF (SELECT TRUE FROM
(v1 > 0) AND (v2 > 0) => v2 <= maxSS / v1,
(v1 > 0) AND (v2 < 0) => v2 >= minSS / v1,
(v1 < 0) AND (v2 > 0) => v1 >= minSS / v2,
(v1 < 0) AND (v2 < 0) =>
v1 # minSS AND v2 # minSS AND v2 >= maxSS / v1,
ENDCASE => TRUE) THEN
v ← v1 * v2
ELSE GO TO Overflow;
div =>
IF v2 # 0 AND (v2 # -1 OR v1 # minSS) THEN v ← v1 / v2
ELSE GO TO Overflow;
mod => IF v2 # 0 THEN v ← v1 MOD v2 ELSE GO TO Overflow;
ENDCASE => ERROR;
t ← MakeTreeLiteral[v]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← TRUE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}
};
maxSU: CARDINAL = CARDINAL.LAST;
TestSU: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
v1: CARDINAL = TreeLiteralValue[t1];
v2: CARDINAL = TreeLiteralValue[t2];
RETURN[SELECT op FROM
relE => v1 = v2,
relL => v1 < v2,
relG => v1 > v2,
ENDCASE => ERROR]};
UnarySU: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
v1: CARDINAL = TreeLiteralValue[tb[node].son[1]];
SELECT tb[node].name FROM
uminus => IF v1 # 0 THEN GO TO Overflow;
abs => NULL;
ENDCASE => ERROR;
t ← MakeTreeLiteral[v1]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← FALSE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}
};
BinarySU: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
v: CARDINAL;
v1: CARDINAL = TreeLiteralValue[tb[node].son[1]];
v2: CARDINAL = TreeLiteralValue[tb[node].son[2]];
SELECT tb[node].name FROM
plus => IF v2 <= maxSU-v1 THEN v ← v1 + v2 ELSE GO TO Overflow;
minus => IF v1 >= v2 THEN v ← v1 - v2 ELSE GO TO Overflow;
times => IF v1 = 0 OR v2 <= maxSU/v1 THEN v ← v1 * v2 ELSE GO TO Overflow;
div => IF v2 # 0 THEN v ← v1 / v2 ELSE GO TO Overflow;
mod => IF v2 # 0 THEN v ← v1 MOD v2 ELSE GO TO Overflow;
ENDCASE => ERROR;
t ← MakeTreeLiteral[v]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← FALSE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}
};
minLS: LS = LS.FIRST;
maxLS: LS = LS.LAST;
TestLS: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
v1: LS = LongLiteralValue[t1];
v2: LS = LongLiteralValue[t2];
RETURN[SELECT op FROM
relE => v1 = v2,
relL => v1 < v2,
relG => v1 > v2,
ENDCASE => ERROR]
};
UnaryLS: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
v: LS;
v1: LS = LongLiteralValue[tb[node].son[1]];
SELECT tb[node].name FROM
uminus => IF v1 # minLS THEN v ← -v1 ELSE GO TO Overflow;
abs => IF v1 # minLS THEN v ← IF v1 < 0 THEN -v1 ELSE v1 ELSE GO TO Overflow;
ENDCASE => ERROR;
t ← MakeLongLiteral[v, tb[node].info]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← TRUE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}
};
BinaryLS: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
v: LS;
v1: LS = LongLiteralValue[tb[node].son[1]];
v2: LS = LongLiteralValue[tb[node].son[2]];
SELECT tb[node].name FROM
plus =>
IF (IF v1 >= 0 THEN v2 <= maxLS-v1 ELSE v2 >= minLS-v1) THEN v ← v1 + v2
ELSE GO TO Overflow;
minus =>
IF (IF v1 >= 0 THEN v1-maxLS <= v2 ELSE v1-minLS >= v2) THEN v ← v1 - v2
ELSE GO TO Overflow;
times =>
IF (SELECT TRUE FROM
(v1 > 0) AND (v2 > 0) => v2 <= maxLS / v1,
(v1 > 0) AND (v2 < 0) => v2 >= minLS / v1,
(v1 < 0) AND (v2 > 0) => v1 >= minLS / v2,
(v1 < 0) AND (v2 < 0) =>
v1 # minLS AND v2 # minLS AND v2 >= maxLS / v1,
ENDCASE => TRUE) THEN
v ← v1 * v2
ELSE GO TO Overflow;
div =>
IF v2 # 0 AND (v2 # -1 OR v1 # minLS) THEN v ← v1 / v2
ELSE GO TO Overflow;
mod => IF v2 # 0 THEN v ← v1 MOD v2 ELSE GO TO Overflow;
ENDCASE => ERROR;
t ← MakeLongLiteral[v, tb[node].info]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← TRUE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}
};
maxLU: LU = LU.LAST;
TestLU: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
v1: LU = LongLiteralValue[t1];
v2: LU = LongLiteralValue[t2];
RETURN[SELECT op FROM
relE => v1 = v2,
relL => v1 < v2,
relG => v1 > v2,
ENDCASE => ERROR]
};
UnaryLU: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
v1: LU = LongLiteralValue[tb[node].son[1]];
SELECT tb[node].name FROM
uminus => IF v1 # 0 THEN GO TO Overflow;
abs => NULL;
ENDCASE => ERROR;
t ← MakeLongLiteral[v1, tb[node].info]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← FALSE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}
};
BinaryLU: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
v: LU;
v1: LU = LongLiteralValue[tb[node].son[1]];
v2: LU = LongLiteralValue[tb[node].son[2]];
SELECT tb[node].name FROM
plus => IF v2 <= maxLU-v1 THEN v ← v1 + v2 ELSE GO TO Overflow;
minus => IF v1 >= v2 THEN v ← v1 - v2 ELSE GO TO Overflow;
times => IF v1 = 0 OR v2 <= maxLU/v1 THEN v ← v1 * v2 ELSE GO TO Overflow;
div => IF v2 # 0 THEN v ← v1 / v2 ELSE GO TO Overflow;
mod => IF v2 # 0 THEN v ← v1 MOD v2 ELSE GO TO Overflow;
ENDCASE => ERROR;
t ← MakeLongLiteral[v, tb[node].info]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← FALSE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}
};
TestOther: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
RETURN[SELECT op FROM
relE => TreeLiteralDesc[t1] = TreeLiteralDesc[t2],
ENDCASE => ERROR]
};
UnaryOther: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
fail: BOOL ← FALSE;
IF tb[node].attr1-- REAL
THEN {
ENABLE Real.RealException => {fail ← TRUE; RESUME};
v: REAL;
v1: REAL = LongLiteralValue[tb[node].son[1]];
SELECT tb[node].name FROM
uminus => v ← Real.Negate[v1];
abs => v ← Real.Abs[v1];
ENDCASE => ERROR;
IF fail THEN GO TO Overflow;
t ← MakeLongLiteral[v, tb[node].info]; FreeNode[node];
EXITS
Overflow => {
tb[node].attr3 ← TRUE; t ← [subtree[node]]; Log.ErrorTree[overflow, t]}}
ELSE ERROR};
OpError: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {ERROR};
}.