C2CIntCodeUtilsImpl.mesa
Copyright Ó 1987, 1988, 1989, 1990, 1991, 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, February 19, 1988 3:01:27 pm PST
Christian Jacobi, January 25, 1993 10:07 am PST
DIRECTORY
C2CAccess,
C2CBasics,
C2CTarget,
C2CIntCodeUtils,
IntCodeDefs,
IntCodeUtils;
C2CIntCodeUtilsImpl:
CEDAR
PROGRAM
IMPORTS C2CAccess, C2CBasics, C2CIntCodeUtils, IntCodeUtils
EXPORTS C2CIntCodeUtils =
CountNodes:
PUBLIC
PROC [nodes: IntCodeDefs.NodeList]
RETURNS [cnt:
INT ¬ 0] = {
WHILE nodes#
NIL
DO
cnt ¬ cnt+1; nodes ¬ nodes.rest;
ENDLOOP;
};
AnyNodeHasCode:
PUBLIC
PROC [nodes: IntCodeDefs.NodeList]
RETURNS [
BOOL ¬
FALSE] = {
FOR nl: NodeList ¬ nodes, nl.rest
WHILE nl#
NIL
DO
IF NodeHasCode[nl.first] THEN RETURN [TRUE];
ENDLOOP;
};
NodeHasCode:
PUBLIC
PROC [node: IntCodeDefs.Node]
RETURNS [
BOOL] = {
IF node=NIL THEN RETURN [FALSE];
WITH node
SELECT
FROM
sourceNode: SourceNode => RETURN [AnyNodeHasCode[sourceNode.nodes]];
commentNode: CommentNode => RETURN [FALSE];
ENDCASE => RETURN [TRUE];
};
LastNodeWithCode:
PUBLIC
PROC [nodes: IntCodeDefs.NodeList]
RETURNS [node: IntCodeDefs.Node ¬
NIL] = {
FOR nodesLeft: IntCodeDefs.NodeList ¬ nodes, nodesLeft.rest
WHILE nodesLeft#
NIL
DO
IF NodeHasCode[nodesLeft.first] THEN node ¬ nodesLeft.first
ENDLOOP
};
CheckArgCount:
PUBLIC
PROC [args: IntCodeDefs.NodeList, n:
INT] = {
WHILE args#
NIL
DO
IF n<=0 THEN C2CBasics.CantHappen;
args ¬ args.rest; n ¬ n-1;
ENDLOOP;
IF n#0 THEN C2CBasics.CantHappen;
};
IsSimpleConst:
PUBLIC
PROC [node: IntCodeDefs.Node]
RETURNS [is:
BOOL ¬
FALSE, val:
CARD ¬ 0] = {
IF node#
NIL
AND node.bits<=bitsPerWord
THEN
WITH node
SELECT
FROM
constNode: ConstNode =>
WITH constNode
SELECT
FROM
wordConst: WordConstNode => {
RETURN [TRUE, IntCodeUtils.WordToCard[wordConst.word]];
};
ENDCASE;
var: Var =>
WITH var.location
SELECT
FROM
dummy: DummyLocation => RETURN [TRUE, 0];
ENDCASE;
ENDCASE;
};
IsFieldVar:
PUBLIC
PROC [node: IntCodeDefs.Node]
RETURNS [is:
BOOL ¬
FALSE] = {
WITH node
SELECT
FROM
var: Var =>
WITH var.location
SELECT
FROM
field: FieldLocation => RETURN [TRUE];
ENDCASE => NULL;
ENDCASE => NULL;
};
GenConst:
PUBLIC
PROC [value:
INT, bits:
INT]
RETURNS [ConstNode] = {
RETURN [IntCodeUtils.zone.NEW[NodeRep.const.word ¬ [bits, const[word[IntCodeUtils.IntToWord[value]]]]]];
};
keyForMaxVariableId: REF INT ~ NEW[INT]; --unique
NewVariableId:
PUBLIC
PROC []
RETURNS [id: VariableId] = {
MaxVariableId:
PROC [node: Node]
RETURNS [maxVariableId:
INT ¬ nullVariableId] = {
--returns the maximal value used as an VariableId recursively down this node
VisitVariableIds: IntCodeUtils.Visitor = {
WITH node
SELECT
FROM
var: Var => maxVariableId ¬ MAX[maxVariableId, var.id];
ENDCASE => {};
IntCodeUtils.MapNode[node, VisitVariableIds];
RETURN [node];
};
[] ¬ VisitVariableIds[node];
};
WITH C2CBasics.GetProp[keyForMaxVariableId]
SELECT
FROM
ri: REF INT => id ¬ ri ¬ ri+1
ENDCASE => {
id ¬ MaxVariableId[C2CBasics.rootNode];
id ¬ ((id/100000)+1) * 100000;
C2CBasics.PutProp[keyForMaxVariableId, NEW[INT ¬ id]]
};
};
UseTemporaryIfReused:
PUBLIC
PROC [arg: Node, addr:
BOOL ¬
FALSE]
RETURNS [
BOOL ¬
TRUE] = {
SimpleReUse:
PROC [arg: Node]
RETURNS [
BOOL ¬
TRUE] = {
--returns TRUE only for constants and very simple variables
WITH arg
SELECT
FROM
const: ConstNode => RETURN [TRUE];
var: Var => {
IF var.location=nullLocation THEN RETURN [TRUE];
WITH var.location
SELECT
FROM
globLoc: GlobalVarLocation => RETURN [TRUE];
locLoc: LocalVarLocation => RETURN [TRUE];
ENDCASE => RETURN [FALSE];
};
ENDCASE => RETURN [FALSE];
};
IF ~IntCodeUtils.SideEffectFree[node: arg,
noSignals:
TRUE]
THEN
RETURN [
TRUE];
--eventual alternative: could consider trap on first deref NOT a sideeffect in case addr=TRUE
WITH arg
SELECT
FROM
apply: ApplyNode => {
WITH apply.proc
SELECT
FROM
oper: OperNode =>
WITH oper.oper
SELECT
FROM
arithOp: ArithOper =>
SELECT arithOp.select
FROM
add, sub => {
C2CIntCodeUtils.CheckArgCount[apply.args, 2];
IF SimpleReUse[apply.args.first] AND SimpleReUse[apply.args.rest.first] THEN RETURN [FALSE]
};
ENDCASE;
ENDCASE;
ENDCASE;
RETURN [TRUE];
};
const: ConstNode => RETURN [FALSE];
var: Var => {
IF var.location=nullLocation THEN RETURN [FALSE];
WITH var.location
SELECT
FROM
globLoc: GlobalVarLocation => RETURN [FALSE];
locLoc: LocalVarLocation => RETURN [FALSE];
derefLoc: DerefLocation => {
--on Sunos4 compiler for Sparc I have found that the compiler might optimize away a temporary but wont optimize away multiple dereferences
IF ~addr THEN RETURN [TRUE];
IF SimpleReUse[derefLoc.addr] THEN RETURN [FALSE];
RETURN [TRUE];
}
ENDCASE => RETURN [TRUE];
};
ENDCASE => RETURN [TRUE];
};
UsingTemporaryWhichGeneratesStatementCode:
PUBLIC
PROC [arg: Node]
RETURNS [
BOOL ¬
FALSE] = {
use grep to find all usage of UseTemporaryIfReused; check which generate statement code
WITH arg
SELECT
FROM
apply: ApplyNode =>
WITH apply.proc
SELECT
FROM
oper: OperNode => {
IF ~C2CAccess.params.supportInlineFloatingPoint THEN RETURN [FALSE];
WITH oper.oper
SELECT
FROM
arithOp: ArithOper =>
IF arithOp.class.kind=real
THEN {
SELECT arithOp.select
FROM
min, max, abs => RETURN [TRUE]
ENDCASE => {};
};
ENDCASE => {};
};
machineCode: MachineCodeNode => {};
ENDCASE => RETURN [TRUE];
ENDCASE => {};
};
StatementCode:
PUBLIC
PROC [node: Node]
RETURNS [hasLabel:
BOOL ¬
FALSE] = {
--Checks whether node contains a label, goto, need for temporary, strong in tree.
--To detect statement code which is not ok in conditional expressions
--This is the stronger test
Visit: IntCodeUtils.Visitor = {
IF hasLabel THEN RETURN [node];
IF UsingTemporaryWhichGeneratesStatementCode[node]
THEN {
hasLabel ¬ TRUE; RETURN [node];
};
label checks and recursing
WITH node
SELECT
FROM
var: Var =>
WITH var.location
SELECT
FROM
localLoc: LocalVarLocation =>{RETURN [node]}; --don't recurse and find this label
compLoc: CompositeLocation => {
because of lousy implementation of CompositeLocation
hasLabel ¬ TRUE; RETURN [node]
};
xLoc: IndexedLocation => {
might be a little bit to conservative
WITH xLoc.base
SELECT
FROM
bVar: Var => {
WITH bVar.location
SELECT
FROM
localLoc: LocalVarLocation => {};
globLoc: GlobalVarLocation => {};
derefLoc: DerefLocation => {};
ENDCASE => {hasLabel ¬ TRUE; RETURN [node]};
};
ENDCASE => {hasLabel ¬ TRUE; RETURN [node]};
};
ENDCASE => {};
oper: OperNode =>
WITH oper.oper
SELECT
FROM
--also inside apply
code: CodeOper => {RETURN [node]}; --don't recurse and find this label
ENDCASE => {};
apply: ApplyNode => {
IF apply.handler#NIL THEN {hasLabel ¬ TRUE; RETURN [node]};
WITH apply.proc
SELECT
FROM
--oper used inside apply because we need arguments...
oper: OperNode => {
WITH oper.oper
SELECT
FROM
mesa: MesaOper => {
because of lousy implementation of All
SELECT mesa.mesa
FROM
all => {hasLabel ¬ TRUE; RETURN [node]};
ENDCASE => {}
};
arith: ArithOper => {
IF arith.class.precision>C2CTarget.bitsPerWord THEN {hasLabel ¬ TRUE; RETURN [node]};
SELECT arith.select
FROM
abs => IF C2CIntCodeUtils.UseTemporaryIfReused[apply.args.first] THEN {hasLabel ¬ TRUE; RETURN [node]};
min, max => {
cnt: INT ¬0;
FOR argl: NodeList ¬ apply.args, argl.rest
WHILE argl#
NIL
DO
cnt ¬ cnt+1;
IF cnt>2 OR C2CIntCodeUtils.UseTemporaryIfReused[argl.first] THEN {hasLabel ¬ TRUE; RETURN [node]};
ENDLOOP;
}
ENDCASE => {}
};
conv: ConvertOper => {
IF C2CIntCodeUtils.UseTemporaryIfReused[apply.args.first] THEN {hasLabel ¬ TRUE; RETURN [node]};
IF conv.to.precision>C2CTarget.bitsPerWord THEN {hasLabel ¬ TRUE; RETURN [node]};
};
ENDCASE => {};
};
ENDCASE => {}
};
block: BlockNode => {
nodes: NodeList ¬ block.nodes;
--jump ahead of decls [they either don't generate code, or it is deteced anyway]
WHILE nodes#NIL AND ISTYPE[nodes.first, DeclNode] DO nodes ¬ nodes.rest ENDLOOP;
--check for more than a single node
IF nodes#NIL AND nodes.rest#NIL THEN {hasLabel ¬ TRUE; RETURN [node]};
};
source: SourceNode => {
--check for more than a single node
IF source.nodes#NIL AND source.nodes.rest#NIL THEN {hasLabel ¬ TRUE; RETURN [node]};
};
decl: DeclNode => {
IF decl.init#NIL THEN {hasLabel ¬ TRUE; RETURN [node]};
};
label: LabelNode =>
--nullLogicalId's are placed in for unused labels
IF label.label.id#nullLogicalId THEN {hasLabel ¬ TRUE; RETURN [node]};
goto: GotoNode => {
hasLabel ¬ TRUE; RETURN [node]; --don't recurse and find the destination label
};
return: ReturnNode => {
hasLabel ¬ TRUE; RETURN [node]; --don't recurse
};
assign: AssignNode => {
1) because of lousy implementation of AssignNode
2) also because we stop recursion for check of lHSMaskNShift here
hasLabel ¬ TRUE; RETURN [node]
};
lambda: LambdaNode => C2CBasics.CantHappen; --nested procs
ENDCASE => {};
IntCodeUtils.MapNode[node, Visit];
RETURN [node];
};
[] ¬ Visit[node];
};
StatementJumps:
PUBLIC
PROC [node: Node]
RETURNS [hasLabel:
BOOL ¬
FALSE] = {
--Checks whether node contains a label, goto, shallow in tree
--Does not care about assignments in statement part.
--For detection of the so called block assignments
--This is the weaker test
original: Node ¬ node;
Visit: IntCodeUtils.Visitor = {
IF hasLabel THEN RETURN [node];
label checks and recursing
WITH node
SELECT
FROM
block: BlockNode => {
IF block.bits=0 THEN RETURN [node];
};
label: LabelNode =>
--nullLogicalId's are placed in for unused labels
IF label.label.id#nullLogicalId THEN {hasLabel ¬ TRUE; RETURN [node]};
goto: GotoNode => {
hasLabel ¬ TRUE; RETURN [node]; --don't recurse and find the destination label
};
lambda: LambdaNode => C2CBasics.CantHappen; --nested procs
var: Var =>
WITH var.location
SELECT
FROM
localVar: LocalVarLocation => {RETURN [node]}; --don't recurse and find this label
ENDCASE => {};
oper: OperNode =>
WITH oper.oper
SELECT
FROM
code: CodeOper => {RETURN [node]}; --don't recurse and find this label
ENDCASE => {};
return: ReturnNode => {
hasLabel ¬ TRUE; RETURN [node]; --don't recurse
};
apply: ApplyNode => {
IF apply.handler#NIL THEN {hasLabel ¬ TRUE; RETURN [node]};
IntCodeUtils.MapNode[apply.proc, Visit];
RETURN [node]; --don't recurse on arguments
};
ENDCASE => {};
IntCodeUtils.MapNode[node, Visit];
RETURN [node];
};
[] ¬ Visit[node];
};
SizeIsProvableOk:
PUBLIC
PROC [node: Node]
RETURNS [
BOOL ¬
FALSE] = {
--ok is defined as:
--node.size correct, or,
--if not correct such that a load is not wrong, but maybe inefficient
IF node.bits<=0 THEN RETURN [FALSE];
WITH node
SELECT
FROM
var: Var =>
WITH var.location
SELECT
FROM
local: LocalVarLocation => RETURN [TRUE];
global: GlobalVarLocation => RETURN [TRUE];
deref: DerefLocation => RETURN [FALSE];
indexed: IndexedLocation => RETURN [TRUE];
field: FieldLocation => RETURN [SizeIsProvableOk[field.base]];
composite: CompositeLocation => RETURN [TRUE];
dummy: DummyLocation => RETURN [TRUE];
ENDCASE => C2CBasics.CaseMissing;
apply: ApplyNode => RETURN [TRUE];
block: BlockNode => RETURN [TRUE];
const: ConstNode => RETURN [TRUE];
assign: AssignNode => RETURN [TRUE];
decl: DeclNode => RETURN [TRUE];
cond: CondNode => RETURN [TRUE];
label: LabelNode => RETURN [TRUE];
return: ReturnNode => RETURN [TRUE];
source: SourceNode => RETURN [TRUE];
enable: EnableNode => RETURN [TRUE];
lambda: LambdaNode => RETURN [TRUE];
module: ModuleNode => RETURN [TRUE];
ENDCASE => C2CBasics.CaseMissing;
};
HasLabel:
PUBLIC
PROC [node: Node]
RETURNS [hasLabel:
BOOL ¬
FALSE] = {
inner: IntCodeUtils.Visitor = {
n: Node ¬ node;
list: NodeList ¬ NIL;
DO
IF hasLabel THEN EXIT;
WITH n
SELECT
FROM
var: Var => {
WITH var.location
SELECT
FROM
field: FieldLocation => {n ¬ field.base; LOOP};
deref: DerefLocation => {n ¬ deref.addr; LOOP};
indexed: IndexedLocation => {
[] ¬ inner[indexed.base];
n ¬ indexed.index; LOOP
};
comp: CompositeLocation => {list ¬ comp.parts; EXIT};
ENDCASE;
};
labelNode: LabelNode => {
label: Label = labelNode.label;
IF label.used THEN {hasLabel ¬ TRUE; EXIT};
n ¬ label.node;
LOOP;
};
lambda: LambdaNode => {hasLabel ¬ TRUE; EXIT};
block: BlockNode => {list ¬ block.nodes; EXIT};
source: SourceNode => {list ¬ source.nodes; EXIT};
enable: EnableNode => {list ¬ enable.scope; EXIT};
rtn: ReturnNode => {list ¬ rtn.rets; EXIT};
goto: GotoNode => EXIT;
mc: MachineCodeNode => hasLabel ¬ TRUE; --there might be a label inside...
cond: CondNode => {
FOR each: CaseList ¬ cond.cases, each.rest
WHILE each#
NIL
AND ~ hasLabel
DO
FOR tests: NodeList ¬ each.tests, tests.rest
WHILE tests#
NIL
AND ~ hasLabel
DO
[] ¬ inner[tests.first];
ENDLOOP;
IF ~hasLabel THEN [] ¬ inner[each.body];
ENDLOOP;
};
apply: ApplyNode => {
[] ¬ inner[apply.proc];
list ¬ apply.args; EXIT
};
ENDCASE => IF n # NIL THEN IntCodeUtils.MapNode[n, inner];
EXIT;
ENDLOOP;
WHILE list#NIL AND ~ hasLabel DO [] ¬ inner[list.first]; list ¬ list.rest; ENDLOOP;
RETURN [node];
};
[] ¬ inner[node];
};
END.