--FILE: RandomCodeTypedProgramGraphsImpl.mesa
--Last Edited by: Sturgis, April 26, 1984 9:24:24 am PST

-- comment: May 7, 1984 3:50:47 pm PDT: must change the frame model to combine local vars and expression stack? without losing the information tables?

-- currentActivity: April 25, 1984 2:29:18 pm PST: simplifying the graph modification procedures. Yet to do: move op creation code to the individual op sections


-- remark: April 18, 1984 4:39:03 pm PST: Have to worry about not having to re-sort each time I want to print etc to avoid high unneeded costs, but must re-sort at each graph change?.


DIRECTORY
 IO USING[card, int, PutF, rope, STREAM],
 RandomCodeTypes USING[ArgPairTypeCheck, ArgSeqTypeCheck, CopySeqType, CopyWithOneTypeChanged, CreateSeqType, CreateTypeExtendingPartOfType, FillSeqType, FindFirstDiff, FrameVarsCheck, GetArgsResultsOfProcedureType, GetLength, GetLocalOffset, GetRemoteOffset, GetOrdinaryWordType, GetTypeSetOfSeq, GetWordTypeFromOffset, LoadIndirectTypeCheck, MergeTypes, PopSomeTypes, PrintSeqType, PushOneType, ResultSeqTypeCheck, ResultWordTypeCheck, SeqType, StackBaseCheck, StoreIndirectTypeCheck, SubtractAddTypes, TopOfSeq, TopTwoOfSeq, TypeSet, WordStorableAs, WordType],
 RandomCodeTypedProgramGraphs USING[ArcNumber, DummyNodesTable, DummyNodesTableBody, DummyNodesTableArray, LoadStore, OpDescriptor, OpDescriptorBody, OpKind, OpKindBody, OpTypeClass, ProcedureInfo, ProcedureInfoBody],
 Rope USING[ROPE];

RandomCodeTypedProgramGraphsImpl: CEDAR MONITOR IMPORTS IO, RandomCodeTypes EXPORTS RandomCodeTypedProgramGraphs =

BEGIN
OPEN RandomCodeTypes, RandomCodeTypedProgramGraphs;

-- program graph nodes

PGNode: TYPE = REF PGNodeBody;

PGNodeBody: PUBLIC TYPE = RECORD[
 frameVarsState: SeqType ← NIL,
 stackState: SeqType ← NIL,
 op: OpDescriptor ← NIL,
 arcs: ARRAY ArcNumber OF PGNode ← [NIL, NIL],
 typeCheckPass: LONG CARDINAL ← 0,
 procedureInfo: ProcedureInfo ← NIL,
 dummyTableIndex: CARDINAL ← 0,
 relativeAddress: INT ← 0,
 
 -- following is info used during print sorting
 backArcs: ARRAY ArcNumber OF BOOLEAN ← [FALSE, FALSE],
 scanNumb: CARDINAL ← 0,
 nFwdArcs: CARDINAL ← 0,
 nBackArcs: CARDINAL ← 0,
 printSeqNumb: CARDINAL ← 0,
 rib: BOOLEAN ← FALSE,
 next: PGNode ← NIL
 ];



NullOpInstallationRelease: PROCEDURE[OpDescriptor, PGNode] = {NULL};
NullOpGetDummyOpShape: PROCEDURE[OpDescriptor] RETURNS[nArgs, nResults: CARDINAL] = {ERROR};
 
ArcNumberNames: ARRAY ArcNumber OF Rope.ROPE ← ["first", "second"]; 

TooFar: PUBLIC SIGNAL = CODE;


-- dummy node table oriented code
 
CreateDummyTableEntry: PROCEDURE[table: DummyNodesTable, node: PGNode] RETURNS[--index-- CARDINAL] =
 BEGIN
 index: CARDINAL;
 IF table.nNodes = table.nodes.MaxNNodes THEN ERROR;
 table.nodes[table.nNodes] ← node;
 index ← table.nNodes;
 table.nNodes ← table.nNodes+1;
 RETURN[index];
 END;

CheckDummyTableEntry: PROCEDURE[table: DummyNodesTable, node: PGNode, index: CARDINAL] =
 BEGIN
 IF index >= table.nNodes THEN ERROR;
 IF table.nodes[index] # node THEN ERROR;
 END;

ReleaseDummyTableEntry: PROCEDURE[table: DummyNodesTable, node: PGNode, index: CARDINAL] =
 BEGIN
 CheckDummyTableEntry[table, node, index];
 table.nNodes ← table.nNodes-1;
 table.nodes[index] ← table.nodes[table.nNodes];
 NoteNewDummyOpNodeIndex[table.nodes[index], index];
 END;

GetRandomDummyTableEntry: PUBLIC PROCEDURE[table: DummyNodesTable, random: CARDINAL] RETURNS[PGNode] =
 {RETURN[table.nodes[random MOD table.nNodes]]};

GetDummyTableSize: PUBLIC PROCEDURE[table: DummyNodesTable] RETURNS[CARDINAL] =
 {RETURN[table.nNodes]};

 
--- type checking code

pass: CARDINAL ← 0;
 
BeginTypeCheck: PUBLIC ENTRY PROCEDURE[node: PGNode] =
 BEGIN
 ENABLE UNWIND => NULL;
 thisPass: CARDINAL ← pass ← pass+1;
 TypeCheckGraphReachableFromANode[node, thisPass];
 END;

TypeCheckGraphReachableFromANode: PROCEDURE[node: PGNode, thisPass: CARDINAL] =
 BEGIN
 IF node.typeCheckPass = thisPass THEN RETURN;
 node.typeCheckPass ← thisPass;
 node.op.kind.typeCheck[node.op, node];
 FOR n: ArcNumber IN ArcNumber DO
  IF node.arcs[n] # NIL THEN TypeCheckGraphReachableFromANode[node.arcs[n], thisPass];
  ENDLOOP;
 END;


TypeCheckBase: PROCEDURE[node: PGNode, arc: ArcNumber, nArgs, nResults: CARDINAL, skipResultVar: CARDINAL] =
 BEGIN
 target: PGNode ← node.arcs[arc];
 IF target = NIL THEN ERROR;
 StackBaseCheck[node.stackState, target.stackState, nArgs, nResults];
 FrameVarsCheck[node.frameVarsState, target.frameVarsState, skipResultVar];
 END;
 

BasicNodeTypeCheck: PUBLIC PROCEDURE[node: PGNode, nArgs, nResults: CARDINAL, skipResultVar: CARDINAL ← LAST[CARDINAL], twoArcs: BOOLEAN ← FALSE, jump: BOOLEAN ← FALSE] =
 BEGIN
 IF nArgs = 0 AND nResults = 1 AND GetLength[node.arcs[first].frameVarsState] = GetLength[node.frameVarsState] + 1 AND skipResultVar = LAST[CARDINAL] AND NOT twoArcs THEN -- we are in the special case of pushing onto the local variables
  BEGIN
  nResults ← 0;
  skipResultVar ← GetLength[node.frameVarsState];
  END;
 IF jump THEN
  BEGIN
  IF node.arcs[first] # NIL THEN ERROR;
  TypeCheckBase[node, second, nArgs, nResults, skipResultVar];
  END
  ELSE IF twoArcs THEN
   BEGIN
   TypeCheckBase[node, first, nArgs, nResults, skipResultVar];
   TypeCheckBase[node, second, nArgs, nResults, skipResultVar];
   END
  ELSE
   BEGIN
   TypeCheckBase[node, first, nArgs, nResults, skipResultVar];
   IF node.arcs[second] # NIL THEN ERROR;
   END;
 FOR arc: ArcNumber IN (second..LAST[ArcNumber]] DO
  IF node.arcs[arc] # NIL THEN ERROR;
  ENDLOOP;
 IF node.arcs[first] # NIL AND node.arcs[first] = node.procedureInfo.entryNode THEN ERROR;
 IF node.arcs[second] # NIL AND node.arcs[second] = node.procedureInfo.entryNode THEN ERROR;
 IF node.procedureInfo.linearized AND node.arcs[first] # NIL AND node.arcs[first] # node.next THEN ERROR;
 END;
 
TypeCheckEPNode: PUBLIC PROCEDURE[node: PGNode, nArgs: CARDINAL] =
 BEGIN
 next: PGNode ← node.arcs[first];
 IF node.procedureInfo.entryNode # node THEN ERROR;
 IF nArgs # GetLength[node.procedureInfo.allowedArgs] THEN ERROR;
 IF node.frameVarsState # NIL THEN ERROR;
 IF node.stackState # NIL THEN ERROR;
 FOR I: CARDINAL IN [0..GetLength[node.procedureInfo.allowedArgs]) DO
  IF NOT WordStorableAs[
   GetWordTypeFromOffset[node.procedureInfo.allowedArgs, I],
   GetWordTypeFromOffset[next.frameVarsState, I]] THEN ERROR;
  ENDLOOP;
 FOR I: CARDINAL IN [GetLength[node.procedureInfo.allowedArgs]..GetLength[next.frameVarsState]) DO
  IF GetWordTypeFromOffset[next.frameVarsState, I].type # uninitialized THEN ERROR;
  ENDLOOP;
 IF next.stackState # NIL AND GetLength[next.stackState] # 0 THEN ERROR;
 FOR arc: ArcNumber IN (second..LAST[ArcNumber]] DO
  IF node.arcs[arc] # NIL THEN ERROR;
  ENDLOOP;
 END;
 
TypeCheckRETNode: PUBLIC PROCEDURE[node: PGNode, nResults: CARDINAL] =
 BEGIN
 IF nResults # GetLength[node.procedureInfo.possibleResults] THEN ERROR;
 FOR I: CARDINAL IN [0..nResults) DO
  IF NOT WordStorableAs[
   GetWordTypeFromOffset[node.frameVarsState, I],
   GetWordTypeFromOffset[node.procedureInfo.possibleResults, I]] THEN ERROR;
  ENDLOOP;
 FOR arc: ArcNumber IN ArcNumber DO
  IF node.arcs[arc] # NIL THEN ERROR;
  ENDLOOP;
 END;

CheckRelativeJump: PUBLIC PROCEDURE[node: PGNode, relativeJumpBytes: INT] =
 BEGIN
 IF node.arcs[second] # NIL AND node.arcs[second].relativeAddress # (node.relativeAddress + relativeJumpBytes) THEN ERROR;
 END;
 


-- dummy node procedures

RecordDummyOpNode: PROCEDURE[node: PGNode] =
 {node.dummyTableIndex ← CreateDummyTableEntry[node.procedureInfo.dummyNodesTable, node]};

CheckDummyOpNodeEntry: PROCEDURE[node: PGNode] =
 {CheckDummyTableEntry[node.procedureInfo.dummyNodesTable, node, node.dummyTableIndex]};

ReleaseDummyOpNodeEntry: PROCEDURE[node: PGNode] =
 {ReleaseDummyTableEntry[node.procedureInfo.dummyNodesTable, node, node.dummyTableIndex]};
 
NoteNewDummyOpNodeIndex: PROCEDURE[node: PGNode, index: CARDINAL] =
 {node.dummyTableIndex ← index};
 
PrintDummyNodeDetails: PROCEDURE[node: PGNode, on: IO.STREAM, nested: CARDINAL] =
 BEGIN
 FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
  on.PutF["(%g, %g)\N", IO.card[LOOPHOLE[node.procedureInfo.procedure, LONG CARDINAL]], IO.card[node.dummyTableIndex]];
 END;
 

-- final procedures for linearizing and binary output

AssignRelativeGraphNodeAddresses: PUBLIC PROCEDURE[node: PGNode, GetJBOpForJump: PROCEDURE[deltaBytes: INTEGER] RETURNS[OpDescriptor], GetJDBOpForJump: PROCEDURE[deltaBytes: INTEGER] RETURNS[OpDescriptor]] RETURNS[size: INT] =
 -- may have to install some extra jumps, or modify some conditional jumps
 -- assumes that the graph is already print sorted
 BEGIN
 relativeAddress: INT ← 0;
 modified: BOOLEAN ← TRUE;
 
 -- first pass
 FOR n: PGNode ← node, n.next WHILE n # NIL DO
  IF n.arcs[first] # NIL AND n.arcs[first] # n.next THEN LinearizeNode[n, GetJBOpForJump];
  n.relativeAddress ← relativeAddress;
  relativeAddress ← relativeAddress + n.op.kind.GetSize[n.op];
  ENDLOOP;
  
  
 -- now handle jumps that are too far to fit in a byte field
 WHILE modified DO
  modified ← FALSE;
  relativeAddress ← 0;
  FOR n: PGNode ← node, n.next WHILE n # NIL DO
   IF n.arcs[second] # NIL THEN
    n.op.kind.SetRelativeJump[n.op, n.arcs[second].relativeAddress - n.relativeAddress
     ! TooFar =>
      BEGIN
      modified ← TRUE;
      InstallLongJump[n, GetJBOpForJump, GetJDBOpForJump];
      -- the relative address will get set on next pass
      CONTINUE;
      END];
   IF n.relativeAddress # relativeAddress THEN
    BEGIN
    n.relativeAddress ← relativeAddress;
    modified ← TRUE;
    END;
   relativeAddress ← relativeAddress + n.op.kind.GetSize[n.op];
   ENDLOOP;
  ENDLOOP;
  
 RETURN[relativeAddress];
 END;

TearDownGraph: PUBLIC PROCEDURE[node: PGNode] =
 BEGIN
 next: PGNode;
 FOR n: PGNode ← node, next WHILE next # NIL DO
  next ← n.next;
  node.frameVarsState ← NIL;
  node.stackState ← NIL;
  node.op ← NIL;
  node.arcs ← [NIL, NIL];
  node.procedureInfo ← NIL;
  node.next ← NIL
  ENDLOOP;  
 END;
 
-- new, basic graph modification procedures

CreateProcedureGraph: PUBLIC PROCEDURE[
  allowedArgs, frameExtension, possibleResults: SeqType,
  typeSet: TypeSet,
  random: PROCEDURE RETURNS[CARDINAL],
  getEPOpForEntry: PROCEDURE[nArgs: CARDINAL] RETURNS[OpDescriptor],
  getDragonOp: PROCEDURE[
   class: OpTypeClass,
   random: PROCEDURE RETURNS[CARDINAL],
   selectLocalIndex: PROCEDURE RETURNS[CARDINAL],
   selectRemoteIndex: PROCEDURE RETURNS[CARDINAL],
   selectLocalRemoteIndices: PROCEDURE RETURNS[l,r: CARDINAL]]
   RETURNS[OpDescriptor],
  getRetOpForReturn: PROCEDURE[nRetWords: CARDINAL] RETURNS[OpDescriptor]]
 
 RETURNS[
  procedureInfo: ProcedureInfo]
  =
 BEGIN
 array: REF DummyNodesTableArray ← NEW[DummyNodesTableArray[100]];
 table: DummyNodesTable ← NEW[DummyNodesTableBody ← [0, array]];
 extensionLength: CARDINAL ← GetLength[frameExtension];
 
 entryNode: PGNode ← BuildANewNode[NIL, NIL, NIL];
 tailNode: PGNode;
 initialFrameVars: SeqType ← CopySeqType[allowedArgs];
 initialStack: SeqType ← CreateSeqType[typeSet, NIL, 0];
 
 procedureInfo ← NEW[ProcedureInfoBody ← [
  NIL, allowedArgs, possibleResults, table, FALSE, typeSet, entryNode, FALSE, FALSE]];

 
 entryNode.procedureInfo ← procedureInfo;
 
 -- fix up the entry node
 tailNode ← InstallAnOpAndAppendNextNode[entryNode, getEPOpForEntry[GetLength[allowedArgs]], 0, NIL];
 tailNode.frameVarsState ← initialFrameVars;
 
 -- initialize the frame extension, by "pushing" the initial values
 FOR I: CARDINAL IN [0..GetLength[frameExtension]) DO
  type: WordType ← GetWordTypeFromOffset[frameExtension, I];
  local, remote: CARDINAL;
  op: OpDescriptor;
  selectLocal: PROCEDURE RETURNS[CARDINAL] = {RETURN[local]};
  selectLocalRemote: PROCEDURE RETURNS[CARDINAL, CARDINAL] = {RETURN[local, remote]};
  local ← GetLocalOffset[initialFrameVars, type, random[]];
  IF local # LAST[CARDINAL] THEN
   {IF (op ← getDragonOp[PushT, random, selectLocal, NIL, NIL]) = NIL THEN ERROR}
   ELSE
    BEGIN
    [local, remote] ← GetRemoteOffset[initialFrameVars, type, random[]];
   IF local = LAST[CARDINAL] THEN ERROR;
   IF (op ← getDragonOp[PushFIT, random, NIL, NIL, selectLocalRemote]) = NIL THEN ERROR;
   END;
  tailNode ← InstallAnOpAndAppendNextNode[tailNode, op, 0, NIL, LAST[CARDINAL], type];
  IF GetTypeSetOfSeq[tailNode.frameVarsState] = NIL THEN ERROR;  
  ENDLOOP;
 
 -- push the results on the stack
  BEGIN
  targetNode: PGNode ← BuildANewNode[tailNode.frameVarsState, possibleResults, procedureInfo];
  IF tailNode.stackState = NIL THEN tailNode.stackState ← CreateSeqType[GetTypeSetOfSeq[tailNode.frameVarsState], NIL, 0];
  CreateDummyOpArc[tailNode, targetNode];
  tailNode ← targetNode;
  END;
 
 -- finally, store the results
 FOR I: CARDINAL DECREASING IN [0..GetLength[possibleResults]) DO
  type: WordType ← GetWordTypeFromOffset[possibleResults, I];
  LocalIndex: PROCEDURE RETURNS[CARDINAL] = {RETURN[I]};
  op: OpDescriptor;
  IF type # TopTwoOfSeq[tailNode.stackState].s0 THEN ERROR;
  op ← getDragonOp[StoreLocalT, random, LocalIndex, NIL, NIL];
  IF op = NIL THEN ERROR;
  tailNode ← InstallAnOpAndAppendNextNode[tailNode, op, 1, NIL, I, type];
  ENDLOOP;
 
 -- lastly, install the return op code
 tailNode.op ← getRetOpForReturn[GetLength[possibleResults]];
 END;
 
BuildANewNode: PUBLIC PROCEDURE[frameVarsType, stackType: SeqType, procedureInfo: ProcedureInfo] RETURNS[PGNode] =
 BEGIN
 newNode: PGNode ← NEW[PGNodeBody];
 newNode.frameVarsState ← CopySeqType[frameVarsType];
 newNode.stackState ← CopySeqType[stackType];
 newNode.procedureInfo ← procedureInfo;
 RETURN[newNode];
 END;

InstallAnOp: PROCEDURE[node: PGNode, op: OpDescriptor, targetOne, targetTwo: PGNode ← NIL] =
 BEGIN
 IF node.op # NIL THEN
  BEGIN
  node.op.kind.Release[node.op, node];
  END;
 node.op ← op;
 node.arcs ← [targetOne, targetTwo];
 op.kind.NoteInstallation[op, node];
 END;

InstallAnOpAndAppendNextNode: PROCEDURE[node: PGNode, op: OpDescriptor, nArgs: CARDINAL, possibleResult: WordType, possibleChangeLocal: CARDINAL ← LAST[CARDINAL], possibleNewLocalType: WordType ← NIL] RETURNS[PGNode] =
 BEGIN
 newStack, newFrameState: SeqType;
 newNode: PGNode;
 IF node.op # NIL THEN ERROR;
 FOR i: ArcNumber IN ArcNumber DO IF node.arcs[i] # NIL THEN ERROR ENDLOOP;
 newStack ← PopSomeTypes[node.stackState, nArgs];
 IF possibleResult # NIL THEN newStack ← PushOneType[newStack, possibleResult];
 newFrameState ← IF possibleNewLocalType = NIL THEN CopySeqType[node.frameVarsState]
  ELSE IF possibleChangeLocal = LAST[CARDINAL] THEN
   PushOneType[node.frameVarsState, possibleNewLocalType]
  ELSE CopyWithOneTypeChanged[node.frameVarsState, possibleChangeLocal, possibleNewLocalType];
 newNode ← BuildANewNode[newFrameState, newStack, node.procedureInfo];
 InstallAnOp[node, op, newNode, NIL];
 RETURN[newNode];
 END; 

CreateDummyOpArc: PROCEDURE[sourceNode, targetNode: PGNode] =
 BEGIN
 op: OpDescriptor ← CreateDummyOp[sourceNode.stackState, targetNode.stackState];
 InstallAnOp[sourceNode, op, targetNode];
 END; 

GetDummyNodeOpShape: PUBLIC PROCEDURE[node: PGNode] RETURNS[nArgs, nResults: CARDINAL] =
 {[nArgs, nResults] ← node.op.kind.GetDummyOpShape[node.op]};

GetStack: PUBLIC PROCEDURE[node: PGNode] RETURNS[SeqType] =
 {RETURN[node.stackState]};

GetNextStack: PUBLIC PROCEDURE[node: PGNode] RETURNS[SeqType] =
 {RETURN[node.arcs[first].stackState]};
 
GetTopOfStack: PUBLIC PROCEDURE[node: PGNode] RETURNS[WordType] =
 {RETURN[TopTwoOfSeq[node.stackState].s0]};
 
GetTopOfNextStack: PUBLIC PROCEDURE[node: PGNode] RETURNS[WordType] =
 BEGIN
 IF (node.arcs[first].stackState = NIL OR GetLength[node.arcs[first].stackState] = 0) AND GetLength[node.arcs[first].frameVarsState] = GetLength[node.frameVarsState]+1 THEN -- we are in the special case of pushing onto the local frame vars
  RETURN[TopTwoOfSeq[node.arcs[first].frameVarsState].s0]
  ELSE RETURN[TopTwoOfSeq[node.arcs[first].stackState].s0]
 END;

GetNextOfStack: PUBLIC PROCEDURE[node: PGNode] RETURNS[WordType] =
 {RETURN[TopTwoOfSeq[node.stackState].s1]};

GetNextOfNextStack: PUBLIC PROCEDURE[node: PGNode] RETURNS[WordType] =
 {RETURN[TopTwoOfSeq[node.arcs[first].stackState].s1]};

GetFrameVarType: PUBLIC PROCEDURE[node: PGNode, varOffset: CARDINAL] RETURNS[WordType] =
 {RETURN[GetWordTypeFromOffset[node.frameVarsState, varOffset]]};

GetNextFrameVarType: PUBLIC PROCEDURE[node: PGNode, varOffset: CARDINAL] RETURNS[WordType] =
 {RETURN[GetWordTypeFromOffset[node.arcs[first].frameVarsState, varOffset]]};

GetTypeSet: PUBLIC PROCEDURE[node: PGNode] RETURNS[TypeSet] =
 {RETURN[node.procedureInfo.typeSet]};


LinearizeNode: PROCEDURE[n: PGNode, GetJBOpForJump: PROCEDURE[deltaBytes: INTEGER] RETURNS[OpDescriptor]] =
BEGIN
jumpNode: PGNode ← BuildANewNode[n.arcs[first].frameVarsState, n.arcs[first].stackState, n.procedureInfo];
InstallAnOp[jumpNode, GetJBOpForJump[0], NIL, n.arcs[first]];
n.arcs[first] ← jumpNode;
jumpNode.next ← n.next;
n.next ← jumpNode;
END;

InstallLongJump: PROCEDURE[n: PGNode, GetJBOpForJump, GetJDBOpForJump: PROCEDURE[deltaBytes: INTEGER] RETURNS[OpDescriptor]] =
BEGIN
SELECT n.arcs[first] FROM
 = NIL =>
  BEGIN
  -- the current op must be JB, but we don't have a way to check that
  next: PGNode ← n.next;
  InstallAnOp[n, GetJDBOpForJump[0], NIL, n.arcs[second]];
  n.next ← next;
  END;
  
 # NIL =>
  BEGIN
  -- we use a dumb solution, later we can add code to try for a better one involving changing the mode of the op   
  next: PGNode ← n.next;
  shortJumpNode: PGNode ← BuildANewNode[n.arcs[first].frameVarsState, n.arcs[first].stackState, n.procedureInfo];
  longJumpNode: PGNode ← BuildANewNode[n.arcs[second].frameVarsState, n.arcs[second].stackState, n.procedureInfo];
  InstallAnOp[longJumpNode, GetJDBOpForJump[0], NIL, n.arcs[second]];
  longJumpNode.next ← next;
  InstallAnOp[shortJumpNode, GetJBOpForJump[0], NIL, n.arcs[first]];
  shortJumpNode.next ← longJumpNode;
  n.arcs[first] ← shortJumpNode;
  n.arcs[second] ← longJumpNode;
  n.next ← shortJumpNode;
  END;
  
 ENDCASE => ERROR;
END;
 
 
-- graph modification procedures


SplitADummyArc: PUBLIC PROCEDURE[source: PGNode, copySomeOfOpSource: BOOLEAN, amountOfCopy: CARDINAL, extension: SeqType] =
 BEGIN
 intermediateStackType: SeqType ← CreateIntermediateType[source, copySomeOfOpSource, amountOfCopy, extension];
 newNode: PGNode ← BuildANewNode[source.frameVarsState, intermediateStackType, source.procedureInfo];
 CreateDummyOpArc[newNode, source.arcs[first]];
 CreateDummyOpArc[source, newNode];
 END;
 
InsertTestA: PUBLIC PROCEDURE[source: PGNode, op: OpDescriptor, loop: BOOLEAN] =
 BEGIN
 typeSet: TypeSet ← GetTypeSetOfSeq[source.frameVarsState];
 additionalArg: SeqType;
 testNodeStackState: SeqType;
 bodyABNodeStackStates: SeqType;
 bodyANode: PGNode;
 bodyBNode: PGNode;
 testNode: PGNode;
 
 GenOrdinaryWordType: PROCEDURE[i: CARDINAL] RETURNS[WordType] =
  {RETURN[GetOrdinaryWordType[typeSet]]};
 
 -- build the new stack states
 additionalArg ← CreateSeqType[typeSet, NIL, 1];
 FillSeqType[additionalArg, GenOrdinaryWordType];
 testNodeStackState ← MergeTypes[source.stackState, additionalArg];
 bodyABNodeStackStates ← SubtractAddTypes[testNodeStackState, additionalArg, NIL];
 
  
 -- prepare bodyANode
 bodyANode ← BuildANewNode[source.frameVarsState, bodyABNodeStackStates, source.procedureInfo];
 
 -- prepare bodyBNode
 bodyBNode ← BuildANewNode[source.frameVarsState, bodyABNodeStackStates, source.procedureInfo];
 CreateDummyOpArc[bodyBNode, source.arcs[first]];
 
 -- prepare test node
 testNode ← BuildANewNode[source.frameVarsState, testNodeStackState, source.procedureInfo];
 InstallAnOp[testNode, op, bodyANode, bodyBNode];
 
 -- finally
 CreateDummyOpArc[bodyANode, IF loop THEN testNode ELSE source.arcs[first]];
  -- last arc is built here so that test node is built before the arc if a loop being built
 CreateDummyOpArc[source, testNode];
 END;

InsertSourceReduction: PUBLIC PROCEDURE[source: PGNode, selectOp: PROCEDURE[dummyOp: OpDescriptor, locals: SeqType, ordinaryWordType: WordType] RETURNS[OpDescriptor, CARDINAL]] =
 BEGIN
 op: OpDescriptor;
 nPop: CARDINAL;
 intermediateNode: PGNode;
 
 [op, nPop] ← selectOp[source.op, source.frameVarsState, GetOrdinaryWordType[source.procedureInfo.typeSet]];
 IF op = NIL THEN RETURN;

 intermediateNode ← BuildANewNode[source.frameVarsState, PopSomeTypes[source.stackState, nPop], source.procedureInfo];
 CreateDummyOpArc[intermediateNode, source.arcs[first]];
 InstallAnOp[source, op, intermediateNode];
 END;

InsertTargetReduction: PUBLIC PROCEDURE[source: PGNode, selectOp: PROCEDURE[dummyOp: OpDescriptor, locals: SeqType, ordinaryWordType: WordType] RETURNS[OpDescriptor, CARDINAL]] =
 BEGIN
 op: OpDescriptor;
 nPush: CARDINAL;
 intermediateNode: PGNode;
 
 [op, nPush] ← selectOp[source.op, source.frameVarsState, GetOrdinaryWordType[source.procedureInfo.typeSet]];
 IF op = NIL THEN RETURN;
 
 intermediateNode ← BuildANewNode[source.frameVarsState, PopSomeTypes[source.arcs[first].stackState, nPush], source.procedureInfo];
 InstallAnOp[intermediateNode, op, source.arcs[first]];
 CreateDummyOpArc[source, intermediateNode]; 
 END;

InsertSFCallInDummyArc: PUBLIC PROCEDURE[source: PGNode, op: OpDescriptor, procType: WordType] =
 BEGIN
 opArgs, opRets: SeqType;
 prePreCallStackType: SeqType;
 preCallStackType: SeqType;
 postCallStackType: SeqType;
 callNode, retNode: PGNode;
 
 -- compute new stack types
 [opArgs, opRets] ← GetArgsResultsOfProcedureType[procType];
 prePreCallStackType ← MergeTypes[source.stackState, opArgs];
 preCallStackType ← PushOneType[prePreCallStackType, procType];
 postCallStackType ← SubtractAddTypes[prePreCallStackType, opArgs, NIL];
 
 -- prepare return node
 retNode ← BuildANewNode[source.frameVarsState, postCallStackType, source.procedureInfo];
 CreateDummyOpArc[retNode, source.arcs[first]];
 
 -- prepare call node
 callNode ← BuildANewNode[source.frameVarsState, preCallStackType, source.procedureInfo];
 InstallAnOp[callNode, op, retNode, NIL];
 
 -- finally
 CreateDummyOpArc[source, callNode]; 
 END;

RemoveNullDummy: PUBLIC PROCEDURE[source: PGNode] =
 BEGIN
 nArgs, nResults: CARDINAL;
 old: PGNode ← source.arcs[first];
 [nArgs, nResults] ← source.op.kind.GetDummyOpShape[source.op];
 IF nArgs # 0 OR nResults # 0 THEN ERROR;
 InstallAnOp[source, old.op.kind.Copy[old.op], old.arcs[first], old.arcs[second]];
 END;
 



-- some type manipulations

CreateIntermediateType: PROCEDURE[source: PGNode, copySomeOfOpSource: BOOLEAN, amountOfCopy: CARDINAL, extension: SeqType] RETURNS[SeqType] =
 BEGIN
 sourceOpData: REF DummyOpDataBody ← NARROW[source.op.data];
 model: SeqType ← IF copySomeOfOpSource THEN source.stackState ELSE source.arcs[first].stackState;
 baseSize: CARDINAL ← GetLength[source.stackState] - GetLength[sourceOpData.allowedArgs];
 reducedCopy: CARDINAL ← MIN[amountOfCopy, GetLength[model]-baseSize];
 out: SeqType ← CreateTypeExtendingPartOfType[model, baseSize+reducedCopy, extension];
 RETURN[out];
 END;

 
 

-- code for sorting nodes and printing

-- this procedure assumes that PrintSortGraph has previously been called.

PrintGraph: PUBLIC PROCEDURE[title: Rope.ROPE, node: PGNode, on: IO.STREAM] =
 BEGIN
 seqNumber: CARDINAL ← 0;
 on.PutF["\N\N\N%g\N\N", IO.rope[title]];
 FOR n: PGNode ← node, n.next WHILE n # NIL DO
  {n.printSeqNumb ← seqNumber ← seqNumber+1}
  ENDLOOP;
 FOR n: PGNode ← node, n.next WHILE n # NIL DO
  PrintOneGraphNode[n, on]
  ENDLOOP;
 END;


-- PrintSortGraph: This procedure sorts that portion of the program graph which is reachable from the given node. The result is that the "next" field at each node is arranged to point to the next node in the sort order. The resulting order is a "print order". First, all "backward" arcs are identified, thus finding a tree which covers the graph. The print order is determined such that a given node will be "visited" only after all nodes from which it can be reached (by "forward" arcs) have already been visited. Otherwise, nodes which can be visited by "first" arcs will be visited before nodes that require following "second" arcs, etc. Uses an incremented value of the (global) variable sortScanNumb to distinguish visits of this sort call from those of previous calls.
 
PrintSortGraph: PUBLIC ENTRY PROCEDURE[node: PGNode] =
 BEGIN
 thisPass: CARDINAL ← sortScanNumb + 1;
 last: PGNode;
 sortScanNumb ← thisPass;
 FirstSortVisit[node, thisPass];
 last ← SecondSortVisit[node, thisPass, NIL];
 last.next ← NIL;
 END;
 
sortScanNumb: CARDINAL ← 0;

-- NOTE: following sort procedures would have a simpler form if they were purely recursive, but we try to avoid a recursion for each node that only has a single outgoing pointer, which is its first pointer and which is not a backward pointer.

-- FirstSortVisit: marks all "backward" arcs, and also leaves in each node a count of the number of forward arcs pointing to the node. Touches only those nodes reachable from start. There had better be no other incarnation of this procedure running on the same graph at the same time.

FirstSortVisit: PROCEDURE[firstNode: PGNode, scanNumb: CARDINAL] =
 BEGIN
 node: PGNode ← firstNode;
 lastNode: PGNode;
 DO
  ok: BOOLEAN ← TRUE; -- tentative
  node.scanNumb ← scanNumb;
  node.rib ← TRUE;
  node.nFwdArcs ← 1;
  node.nBackArcs ← 0;
  IF node.arcs[first] = NIL THEN ok ← FALSE;
  FOR i: ArcNumber IN (FIRST[ArcNumber]..LAST[ArcNumber]]
   DO IF node.arcs[i] # NIL THEN ok ← FALSE ENDLOOP;
  
  -- in the following code we advance one node and loop
  IF ok AND node.arcs[first].scanNumb # scanNumb THEN
   BEGIN
   node.backArcs[first] ← FALSE;
   node ← node.arcs[first];
   LOOP;
   END;
  
  -- in the following code we handle the case of more than one out pointer, or first pointer = NIL
  FOR i: ArcNumber IN ArcNumber DO
   IF node.arcs[i] # NIL AND node.arcs[i].scanNumb = scanNumb THEN
    BEGIN -- this node has been visited
    IF node.arcs[i].rib THEN
     BEGIN -- we have a back pointer in hand
     node.arcs[i].nBackArcs ← node.arcs[i].nBackArcs + 1;
     node.backArcs[i] ← TRUE;
     END
     ELSE
      BEGIN -- we have a forward pointer in hand
      node.arcs[i].nFwdArcs ← node.arcs[i].nFwdArcs + 1;
      node.backArcs[i] ← FALSE;
      END
    END
    ELSE IF node.arcs[i] # NIL THEN
     BEGIN -- this node has not been visited
     node.backArcs[i] ← FALSE;
     FirstSortVisit[node.arcs[i], scanNumb];
     END;
   ENDLOOP;
  
  lastNode ← node;
  EXIT;
  ENDLOOP;
 
 -- now lets remove the rib marking
 node ← firstNode;
 DO
  node.rib ← FALSE;
  IF node = lastNode THEN EXIT;
  node ← node.arcs[first];
  ENDLOOP;
 END;
 

-- SecondSortVisit: this procedure plants the next pointers in print sort order

SecondSortVisit: PROCEDURE[firstNode: PGNode, scanNumb: CARDINAL, previous: PGNode] RETURNS[last: PGNode] =
 BEGIN
 node: PGNode ← firstNode;
 DO
  ok: BOOLEAN ← TRUE; -- tentative
  IF node.arcs[first] = NIL THEN ok ← FALSE;
  IF node.backArcs[first] THEN ok ← FALSE;
  IF ok AND node.arcs[first].nFwdArcs # 1 THEN ok ← FALSE;
  FOR i: ArcNumber IN (FIRST[ArcNumber]..LAST[ArcNumber]]
   DO IF node.arcs[i] # NIL THEN ok ← FALSE ENDLOOP;
   
  -- visit this node 
  IF node.scanNumb # scanNumb THEN ERROR;
  IF previous # NIL THEN previous.next ← node;
  last ← node;
  
  IF ok THEN
   BEGIN -- step along a simple chain
   node.arcs[first].nFwdArcs ← node.arcs[first].nFwdArcs-1;
   IF node.arcs[first].nFwdArcs # 0 THEN ERROR;
   previous ← node;
   node ← node.arcs[first];
   LOOP;
   END
   ELSE -- not the ok case, not a simple chain advance
    BEGIN
    FOR i: ArcNumber IN ArcNumber DO
     IF NOT node.backArcs[i] AND node.arcs[i] # NIL THEN
      BEGIN
      node.arcs[i].nFwdArcs ← node.arcs[i].nFwdArcs - 1;
      IF node.arcs[i].nFwdArcs = 0 THEN
       BEGIN
       last ← SecondSortVisit[node.arcs[i], scanNumb, last];
       END;
      END;
     ENDLOOP;
    RETURN[last];
    END;
   ENDLOOP;
 END;


PrintOneGraphNode: PROCEDURE[node: PGNode, on: IO.STREAM] =
 BEGIN
 
 -- print node title
 on.PutF["%g [%g]\N", IO.card[node.printSeqNumb], IO.int[node.relativeAddress]];
 
 -- print initial stack state
 on.PutF["stack state: "];
 PrintSeqType[node.stackState, on];
 on.PutF["\N"];
 
 -- print operation
 PrintOpDescriptor[node.op, node, on, 4];
 
 -- print outgoing arcs
 IF node.arcs[first] = NIL THEN
  on.PutF[" %g: %g\N", IO.rope[ArcNumberNames[first]], IO.rope["NIL"]];
 IF node.arcs[first] # NIL AND node.arcs[first].printSeqNumb # node.printSeqNumb+1 THEN
  on.PutF[" %g: %g\N", IO.rope[ArcNumberNames[first]], IO.card[node.arcs[first].printSeqNumb]];
 IF node.arcs[first] # NIL AND node.arcs[first].printSeqNumb = node.printSeqNumb+1 THEN
  BEGIN
  printFirst: BOOLEAN ← FALSE; -- tentative
  FOR i: ArcNumber IN (FIRST[ArcNumber]..LAST[ArcNumber]] DO
   IF node.arcs[i] # NIL THEN {printFirst ← TRUE; EXIT}
   ENDLOOP;
  IF printFirst THEN on.PutF[" %g: %g\N", IO.rope[ArcNumberNames[first]], IO.card[node.arcs[first].printSeqNumb]];
  END;
 FOR i: ArcNumber IN (FIRST[ArcNumber]..LAST[ArcNumber]] DO
  IF node.arcs[i] # NIL THEN
   on.PutF[" %g: %g\N", IO.rope[ArcNumberNames[i]], IO.card[node.arcs[i].printSeqNumb]];
  ENDLOOP;
 on.PutF["\N"];
 END;

PrintOpDescriptor: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
 BEGIN
 IF op = NIL THEN
  BEGIN
  FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
   on.PutF["NIL op\N"];
  END
 ELSE
  BEGIN
  FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
   on.PutF["%g\N", IO.rope[op.kind.name]]; 
  op.kind.printDetails[op, node, on, nested+4];
  END;
 END;


-- byte generation

GenGraphBytes: PUBLIC PROCEDURE[node: PGNode, oneByte: PROC[[0..255]]] =
 BEGIN
 FOR n: PGNode ← node, n.next WHILE n # NIL DO
  GenBytesForOneGraphNode[n, oneByte]
  ENDLOOP;
 END;

GenBytesForOneGraphNode: PROCEDURE[node: PGNode, oneByte: PROC[[0..255]]] =
 {GenBytesForOpDescriptor[node.op, oneByte]};

GenBytesForOpDescriptor: PROCEDURE[op: OpDescriptor, oneByte: PROC[[0..255]]] =
 {op.kind.genBytes[op, oneByte]};



--
-- what follows is specific to various op types
--


-- Dummy Op

DummyOpKind: OpKind ← NEW[OpKindBody ← [
 "dummyOp",
 CopyDummyOp,
 NoteDummyOpInstallation,
 ReleaseDummyOp,
 GetDummyOpShape,
 NIL,
 NIL,
 TypeCheckDummyOp,
 PrintDummyOpDetails]];
 
DummyOpDataBody: TYPE = RECORD[
 allowedArgs: SeqType ← NIL,
 possibleResults: SeqType ← NIL
 ];

CopyDummyOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF DummyOpDataBody ← NARROW[op.data];
 outData: REF DummyOpDataBody ← NEW[DummyOpDataBody];
 outOp: OpDescriptor ← NEW[OpDescriptorBody ← [DummyOpKind, outData]];
 outData.allowedArgs ← CopySeqType[inData.allowedArgs];
 outData.possibleResults ← CopySeqType[inData.possibleResults];
 RETURN[outOp];
 END;
 
CreateDummyOp: PROCEDURE[source, target: SeqType] RETURNS[OpDescriptor] =
 BEGIN
 baseSize: CARDINAL;
 data: REF DummyOpDataBody ← NEW[DummyOpDataBody];
 op: OpDescriptor ← NEW[OpDescriptorBody ← [DummyOpKind, data]];
 args: SeqType;
 results: SeqType;

 -- determine appropriate base
 baseSize ← FindFirstDiff[source, target];
 
 -- build the dummy op
 args ← TopOfSeq[source, baseSize];
 results ← TopOfSeq[target, baseSize];
 
 data.allowedArgs ← args;
 data.possibleResults ← results;
 
 RETURN[op]
 END;


NoteDummyOpInstallation: PROCEDURE[op: OpDescriptor, node: PGNode] =
 {RecordDummyOpNode[node]};
 
ReleaseDummyOp: PROCEDURE[op: OpDescriptor, node: PGNode] =
 {ReleaseDummyOpNodeEntry[node]};
 
GetDummyOpShape: PROCEDURE[op: OpDescriptor] RETURNS[nArgs, nResults: CARDINAL] =
 BEGIN
 data: REF DummyOpDataBody ← NARROW[op.data];
 RETURN[GetLength[data.allowedArgs], GetLength[data.possibleResults]];
 END;
 
TypeCheckDummyOp: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF DummyOpDataBody ← NARROW[op.data];
 
 BasicNodeTypeCheck[node, GetLength[opData.allowedArgs], GetLength[opData.possibleResults]];
 CheckDummyOpNodeEntry[node];
 ArgSeqTypeCheck[node.stackState, opData.allowedArgs];
 ResultSeqTypeCheck[opData.possibleResults, node.arcs[first].stackState];
 END;
 
PrintDummyOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
 BEGIN
 opData: REF DummyOpDataBody ← NARROW[op.data];
 PrintDummyNodeDetails[node, on, nested];
 FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
  on.PutF["args : "]; PrintSeqType[opData.allowedArgs, on]; on.PutF["\N"];
 FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
  on.PutF["results: "]; PrintSeqType[opData.possibleResults, on]; on.PutF["\N"];
 END;
 
TopTwoArgsOfDummyOp: PUBLIC PROCEDURE[dummyOp: OpDescriptor] RETURNS[s0, s1: WordType] =
 BEGIN
 opData: REF DummyOpDataBody ← NARROW[dummyOp.data];
 [s0, s1] ← TopTwoOfSeq[opData.allowedArgs];
 END;

TopResultOfDummyOp: PUBLIC PROCEDURE[dummyOp: OpDescriptor] RETURNS[t0: WordType] =
 BEGIN
 opData: REF DummyOpDataBody ← NARROW[dummyOp.data];
 [t0, ] ← TopTwoOfSeq[opData.possibleResults];
 END;
 





-- Dummy Test Op

DummyTestOpKindDataBody: TYPE = RECORD[ordinaryWordType: WordType];

dummyTestOpKind: OpKind ← NEW[OpKindBody ← ["dummyTestOp", CopyDummyTestOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckDummyTest, PrintDummyTestOpDetails]];

CopyDummyTestOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF DummyTestOpKindDataBody ← NARROW[op.data];
 outData: REF DummyTestOpKindDataBody ← NEW[DummyTestOpKindDataBody];
 outOp: OpDescriptor ← NEW[OpDescriptorBody ← [dummyTestOpKind, outData]];
 outData.ordinaryWordType ← inData.ordinaryWordType;
 RETURN[outOp];
 END;

CreateDummyTestOp: PROCEDURE[typeSet: TypeSet] RETURNS[OpDescriptor] =
 BEGIN
 data: REF DummyTestOpKindDataBody← NEW[DummyTestOpKindDataBody ← [GetOrdinaryWordType[typeSet]]];
 RETURN[NEW[OpDescriptorBody ← [dummyTestOpKind, data]]];
 END;

TypeCheckDummyTest: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF DummyTestOpKindDataBody ← NARROW[op.data];
 
 BasicNodeTypeCheck[node, 1, 0, LAST[CARDINAL], TRUE];
 ArgPairTypeCheck[node.stackState, opData.ordinaryWordType, NIL];
 END;

PrintDummyTestOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
 {NULL};


-- Local ops

LocalOpKindDataBody: TYPE = RECORD[
 localVar: CARDINAL];

storeLocalOpKind: OpKind ← NEW[OpKindBody ← ["storeLOp", CopyStoreLOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckStoreL, PrintLocalOpDetails]];

loadLocalOpKind: OpKind ← NEW[OpKindBody ← ["loadLOp", CopyLoadLOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckLoadL, PrintLocalOpDetails]];

CopyLoadLOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF LocalOpKindDataBody ← NARROW[op.data];
 RETURN[CreateLocalOp[load, inData.localVar]];
 END;

CopyStoreLOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF LocalOpKindDataBody ← NARROW[op.data];
 RETURN[CreateLocalOp[store, inData.localVar]];
 END;

CreateLocalOp: PUBLIC PROCEDURE[loadStore: LoadStore, localOffset: CARDINAL] RETURNS[OpDescriptor] =
 BEGIN
 kind: OpKind ← IF loadStore = load THEN loadLocalOpKind ELSE storeLocalOpKind;
 data: REF LocalOpKindDataBody ← NEW[LocalOpKindDataBody ← [localOffset]];
 
 RETURN[NEW[OpDescriptorBody ← [kind, data]]];
 END;

 
TypeCheckStoreL: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF LocalOpKindDataBody ← NARROW[op.data];
 
 BasicNodeTypeCheck[node, 1, 0, opData.localVar];
 ArgPairTypeCheck[node.stackState, GetWordTypeFromOffset[node.arcs[first].frameVarsState, opData.localVar], NIL];
 END;
 
TypeCheckLoadL: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF LocalOpKindDataBody ← NARROW[op.data];
 
 BasicNodeTypeCheck[node, 0, 1];
 ResultWordTypeCheck[GetWordTypeFromOffset[node.frameVarsState, opData.localVar], node.arcs[first].stackState];
 END;

PrintLocalOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
 BEGIN
 opData: REF LocalOpKindDataBody ← NARROW[op.data];
 FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
  on.PutF["localVar: %g\N", IO.card[opData.localVar]];
 END;


-- Indirect Ops

IndirectOpKindDataBody: TYPE = RECORD[
 remoteOffset: CARDINAL];

loadIOpKind: OpKind ← NEW[OpKindBody ← ["loadIOp", CopyLoadIOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckLoadI, PrintIndirectOpDetails]];

storeIOpKind: OpKind ← NEW[OpKindBody ← ["storeIOp", CopyStoreIOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckStoreI, PrintIndirectOpDetails]];

CopyLoadIOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF IndirectOpKindDataBody ← NARROW[op.data];
 RETURN[CreateIndirectOp[load, inData.remoteOffset]];
 END;

CopyStoreIOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF IndirectOpKindDataBody ← NARROW[op.data];
 RETURN[CreateIndirectOp[store, inData.remoteOffset]];
 END;

CreateIndirectOp: PUBLIC PROCEDURE[loadStore: LoadStore, remoteOffset: CARDINAL] RETURNS[OpDescriptor] =
 BEGIN
 kind: OpKind ← IF loadStore = load THEN loadIOpKind ELSE storeIOpKind;
 data: REF IndirectOpKindDataBody ← NEW[IndirectOpKindDataBody ← [remoteOffset]];
 
 RETURN[NEW[OpDescriptorBody ← [kind, data]]];
 END;


 
TypeCheckStoreI: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF IndirectOpKindDataBody ← NARROW[op.data];
 s1: WordType;
 
 BasicNodeTypeCheck[node, 2, 0];
 [ , s1] ← TopTwoOfSeq[node.stackState];
 StoreIndirectTypeCheck[node.stackState, s1, opData.remoteOffset];
 END;

TypeCheckLoadI: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF IndirectOpKindDataBody ← NARROW[op.data];
 s0: WordType;
 
 BasicNodeTypeCheck[node, 1, 1];  
 [s0, ] ← TopTwoOfSeq[node.stackState];
 LoadIndirectTypeCheck[s0, opData.remoteOffset, node.arcs[first].stackState];
 END;
 
PrintIndirectOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
 BEGIN
 opData: REF IndirectOpKindDataBody ← NARROW[op.data];
 FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
  on.PutF["remoteOffset: %g\N", IO.card[opData.remoteOffset]];
 END;
 

-- Local Indirect Ops

LocalIndirectOpKindDataBody: TYPE = RECORD[
 localVar: CARDINAL,
 remoteOffset: CARDINAL];

loadLocalIndirectOpKind: OpKind ← NEW[OpKindBody ← ["loadLI", CopyLoadLIOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckLoadLI, PrintLocalIndirectOpDetails]];

storeLocalIndirectOpKind: OpKind ← NEW[OpKindBody ← ["storeLI", CopyStoreLIOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckStoreLI, PrintLocalIndirectOpDetails]];

CopyLoadLIOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF LocalIndirectOpKindDataBody ← NARROW[op.data];
 RETURN[CreateLocalIndirectOp[load, inData.localVar, inData.remoteOffset]];
 END;

CopyStoreLIOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF LocalIndirectOpKindDataBody ← NARROW[op.data];
 RETURN[CreateLocalIndirectOp[store, inData.localVar, inData.remoteOffset]];
 END;

CreateLocalIndirectOp: PUBLIC PROCEDURE[loadStore: LoadStore, localOffset: CARDINAL, remoteOffset: CARDINAL] RETURNS[OpDescriptor] =
 BEGIN
 kind: OpKind ← IF loadStore = load THEN loadLocalIndirectOpKind ELSE storeLocalIndirectOpKind;
 data: REF LocalIndirectOpKindDataBody ← NEW[LocalIndirectOpKindDataBody ← [localOffset, remoteOffset]];
 
 RETURN[NEW[OpDescriptorBody ← [kind, data]]];
 END;



TypeCheckLoadLI: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF LocalIndirectOpKindDataBody ← NARROW[op.data];
 pointer: WordType;
 
 BasicNodeTypeCheck[node, 0, 1]; 
 pointer ← GetWordTypeFromOffset[node.frameVarsState, opData.localVar];
 LoadIndirectTypeCheck[pointer, opData.remoteOffset, node.arcs[first].stackState];
 END;

TypeCheckStoreLI: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF LocalIndirectOpKindDataBody ← NARROW[op.data];
 pointer: WordType;
 
 BasicNodeTypeCheck[node, 1, 0]; 
 pointer ← GetWordTypeFromOffset[node.frameVarsState, opData.localVar];
 StoreIndirectTypeCheck[node.stackState, pointer, opData.remoteOffset];
 END;
   
PrintLocalIndirectOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
 BEGIN
 opData: REF LocalIndirectOpKindDataBody ← NARROW[op.data];
 FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
  on.PutF["LocalIndirect localVar: %g, remoteOffset: %g\N", IO.card[opData.localVar], IO.card[opData.remoteOffset]];
 END;


 
-- stack Ops

binOpKind: OpKind ← NEW[OpKindBody ← ["stackBinOp", CopyStackBinOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckStackBinOp, PrintStackOpDetails]];

popOpKind: OpKind ← NEW[OpKindBody ← ["popOp", CopyPopOp, NullOpInstallationRelease, NullOpInstallationRelease, NullOpGetDummyOpShape, NIL, NIL, TypeCheckStackPopOp, PrintStackOpDetails]];

StackOpKindDataBody: TYPE = RECORD[ordinaryWordType: WordType];

CopyStackBinOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF StackOpKindDataBody ← NARROW[op.data];
 RETURN[CreateBinaryOp[inData.ordinaryWordType]];
 END;

CopyPopOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
 BEGIN
 inData: REF StackOpKindDataBody ← NARROW[op.data];
 RETURN[CreatePopOp[inData.ordinaryWordType]];
 END;

CreateBinaryOp: PUBLIC PROCEDURE[ordinaryWordType: WordType] RETURNS[OpDescriptor] =
 BEGIN
 kind: OpKind ← binOpKind;
 data: REF StackOpKindDataBody ← NEW[StackOpKindDataBody ← [ordinaryWordType]];
 
 RETURN[NEW[OpDescriptorBody ← [kind, data]]];
 END;

CreatePopOp: PUBLIC PROCEDURE[ordinaryWordType: WordType] RETURNS[OpDescriptor] =
 BEGIN
 kind: OpKind ← popOpKind;
 data: REF StackOpKindDataBody ← NEW[StackOpKindDataBody ← [ordinaryWordType]];
 
 RETURN[NEW[OpDescriptorBody ← [kind, data]]];
 END;


TypeCheckStackBinOp: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF StackOpKindDataBody ← NARROW[op.data];
 
 BasicNodeTypeCheck[node, 2, 1]; 
 ArgPairTypeCheck[node.stackState, opData.ordinaryWordType, opData.ordinaryWordType];
 ResultWordTypeCheck[opData.ordinaryWordType, node.arcs[first].stackState];
 END;

TypeCheckStackPopOp: PROCEDURE[op: OpDescriptor, node: PGNode] =
 BEGIN
 opData: REF StackOpKindDataBody ← NARROW[op.data];
 
 BasicNodeTypeCheck[node, 1, 0];
 END;

PrintStackOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
 {NULL};



-- module main procedures

END.

MODULE HISTORY

Initial by: Sturgis, March 17, 1984 2:58:45 pm PST

Remark: March 19, 1984 5:18:16 pm PST: did the trivial type check on a single arc.

Remark: March 20, 1984 2:18:43 pm PST: successfully split an arc using SplitADummyArc. BeginTypeCheck succeeded.

Remark: March 21, 1984 7:24:20 pm PST: successfully split an arc adding a loop.

Remark: March 21, 1984 7:31:10 pm PST: successfully split an arc adding a branch.

Remark: April 18, 1984 9:32:35 am PST: have added the basic print code, including a print sort procedure.

Remark: April 26, 1984 1:07:16 pm PST: basic program graph stuff works, including building a table of dummy arcs. Still have to get specific about actual dragon op codes, and still have to build the type tables to allow finding fields of appropriate type.

Chang;