SaffronCreateProgramGraphImpl.Mesa
James Rauen, August 8, 1988 7:47:19 pm PDT
Last edited by: James Rauen August 23, 1988 5:37:50 pm PDT
Implementation of the functions defined in SaffronProgramGraphDecls.ThreeC4
DIRECTORY
Rope USING [ROPE],
SaffronBaseDef USING [],
SaffronContextPrivateTypes USING [ValueNodeBody],
SaffronErrorHandling USING [InternalError],
SaffronPGDef USING [],
SaffronProgramGraphPrivateTypes;
SaffronCreateProgramGraphImpl: CEDAR PROGRAM
IMPORTS SaffronErrorHandling
EXPORTS SaffronBaseDef, SaffronPGDef
= BEGIN
OPEN
EH: SaffronErrorHandling,
PG: SaffronProgramGraphPrivateTypes,
PT: SaffronContextPrivateTypes;
ProgramGraphNode: TYPE = REF ProgramGraphNodeBody;
ProgramGraphNodeBody: PUBLIC TYPE = PG.ProgramGraphNodeBody;
ProcedureGraphNode: TYPE = REF ProcedureGraphNodeBody;
ProcedureGraphNodeBody: PUBLIC TYPE = PG.ProcedureGraphNodeBody;
ProgramFragmentNode: TYPE = REF ProgramFragmentNodeBody;
ProgramFragmentNodeBody: PUBLIC TYPE = PG.ProgramFragmentNodeBody;
ParameterizedFieldDescriptorNode: TYPE = REF ParameterizedFieldDescriptorNodeBody;
ParameterizedFieldDescriptorNodeBody: PUBLIC TYPE = PG.ParameterizedFieldDescriptorNodeBody;
ValueNode: TYPE = REF ValueNodeBody;
ValueNodeBody: PUBLIC TYPE = PT.ValueNodeBody;
Parameterized Field Descriptor
EmptyPFD: PUBLIC PROC RETURNS [ParameterizedFieldDescriptorNode] = BEGIN
RETURN [NEW[ParameterizedFieldDescriptorNodeBody ← [NIL, NIL]]];
END;
AddNestedCellToPFD: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode] RETURNS [ParameterizedFieldDescriptorNode] = BEGIN
cell: PG.ParameterizedFieldDescriptorCell ← NEW[PG.ParameterizedFieldDescriptorCellBody ← [
next: NIL,
k: nested[]
]];
RETURN [AddCellToPFD[pfd, cell]];
END;
AddStaticLinkCellToPFD: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode] RETURNS [ParameterizedFieldDescriptorNode] = BEGIN
cell: PG.ParameterizedFieldDescriptorCell ← NEW[PG.ParameterizedFieldDescriptorCellBody ← [
next: NIL,
k: staticLink[]
]];
RETURN [AddCellToPFD[pfd, cell]];
END;
AddVarsCellToPFD: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode, id: Rope.ROPE] RETURNS [ParameterizedFieldDescriptorNode] = BEGIN
id should probably be a GEN.IdNode instead...
cell: PG.ParameterizedFieldDescriptorCell ← NEW[PG.ParameterizedFieldDescriptorCellBody ← [
next: NIL,
k: vars[id]
]];
RETURN [AddCellToPFD[pfd, cell]];
END;
AddFieldNameCellToPFD: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode, fieldName: Rope.ROPE] RETURNS [ParameterizedFieldDescriptorNode] = BEGIN
cell: PG.ParameterizedFieldDescriptorCell ← NEW[PG.ParameterizedFieldDescriptorCellBody ← [
next: NIL,
k: fieldName[fieldName]
]];
RETURN [AddCellToPFD[pfd, cell]];
END;
AddCellToPFD: PROC [pfd: ParameterizedFieldDescriptorNode, cell: PG.ParameterizedFieldDescriptorCell] RETURNS [ParameterizedFieldDescriptorNode] = BEGIN
IF pfd.firstCell = NIL
THEN pfd.firstCell ← cell
ELSE pfd.lastCell.next ← cell;
pfd.lastCell ← cell;
RETURN [pfd];
END;
PFDIsLocal: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode] RETURNS [BOOLEAN] = BEGIN
RETURN [(pfd.firstCell # NIL) AND (pfd.firstCell.kind # staticLink)];
END;
Program Graph
CreateEmptyProgramGraph: PUBLIC PROC RETURNS [ProgramGraphNode] = BEGIN
RETURN [NEW[ProgramGraphNodeBody ← [NIL, NIL, NIL]]];
END;
FakeDamageProgramGraph: PUBLIC PROC [pg: ProgramGraphNode]RETURNS [ProgramGraphNode] = BEGIN
RETURN [pg];
END;
AddSubroutineProcedureGraphToProgramGraph: PUBLIC PROC [subroutine: ProcedureGraphNode, pg: ProgramGraphNode] RETURNS [ProgramGraphNode] = BEGIN
cell: PG.ProcedureGraphCell ← NEW[PG.ProcedureGraphCellBody ← [NIL, subroutine]];
IF pg.firstSubroutine = NIL
THEN pg.firstSubroutine ← cell
ELSE pg.lastSubroutine.next ← cell;
pg.lastSubroutine ← cell;
RETURN [pg];
END;
AddMainProcedureGraphToProgramGraph: PUBLIC PROC [main: ProcedureGraphNode, pg: ProgramGraphNode] RETURNS [ProgramGraphNode] = BEGIN
IF pg.main = NIL
THEN {
pg.main ← main;
RETURN [pg];
}
ELSE
ERROR EH.InternalError["Tried adding a second main routine to program graph"];
END;
Procedure Graph
MakeProcedureGraph: PUBLIC PROC [pf: ProgramFragmentNode] RETURNS [ProcedureGraphNode] = BEGIN
returnNode: PG.OperationNode ← NEW[PG.OperationNodeBody ← [
signalCatchNode: NIL,
outgoingActionEdges: NIL,
effects: NEW[PG.OpReturnBody ← NULL]
]];
LinkToReturn: PROC [node: PG.OperationNode] =
{node.outgoingActionEdges.to ← returnNode};
DemandProgramFragmentNodeInvariant[pf];
MapOntoExitingOperationNodes[pf, LinkToReturn];
RETURN [NEW[PG.ProcedureGraphNodeBody ← [code: pf]]];
END;
Program Fragment
ConcatProgramFragments: PUBLIC PROC [pf1, pf2: ProgramFragmentNode] RETURNS [ProgramFragmentNode] = BEGIN
SELECT TRUE FROM
ProgramFragmentIsNoOp[pf1] => RETURN [pf2];
ProgramFragmentIsNoOp[pf2] => RETURN [pf1];
ENDCASE => {
LinkEm: PROC [node: PG.OperationNode] =
{node.outgoingActionEdges.to ← pf2.firstOperation};
DemandProgramFragmentNodeInvariant[pf1];
DemandProgramFragmentNodeInvariant[pf2];
MapOntoExitingOperationNodes[pf1, LinkEm];
RETURN [NEW[ProgramFragmentNodeBody ← [pf1.firstOperation, pf2.exitingOperations]]];
};
END;
DemandProgramFragmentNodeInvariant: PROC [pf: ProgramFragmentNode] = BEGIN
Insist: PROC [operation: PG.OperationNode] = BEGIN
IF operation.outgoingActionEdges.label # next
OR operation.outgoingActionEdges.to # NIL
OR operation.outgoingActionEdges.next # NIL
THEN ERROR EH.InternalError["Program graph representation invariant violated"];
END;
MapOntoExitingOperationNodes[pf, Insist];
END;
ProgramFragmentIsNoOp: PROC [pf: ProgramFragmentNode] RETURNS [BOOLEAN] = BEGIN
RETURN [pf.firstOperation = NIL AND pf.exitingOperations = NIL];
END;
MapOntoExitingOperationNodes: PROC [pf: ProgramFragmentNode, proc: PROC [PG.OperationNode]] = BEGIN
FOR opList: LIST OF PG.OperationNode ← pf.exitingOperations, opList.rest
WHILE (opList # NIL) DO
proc[opList.first];
ENDLOOP;
END;
MakeSingleOperationProgramFragment: PROC [effects: REF ANY] RETURNS [ProgramFragmentNode] = BEGIN
opNode: PG.OperationNode ← NEW[PG.OperationNodeBody ← [
signalCatchNode: NIL,
outgoingActionEdges: NEW[PG.OutgoingActionsCellBody ← [next, NIL, NIL]],
effects: effects
]];
RETURN[NEW[ProgramFragmentNodeBody ← [opNode, LIST[opNode]]]]
END;
MakePGPushConstant: PUBLIC PROC [v: ValueNode] RETURNS [ProgramFragmentNode] = {
IF (v.kind # static) AND (v.kind # trash)
THEN ERROR EH.InternalError["PushConstant argument is neither constant nor trash!"];
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpPushConstantBody ← [v]]]];
};
MakePGNoOp: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[NEW[ProgramFragmentNodeBody ← [NIL, NIL]]]
};
MakePGNegate: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpUnaryFunctionBody ← [negate[]]]]];
};
MakePGNot: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpUnaryFunctionBody ← [not[]]]]];
};
MakePGAdd: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [add[]]]]];
};
MakePGSubtract: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [subtract[]]]]];
};
MakePGMultiply: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [multiply[]]]]];
};
MakePGDivide: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [divide[]]]]];
};
MakePGMod: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [mod[]]]]];
};
MakePGAnd: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [and[]]]]];
};
MakePGOr: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [or[]]]]];
};
MakePGEqual: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [equal[]]]]];
};
MakePGNotEqual: PUBLIC PROC RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpBinaryFunctionBody ← [notEqual[]]]]];
};
MakePGLoadLocal: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode] RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpLoadLocalBody ← [pfd, NIL]]]];
};
MakePGLoadIndirect: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode] RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpLoadIndirectBody ← [pfd, NIL, NIL]]]];
};
MakePGStoreLocal: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode] RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpStoreLocalBody ← [pfd, NIL]]]];
};
MakePGStoreIndirect: PUBLIC PROC [pfd: ParameterizedFieldDescriptorNode] RETURNS [ProgramFragmentNode] = {
RETURN[MakeSingleOperationProgramFragment[NEW[PG.OpStoreIndirectBody ← [pfd, NIL, NIL]]]];
};
MakePGTest: PUBLIC PROC [ifPart, thenPart, elsePart: ProgramFragmentNode] RETURNS [ProgramFragmentNode] = BEGIN
fork: PG.OperationNode ← NEW[PG.OperationNodeBody ← [
signalCatchNode: NIL,
outgoingActionEdges: NEW[PG.OutgoingActionsCellBody ← [ifTrue, thenPart.firstOperation, NEW[PG.OutgoingActionsCellBody ← [ifFalse, elsePart.firstOperation, NIL]]]],
effects: NEW[PG.OpTestBody]
]];
exitList: LIST OF PG.OperationNode ← NIL;
LinkToFork: PROC [node: PG.OperationNode] = {node.outgoingActionEdges.to ← fork};
AddToExitList: PROC [node: PG.OperationNode] = {exitList ← CONS[node, exitList]};
DemandProgramFragmentNodeInvariant[ifPart];
DemandProgramFragmentNodeInvariant[thenPart];
DemandProgramFragmentNodeInvariant[elsePart];
MapOntoExitingOperationNodes[ifPart, LinkToFork];
MapOntoExitingOperationNodes[thenPart, AddToExitList];
MapOntoExitingOperationNodes[elsePart, AddToExitList];
RETURN [NEW[ProgramFragmentNodeBody ← [ifPart.firstOperation, exitList]]];
END;
END.