ThreeC4FlowAnalImpl: CEDAR PROGRAM IMPORTS IO, Rope, ThreeC4Support, ThreeC4BaseDecl1Def, ThreeC4BaseDecl2Def, ThreeC4PrimImplDefs, UnionFind EXPORTS ThreeC4BaseDecl2Def, ThreeC4RecFcnImplAbGramDef, ThreeC4FlowAnalDefs, ThreeC4PrimImplDefs =
BEGIN OPEN ThreeC4BaseDecl1Def, ThreeC4BaseDecl2Def, ThreeC4PrimImplDefs;
FcnDefGraphNode: TYPE = REF FcnDefGraphNodeBody;
FcnDefGraphNodeBody: PUBLIC TYPE = RECORD[
error: BOOLEAN, -- set true upon the occurance of an error
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
recursive: BOOLEAN,
names: HashTable,
args: SlotSeq,
results: SlotSeq,
damageSites: LIST OF Slot,
shareLists: LIST OF LIST OF Slot,
shareSets: Slot -- chained via <Slot.previous, Slot.next>--];
Slot: TYPE = REF SlotBody;
SlotBody: TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
info: REF ANY,
nominalElement: UnionFind.SetElement, -- slot = GetData[slot.nominalElement]
damaged: BOOLEAN, -- valid only for canonical representatives of a share set
previous, next: Slot -- used to chain canonical representatives of a share set -- ];
SlotSeq: TYPE = REF SlotSeqBody;
SlotSeqBody: TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
slots: SEQUENCE nSlots: CARDINAL OF Slot];
FcnCall: TYPE = REF FcnCallBody;
FcnCallBody: TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
name: NameNode, -- the location of the first id in the name marks the location of the call
args: SlotSeq,
results: SlotSeq,
father: CallGraphNodeNode
];
Assignment: TYPE = REF AssignmentBody;
AssignmentBody: TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
vars: SlotSeq];
ArgResultSlotInfo: TYPE = REF ArgResultSlotInfoBody;
ArgResultSlotInfoBody: TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
name: NameNode,
argResult: SlotCase,
seq: SlotSeq,
index: INT,
call: FcnCall, -- NIL if this is an arg or result of a defGraph or of an implementation --
graph: REF ANY,
damageSite: BOOLEAN,
shared: BOOLEAN];
LiteralOrRssSlotInfo: TYPE = REF LiteralOrRssSlotInfoBody;
LiteralOrRssSlotInfoBody: TYPE = RECORD[
position: INT];
SlotCase: TYPE = {callArg, callResult, implArg, implResult, defArg, defResult, var};
FcnImplGraphNode: TYPE = REF FcnImplGraphNodeBody;
FcnImplGraphNodeBody: PUBLIC TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
fcnId: IdentifierNode,
argSlots: SlotSeq,
resultSlots: SlotSeq,
callGraph: CallGraphNodeNode,
shareSets: Slot, -- chained via <Slot.previous, Slot.next>
varNames: LIST OF LIST OF VarInfo];
VarInfo: TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
name: NameNode,
slot: Slot];
SlotListNode: TYPE = REF SlotListNodeBody;
SlotListNodeBody: PUBLIC TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
first, last: SlotListCell];
SlotListCell: TYPE = REF SlotListCellBody;
SlotListCellBody: TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
slot: Slot, next: SlotListCell];
SlotListCellPair: TYPE = RECORD[goingDown: BOOLEAN, a, b: SlotListCell];
-- not all of the fields in the following record are non NIL in any one instance.
CallGraphNodeNode: TYPE = REF CallGraphNodeNodeBody;
CallGraphNodeNodeBody: PUBLIC TYPE = RECORD[
goingDown: BOOLEAN ← FALSE, -- set true during tear down process
case: CallGraphNodeCase,
firstSubNode, secondSubNode: CallGraphNodeNode,
father: CallGraphNodeNode,
data: REF ANY];
-- the data field contains different info depending on the case
-- parallel, cond, seqential => NIL
-- call => FcnCall
-- assignment => Assignment
-- varUse, literalUse => Slot
CallGraphNodeCase: TYPE = {parallel, cond, sequential, call, assignment, varUse, literalUse};
-- tear down procedures for the above data structures
TearDownFcnDefGraphNode: PUBLIC PROC[node: FcnDefGraphNode] RETURNS[FcnDefGraphNode] =
BEGIN
KillNamedSlot: PROC[info: REF ANY, name: NameNode] =
{[] ← TearDownSlot[NARROW[info]]};
IF node = NIL THEN RETURN[NIL];
node.goingDown ← TRUE;
EnumerateHashTable[node.names, KillNamedSlot];
node.args ← TearDownSlotSeq[node.args];
node.results ← TearDownSlotSeq[node.results];
node.damageSites ← TearDownListOfSlot[node.damageSites];
node.shareLists ← TearDownListOfListOfSlot[node.shareLists];
node.shareSets ← TearDownSlot[node.shareSets];
RETURN[NIL];
END;
TearDownSlot: PROC[slot: Slot] RETURNS[Slot] =
BEGIN
IF slot = NIL OR slot.goingDown THEN RETURN[NIL];
slot.goingDown ← TRUE;
WITH slot.info SELECT FROM
arsi: ArgResultSlotInfo => slot.info ← TearDownArgResultSlotInfo[arsi];
lorsi: LiteralOrRssSlotInfo => slot.info ← TearDownLiteralOrRssSlotInfo[lorsi];
ENDCASE => ERROR;
UnionFind.DismemberSet[slot.nominalElement];
slot.nominalElement ← NIL;
slot.previous ← TearDownSlot[slot.previous];
slot.next ← TearDownSlot[slot.next];
RETURN[NIL]
END;
TearDownListOfSlot: PROC[list: LIST OF Slot] RETURNS[LIST OF Slot] =
BEGIN
FOR cell: LIST OF Slot ← list, cell.rest WHILE cell # NIL DO
cell.first ← TearDownSlot[cell.first];
ENDLOOP;
RETURN[NIL];
END;
TearDownListOfListOfSlot: PROC[lists: LIST OF LIST OF Slot] RETURNS[LIST OF LIST OF Slot] =
BEGIN
FOR cell: LIST OF LIST OF Slot ← lists, cell.rest WHILE cell # NIL DO
cell.first ← TearDownListOfSlot[cell.first];
ENDLOOP;
RETURN[NIL];
END;
TearDownSlotSeq: PROC[slotSeq: SlotSeq] RETURNS[SlotSeq] =
BEGIN
IF slotSeq = NIL OR slotSeq.goingDown THEN RETURN[NIL];
slotSeq.goingDown ← TRUE;
FOR I: CARDINAL IN [0..slotSeq.nSlots) DO
slotSeq.slots[I] ← TearDownSlot[slotSeq.slots[I]];
ENDLOOP;
RETURN[NIL]
END;
TearDownFcnCall: PROC[fcnCall: FcnCall] RETURNS[FcnCall] =
BEGIN
IF fcnCall = NIL OR fcnCall.goingDown THEN RETURN[NIL];
fcnCall.goingDown ← TRUE;
fcnCall.name ← NIL;
fcnCall.args ← TearDownSlotSeq[fcnCall.args];
fcnCall.results ← TearDownSlotSeq[fcnCall.results];
fcnCall.father ← TearDownCallGraphNodeNode[fcnCall.father];
RETURN[NIL];
END;
TearDownAssignment: PROC[assign: Assignment] RETURNS[Assignment] =
BEGIN
IF assign = NIL OR assign.goingDown THEN RETURN[NIL];
assign.goingDown ← TRUE;
assign.vars ← TearDownSlotSeq[assign.vars];
RETURN[NIL];
END;
TearDownArgResultSlotInfo: PROC[arsi: ArgResultSlotInfo] RETURNS[ArgResultSlotInfo] =
BEGIN
IF arsi = NIL OR arsi.goingDown THEN RETURN[NIL];
arsi.goingDown ← TRUE;
arsi.name ← NIL;
arsi.seq ← TearDownSlotSeq[arsi.seq];
arsi.call ← TearDownFcnCall[arsi.call];
arsi.graph ← NIL; -- what is this, should I follow it?
RETURN[NIL];
END;
TearDownLiteralOrRssSlotInfo: PROC[lrsi: LiteralOrRssSlotInfo] RETURNS[LiteralOrRssSlotInfo] =
BEGIN
RETURN[NIL];
END;
TearDownFcnImplGraphNode: PROC[fcnImpl: FcnImplGraphNode] RETURNS[FcnImplGraphNode] =
BEGIN
IF fcnImpl = NIL OR fcnImpl.goingDown THEN RETURN[NIL];
fcnImpl.goingDown ← TRUE;
fcnImpl.fcnId ← NIL;
fcnImpl.argSlots ← TearDownSlotSeq[fcnImpl.argSlots];
fcnImpl.resultSlots ← TearDownSlotSeq[fcnImpl.resultSlots];
fcnImpl.callGraph ← TearDownCallGraphNodeNode[fcnImpl.callGraph];
fcnImpl.shareSets ← TearDownSlot[fcnImpl.shareSets];
fcnImpl.varNames ← TearDownListOfListOfVarInfo[fcnImpl.varNames];
RETURN[NIL];
END;
TearDownListOfVarInfo: PROC[list: LIST OF VarInfo] RETURNS[LIST OF VarInfo] =
BEGIN
FOR cell: LIST OF VarInfo ← list, cell.rest WHILE cell # NIL DO
IF cell.first.goingDown THEN RETURN[NIL];
cell.first.goingDown ← TRUE;
cell.first.name ← NIL;
cell.first.slot ← TearDownSlot[cell.first.slot];
ENDLOOP;
RETURN[NIL];
END;
TearDownListOfListOfVarInfo: PROC[lists: LIST OF LIST OF VarInfo] RETURNS[LIST OF LIST OF VarInfo] =
BEGIN
FOR cell: LIST OF LIST OF VarInfo ← lists, cell.rest WHILE cell # NIL DO
cell.first ← TearDownListOfVarInfo[cell.first];
ENDLOOP;
RETURN[NIL];
END;
TearDownSlotListNode: PROC[slotListNode: SlotListNode] RETURNS[SlotListNode] =
BEGIN
IF slotListNode = NIL OR slotListNode.goingDown THEN RETURN[NIL];
slotListNode.goingDown ← TRUE;
slotListNode.first ← TearDownSlotListCell[slotListNode.first];
slotListNode.last ← TearDownSlotListCell[slotListNode.last];
RETURN[NIL];
END;
TearDownSlotListCell: PROC[slotListCell: SlotListCell] RETURNS[SlotListCell] =
BEGIN
IF slotListCell = NIL OR slotListCell.goingDown THEN RETURN[NIL];
slotListCell.goingDown ← TRUE;
slotListCell.slot ← TearDownSlot[slotListCell.slot];
slotListCell.next ← TearDownSlotListCell[slotListCell.next];
RETURN[NIL];
END;
TearDownCallGraphNodeNode: PROC[node: CallGraphNodeNode]RETURNS[CallGraphNodeNode] =
BEGIN
IF node = NIL OR node.goingDown THEN RETURN[NIL];
node.goingDown ← TRUE;
node.firstSubNode ← TearDownCallGraphNodeNode[node.firstSubNode];
node.secondSubNode ← TearDownCallGraphNodeNode[node.secondSubNode];
node.father ← TearDownCallGraphNodeNode[node.father];
IF node.data # NIL THEN WITH node.data SELECT FROM
fcncall: FcnCall => node.data ← TearDownFcnCall[fcncall];
assgn: Assignment => node.data ← TearDownAssignment[assgn];
slot: Slot => node.data ← TearDownSlot[slot];
ENDCASE => ERROR;
RETURN[NIL];
END;
-- interface procedures that apply to FcnDef graphs
BuildFcnBaseGraph: PUBLIC PROC[argNames: NameListNode, resultNames: NameListNode] RETURNS[FcnDefGraphNode] =
BEGIN
graph: FcnDefGraphNode ← NEW[FcnDefGraphNodeBody←[
error: FALSE, -- tentative
recursive: FALSE, -- tentative
names: CreateHashTable[5],
args: NIL,
results: NIL,
damageSites: NIL,
shareLists: NIL]];
[graph.args, graph.shareSets] ← BuildNamedSlotSeq[argNames, defArg, NIL, graph, graph.shareSets];
[graph.results, graph.shareSets] ← BuildNamedSlotSeq[resultNames, defResult, NIL, graph, graph.shareSets];
FOR x: INT IN [0..graph.args.nSlots) DO
info: REF ANY ← graph.args.slots[x].info;
WITH info SELECT FROM
arsi: ArgResultSlotInfo => MakeEntry[graph.names, arsi.name, graph.args.slots[x]];
ENDCASE => ERROR;
ENDLOOP;
FOR x: INT IN [0..graph.results.nSlots) DO
info: REF ANY ← graph.results.slots[x].info;
WITH info SELECT FROM
arsi: ArgResultSlotInfo => MakeEntry[graph.names, arsi.name, graph.results.slots[x]];
ENDCASE => ERROR;
ENDLOOP;
END;
FakeCopyFcnBaseGraph: PUBLIC PROC[graph: FcnDefGraphNode] RETURNS[FcnDefGraphNode] =
{RETURN[graph]};
RecordShareList: PUBLIC PROC[graph: FcnDefGraphNode, names: NameListNode] RETURNS[FcnDefGraphNode] =
BEGIN
list: LIST OF Slot ← NIL;
seeAName: PROC[name: NameNode] =
BEGIN
info: REF ANY;
slot: Slot;
slotInfo: ArgResultSlotInfo;
info ← FindEntry[graph.names, name];
IF info = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected arg/result"];
RETURN;
END;
slot ← NARROW[info];
slotInfo ← NARROW[slot.info];
IF slotInfo.damageSite THEN
BEGIN
ReportError[IO.PutFR["sharing a damage site, %g", IO.rope[PutNameR[name]]]];
graph.error ← TRUE;
END;
list ← CONS[slot, list];
slotInfo.shared ← TRUE;
END;
GenNames[names, seeAName];
graph.shareLists ← CONS[list, graph.shareLists];
RETURN[graph];
END;
RecordDamageList: PUBLIC PROC[graph: FcnDefGraphNode, names: NameListNode] RETURNS[FcnDefGraphNode] =
BEGIN
seeAName: PROC[name: NameNode] =
BEGIN
info: REF ANY;
slot: Slot;
slotInfo: ArgResultSlotInfo;
info ← FindEntry[graph.names, name];
IF info = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected arg/result"];
RETURN;
END;
slot ← NARROW[info];
slotInfo ← NARROW[slot.info];
IF slotInfo.shared THEN
BEGIN
ReportError[IO.PutFR["damaging a share site, %g", IO.rope[PutNameR[name]]]];
graph.error ← TRUE;
END;
IF NOT slotInfo.damageSite THEN graph.damageSites ← CONS[slot, graph.damageSites];
slotInfo.damageSite ← TRUE;
END;
GenNames[names, seeAName];
RETURN[graph];
END;
PrepareRecFcnDefGraph: PUBLIC PROC[graph: FcnDefGraphNode] RETURNS[FcnDefGraphNode] =
BEGIN
graph.recursive ← TRUE;
FOR shares: LIST OF LIST OF Slot ← graph.shareLists, shares.rest WHILE shares # NIL DO
list: LIST OF Slot ← shares.first;
slot1: Slot ← list.first;
FOR otherSlots: LIST OF Slot ← list.rest, otherSlots.rest WHILE otherSlots # NIL DO
graph.shareSets ← MakeTwoSlotsShare[slot1, otherSlots.first, graph.shareSets]
ENDLOOP;
ENDLOOP;
RETURN[graph];
END;
ShowFcnDefGraph: PUBLIC PROC[graph: FcnDefGraphNode, indent: CARDINAL, on: IO.STREAM] =
BEGIN
IF graph.recursive THEN {ShowIndent[indent, on]; IO.PutF[on, "(Recursive)\N"]};
ShowIndent[indent, on]; IO.PutF[on, "Args\N"];
ShowSlotSeq[graph.args, indent+2, on];
ShowIndent[indent, on]; IO.PutF[on, "Results\N"];
ShowSlotSeq[graph.results, indent+2, on];
FOR shares: LIST OF LIST OF Slot ← graph.shareLists, shares.rest WHILE shares # NIL DO
ShowIndent[indent, on]; IO.PutF[on, "OneDeclaredShareSet\N"];
ShowIndent[indent+3, on];
FOR slots: LIST OF Slot ← shares.first, slots.rest WHILE slots # NIL DO
ShowSlotId[slots.first, on];
IO.PutF[on, " "];
ENDLOOP;
IO.PutF[on, "\N"];
ENDLOOP;
FOR canonSlot: Slot ← graph.shareSets, canonSlot.next WHILE canonSlot # NIL DO
ShowShareSet[canonSlot, indent+2, on];
ENDLOOP;
END;
-- interface procedures that apply to FcnImpl graphs
BuildFcnImplGraph: PUBLIC PROC[lookup: LookupContextNode, fcnId: IdentifierNode, args: NameListNode] RETURNS[FcnImplGraphNode] =
BEGIN
graph: FcnImplGraphNode ← NEW[FcnImplGraphNodeBody←[FALSE, fcnId]];
[graph.argSlots, graph.shareSets] ← BuildNamedSlotSeq[args, implArg, NIL, graph, graph.shareSets];
-- create one empty level of var names
graph.varNames ← CONS[NIL, NIL];
-- record the variable slots with their names
BEGIN
x: INT ← 0;
seeOneName: PROC[name: NameNode] =
BEGIN
graph.varNames.first ← CONS[[FALSE, name, graph.argSlots.slots[x]], graph.varNames.first];
x ← x+1;
END;
GenNames[args, seeOneName];
END;
RETURN[graph];
END;
FakeCopyFcnImplGraph: PUBLIC PROC[graph: FcnImplGraphNode] RETURNS[FcnImplGraphNode] =
{RETURN[graph]};
RecordCall: PUBLIC PROC[graph: FcnImplGraphNode, lookup: LookupContextNode, fnName: IdentifierNode, argSlots: SlotListNode, previousCGN: CallGraphNodeNode] RETURNS[FcnImplGraphNode, SlotListNode, CallGraphNodeNode] =
BEGIN
fcnName: NameNode ← BuildName[fnName];
defGraph: FcnDefGraphNode ← LookUpFcnDefGraph[lookup, fcnName];
call: FcnCall← NEW[FcnCallBody←[FALSE, fcnName, NIL, NIL, NIL]];
resultSlotList: SlotListNode;
cgn: CallGraphNodeNode ← NEW[CallGraphNodeNodeBody←[FALSE, call, NIL, NIL, NIL, call]];
x: INT;
seqCGN: CallGraphNodeNode;
FindReplicatedSlot: PROC[defSlot: Slot] RETURNS[Slot] =
BEGIN
info: ArgResultSlotInfo ← NARROW[defSlot.info];
IF info.argResult = defArg THEN RETURN[call.args.slots[info.index]];
IF info.argResult = defResult THEN RETURN[call.results.slots[info.index]];
ERROR;
END;
[call.args, graph.shareSets] ← ReplicateASlotSeq[defGraph.args, callArg, call, graph, graph.shareSets];
[call.results, graph.shareSets] ← ReplicateASlotSeq[defGraph.results, callResult, call, graph, graph.shareSets];
-- we make the sharing relation among the call arg/result slots agree with that in the function declaration
FOR shareLists: LIST OF LIST OF Slot ← defGraph.shareLists, shareLists.rest
WHILE shareLists # NIL DO
list: LIST OF Slot ← shareLists.first;
firstDefSlot: Slot ← list.first;
FOR slots: LIST OF Slot ← list.rest, slots.rest WHILE slots # NIL DO
anotherDefSlot: Slot ← slots.first;
graph.shareSets ← MakeTwoSlotsShare[FindReplicatedSlot[firstDefSlot], FindReplicatedSlot[anotherDefSlot], graph.shareSets];
ENDLOOP;
ENDLOOP;
-- make the damage info in the call arg/result slots agree with that in the function declaration
FOR damageSites: LIST OF Slot ← defGraph.damageSites, damageSites.rest WHILE damageSites # NIL DO
DamageASlot[FindReplicatedSlot[damageSites.first]];
ENDLOOP;
-- make the call argSlots share with the actual arg slots
x ← 0;
IF argSlots # NIL THEN FOR argCell: SlotListCell ← argSlots.first, argCell.next DO
graph.shareSets ← MakeTwoSlotsShare[call.args.slots[x], argCell.slot, graph.shareSets];
x ← x + 1;
IF argCell = argSlots.last THEN EXIT;
ENDLOOP;
-- make up a list of the result slots
resultSlotList ← IF call.results.nSlots = 0 THEN NIL ELSE NEW[SlotListNodeBody←[FALSE, NIL, NIL]];
FOR y: INT IN [0..call.results.nSlots) DO
cell: SlotListCell ← NEW[SlotListCellBody←[FALSE, call.results.slots[y], NIL]];
IF resultSlotList.last = NIL
THEN resultSlotList.first ← cell
ELSE resultSlotList.last.next ← cell;
resultSlotList.last ← cell;
ENDLOOP;
-- set the father field of the call
call.father ← cgn;
-- make up a sequential node to hold call and the evaluation of its arguments
[ , seqCGN] ← RecordSequential[graph, previousCGN, cgn];
RETURN[graph, resultSlotList, seqCGN];
END;
RecordAssignment: PUBLIC PROC[graph: FcnImplGraphNode, varNames: NameListNode, valueSlots: SlotListNode, previousCGN: CallGraphNodeNode] RETURNS[FcnImplGraphNode, CallGraphNodeNode] =
BEGIN
varSlots: SlotSeq;
x: INT;
newCGN: CallGraphNodeNode;
seeOneName: PROC[name: NameNode] =
{graph.varNames.first ← CONS[[FALSE, name, varSlots.slots[x]], graph.varNames.first]; x←x+1};
-- build the slot seq for the variables
[varSlots, graph.shareSets] ← BuildNamedSlotSeq[varNames, var, NIL, graph, graph.shareSets];
-- make the variable slots share with the supplied value slots
x ← 0;
IF valueSlots # NIL THEN FOR valueCell: SlotListCell ← valueSlots.first, valueCell.next DO
graph.shareSets ← MakeTwoSlotsShare[varSlots.slots[x], valueCell.slot, graph.shareSets];
x ← x + 1;
IF valueCell = valueSlots.last THEN EXIT;
ENDLOOP;
-- record the variable slots with their names
x ← 0;
GenNames[varNames, seeOneName];
[ , newCGN] ← RecordSequential[graph, previousCGN,
NEW[CallGraphNodeNodeBody←[FALSE, assignment, NIL, NIL, NIL, NEW[AssignmentBody←[FALSE, varSlots]]]]];
RETURN[graph, newCGN];
END;
RecordSequential: PUBLIC PROC[graph: FcnImplGraphNode, cgn1: CallGraphNodeNode, cgn2: CallGraphNodeNode] RETURNS[FcnImplGraphNode, CallGraphNodeNode] =
BEGIN
newCGN: CallGraphNodeNode ← NEW[CallGraphNodeNodeBody←[FALSE, sequential, cgn1, cgn2]];
IF cgn1 # NIL THEN
{IF cgn1.father # NIL THEN ERROR; cgn1.father ← newCGN};
IF cgn2 # NIL THEN
{IF cgn2.father # NIL THEN ERROR; cgn2.father ← newCGN};
RETURN[graph, newCGN]
END;
RecordParallel: PUBLIC PROC[graph: FcnImplGraphNode, cgn1: CallGraphNodeNode, cgn2: CallGraphNodeNode] RETURNS[FcnImplGraphNode, CallGraphNodeNode] =
BEGIN
newCGN: CallGraphNodeNode ← NEW[CallGraphNodeNodeBody←[FALSE, parallel, cgn1, cgn2]];
IF cgn1 # NIL THEN
{IF cgn1.father # NIL THEN ERROR; cgn1.father ← newCGN};
IF cgn2 # NIL THEN
{IF cgn2.father # NIL THEN ERROR; cgn2.father ← newCGN};
RETURN[graph, newCGN]
END;
RecordCondition: PUBLIC PROC[graph: FcnImplGraphNode, ifSlotList: SlotListNode, ifCGN: CallGraphNodeNode, thenSlotList: SlotListNode, thenCGN: CallGraphNodeNode, elseSlotList: SlotListNode, elseCGN: CallGraphNodeNode] RETURNS[FcnImplGraphNode, SlotListNode, CallGraphNodeNode] =
BEGIN
condCGN: CallGraphNodeNode ← NEW[CallGraphNodeNodeBody←[FALSE, cond, thenCGN, elseCGN]];
seqCGN: CallGraphNodeNode ← NEW[CallGraphNodeNodeBody←[FALSE, sequential, ifCGN, condCGN]];
IF ifCGN.father # NIL OR thenCGN.father # NIL OR elseCGN.father # NIL THEN ERROR;
thenCGN.father ← condCGN;
elseCGN.father ← condCGN;
condCGN.father ← seqCGN;
ifCGN.father ← seqCGN;
-- make the thenSlotList slots share with the elseSlotList slots
IF thenSlotList # NIL THEN
FOR slots: SlotListCellPair ← [FALSE, thenSlotList.first, elseSlotList.first], [FALSE, slots.a.next, slots.b.next]
WHILE (slots.a # NIL AND slots.b # NIL) DO
graph.shareSets ← MakeTwoSlotsShare[slots.a.slot, slots.b.slot, graph.shareSets];
ENDLOOP;
RETURN[graph, thenSlotList, seqCGN]
END;
RecordSimpleVarUse: PUBLIC PROC[graph: FcnImplGraphNode, lookup: LookupContextNode, id: IdentifierNode] RETURNS[FcnImplGraphNode, SlotListNode, CallGraphNodeNode] =
BEGIN
name: NameNode ← BuildName[id];
-- see if we are dealing with a know variable
FOR varNamesLists: LIST OF LIST OF VarInfo ← graph.varNames, varNamesLists.rest WHILE varNamesLists # NIL DO
FOR varNames: LIST OF VarInfo ← varNamesLists.first, varNames.rest WHILE varNames # NIL DO
IF EqualNames[name, varNames.first.name] THEN
BEGIN
cell: SlotListCell ← NEW[SlotListCellBody←[FALSE, varNames.first.slot, NIL]];
cgn: CallGraphNodeNode ← NEW[CallGraphNodeNodeBody ← [FALSE, varUse, NIL, NIL, NIL, cell.slot]];
RETURN[graph, NEW[SlotListNodeBody←[FALSE, cell, cell]], cgn];
END;
ENDLOOP;
ENDLOOP;
-- we didn't find the name, so we ASSUME it is a right hand side symbol
BEGIN
g: FcnImplGraphNode; sln: SlotListNode; cgn: CallGraphNodeNode;
[g, sln, cgn] ← RecordLiteralUse[graph, id.position];
RETURN[g, sln, cgn];
END;
END;
RecordModIdUse: PUBLIC PROC[graph: FcnImplGraphNode, lookup: LookupContextNode, id1, id2: IdentifierNode] RETURNS[FcnImplGraphNode, SlotListNode, CallGraphNodeNode] =
BEGIN
g: FcnImplGraphNode; sln: SlotListNode; cgn: CallGraphNodeNode;
[g, sln, cgn] ← RecordLiteralUse[graph, id1.position];
RETURN[g, sln, cgn];
END;
RecordLiteralUse: PUBLIC PROC[graph: FcnImplGraphNode, position: INT] RETURNS[FcnImplGraphNode, SlotListNode, CallGraphNodeNode] =
BEGIN
slotInfo: LiteralOrRssSlotInfo ← NEW[LiteralOrRssSlotInfoBody←[position]];
slot: Slot ← graph.shareSets ← BuildSingletonSlot[slotInfo, graph.shareSets];
cell: SlotListCell ← NEW[SlotListCellBody←[FALSE, slot, NIL]];
cgn: CallGraphNodeNode ← NEW[CallGraphNodeNodeBody ← [FALSE, varUse, NIL, NIL, NIL, slot]];
RETURN[graph, NEW[SlotListNodeBody←[FALSE, cell, cell]], cgn];
END;
OpenWithWhereList: PUBLIC PROC[graph: FcnImplGraphNode] RETURNS[FcnImplGraphNode] =
BEGIN
graph.varNames ← CONS[NIL, graph.varNames];
RETURN[graph]
END;
CloseWithWhereList: PUBLIC PROC[graph: FcnImplGraphNode] RETURNS[FcnImplGraphNode] =
BEGIN
graph.varNames ← graph.varNames.rest;
RETURN[graph];
END;
CheckFcnImpl: PUBLIC PROC[lookup: LookupContextNode, graph: FcnImplGraphNode, results: SlotListNode, cgn: CallGraphNodeNode] RETURNS[BOOLEAN] =
BEGIN
-- this is where the flow analysis gets done for one implementation
defGraph: FcnDefGraphNode ← LookUpFcnDefGraph[lookup, BuildName[graph.fcnId]];
x: INT;
GetDefSlot: PROC[info: ArgResultSlotInfo] RETURNS[Slot] =
BEGIN
SELECT info.argResult FROM
callArg, callResult =>
BEGIN
fcnDefGraph: FcnDefGraphNode ← LookUpFcnDefGraph[lookup, info.call.name];
SELECT info.argResult FROM
callArg => RETURN[fcnDefGraph.args.slots[info.index]];
callResult => RETURN[fcnDefGraph.results.slots[info.index]];
ENDCASE => ERROR;
END;
implArg => RETURN[defGraph.args.slots[info.index]];
implResult => RETURN[defGraph.results.slots[info.index]];
ENDCASE => ERROR;
END;
-- build a slot sequence to hold results
[graph.resultSlots, graph.shareSets] ← BuildNSlotSeq[CountSlotList[results], implResult, graph, graph.shareSets];
x ← 0;
FOR cell: SlotListCell ← results.first, cell.next WHILE cell # NIL DO
graph.shareSets ← MakeTwoSlotsShare[cell.slot, graph.resultSlots[x], graph.shareSets];
x ← x + 1;
ENDLOOP;
-- record the call graph
graph.callGraph ← cgn;
-- for debugging
IF FALSE THEN ShowFcnImplGraph[graph, 0, ThreeC4Support.GetReportStream[]];
-- compare share relation in this implementation with that declared for the function
-- also compare arg damage info in this implementation with that declared for the function
FOR cannon: Slot ← graph.shareSets, cannon.next WHILE cannon # NIL DO
firstImplBoundarySlot: Slot ← NIL;
firstDefBoundarySlot: Slot ← NIL;
damagedShareSet: BOOLEAN ← cannon.damaged;
SeeOneSlot: PROC[aSlot: Slot] RETURNS[BOOLEAN] =
BEGIN
WITH aSlot.info SELECT FROM
arsi: ArgResultSlotInfo =>
IF arsi.argResult = implArg OR arsi.argResult = implResult THEN
BEGIN -- slot is a boundary slot
IF firstImplBoundarySlot = NIL THEN
BEGIN
firstImplBoundarySlot ← aSlot;
firstDefBoundarySlot ← GetDefSlot[arsi];
END
ELSE
BEGIN
-- at this point we have two boundary slots of the implementation
-- which share
IF GetCannonicalSlot[firstDefBoundarySlot] # GetCannonicalSlot[GetDefSlot[arsi]] THEN
BEGIN -- we have an error situation
ReportError[IO.PutFR["Two implementation arg/results share,\N\Tand the function definition does not declare them as sharing\N\T\T%g, \N\T\T%g\N\N", IO.rope[PutSlotToRope[firstImplBoundarySlot]], IO.rope[PutSlotToRope[aSlot]]]]
END;
END;
-- check for correct damage info at boundary
IF damagedShareSet THEN
BEGIN
defSlot: Slot ← IF aSlot = firstImplBoundarySlot
THEN firstDefBoundarySlot
ELSE GetDefSlot[arsi];
IF NOT NARROW[defSlot.info, ArgResultSlotInfo].damageSite THEN
BEGIN-- we have an error situation
ReportError[IO.PutFR["an implementation arg/result is damaged,\N\Tand the function definition does not declare it as damaged\N\T\T%g\N\N", IO.rope[PutSlotToRope[aSlot]]]];
END
END;
END;
lorsi: LiteralOrRssSlotInfo => NULL;
ENDCASE => ERROR;
RETURN[TRUE];
END;
GenSlotsInShareSet[cannon, SeeOneSlot];
ENDLOOP;
-- see if any results are damaged (this should have been gotten above, but for the moment I am nervous)
FOR x: INT IN [0..graph.resultSlots.nSlots) DO
IF GetCannonicalSlot[graph.resultSlots.slots[x]].damaged THEN
BEGIN-- we have an error situation
ReportError[IO.PutFR["an implementation result is damaged\N\T\T%g\N\N", IO.rope[PutSlotToRope[graph.resultSlots.slots[x]]]]];
END;
ENDLOOP;
-- assess damage to internal call arguments
-- we begin by scanning all share sets, looking for those that are both damaged, and contain an internal call argument
FOR cannonSlot: Slot ← graph.shareSets, cannonSlot.next WHILE cannonSlot # NIL DO
IF cannonSlot.damaged THEN
BEGIN -- this share set is damaged, see if it contains an internal call argument
suspiciousSet: BOOLEAN ← FALSE; -- tentative
CheckForSuspicious: PROC[aSlot: Slot] RETURNS[BOOLEAN] =
BEGIN
WITH aSlot.info SELECT FROM
arsi: ArgResultSlotInfo => IF arsi.argResult = callArg THEN
BEGIN -- this share set requires further examination
suspiciousSet ← TRUE;
RETURN[FALSE];
END;
lorsi: LiteralOrRssSlotInfo => NULL;
ENDCASE => ERROR;
RETURN[TRUE];
END;
ExamineDamageSites: PROC[aSlot: Slot] RETURNS[BOOLEAN] =
BEGIN
WITH aSlot.info SELECT FROM
arsi: ArgResultSlotInfo => IF arsi.argResult = callArg THEN
BEGIN
defSlot: Slot ← GetDefSlot[arsi];
WITH defSlot.info SELECT FROM
defArsi: ArgResultSlotInfo =>
IF defArsi.damageSite THEN -- we have a damage site
ExploreCallGraph[arsi.call.father, NIL, aSlot];
ENDCASE => ERROR;
END;
lorsi: LiteralOrRssSlotInfo => NULL;
ENDCASE => ERROR;
RETURN[TRUE];
END;
GenSlotsInShareSet[cannonSlot, CheckForSuspicious];
IF NOT suspiciousSet THEN LOOP; -- examine the next share set
GenSlotsInShareSet[cannonSlot, ExamineDamageSites]
END;
ENDLOOP;
-- close up shop
[] ← TearDownFcnImplGraphNode[graph];
RETURN[TRUE];
END;
damages first arg, shares second arg with result
ConcatSlotList: PUBLIC PROC[list1, list2: SlotListNode] RETURNS[SlotListNode] =
BEGIN
IF list1 = NIL OR list1.first = NIL THEN RETURN[list2];
IF list2 = NIL OR list2.first = NIL THEN RETURN[list1];
list1.last.next ← list2.first;
list1.last ← list2.last;
RETURN[list1];
END;
BuildEmptySlotList: PUBLIC PROC RETURNS[SlotListNode] = {RETURN[NIL]};
BuildEmptyCallGraphNode: PUBLIC PROC RETURNS[CallGraphNodeNode] = {RETURN[NIL]};
-- slot share set support procedures
GetCannonicalSlot: PROC[slot: Slot] RETURNS[Slot] =
{RETURN[NARROW[UnionFind.GetData[UnionFind.Find[slot.nominalElement]]]]};
GenSlotsInShareSet: PROC[slot: Slot, for: PROC[Slot] RETURNS[BOOLEAN]] =
BEGIN
firstElement: UnionFind.SetElement ← slot.nominalElement;
IF NOT for[NARROW[UnionFind.GetData[firstElement]]] THEN RETURN;
FOR anElement: UnionFind.SetElement ← UnionFind.EnumerateSet[firstElement], UnionFind.EnumerateSet[anElement] WHILE anElement # firstElement DO
IF NOT for[NARROW[UnionFind.GetData[anElement]]]
THEN RETURN;
ENDLOOP;
END;
BuildSingletonSlot: PROC[info: REF ANY, list: Slot] RETURNS[slot: Slot] =
BEGIN
slot ← NEW[SlotBody←[FALSE, info, NIL, FALSE, NIL, NIL]];
slot.nominalElement ← UnionFind.MakeSet[slot];
slot.previous ← NIL;
slot.next ← list;
IF list # NIL THEN list.previous ← slot;
END;
ReportCycle: PROC[slot: Slot] =
BEGIN
msg: Rope.ROPE;
SeeASlot: PROC [slot: Slot] RETURNS [BOOLEAN] =
BEGIN
msg ← Rope.Cat[msg, "\n ", PutSlotToRope[slot]];
RETURN [TRUE];
END;
msg ← "cycle detected in share set";
GenSlotsInShareSet[slot, SeeASlot];
ReportError[msg];
END;
MakeTwoSlotsShare: PROC[slot1, slot2: Slot, list: Slot] RETURNS[newList: Slot] =
BEGIN
canonEl1, canonEl2: UnionFind.SetElement;
changedList: Slot ← list;
canonSlot1, canonSlot2: Slot;
newCanonSlot: Slot;
IF (canonEl1 ← UnionFind.Find[slot1.nominalElement]) = (canonEl2 ← UnionFind.Find[slot2.nominalElement])
THEN {ReportCycle[slot1]; RETURN[changedList]};
canonSlot1 ← NARROW[UnionFind.GetData[canonEl1]];
canonSlot2 ← NARROW[UnionFind.GetData[canonEl2]];
IF canonSlot1 = canonSlot2 THEN ERROR;
IF canonSlot1.previous = NIL AND changedList # canonSlot1 THEN ERROR;
IF canonSlot1.previous # NIL AND canonSlot1.previous.next # canonSlot1 THEN ERROR;
IF canonSlot1.next # NIL AND canonSlot1.next.previous # canonSlot1 THEN ERROR;
IF canonSlot2.previous = NIL AND changedList # canonSlot2 THEN ERROR;
IF canonSlot2.next # NIL AND canonSlot2.next.previous # canonSlot2 THEN ERROR;
changedList ← RemoveSlotFromList[changedList, canonSlot1];
changedList ← RemoveSlotFromList[changedList, canonSlot2];
newCanonSlot ← NARROW[UnionFind.GetData[UnionFind.Union[canonEl1, canonEl2]]];
IF newCanonSlot # NARROW[UnionFind.GetData[UnionFind.Find[canonEl1]], Slot] THEN ERROR;
IF newCanonSlot # NARROW[UnionFind.GetData[UnionFind.Find[canonEl2]], Slot] THEN ERROR;
newCanonSlot.damaged ← canonSlot1.damaged OR canonSlot2.damaged;
changedList ← AddSlotToList[changedList, newCanonSlot];
IF changedList # newCanonSlot THEN ERROR;
IF changedList.next = changedList THEN ERROR;
RETURN[changedList];
END;
DamageASlot: PROC[slot: Slot] =
BEGIN
IF slot.damaged THEN RETURN;
slot.damaged ← TRUE;
NARROW[UnionFind.GetData[UnionFind.Find[slot.nominalElement]], Slot].damaged ← TRUE;
END;
-- following two procedures are used for lists of canonical slots
AddSlotToList: PROC[list: Slot, slot: Slot] RETURNS[newList: Slot] =
BEGIN
IF slot.previous # NIL OR slot.next # NIL THEN ERROR;
IF list # NIL AND list.previous # NIL THEN ERROR;
slot.next ← list;
slot.previous ← NIL;
IF list # NIL THEN list.previous ← slot;
RETURN[slot];
END;
RemoveSlotFromList: PROC[list: Slot, slot: Slot] RETURNS[newList: Slot] =
BEGIN
changedList: Slot ← list;
IF list # NIL AND list.previous # NIL THEN ERROR;
IF slot.previous = NIL THEN changedList ← slot.next ELSE slot.previous.next ← slot.next;
IF slot.next # NIL THEN slot.next.previous ← slot.previous;
slot.next ← slot.previous ← NIL;
RETURN[changedList];
END;
-- general support procedures
BuildNamedSlotSeq: PROC[names: NameListNode, argResult: SlotCase, call: FcnCall, graph: REF ANY, list: Slot] RETURNS[newSeq: SlotSeq, newList: Slot] =
BEGIN
seq: SlotSeq ← NEW[SlotSeqBody[CountNames[names]]];
changedList: Slot ← list;
x: INT ← 0;
seeAName: PROC[name: NameNode] =
BEGIN
slotInfo: ArgResultSlotInfo ← NEW[ArgResultSlotInfoBody←[
FALSE, name, argResult, seq, x, call, graph, FALSE, FALSE]];
changedList ← seq[x] ← BuildSingletonSlot[slotInfo, changedList];
x ← x+1;
END;
IF list # NIL AND list.previous # NIL THEN ERROR;
GenNames[names, seeAName];
IF changedList # NIL AND changedList.previous # NIL THEN ERROR;
RETURN[seq, changedList];
END;
BuildNSlotSeq: PROC[n: INT, argResult: SlotCase, graph: REF ANY, list: Slot] RETURNS[newSeq: SlotSeq, newList: Slot] =
BEGIN
seq: SlotSeq ← NEW[SlotSeqBody[n]];
changedList: Slot ← list;
IF changedList # NIL AND changedList.previous # NIL THEN ERROR;
FOR x: INT IN [0..n) DO
slotInfo: ArgResultSlotInfo ← NEW[ArgResultSlotInfoBody←[
FALSE, NIL, argResult, seq, x, NIL, graph, FALSE, FALSE]];
changedList ← seq[x] ← BuildSingletonSlot[slotInfo, changedList];
ENDLOOP;
IF changedList # NIL AND changedList.previous # NIL THEN ERROR;
RETURN[seq, changedList];
END;
ReplicateASlotSeq: PROC[seq: SlotSeq, case: SlotCase, call: FcnCall, graph: REF ANY, list: Slot] RETURNS[SlotSeq, Slot] =
BEGIN
changedList: Slot ← list;
newSeq: SlotSeq ← NEW[SlotSeqBody[seq.nSlots]];
IF changedList # NIL AND changedList.previous # NIL THEN ERROR;
FOR I: INT IN [0..seq.nSlots) DO
slotInfo: REF ANY ← WITH seq.slots[I].info SELECT FROM
arsi: ArgResultSlotInfo => NEW[ArgResultSlotInfoBody←[FALSE, NIL, case, newSeq, I, call, graph, FALSE, FALSE]]
ENDCASE => ERROR;
changedList ← newSeq[I] ← BuildSingletonSlot[slotInfo, changedList];
ENDLOOP;
IF changedList # NIL AND changedList.previous # NIL THEN ERROR;
RETURN[newSeq, changedList];
END;
CountNames: PROC[names: NameListNode] RETURNS[INT] =
BEGIN
n: INT ← 0;
seeAName: PROC[name: NameNode] = {n ← n + 1};
GenNames[names, seeAName];
RETURN[n];
END;
CountSlotList: PROC[list: SlotListNode] RETURNS[INT] =
BEGIN
x: INT ← 0;
IF list = NIL THEN RETURN[0];
FOR cell: SlotListCell ← list.first, cell.next DO
x ← x + 1;
IF cell = list.last THEN RETURN[x];
ENDLOOP;
END;
-- this is the key procedure for assessing call argument damage
-- it examines all arg slots of all calls that are the same as the original call, or might occur later. If any such arg slot is not the damageSite itself, but is in the same share set as the damage site, then we have an error situation.
ExploreCallGraph: PROC[node: CallGraphNodeNode, from: CallGraphNodeNode, damageSite: Slot] =
BEGIN
IF node = NIL THEN RETURN;
SELECT node.case FROM
parallel =>
BEGIN
IF node.firstSubNode # from THEN ExploreCallGraph[node.firstSubNode, node, damageSite];
IF node.secondSubNode # from THEN ExploreCallGraph[node.secondSubNode, node, damageSite];
END;
cond => IF node.father = from THEN
BEGIN
ExploreCallGraph[node.firstSubNode, node, damageSite];
ExploreCallGraph[node.secondSubNode, node, damageSite];
END;
sequential =>
BEGIN
IF node.father = from THEN ExploreCallGraph[node.firstSubNode, node, damageSite];
IF node.secondSubNode # from THEN ExploreCallGraph[node.secondSubNode, node, damageSite];
END;
call =>
BEGIN
callArgs: SlotSeq ← NARROW[node.data, FcnCall].args;
FOR x: INT IN [0..callArgs.nSlots) DO
IF callArgs.slots[x] # damageSite AND UnionFind.InSameSet[callArgs.slots[x].nominalElement, damageSite.nominalElement] THEN
BEGIN -- we have an error situation
ReportError[IO.PutFR["an argument to a function call is damaged\N\T The damaged argument\N\T\T%g\N\T the source of the damage\N\T\T%g\N\N", IO.rope[PutSlotToRope[callArgs.slots[x]]], IO.rope[PutSlotToRope[damageSite]]]];
END;
ENDLOOP;
END;
assignment, literalUse, varUse => NULL;
ENDCASE => ERROR;
IF node.father # from AND node.father # NIL THEN ExploreCallGraph[node.father, node, damageSite];
END;
-- print procedures
ShowIndent: PROC[indent: CARDINAL, on: IO.STREAM] =
{FOR I: CARDINAL IN [0..indent) DO IO.PutF[on, " "] ENDLOOP};
ShowShareSet: PROC[canonSlot: Slot, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowOneSlot: PROC[aSlot: Slot] RETURNS[BOOLEAN] =
{ShowShareSetSlot[aSlot, indent+2, on]; RETURN[TRUE]};
ShowIndent[indent, on]; IO.PutF[on, "one share set\N"];
IF canonSlot.damaged THEN {ShowIndent[indent+2, on]; IO.PutF[on, "(damaged)\N"]};
GenSlotsInShareSet[canonSlot, ShowOneSlot];
END;
ShowShareSetSlot: PROC[slot: Slot, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; ShowSlotId[slot, on];
WITH slot.info SELECT FROM
arsi: ArgResultSlotInfo => IF arsi.argResult = defArg THEN
BEGIN
IF arsi.damageSite THEN IO.PutF[on, " (damageSite)"];
IF NARROW[UnionFind.GetData[slot.nominalElement], Slot].damaged THEN
IO.PutF[on, " (damaged)"];
END;
ENDCASE => NULL;
IO.PutF[on, "\N"];
END;
ShowSlotSeq: PROC[seq: SlotSeq, indent: CARDINAL, on: IO.STREAM] =
BEGIN
FOR I: INT IN [0..seq.nSlots) DO
ShowIndent[indent, on]; IO.PutF[on, "slot x = %g\N", IO.int[I]];
ShowSlot[seq[I], indent+2, on];
ENDLOOP;
END;
ShowSlot: PROC[slot: Slot, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "id = "];
ShowSlotId[slot, on];
IO.PutF[on, "\N"];
WITH slot.info SELECT FROM
arsi: ArgResultSlotInfo => ShowArgResultSlot[arsi, indent, on];
lorssi: LiteralOrRssSlotInfo => {ShowIndent[indent, on]; IO.PutF[on, "literal (or RSS) at [%g]\N", IO.int[lorssi.position]]};
ENDCASE => ERROR;
END;
ShowArgResultSlot: PROC[info: ArgResultSlotInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on];
IF info.name # NIL THEN
{ShowName[info.name, on]; ShowNamePosition[info.name, on]};
IO.PutF[on, "\N"];
ShowIndent[indent, on]; IO.PutF[on, "case = %g\N", IO.rope[
SELECT info.argResult FROM
callArg => "callArg",
callResult => "callResult",
implArg => "implArg",
implResult => "implResult",
defArg => "defArg",
defResult => "defResult",
var => "var"
ENDCASE => ERROR]];
ShowIndent[indent, on]; IO.PutF[on, "index = %g\N", IO.int[info.index]];
IF info.call # NIL THEN
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "calling "];
ShowName[info.call.name, on];
IO.PutF[on, " at "];
ShowNamePosition[info.call.name, on];
IO.PutF[on, "\N"];
END;
IF info.damageSite THEN
{ShowIndent[indent, on]; IO.PutF[on, "is a damageSite\N"]};
IF info.shared THEN
{ShowIndent[indent, on]; IO.PutF[on, "is shared\N"]};
END;
ShowSlotId: PROC[slot: Slot, on: IO.STREAM] =
BEGIN
IO.PutF[on, "%g", IO.card[LOOPHOLE[slot, LONG CARDINAL]]];
END;
ShowCallGraph: PROC[cgn: CallGraphNodeNode, indent: CARDINAL, on: IO.STREAM] =
BEGIN
IF cgn = NIL THEN
{ShowIndent[indent, on]; IO.PutF[on, "NIL cgn\N"]; RETURN};
ShowIndent[indent, on]; IO.PutF[on, "cgn case = %g\N", IO.rope[SELECT cgn.case FROM
parallel => "parallel",
cond => "cond",
sequential => "sequential",
call => "call",
assignment => "assignment",
varUse => "varUse",
literalUse => "literalUse",
ENDCASE => ERROR]];
SELECT cgn.case FROM
parallel, cond, sequential =>
BEGIN
ShowCallGraph[cgn.firstSubNode, indent+1, on];
ShowCallGraph[cgn.secondSubNode, indent+1, on];
END;
call => ShowCall[NARROW[cgn.data], indent+1, on];
literalUse, varUse => ShowSlot[NARROW[cgn.data], indent+1, on];
assignment => ShowSlotSeq[NARROW[cgn.data, Assignment].vars, indent+2, on];
ENDCASE => ERROR;
END;
ShowCall: PROC[call: FcnCall, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "calling "];
ShowName[call.name, on]; ShowNamePosition[call.name, on]; IO.PutF[on, "\N"];
ShowIndent[indent, on]; IO.PutF[on, "args = \N"]; ShowSlotSeq[call.args, indent+2, on];
ShowIndent[indent, on]; IO.PutF[on, "results = \N"]; ShowSlotSeq[call.results, indent+2, on];
END;
ShowFcnImplGraph: PROC[graph: FcnImplGraphNode, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "a function impl graph, name = %g, at [%g]\N",
IO.rope[graph.fcnId.text], IO.int[graph.fcnId.position]];
ShowIndent[indent+1, on]; IO.PutF[on, "arg slots\N"];
ShowSlotSeq[graph.argSlots, indent+2, on];
ShowIndent[indent+1, on]; IO.PutF[on, "result slots\N"];
ShowSlotSeq[graph.resultSlots, indent+2, on];
ShowIndent[indent+1, on]; IO.PutF[on, "call graph\N"];
ShowCallGraph[graph.callGraph, indent+2, on];
ShowIndent[indent+1, on]; IO.PutF[on, "share sets\N"];
FOR shareSet: Slot ← graph.shareSets, shareSet.next WHILE shareSet # NIL DO
ShowShareSet[shareSet, indent+2, on];
ENDLOOP;
END;
PutSlotToRope: PROC[slot: Slot] RETURNS[Rope.ROPE] =
BEGIN
CallArgResult: PROC[argResult: Rope.ROPE, arsi: ArgResultSlotInfo] RETURNS[Rope.ROPE] =
BEGIN
callAtStream: IO.STREAM ← IO.ROS[];
ShowNamePosition[arsi.call.name, callAtStream];
RETURN[IO.PutFR["call %g index %g of call at [%g]", IO.rope[argResult], IO.int[arsi.index], IO.rope[IO.RopeFromROS[callAtStream]]]];
END;
ImplArgResult: PROC[argResult: Rope.ROPE, arsi: ArgResultSlotInfo] RETURNS[Rope.ROPE] =
BEGIN
graph: FcnImplGraphNode ← NARROW[arsi.graph];
RETURN[IO.PutFR["implementation %g index %g of implementation at [%g]", IO.rope[argResult], IO.int[arsi.index], IO.int[graph.fcnId.position]]]
END;
DefArgResult: PROC[argResult: Rope.ROPE, arsi: ArgResultSlotInfo] RETURNS[Rope.ROPE] =
BEGIN
defAtStream: IO.STREAM ← IO.ROS[];
ShowNamePosition[arsi.name, defAtStream];
RETURN[IO.PutFR["fcn definition %g index %g at [%g]", IO.rope[argResult], IO.int[arsi.index], IO.rope[IO.RopeFromROS[defAtStream]]]]
END;
Var: PROC[argResult: Rope.ROPE, arsi: ArgResultSlotInfo] RETURNS[Rope.ROPE] =
BEGIN
graph: FcnImplGraphNode ← NARROW[arsi.graph];
RETURN[IO.PutFR["implementation %g of implementation at [%g]", IO.rope[argResult], IO.int[graph.fcnId.position]]]
END;
WITH slot.info SELECT FROM
arsi: ArgResultSlotInfo =>
BEGIN
SELECT arsi.argResult FROM
callArg => RETURN[CallArgResult["argument", arsi]];
callResult => RETURN[CallArgResult["result", arsi]];
implArg => RETURN[ImplArgResult["argument", arsi]];
implResult => RETURN[ImplArgResult["result", arsi]];
defArg => RETURN[DefArgResult["argument", arsi]];
defResult => RETURN[DefArgResult["result", arsi]];
var => RETURN[Var["variable", arsi]];
ENDCASE => ERROR;
END;
ENDCASE => ERROR;
END;
END..