DIRECTORY
Alloc,
Basics,
IntCodeDefs,
IntCodeStuff,
IntCodeUtils,
LiteralOps,
MimCode,
MimP5S,
MimP5Stuff,
MimP5U,
MimZones,
SymbolOps,
Symbols,
Target: TYPE MachineParms USING [bitsPerWord],
Tree,
TreeOps;
MimP5StuffImpl: CEDAR PROGRAM
IMPORTS Basics, IntCodeStuff, IntCodeUtils, LiteralOps, MimCode, MimP5S, MimP5U, MimZones, SymbolOps, TreeOps
EXPORTS MimP5Stuff
= BEGIN OPEN IntCodeDefs, MimCode;
collapseConsBlocks: BOOL Ź TRUE;
splitCrossWords: BOOL Ź TRUE;
zeroSpanTrigger: NAT Ź 4;
zeroSpanInline: NAT Ź 4;
aggressiveCanonBlock: BOOL Ź TRUE;
simplifyParts: BOOL Ź TRUE;
elimUselessGoTos: BOOL Ź TRUE;
flattenLists: BOOL Ź TRUE;
bpw: NAT = Target.bitsPerWord;
BitIndex: TYPE = [0..bpw);
unsignedClass: IntCodeDefs.ArithClass Ź [unsigned, FALSE, bpw];
BlockValSimplify: PUBLIC PROC [cl: CodeList, node: Node, bn: BlockNode]
RETURNS [BOOL] = {
nodes: NodeList Ź bn.nodes;
declVar: Var Ź NIL;
declInit: Node Ź NIL;
declRest: NodeList Ź NIL;
lag: NodeList Ź NIL;
var: Var Ź NIL;
isAssign: BOOL Ź FALSE;
WITH node SELECT FROM
assign: AssignNode => {var Ź assign.lhs; isAssign Ź TRUE};
decl: DeclNode => var Ź decl.var;
ENDCASE => ERROR;
WHILE nodes # NIL DO
rest: NodeList Ź nodes.rest;
first: Node Ź nodes.first;
IF isAssign AND Intersects[first, var] THEN EXIT;
WITH first SELECT FROM
last: Var => IF rest # NIL OR last # declVar THEN EXIT ELSE {
inner: IntCodeUtils.Visitor = TRUSTED {
IF node = declVar THEN RETURN [var];
IntCodeUtils.MapNode[node, inner];
RETURN [node];
};
lag.rest Ź NIL;
bn.bits Ź 0;
WITH node SELECT FROM
assign: AssignNode =>
IF declInit = NIL THEN node Ź NIL ELSE assign.rhs Ź declInit;
decl: DeclNode => decl.init Ź declInit;
ENDCASE => ERROR;
IntCodeUtils.MapNodeList[declRest, inner];
MimP5U.MoreCode[cl, node];
bn.nodes Ź declRest;
MimP5U.MoreCode[cl, bn];
RETURN [TRUE];
};
decl: REF NodeRep.decl => IF declVar = NIL THEN {
declInit Ź decl.init;
declVar Ź decl.var;
declRest Ź rest;
IF declVar = NIL OR declVar.flags[named] THEN EXIT;
IF declVar.bits # var.bits THEN EXIT;
};
ENDCASE => {
IF declVar = NIL THEN EXIT;
};
lag Ź nodes;
nodes Ź rest;
ENDLOOP;
RETURN [FALSE];
};

MakeConsBlock: PUBLIC PROC [cl: CodeList, dest: Node, bits: INT, assumeTemp: BOOL]
RETURNS [Node] = {
new: Node Ź MimP5U.MakeBlock[cl, bits];
WITH new SELECT FROM
block: REF NodeRep.block => {
oldList: NodeList Ź block.nodes;
inhibitZeroPrune: BOOL Ź FALSE;
zerosAssigned: INT Ź 0;
zeroBitsAssigned: INT Ź 0;
totalAssigned: INT Ź 0;
minOffset: INT Ź INT.LAST;
maxOffset: INT Ź 0;
changed: BOOL Ź FALSE;
IF oldList # NIL THEN WITH oldList.first SELECT FROM
decl: DeclNode => IF decl.var = dest AND decl.init # NIL THEN {
rest: NodeList Ź oldList.rest;
IF rest # NIL THEN WITH rest.first SELECT FROM
assign: REF NodeRep.assign =>
WITH assign.lhs.location SELECT FROM
field: REF LocationRep.field =>
IF field.base = dest THEN {
ffLoc: IntCodeDefs.Location Ź z.NEW[IntCodeDefs.LocationRep.field
Ź [field[start: 0, base: field.base]]];
ffVar: Var Ź z.NEW[IntCodeDefs.VarRep
Ź [bits: bits, details: var[location: ffLoc]]];
newAssn: Node Ź MimP5U.Assign[lhs: ffVar, rhs: decl.init];
decl.init Ź NIL;
oldList.rest Ź MimP5U.MakeNodeList[newAssn, rest];
};
ENDCASE;
ENDCASE;
};
ENDCASE;
FOR pass: NAT IN [1..2] DO
lag: NodeList Ź NIL;
each: NodeList Ź oldList;
WHILE each # NIL DO
rest: NodeList Ź each.rest;
WITH each.first SELECT FROM
assign: REF NodeRep.assign => {
lhs: Var Ź assign.lhs;
rhs: Node Ź assign.rhs;
SELECT TRUE FROM
assumeTemp => {};
NOT IntCodeUtils.SideEffectFree[lhs, FALSE] =>
inhibitZeroPrune Ź TRUE;
NOT IntCodeUtils.SideEffectFree[rhs, FALSE] =>
inhibitZeroPrune Ź TRUE;
ENDCASE;
WITH lhs.location SELECT FROM
field: REF LocationRep.field => {
lBits: INT = lhs.bits;
fStart: INT = field.start;
IF pass = 1 THEN {
IF dest # field.base THEN inhibitZeroPrune Ź totalAssigned # 0;
IF lBits <= bpw THEN {
IF splitCrossWords THEN [] Ź SplitAssignment[each];
IF collapseConsBlocks AND each.rest = rest AND rest # NIL THEN {
WITH rest.first SELECT FROM
nextAssn: AssignNode => IF nextAssn.lhs.bits <= bpw THEN {
IF splitCrossWords THEN [] Ź SplitAssignment[rest];
IF CombineAssignments[each, assumeTemp] THEN
GO TO redo;
};
ENDCASE;
};
};
IF rest # NIL THEN WITH rest.first SELECT FROM
assn2: REF NodeRep.assign =>
WITH assn2.lhs.location SELECT FROM
field2: REF LocationRep.field =>
IF field2.start > (fStart+lBits) THEN
inhibitZeroPrune Ź totalAssigned # 0;
ENDCASE => inhibitZeroPrune Ź totalAssigned # 0;
ENDCASE;
totalAssigned Ź totalAssigned + 1;
};
IF MimP5U.IsZero[rhs] AND lhs.bits >= bpw THEN
IF pass = 1
THEN {
zerosAssigned Ź zerosAssigned + 1;
zeroBitsAssigned Ź zeroBitsAssigned + lBits;
minOffset Ź MIN[minOffset, field.start];
maxOffset Ź MAX[maxOffset, field.start+lBits];
}
ELSE {
IF lag = NIL THEN block.nodes Ź rest ELSE lag.rest Ź rest;
each Ź rest;
GO TO redo;
};
};
ENDCASE => inhibitZeroPrune Ź totalAssigned # 0;
EXITS redo => {changed Ź TRUE; LOOP};
};
ENDCASE =>
IF NOT assumeTemp
AND NOT IntCodeUtils.SideEffectFree[each.first, FALSE] THEN
inhibitZeroPrune Ź TRUE;
lag Ź each;
each Ź rest;
ENDLOOP;
SELECT pass FROM
1 => IF zerosAssigned+zerosAssigned < totalAssigned
OR zerosAssigned <= zeroSpanTrigger
OR inhibitZeroPrune THEN EXIT;
2 => {
start: INT = minOffset - OffsetInWord[minOffset];
maxMod: NAT = OffsetInWord[maxOffset];
lim: INT = maxOffset - maxMod;
zeroBits: INT = lim-start;
zeroConst: Node = MimP5U.MakeConstCard[0];
zeroWords: INT = zeroBits/bpw;
field: Var Ź MimP5U.TakeFieldVar[dest, start, zeroBits];
nodes: NodeList Ź NIL;
IF maxMod # 0 THEN {
field: Var Ź MimP5U.TakeFieldVar[dest, lim, maxMod];
field0: Node Ź MimP5U.TakeField[zeroConst, bpw-maxMod, maxMod];
assign: Node Ź MimP5U.Assign[field, field0];
nodes Ź MimP5U.MakeNodeList[assign, nodes];
};
IF zeroWords <= zeroSpanInline
THEN {
FOR i: NAT IN [0..NAT[zeroWords]) DO
field: Var Ź MimP5U.TakeFieldVar[dest, start+i*bpw, bpw];
assign: Node Ź MimP5U.Assign[field, zeroConst];
nodes Ź MimP5U.MakeNodeList[assign, nodes];
ENDLOOP;
}
ELSE {
allNode: Node Ź MimP5U.ApplyOp[
oper: MimP5U.MesaOpNode[all],
args: MimP5U.MakeArgList2[MimP5U.MakeConstCard[0], MimP5U.MakeConstCard[zeroWords]],
bits: zeroBits];
assign: Node Ź MimP5U.Assign[field, allNode];
nodes Ź MimP5U.MakeNodeList[assign, nodes];
};
{
lag: NodeList Ź NIL;
nodesTail: NodeList Ź IntCodeUtils.NodeListTail[nodes];
FOR each: NodeList Ź block.nodes, each.rest WHILE each # NIL DO
WITH each.first SELECT FROM
var: Var => EXIT;
assign: AssignNode => {
lhs: Var = assign.lhs;
IF lhs = dest THEN EXIT;
WITH lhs.location SELECT FROM
field: REF LocationRep.field => IF field.base = dest THEN EXIT;
ENDCASE;
};
apply: ApplyNode => EXIT;
ENDCASE;
lag Ź each;
ENDLOOP;
IF lag = NIL
THEN {
nodesTail.rest Ź block.nodes;
block.nodes Ź nodes;
}
ELSE {
nodesTail.rest Ź lag.rest;
lag.rest Ź nodes;
};
};
changed Ź TRUE;
};
ENDCASE => ERROR;
ENDLOOP;
IF changed OR aggressiveCanonBlock THEN new Ź CanonBlock[new];
};
ENDCASE;
RETURN [new];
};

Intersects: PUBLIC PROC [node: Node, var: Var] RETURNS [BOOL] = {
DO
list: NodeList Ź NIL;
WITH node SELECT FROM
bn: BlockNode => list Ź bn.nodes;
sn: REF NodeRep.source => list Ź sn.nodes;
dn: REF NodeRep.decl => {
IF Intersects[dn.var, var] THEN RETURN [TRUE];
node Ź dn.init;
LOOP;
};
label: REF NodeRep.label => {node Ź label.label.node; LOOP};
comment: REF NodeRep.comment => RETURN [FALSE];
const: ConstNode => RETURN [FALSE];
an: REF NodeRep.assign => {
IF Intersects[an.lhs, var] THEN RETURN [TRUE];
node Ź an.rhs;
LOOP;
};
cn: REF NodeRep.cond => {
FOR each: CaseList Ź cn.cases, each.rest WHILE each # NIL DO
FOR test: NodeList Ź each.tests, test.rest WHILE test # NIL DO
IF Intersects[test.first, var] THEN RETURN [TRUE];
ENDLOOP;
IF Intersects[each.body, var] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE];
};
apply: REF NodeRep.apply => {
WITH apply.proc SELECT FROM
oper: REF NodeRep.oper => WITH oper.oper SELECT FROM
code: REF OperRep.code => RETURN [TRUE];
escape: REF OperRep.escape => RETURN [TRUE];
ENDCASE => {};
ENDCASE => RETURN [TRUE];
list Ź apply.args;
};
vn: Var => {
IF vn = var THEN RETURN [TRUE];
WITH vn.location SELECT FROM
g: GlobalVarLocation => RETURN [FALSE];
l: LocalVarLocation => RETURN [FALSE];
f: FieldLocation => {node Ź f.base; LOOP};
c: CompositeLocation => list Ź c.parts;
d: DummyLocation => RETURN [FALSE];
x: IndexedLocation =>
IF Intersects[x.index, var] THEN RETURN [TRUE] ELSE {node Ź x.base; LOOP};
ENDCASE => RETURN [TRUE];
};
ENDCASE => IF node = NIL THEN RETURN [FALSE] ELSE RETURN [TRUE];
WHILE list # NIL DO
IF Intersects[list.first, var] THEN RETURN [TRUE];
list Ź list.rest;
ENDLOOP;
RETURN [FALSE];
ENDLOOP;
};

IsSimpleVar: PUBLIC PROC [n: Node] RETURNS [BOOL] = {
DO
WITH n SELECT FROM
v: Var => WITH v.location SELECT FROM
field: FieldLocation => n Ź field.base; 
local: LocalVarLocation => RETURN [TRUE]; 
global: GlobalVarLocation => RETURN [TRUE]; 
ENDCASE => RETURN [FALSE];
ENDCASE => RETURN [FALSE];
ENDLOOP;
};
CanonBlock: PUBLIC PROC [n: Node] RETURNS [Node] = {
WITH n SELECT FROM
block: BlockNode => {
head: NodeList Ź block.nodes;
IF flattenLists THEN head Ź FlattenList[head];
block.nodes Ź head;
IF head = NIL THEN RETURN [NIL];
IF aggressiveCanonBlock THEN {
list: NodeList Ź head;
WHILE list # NIL DO
rest: NodeList Ź list.rest;
IF rest = NIL THEN EXIT;
WITH list.first SELECT FROM
assn1: AssignNode =>
WITH rest.first SELECT FROM
var2: Var =>
IF var2 = assn1.lhs THEN
IF MimP5S.GetCategory[assn1.rhs] <= local THEN
rest.first Ź assn1.rhs;
assn2: AssignNode =>
SELECT TRUE FROM
assn1.lhs = assn2.rhs => {
rhs1: Node = assn1.rhs;
IF NOT IsCard[rhs1] THEN WITH rhs1 SELECT FROM
rv: Var => WITH rv.location SELECT FROM
loc: REF LocationRep.localVar => {};
ENDCASE => GO TO noTricks;
ENDCASE => GO TO noTricks;
assn2.rhs Ź rhs1;
EXITS noTricks => {};
};
NOT IntCodeUtils.SideEffectFree[assn1.rhs, FALSE] => {};
NOT IntCodeUtils.SideEffectFree[assn2.rhs, FALSE] => {};
CombineAssignments[list, FALSE] => {list Ź list.rest; LOOP};
ENDCASE;
ENDCASE;
ENDCASE;
list Ź rest;
ENDLOOP;
};
SELECT TRUE FROM
head.rest = NIL =>
WITH head.first SELECT FROM
dn: REF NodeRep.decl => {};
sn: REF NodeRep.source => {};
ENDCASE => RETURN [head.first];
ENDCASE => {
WITH head.first SELECT FROM
assign: AssignNode => {
rest: NodeList = head.rest;
IF IntCodeUtils.SimplyEqual[assign.lhs, rest.first] AND rest.rest = NIL THEN {
rhs: Node = assign.rhs;
IF NOT IsCard[rhs] THEN
WITH rhs SELECT FROM
var: Var => WITH var.location SELECT FROM
loc: REF LocationRep.localVar => {};
ENDCASE => GO TO noTricks;
ENDCASE => GO TO noTricks;
rest.first Ź rhs;
EXITS noTricks => {};
};
};
decl: DeclNode => {
temp: Var Ź decl.var;
rest: NodeList Ź head.rest;
tail: NodeList Ź IntCodeUtils.NodeListTail[head];
IF NOT temp.flags[named] THEN {
WITH tail.first SELECT FROM
var: Var => IF var = temp THEN {
FOR each: NodeList Ź rest, each.rest DO
first: Node Ź each.first;
WITH first SELECT FROM
var: Var => {
IF decl.init = NIL THEN EXIT;
each.first Ź decl.init;
each.rest Ź NIL;
head Ź rest;
EXIT;
};
assn: AssignNode =>
IF assn.lhs = var THEN {
next: NodeList Ź each.rest;
IF next = tail THEN {
IF decl.init # NIL THEN EXIT;
IF IntCodeStuff.NodeContains[assn.rhs, var] THEN EXIT;
each.first Ź assn.rhs;
each.rest Ź NIL;
head Ź rest;
EXIT;
};
};
ENDCASE;
IF IntCodeStuff.NodeContains[first, var] THEN EXIT;
ENDLOOP;
tail Ź IntCodeUtils.NodeListTail[head];
IF head = tail THEN RETURN [tail.first];
};
ENDCASE;
IF head.first = decl AND
IntCodeUtils.SideEffectFree[decl.init, TRUE] THEN {
lag: NodeList Ź head;
FOR each: NodeList Ź head.rest, each.rest WHILE each # NIL DO
first: Node Ź each.first;
WITH first SELECT FROM
assn: AssignNode => IF assn.lhs = temp THEN {
IF assn.bits # 0 THEN GO TO stop;
first Ź assn.rhs;
};
ENDCASE;
IF IntCodeStuff.NodeContains[first, temp] THEN GO TO stop;
ENDLOOP;
DO
next: NodeList = lag.rest;
IF next = NIL THEN EXIT;
WITH next.first SELECT FROM
assn: AssignNode => IF assn.lhs = temp THEN {
lag.rest Ź next.rest;
LOOP;
};
ENDCASE;
lag Ź next;
ENDLOOP;
head Ź head.rest;
IF head = tail THEN RETURN [tail.first];
EXITS stop => {};
};
};
};
ENDCASE;
IF head = NIL THEN RETURN [NIL];
n Ź MimCode.z.NEW [NodeRep.block Ź [bits: block.bits, details: block[head]]];
};
};
ENDCASE;
RETURN [n];
};

IsCard: PUBLIC PROC [node: Node] RETURNS [BOOL] = {
start: INT Ź 0;
bits: INT Ź IF node = NIL THEN 0 ELSE node.bits;
IF bits = 0 OR bits > bpw THEN RETURN [FALSE];
DO
IF MimP5U.IsZero[node] THEN RETURN [TRUE];
WITH node SELECT FROM
wc: REF NodeRep.const.word => RETURN [TRUE];
var: Var => WITH var.location SELECT FROM
field: REF LocationRep.field => {
node Ź field.base;
start Ź start + field.start;
LOOP;
};
ENDCASE;
ENDCASE;
RETURN [FALSE];
ENDLOOP;
};

GetCard: PUBLIC PROC
[node: Node, start: INT Ź 0, bits: NAT Ź bpw] RETURNS [CARD] = {
IF bits = 0 OR bits > bpw THEN ERROR;
DO
c: CARD Ź 0;
IF NOT MimP5U.IsZero[node] THEN {
lim: NAT Ź OffsetInWord[start+bits];
WITH node SELECT FROM
wc: REF NodeRep.const.word =>
c Ź IntCodeUtils.WordToCard[wc.word];
var: Var => WITH var.location SELECT FROM
field: REF LocationRep.field => {
vBits: NAT Ź var.bits;
vLim: BitIndex Ź OffsetInWord[field.start+vBits];
c Ź GetCard[field.base, 0, bpw];
IF vLim # 0 THEN c Ź Basics.BITRSHIFT[c, bpw-vLim];
IF bits > vBits THEN bits Ź vBits;
};
ENDCASE => ERROR;
ENDCASE => ERROR;
IF bits # bpw THEN c Ź Basics.BITAND[c, Basics.BITRSHIFT[CARD.LAST, bpw-bits]];
IF lim # 0 THEN c Ź Basics.BITLSHIFT[c, bpw-lim];
};
RETURN [c];
ENDLOOP;
};

SubstTailGoTos: PUBLIC PROC [node: Node, label: Label, subst: Node] RETURNS [Node] = {
tail: NodeList Ź NIL;
WITH node SELECT FROM
block: BlockNode => tail Ź block.nodes;
source: SourceNode => tail Ź source.nodes;
cond: CondNode =>
FOR each: CaseList Ź cond.cases, each.rest WHILE each # NIL DO
body: Node = each.body;
IF body # NIL THEN each.body Ź SubstTailGoTos[body, label, subst];
ENDLOOP;
goto: REF NodeRep.goto =>
IF goto.dest = label THEN RETURN [subst] ELSE RETURN [node];
ENDCASE => RETURN [node];
IF tail # NIL THEN {
lag: NodeList Ź NIL;
DO
rest: NodeList Ź tail.rest;
IF rest = NIL THEN {
new: Node Ź SubstTailGoTos[tail.first, label, subst];
tail.first Ź new;
IF new = NIL THEN
IF lag = NIL THEN RETURN [NIL] ELSE lag.rest Ź NIL;
RETURN [node];
};
lag Ź tail;
tail Ź rest;
ENDLOOP;
};
RETURN [node];
};
CombineAssignments: PUBLIC PROC [nl: NodeList, assumeTemp: BOOL] RETURNS [BOOL] = {
IF nl # NIL THEN {
this: Node = nl.first;
rest: NodeList = nl.rest;
IF rest # NIL THEN {
base: Var Ź NIL;
expAccum: Node Ź NIL;
expShift: NAT Ź 0;
constAccum: Node Ź NIL;
thisAssn: AssignNode Ź NIL;
thisStart: INT Ź 0;
thisLen: INT Ź 0;
list: NodeList Ź rest;
changeCount: NAT Ź 0;
WITH this SELECT FROM
assn: AssignNode => {
var: Var = assn.lhs;
thisAssn Ź assn;
WITH var.location SELECT FROM
field: REF LocationRep.field => {
thisLen Ź var.bits;
thisStart Ź field.start;
WITH field.base SELECT FROM
fv: Var => {
WITH fv.location SELECT FROM
deref: REF LocationRep.deref =>
IF NOT IntCodeUtils.SideEffectFree[fv, FALSE] THEN GO TO noDice;
local: REF LocationRep.localVar => {};
global: REF LocationRep.globalVar => {};
ENDCASE => GO TO noDice;
base Ź fv;
};
ENDCASE => GO TO noDice;
};
ENDCASE => GO TO noDice;
};
ENDCASE => GO TO noDice;

IF thisLen >= bpw OR thisLen <= 0 THEN GO TO noDice; 
IF thisAssn.bits # 0 THEN GO TO noDice;
IF (OffsetInWord[thisStart] + thisLen) > bpw THEN GO TO noDice;
IF NOT assumeTemp THEN
IF NOT IntCodeUtils.SideEffectFree[thisAssn.rhs, FALSE] THEN GO TO noDice;

{
acc: Node Ź ShiftLeft[thisAssn.rhs, 0, bpw];
IF IsCard[thisAssn.rhs] THEN constAccum Ź acc ELSE expAccum Ź acc;
};

DO
nextStart: INT Ź 0;
nextLen: [0..bpw) Ź 0;
nextAssn: AssignNode Ź NIL;
WITH list.first SELECT FROM
assn: AssignNode => {
var: Var = assn.lhs;
varBits: INT = var.bits;
off: BitIndex Ź 0;
IF assn.bits # 0 THEN EXIT;
WITH var.location SELECT FROM
field: REF LocationRep.field => {
nextStart Ź field.start;
off Ź OffsetInWord[nextStart];
IF field.base # base THEN EXIT;
};
ENDCASE => EXIT;
IF off # 0 AND (off + varBits) > bpw AND MimP5U.IsZero[assn.rhs] THEN {
leadBits: NAT = bpw-off;
tailBits: INT = varBits-leadBits;
newAssign: Node Ź MimP5U.Assign[
lhs: MimP5U.TakeFieldVar[base, nextStart, leadBits],
rhs: MimP5U.MakeConstCard[0, leadBits]
];
assn.lhs Ź MimP5U.TakeFieldVar[assn.lhs, leadBits, tailBits];
assn.rhs Ź MimP5U.TakeField[assn.rhs, leadBits, tailBits];
list Ź MimP5U.MakeNodeList[newAssign, list];
changeCount Ź changeCount + 1;
LOOP;
};
IF varBits >= bpw OR varBits <= 0 THEN EXIT;
IF (varBits+thisLen) > bpw THEN EXIT;
nextAssn Ź assn;
nextLen Ź varBits;
IF off = 0 OR (off + nextLen) > bpw THEN EXIT;
IF thisStart+thisLen # nextStart THEN EXIT;
IF NOT assumeTemp THEN
IF Intersects[node: nextAssn.rhs, var: base] THEN GO TO noDice;
};
ENDCASE => EXIT;
changeCount Ź changeCount + 1;
IF constAccum # NIL THEN
constAccum Ź ShiftLeft[constAccum, nextLen, bpw];
expShift Ź expShift + nextLen;
IF NOT MimP5U.IsZero[nextAssn.rhs] THEN {
acc: Node = ShiftLeft[nextAssn.rhs, 0, bpw];
IF IsCard[acc]
THEN constAccum Ź Accumulate[constAccum, acc]
ELSE {
IF expAccum # NIL THEN
expAccum Ź ShiftLeft[expAccum, expShift, bpw];
expAccum Ź Accumulate[expAccum, acc];
expShift Ź 0;
};
};
thisLen Ź thisLen + nextLen;
list Ź list.rest;
IF list = NIL THEN EXIT;
ENDLOOP;

IF changeCount = 0 THEN GO TO noDice;

IF expShift # 0 AND expAccum # NIL THEN
expAccum Ź ShiftLeft[expAccum, expShift, bpw];

SELECT TRUE FROM
expAccum = NIL AND constAccum = NIL => GO TO noDice;
expAccum = NIL => expAccum Ź constAccum;
constAccum = NIL => {};
ENDCASE => expAccum Ź Accumulate[expAccum, constAccum];
IF thisLen # bpw THEN
expAccum Ź MimP5U.TakeField[expAccum, bpw-thisLen, thisLen];
nl.first Ź MimP5U.Assign[
lhs: MimP5U.TakeFieldVar[base, thisStart, thisLen],
rhs: expAccum];
nl.rest Ź list;
RETURN [TRUE];

EXITS
noDice => {};
};
};
RETURN [FALSE];
};

SplitAssignment: PUBLIC PROC [nl: NodeList] RETURNS [BOOL] = {
WITH nl.first SELECT FROM
assign: AssignNode => {
lhs: Var = assign.lhs;
rhs: Node = assign.rhs;
IF lhs.bits # rhs.bits THEN ERROR;
WITH lhs.location SELECT FROM
field: REF LocationRep.field => {
lBits: INT = lhs.bits;
IF lBits <= bpw THEN {
bits: NAT = lBits;
fStart: INT = field.start;
mod: BitIndex = OffsetInWord[fStart];
IF bits+mod > bpw THEN
IF IsCard[assign.rhs] THEN {
dst: Node = field.base;
bits1: NAT Ź bpw - mod;
bits2: NAT Ź bits - bits1;
assn1: Node = MimP5U.Assign[
lhs: MimP5U.TakeFieldVar[dst, fStart, bits1],
rhs: MimP5U.TakeField[rhs, 0, bits1]];
assn2: Node = MimP5U.Assign[
lhs: MimP5U.TakeFieldVar[dst, fStart+bits1, bits2],
rhs: MimP5U.TakeField[rhs, bits1, bits2]];
nl.first Ź assn1;
nl.rest Ź MimP5U.MakeNodeList[assn2, nl.rest];
RETURN [TRUE];
};
};
};
ENDCASE;
};
ENDCASE;
RETURN [FALSE];
};

Vulnerable: PUBLIC UNSAFE PROC [t1: Tree.Link, t2: Tree.Link, lhs: BOOL] RETURNS [BOOL] = UNCHECKED {
DO
WITH e1: t1 SELECT TreeOps.GetTag[t1] FROM
subtree => {
tp1: Tree.NodePtr = @tb[e1.index];
n: NAT = tp1.nSons;
IF n = 0 THEN RETURN [FALSE];
SELECT tp1.name FROM
mwconst, nil, clit, llit, nil => RETURN [FALSE];
cast, loophole => {t1 Ź tp1.son[1]; LOOP};
item => {t1 Ź tp1.son[2]; LOOP};
dollar => {t1 Ź tp1.son[1]; LOOP};
uparrow => {t1 Ź tp1.son[1]; lhs Ź FALSE; LOOP};
ENDCASE;
lhs Ź FALSE;
FOR i: NAT IN [1..n) DO
IF Vulnerable[tp1.son[i], t2, FALSE] THEN RETURN [TRUE];
ENDLOOP;
t1 Ź tp1.son[n];
LOOP;
};
symbol => {
sep: Symbols.ISEPointer = @seb[e1.index];
IF lhs OR sep.immutable OR sep.constant THEN RETURN [FALSE];
};
ENDCASE => RETURN [FALSE];
WITH e2: t2 SELECT TreeOps.GetTag[t2] FROM
subtree => {
tp2: Tree.NodePtr = @tb[e2.index];
n: NAT = tp2.nSons;
SELECT tp2.name FROM
mwconst, nil, clit, llit, nil, stringinit, first, last, atom, typecode, textlit, signalinit, procinit => RETURN [FALSE];
pad, chop, ord, val, cast, loophole, length, addr, pred, succ, length, base, float, lengthen, shorten, abs, uminus, not, istype, safen =>
{t2 Ź tp2.son[1]; LOOP};
item => {t2 Ź tp2.son[2]; LOOP};
errorx, syserrorx => RETURN [FALSE];
apply, callx, portcallx, signalx, startx, fork, joinx => RETURN [TRUE];
assign, assignx => IF TreeIntersect[t1, tp2.son[1]] THEN RETURN [TRUE];
ENDCASE;
IF n = 0 THEN RETURN [FALSE];
FOR i: NAT IN [1..n) DO
IF Vulnerable[t1, tp2.son[i], lhs] THEN RETURN [TRUE];
ENDLOOP;
t2 Ź tp2.son[n];
LOOP;
};
ENDCASE;
RETURN [FALSE];
ENDLOOP;
};

SideEffectFree: PUBLIC UNSAFE PROC [t: Tree.Link] RETURNS [BOOL] = UNCHECKED {
IF t = Tree.Null THEN RETURN [FALSE];
WITH v: t SELECT TreeOps.GetTag[t] FROM
subtree => {
tp: Tree.NodePtr Ź @tb[v.index];
n: NAT Ź tp.nSons;
realCheck: BOOL Ź FALSE;
SELECT tp.name FROM
mwconst, nil, clit, llit, stringinit, first, last, atom, typecode, textlit, signalinit, procinit, none => RETURN [TRUE];
ifx, or, and, not, all, cast => {
realCheck Ź TRUE;
};
uminus, all, first, last, pred, succ, ord, val, relE, relN, relL, relGE, relG, relLE, plus, minus, times, power, lengthen, intCC, intOC, intCO, intOO => {
realCheck Ź TRUE;
};
addr, index => {};
min, max => {
list: Tree.Link = tp.son[1];
WITH l: list SELECT TreeOps.GetTag[list] FROM
subtree => IF tb[l.index].name = list THEN {tp Ź @tb[l.index]; n Ź tp.nSons};
ENDCASE;
realCheck Ź TRUE;
};
div, mod => {
son2: Tree.Link = tp.son[2];
WITH s2: son2 SELECT TreeOps.GetTag[son2] FROM
literal => {
IF NOT LiteralOps.IsShort[s2.index] THEN RETURN [FALSE];
IF SymbolOps.DecodeCard[LiteralOps.Value[s2.index].val] = 0 THEN
RETURN [FALSE];
};
ENDCASE => RETURN [FALSE];
realCheck Ź TRUE;
};
dollar => n Ź 1;
seqindex => IF tp.attr3 THEN GO TO mustEval;
in, notin => {
IF NOT SideEffectFree[tp.son[2]] THEN GO TO mustEval;
realCheck Ź TRUE;
n Ź 1;
};
ENDCASE => GO TO mustEval;
FOR i: NAT IN [1..n] DO
son: Tree.Link Ź tp.son[i];
IF NOT SideEffectFree[son] THEN GO TO mustEval;
IF realCheck THEN {
sonType: Symbols.Type = MimP5U.OperandType[son];
sonAC: ArithClass = MimP5U.ArithClassForType[sonType];
IF sonAC.kind >= real THEN RETURN [FALSE];
};
ENDLOOP;
};
ENDCASE;
RETURN [TRUE];
EXITS mustEval => RETURN [FALSE];
};

SimplifyParts: PUBLIC PROC [parts: NodeList, offset: INT Ź 0] RETURNS [NodeList] = {
this: NodeList Ź parts;
maySimplify: BOOL Ź FALSE;
lag: NodeList Ź NIL;
IF NOT simplifyParts THEN RETURN [parts];

WHILE this # NIL DO
rest: NodeList Ź this.rest;
WITH this.first SELECT FROM
tv: Var => WITH tv.location SELECT FROM
tvc: REF LocationRep.composite => {
tvcp: NodeList Ź tvc.parts;
IF tvcp # NIL THEN {
IF lag = NIL THEN parts Ź tvcp ELSE lag.rest Ź tvcp;
WHILE tvcp.rest # NIL DO tvcp Ź tvcp.rest; ENDLOOP;
tvcp.rest Ź rest;
tvc.parts Ź NIL;
LOOP;
};
};
ENDCASE;
ENDCASE;
IF this.first = NIL THEN ERROR;
IF this.first.bits < bpw THEN maySimplify Ź TRUE;
lag Ź this;
this Ź rest;
ENDLOOP;

IF maySimplify THEN {
this Ź parts;
WHILE this # NIL DO
rest: NodeList Ź this.rest;
SELECT TRUE FROM
rest = NIL => EXIT;
this.first.bits >= bpw, rest.first.bits >= bpw => {};
ENDCASE => {
accum: Node Ź this.first;
sum: INT = accum.bits + rest.first.bits;
mod: NAT = offset MOD bpw;
IF mod+sum <= bpw THEN {
lim: NAT Ź mod;
pos: NAT Ź mod;
temp: NodeList Ź this;
end: NodeList Ź this;
accumConst: Node Ź NIL;
WHILE end # NIL DO
nextLim: INT Ź lim+end.first.bits;
IF nextLim > bpw THEN EXIT;
lim Ź nextLim;
end Ź end.rest;
ENDLOOP;
accum Ź NIL;
WHILE temp # end DO
n: Node Ź temp.first;
pos Ź pos + n.bits;
n Ź ShiftLeft[n, lim-pos, bpw];
IF IsCard[n]
THEN accumConst Ź Accumulate[accumConst, n]
ELSE accum Ź Accumulate[accum, n];
temp Ź temp.rest;
ENDLOOP;
accum Ź Accumulate[accum, accumConst];
pos Ź lim-mod;
IF pos # bpw THEN
accum Ź MimP5U.TakeField[accum, bpw-pos, pos];
this.first Ź accum;
this.rest Ź end;
rest Ź end;
};
};
offset Ź offset + this.first.bits;
this Ź rest;
ENDLOOP;
};
RETURN [parts];
};

Accumulate: PUBLIC PROC [x: Node, y: Node] RETURNS [Node] = {
IF x = NIL THEN RETURN [y];
IF y = NIL THEN RETURN [x];
IF IsCard[x] AND IsCard[y] THEN
RETURN [MimP5U.MakeConstCard[GetCard[x] + GetCard[y]]];
IF x.bits < bpw THEN x Ź LocalZeroExtend[x];
IF y.bits < bpw THEN y Ź LocalZeroExtend[y];
IF MimP5U.IsZero[x] THEN RETURN [y];
IF MimP5U.IsZero[y] THEN RETURN [x];
RETURN [MimP5U.BinaryArithOp[op: add, ac: [unsigned, FALSE, bpw], n1: x, n2: y]];
};

ShiftLeft: PUBLIC PROC [n: Node, shift: NAT, bits: NAT Ź 0] RETURNS [Node] = {
IF n = NIL THEN RETURN [NIL];
IF bits = 0 THEN bits Ź n.bits;
SELECT TRUE FROM
shift = 0 => {};
shift >= bpw => RETURN [MimP5U.MakeConstCard[0, bits]];
IsCard[n] => {
c: CARD = Basics.BITLSHIFT[GetCard[n], shift];
RETURN [MimP5U.MakeConstCard[c, bits]];
};
ENDCASE => {
zn: Node = LocalZeroExtend[KeepRightBits[n, bits-shift]];
mult: Node = MimP5U.MakeConstCard[Basics.BITLSHIFT[1, shift]];
n Ź MimP5U.BinaryArithOp[
op: mul, ac: [unsigned, FALSE, bpw],
n1: zn, n2: mult];
};
SELECT n.bits FROM
> bits => n Ź MimP5U.TakeField[n, n.bits-bits, bits];
< bits => n Ź LocalZeroExtend[n, bits];
ENDCASE;
RETURN [n];
};

ShiftRight: PUBLIC PROC [n: Node, shift: NAT, bits: NAT Ź 0] RETURNS [Node] = TRUSTED {
IF n = NIL THEN RETURN [NIL];
IF bits = 0 THEN bits Ź n.bits;
SELECT TRUE FROM
shift = 0 => {};
shift >= bpw => RETURN [MimP5U.MakeConstCard[0, bits]];
IsCard[n] => {
c: CARD Ź Basics.BITRSHIFT[GetCard[n], shift];
RETURN [MimP5U.MakeConstCard[c, bits]];
};
ENDCASE => {
zn: Node Ź LocalZeroExtend[n];
mult: Node Ź MimP5U.MakeConstCard[Basics.BITLSHIFT[1, shift]];
n Ź MimP5U.BinaryArithOp[
op: div, ac: [unsigned, FALSE, bpw],
n1: zn, n2: mult];
};
SELECT n.bits FROM
> bits => n Ź MimP5U.TakeField[n, n.bits-bits, bits];
< bits => n Ź LocalZeroExtend[n, bits];
ENDCASE;
RETURN [n];
};

ContainsLabel: PROC [n: Node, list: NodeList, object: Label] RETURNS [BOOL] = {
visitor: IntCodeUtils.LabelVisitor = {
IF object = label THEN found Ź TRUE;
RETURN [label];
};
found: BOOL Ź FALSE;
IntCodeUtils.VisitLabels[n, visitor, TRUE, FALSE];
IF found THEN RETURN [TRUE];
WHILE list # NIL DO
IntCodeUtils.VisitLabels[list.first, visitor, TRUE, FALSE];
IF found THEN RETURN [TRUE];
list Ź list.rest;
ENDLOOP;
RETURN [FALSE];
};

KeepRightBits: PROC [n: Node, rightBits: NAT] RETURNS [Node] = {
nn: Node Ź n;
DO
WITH nn SELECT FROM
app: REF NodeRep.apply =>
WITH app.proc SELECT FROM
op: REF NodeRep.oper => WITH op.oper SELECT FROM
cvt: REF OperRep.convert =>
IF cvt.from.precision <= rightBits THEN {
nn Ź app.args.first;
LOOP;
};
ENDCASE;
ENDCASE;
fv: Var =>
IF fv.bits >= rightBits THEN
WITH fv.location SELECT FROM
ff: FieldLocation => {
bb: INT = ff.base.bits;
IF bb <= bpw AND fv.bits+ff.start = bb THEN {
nn Ź ff.base;
LOOP;
};
};
ENDCASE;
ENDCASE;
RETURN [nn];
ENDLOOP;
};

OffsetInWord: PROC [offset: CARD] RETURNS [BitIndex] = INLINE {
IF NAT[SIZE[BitIndex]] < NAT[SIZE[CARD]]
THEN RETURN [Basics.LowHalf[offset] MOD bpw]
ELSE RETURN [offset MOD bpw];
};

ShiftLeftLocal: PROC [expr: Node, dist: [0..bpw)] RETURNS [Node] = {
IF expr.bits # bpw THEN expr Ź LocalZeroExtend[expr];
IF dist # 0 THEN
expr Ź MimP5U.BinaryArithOp[
mul, unsignedClass,
expr,
MimP5U.MakeConstCard[Basics.BITLSHIFT[1, dist]]];
RETURN [expr];
};

TreeIntersect: UNSAFE PROC [t1: Tree.Link, t2: Tree.Link] RETURNS [BOOL] = UNCHECKED {
DO
WITH e1: t1 SELECT TreeOps.GetTag[t1] FROM
subtree => {
tp1: Tree.NodePtr = @tb[e1.index];
n: NAT = tp1.nSons;
IF n = 0 THEN RETURN [FALSE];
FOR i: NAT IN [1..n) DO
IF TreeIntersect[tp1.son[i], t2] THEN RETURN [TRUE];
ENDLOOP;
t1 Ź tp1.son[n];
LOOP;
};
symbol => {
WITH e2: t2 SELECT TreeOps.GetTag[t2] FROM
symbol => RETURN [e1.index = e2.index];
subtree => {
tp2: Tree.NodePtr = @tb[e2.index];
n: NAT = tp2.nSons;
IF n = 0 THEN RETURN [FALSE];
SELECT tp2.name FROM
uparrow => RETURN [TRUE];
dot => {
IF tp2.attr1 THEN RETURN [TRUE];
t2 Ź tp2.son[1];
LOOP;
};
index, dindex, seqindex, reloc => {t2 Ź tp2.son[1]; LOOP};
item => {t2 Ź tp2.son[2]; LOOP};
ENDCASE;
IF n = 0 THEN RETURN [FALSE];
FOR i: NAT IN [1..n) DO
IF TreeIntersect[t1, tp2.son[i]] THEN RETURN [TRUE];
ENDLOOP;
t2 Ź tp2.son[n];
LOOP;
};
ENDCASE;
};
ENDCASE;
RETURN [FALSE];
ENDLOOP;
};

NeedsZeroInhibit: PROC [n: Node] RETURNS [BOOL] = {
WITH n SELECT FROM
c: REF NodeRep.const => RETURN [FALSE];
v: Var => WITH v.location SELECT FROM
loc: REF LocationRep.localVar => RETURN [FALSE];
ENDCASE;
apply: REF NodeRep.apply => IF apply.handler = NIL THEN {
FOR each: NodeList Ź apply.args, each.rest WHILE each # NIL DO
IF NeedsZeroInhibit[each.first] THEN RETURN [TRUE];
ENDLOOP;
WITH apply.proc SELECT FROM
op: REF NodeRep.oper => RETURN [FALSE];
mc: REF NodeRep.machineCode => RETURN [FALSE];
ENDCASE;
};
ENDCASE;
RETURN [TRUE];
};

FlattenList: PROC [list: NodeList] RETURNS [NodeList] = {
head: NodeList Ź NIL;
tail: NodeList Ź NIL;
src: NodeList Ź list;
WHILE src # NIL DO
this: Node Ź src.first;
rest: NodeList = src.rest;
redo: BOOL Ź FALSE;
WITH this SELECT FROM
bbn: BlockNode => {
DO
bSrc: NodeList Ź bbn.nodes;
IF bSrc = NIL THEN GO TO skip;
IF bSrc.first = NIL THEN {bbn.nodes Ź bSrc.rest; LOOP};
WITH bSrc.first SELECT FROM
decl: DeclNode => {
bbn.nodes Ź FlattenList[bSrc];
GO TO add;
};
source: SourceNode => {
bbn.nodes Ź FlattenList[bSrc];
GO TO add;
};
ENDCASE;
src.first Ź bSrc.first;
src.rest Ź bSrc;
bbn.nodes Ź bSrc.rest;
bSrc.rest Ź rest;
bSrc.first Ź bbn;
GO TO redo;
ENDLOOP;
EXITS
redo => LOOP;
add => {};
skip => {this Ź NIL};
};
source: SourceNode =>
source.nodes Ź FlattenList[source.nodes];
ENDCASE;
IF this # NIL THEN {
IF rest # NIL THEN WITH rest.first SELECT FROM
labNode: LabelNode => this Ź SubstTailGoTos[this, labNode.label, NIL];
ENDCASE;
IF this # NIL THEN {
src.first Ź this;
src.rest Ź NIL;
IF head = NIL THEN head Ź src ELSE tail.rest Ź src;
tail Ź src;
};
};
src Ź rest;
ENDLOOP;
RETURN [head];
};

LocalZeroExtend: PROC [x: Node, bits: INT Ź bpw] RETURNS [Node] = {
IF x # NIL AND bits = bpw THEN
WITH x SELECT FROM
v: Var => WITH v.location SELECT FROM
fv: REF LocationRep.field =>
IF fv.start # 0 AND fv.start + v.bits = bpw THEN {
base: Node = fv.base;
IF base.bits = bpw THEN {
max: CARD Ź GuessRange[base];
IF Basics.BITRSHIFT[max, v.bits] = 0 THEN {
IF IsCard[base] THEN RETURN [base];
RETURN [base];
};
};
};
ENDCASE;
ENDCASE;
RETURN [MimP5U.ZeroExtend[x, bits]];
};

GuessRange: PROC [x: Node] RETURNS [CARD] = {
bits: INT = IF x = NIL THEN 0 ELSE x.bits;
guess: CARD Ź CARD.LAST;
IF bits = 0 THEN RETURN [0];
IF IsCard[x] THEN RETURN [GetCard[x]];
IF bits > bitsPerWord THEN RETURN [guess];
IF bits < bitsPerWord THEN guess Ź Basics.BITRSHIFT[guess, bitsPerWord-bits];
WITH x SELECT FROM
app: REF NodeRep.apply => IF app.handler = NIL THEN WITH app.proc SELECT FROM
operNode: REF NodeRep.oper => WITH operNode.oper SELECT FROM
arith: REF OperRep.arith => IF arith.class.kind = unsigned THEN
SELECT arith.select FROM
add, mul, div => {
left: Node = app.args.first;
right: Node = app.args.rest.first;
gL: CARD Ź GuessRange[left];
gR: CARD Ź GuessRange[right];
SELECT arith.select FROM
add => {
sum: CARD = gL + gR;
IF sum >= gL AND sum >= gR AND sum < guess THEN guess Ź sum;
};
mul =>
SELECT TRUE FROM
gL = 0 OR gR = 0 => guess Ź 0;
guess / gL > gR AND guess / gR > gL => guess Ź gL*gR;
ENDCASE;
div => {
IF IsCard[right] THEN {
c: CARD Ź GetCard[right];
IF c # 0 THEN {gL Ź gL / c; gR Ź 1};
};
IF gR # 0 AND gL < guess THEN guess Ź gL;
};
ENDCASE;
};
ENDCASE;
cvt: REF OperRep.convert =>
IF cvt.to.kind = unsigned THEN
SELECT cvt.from.kind FROM
signed => {
g: CARD = GuessRange[app.args.first];
guess Ź guess / 2;
IF g < guess THEN guess Ź g;
};
unsigned => {
g: CARD = GuessRange[app.args.first];
IF g < guess THEN guess Ź g;
};
ENDCASE;
check: REF OperRep.check => {
gX: CARD Ź GuessRange[app.args.first];
IF check.class.kind = unsigned THEN
SELECT check.sense FROM
lt, le, eq => {
gY: CARD Ź GuessRange[app.args.rest.first];
IF check.sense = lt AND gY # 0 THEN gY Ź gY - 1;
IF gY < gX THEN gX Ź gY;
};
ENDCASE;
IF gX < guess THEN guess Ź gX;
};
ENDCASE;
ENDCASE;
ENDCASE;
RETURN [guess];
};

VulnerableNotify: Alloc.Notifier = UNCHECKED {
seb Ź base[Symbols.seType];
tb Ź base[Tree.treeType];
};

uselessGoToComment: Node = MimZones.permZone.NEW[NodeRep.comment
Ź [0, comment["eliminated useless go to node"]]];
tb: Tree.Base Ź NIL;		-- tree base (local copy)
seb: Symbols.Base Ź NIL;	-- semantic entry base (local copy)
TRUSTED {MimCode.RegisterNotifier[VulnerableNotify]};
END.

     
MimP5StuffImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) February 4, 1991 5:34 pm PST
Eduardo Pelegri-Llopart December 22, 1988 10:09:09 am PST
Willie-s, September 24, 1991 4:51 pm PDT

Options
TRUE => call ElimUselessGoTos to remove useless go to nodes
FALSE => don't call ElimUselessGoTos
TRUE => call FlattenList
FALSE => don't call FlattenList
Basic defs
Public procedures
Given a code list to generate into, we simplify an assignment or declaration with a block value that declares an unnecessary temporary.  We return TRUE if the simplification was possible, and FALSE if it was not possible.
Makes a block from the given code list, then prunes out excess assignments of zeros by clearing out the block first.
If assumeTemp = TRUE, then we can be more aggressive about combining assignments to dest, because we can assume that the value of dest is not used on the rhs of any assignments in the block.
This declaration should become an assignment in order to correctly collapse, so it is better to rewrite it here.
Any gaps inhibit zero pruning
Just count during the first pass
This assignment can be removed!
If something strange has happened to the record we are assigning, then we can't do the zero pruning, so be conservative!
Urp, a partially zero word at the tail
Don't generate an all node, since C2C can't do very much with it
Find the right place to insert the zeros
Returns TRUE if the execution of node might depend on or affect the value of var.  This routine is quite conservative.
Returns TRUE if the node is a simple variable (local variable, global variable, or field of a simple variable).

Now there are at least two nodes in the list, which may well lead to returning a block.
A special case that sometimes comes up for assign expressions
This block declares a temporary that is then the result
Scan for non-trivial uses of this temporary variable
At this point the declaration is not used, and has no effect, so we splice out all assignments to it.
We have removed the block entirely!
Get the value right-justified in a word
Mask off the bits of the value
Shift the value to the right position
Finds all tail go to nodes and substitutes the subst node for them.

We can get on a word boundary here by splitting the zero assignment into two assignments.
At this point we know that we will accumulate
We have something to accumulate
Now we have the accumulated result to assign in expAccum
This field crosses a word boundary.  For now, only split constants.
This proc is only valid if evaluated after normal Pass4 processing.
Implicit operand, safer to assume side effects
Always SEF
Son checking, no REAL checking
All of these can be done solely on the basis of son checking (inclufing REAL checking)
If the first son is a list then we must use it instead of ourselves.
Check for divisor # 0
Only check first son
Bounds check, so could have side-effect
Don't try to perform OperandType on an interval
Destructively modifies the parts list to try to combine parts that fit within a single word.  Assumes the given target offset to keep from combining across word boundaries.
First, flatten out any embedded composite nodes.
Now, combine adjacent elements that do not appear to be overlapping word boundaries.
Generates code to shift the given node left by the given number of bits, resulting in a node with the given number of bits.  The node given must be less than or equal to bpw wide.  If bits = 0, then the resulting number of bits is the same as the given node.
Generates code to shift the given node right by the given number of bits, resulting in a node with the given number of bits.  The node given must be less than or equal to bpw wide.  If bits = 0, then the resulting number of bits is the same as the given node.
Private procedures
[label: IntCodeDefs.Label, node: IntCodeDefs.Node, define: BOOL] RETURNS [IntCodeDefs.Label]
When we are going to shift left we can ignore bits that get shifted off.  This is a helper routine to peel off useless extensions and fields.  We keep the # of bits on the right specified by rightBits.
The extension adds no useful bits
Taking the field is completely unnecessary, since the high-order bits will get washed out anyway.
Returns TRUE if the variables denoted by t1 and t2 appear to intersect.
Note, in the worst case assigning to dereference can affect anything.
Note, in the worst case assigning to dereference can affect anything.
Removes NIL nodes
Any tail go to nodes are useless
We are extending something we did not have to take a field of to begin with, so just return the base!
The product will not overflow, and is less than guess
called by allocator whenever table area is repacked
 Ę6>  (cedarcode) styleNewlineDelimiter
 headIcode
ĎeCNL0L9L(L Ďk		LLLLLLLLLLL		L

LL.LLLfmLL"L LLLL"L2.5 in tabStopsL2.5 in tabStops7;L2.5 in tabStops$2.5 in tabStopsL2.5 in tabStopsL2.5 in tabStops
LL
L3?Ďn+ZL)ÝLLLLLLL
L4:L!L	LLL
1='L$L""LLLLL
=L''LL**LLLLL	1LLLL
3L%LLLLLLLLL "eLtLžžL''L LLLLLLL	4	?LpL.$L FiLCUL::LL22LLLLLLLLLLL".L".LL!LL
L&?L3
@:L3&,LLLLL.# %LL%%L)0LL""L.	L L""L,,L(L.LLL:LLLLL)0L%L
)MLxLLLLL-"vL'1L&LL
L**LL88LL&L44L??L,,L++LL"@	$L99L//L++LLLLTTLL--L++LL(LL77)?LLLL	?LLLLLLLLLLLLLL
LLLL	>LLLLL 
ALjvLL!L#*L.LLLL,<L	/L#L.LLL&<(>L2LL1LLL4L(L,LLLLL
L'L&L$*L''L#LJLLL@L2LLLLLL 
5Lco
%L((L*L,LLLLL 
4LL.LL
 LLL(.LL.'L$L
L
LLLL(8L(8L<LLLLLLLLLLWL2NL)L$L
L
L=LLLLLLL11 L7"'LLLLLLLLLL*6LLLLLLLL'3LL''L(LL(LLL4'=L-L!LLLL(:LLeLL-LLLLLLL(L#LLLLLL
 L<MLLLLLL 
3LL0L

.L*L,)!LLLLLLLLLL UL
%L!L$L%%)!LL11L  
	3L'L"LLL	OL		1L%LLLLL )VLCLL''L**(>LL0BLL
	<LLLL55LL3LLLLLLLLL SLLLLL
LLLL	LLLL!LLL!@L&L(LL

LLLLLLL L
	5L'L+?L+JL L,,LBLL LLLLL	LL!LLLLL	GLYL
L
!  L44L&&LL==L::L,,LLLL,L%LLL	.L+L+?LLL-LL11L)LL,,L)-L..L%%LLLLLLLL L%L 'L..L L4L(LL07L88L<<L33LLLL LLLLLL 
>
LLL"!LL	LL%%LCLLLL--L&&L33L**LL..LLLLLLLLLL 
%	e*L"LL
L!0L$*L L"L#0LLL
8LLLLL))L<LL*L"L
LixL˘L L$L9GL	GLLL!6LLLLLLLLL 	NLC%L.'L LL	jxL
!!LLLLVLLLLDL	-L#MLLLLL
.L
8:@LLLLLL	

,L'L//L

5LLLL
LL

/L00L66L*LLLLLL!LL 
TLŹŹLLLL	)L L0L'#LL4L3LLLLLLLLL1LLLL LTLLLL5LL (L
LLLLLL	"LLLLLLLL
L'+L"LLL&&LL..LLLLLL"LLLL	LL 
=LLL17L,L,L$L$L/QLL 	NLL
L
LL!7L
	.L!'LL99L)	>L$LLL5L''LLLL 

WLL
L
LL!7L
	.L!'LLL)	>L$LLL5L''LLLL *OStartOfExpansion` -- [label: IntCodeDefs.Label, node: IntCodeDefs.Node, define: BOOL] RETURNS [IntCodeDefs.Label]&&L;\L	$L	LLL%2LL.;LLLLLL @LÉÉL
	0!)L!LLLLL

L-LaLLLLLLLLLL 

?(L,L	LL DL5
LLL	1LLL  	VL;G*L"LLL4LLLL*L
'L"LL
LE LELLLL4:L LLL4LLLLLLLLLLL 3L'
%L0L	9(>L3LL'L.LLLLLL 9LLLLLLLLL
L7LL
LLL
LLLLLLLLLLL

LLL))L.AFL LLLL3LLLLLLLL C
%2LL	+LeL#LLLLLLL$LL 
-L*LL
L&L	*L	M
M
<?LL""LLLL<LL"5L5LLL$LL)LLLLL%LLLL%LLLL&#L#+L0L		LLLLLLLL	LL 	.L3LLLL L-BrLĎc/L #<L.5KL      }  ĹŘ  