--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;

�ÊC˜JšË
œ¡Ïbœ§
� œº�
œÁ�œ—
�œ��œž�œx�œv�œy�œP�œµ� œð
�
œË�œ…�
œ¶�œ†�œ��œ¸
�œ…
�œQ�œ^�
œc�œ¨�œb�œn�œ�
�œ™
�
œ_�
œá�œé�œ¦�œÒ
�œÒ�œä�œý�œÐ�œ¤�
œÖ�œþ�œê
�œ¦�œâ�œ·	�œê	�œñ�œ�œ®
�œS�œø�œô�œL�œR�œÈ
�œë�œà�
œ�œ.�œÄ
�œÒ�œá
�œï
�œ]�	œ�œ(�œ·
�œ´
�œ§
�œ¨
�
œ¶�œ—�œƒ�œ…�œ�œ,�œ·
�œº
�œ±
�œ²
�œ·�œ‘�œž�œ‘�œ�œí�œÌ
�
œÍ
�œü�œË�œÃ�œÏ�	œ�	œ¿
�	œµ
�œ.�œª
�	œ§
�œò
�œó
�œ¶�œ“
�œv˜�ÍJ˜JšÏkœ
˜Jšžœ
ž˜J˜Jš
œ4˜4J˜RJ˜qJ˜OJ˜QJ˜iJ˜€J˜J˜J˜—…—©º¬