--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/IRInstruction.st	Wed Jun 11 14:54:42 2008 +0000
@@ -0,0 +1,354 @@
+"{ Package: 'stx:goodies/newcompiler' }"
+
+Link subclass:#IRInstruction
+	instanceVariableNames:'sourceNode bytecodeIndex sequence'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'NewCompiler-IR'
+!
+
+IRInstruction comment:'I am an instruction in the IR (intermediate representation) language.  The IR serves as the intermediary between the Smalltalk language and the bytecode language.  It is easier to optimize and translate to/from this language than it is to optimize/translate directly from Smalltalk to bytecodes.  The IR is generic and simple consisting of just twelve instructions.  They are:

	goto: labelNum
	if: boolean goto: labelNum1 otherwise: labelNum2
	label: labelNum
	popTop
	pushDup
	pushLiteral: object
	pushBlock: irMethod
	pushBlockMethod: irMethod
	pushTemp: tempIndex
	remoteReturn
	returnTop
	send: selector
	send: selector toSuperOf: behavior
	storeTemp: tempIndex

Each instruction is reified as an instance of one of my eight subclasses and grouped by basic block (IRSequence) into an IRMethod.  IRInterpreter visits each instruction in a IRMethod responding to the above instruction messages sent to it.
'
+!
+
+
+!IRInstruction class methodsFor:'instance creation'!
+
+goto: seq
+
+	^ IRJump new
+		destination: seq
+!
+
+if: bool goto: seq1 otherwise: seq2
+
+	^ IRJumpIf new
+		boolean: bool;
+		destination: seq1;
+		otherwise: seq2
+!
+
+new
+	^super basicNew.
+!
+
+popTop
+
+	^ IRPop new
+!
+
+pushBlock: irMethod
+
+	^ IRConstant new
+		constant: irMethod;
+		type: #block
+!
+
+pushBlockMethod: irMethod
+
+	^ IRConstant new
+		constant: irMethod;
+		type: #blockMethod
+!
+
+pushDup
+
+	^ IRDup new
+!
+
+pushInstVar: index
+
+	^ IRInstVarRead new number: index.
+!
+
+pushLiteral: object
+
+	^ IRConstant new
+		constant: object
+!
+
+pushLiteralVariable: object
+
+	^ IRLiteralVariableRead new
+		association: object.
+	 
+!
+
+pushReceiver
+	^IRInstruction pushTemp: 0
+!
+
+pushTemp: index
+
+	^ IRTempRead new
+		number: index.
+!
+
+pushThisContext
+	^IRInstruction pushTemp: -2
+!
+
+remoteReturn
+
+	^ IRReturn new
+		isRemote: true
+!
+
+returnTop
+
+	^ IRReturn new
+		isRemote: false
+!
+
+send: selector
+
+	^ IRSend new
+		selector: selector
+!
+
+send: selector toSuperOf: behavior
+
+	behavior ifNil: [self error: 'super of nil does not exist'].
+	^ IRSend new
+		selector: selector;
+		superOf: behavior
+!
+
+storeInstVar: index
+
+	^ IRInstVarStore new number: index.
+	
+!
+
+storeIntoLiteralVariable: object
+
+	^ IRLiteralVariableStore new
+		association: object
+!
+
+storeTemp: index
+
+	^ IRTempStore new
+		number: index.
+! !
+
+!IRInstruction class methodsFor:'instance creation - old style blocks'!
+
+blockReturnTop
+
+	^ IRBlockReturnTop new
+		
+!
+
+jumpOverBlock: block to: cont
+	^ (IRJumpOverBlock new)
+				blockSequence: block;
+				destination: cont.
+! !
+
+!IRInstruction methodsFor:'accessing'!
+
+method
+	^sequence method.
+!
+
+sequence
+	^sequence
+!
+
+sequence: aSeq
+	sequence := aSeq
+!
+
+successorSequences
+	"sent to last instruction in sequence which is expected to be a jump and return instruction"
+
+	^ #()
+! !
+
+!IRInstruction methodsFor:'adding'!
+
+addInstructionsAfter: aCollection
+	sequence addInstructions: aCollection after: self.
+!
+
+addInstructionsBefore: aCollection
+	sequence addInstructions: aCollection before: self.
+! !
+
+!IRInstruction methodsFor:'interpret'!
+
+executeOn: interpreter
+	"Send approriate message to interpreter"
+
+	self subclassResponsibility
+! !
+
+!IRInstruction methodsFor:'mapping'!
+
+bytecodeIndex
+
+	^ bytecodeIndex
+!
+
+bytecodeIndex: index
+
+	bytecodeIndex _ index
+!
+
+bytecodeOffset
+	| startpc |
+	startpc := self method compiledMethod initialPC.
+	self bytecodeIndex ifNil: [^startpc].
+	^self bytecodeIndex + startpc - 1.
+!
+
+sourceNode
+
+	^ sourceNode
+	
+!
+
+sourceNode: parseNode
+
+	sourceNode _ parseNode
+	
+! !
+
+!IRInstruction methodsFor:'replacing'!
+
+delete
+	sequence isNil ifTrue: [self error: 'This node doesn''t have a sequence'].
+	sequence remove: self.
+!
+
+replaceNode: aNode withNode: anotherNode 
+	self error: 'I don''t store other nodes'
+!
+
+replaceWith: aNode
+	sequence isNil ifTrue: [self error: 'This node doesn''t have a sequence'].
+	sequence replaceNode: self withNode: aNode
+!
+
+replaceWithInstructions: aCollection 
+
+	sequence isNil ifTrue: [self error: 'This node doesn''t have a sequence'].
+	sequence replaceNode: self withNodes: aCollection
+! !
+
+!IRInstruction methodsFor:'testing'!
+
+isBlockReturnTop
+	^false
+!
+
+isConstant
+
+	^ false
+!
+
+isConstant: valueTest
+
+	^ false
+!
+
+isGoto
+	"is unconditional jump"
+
+	^ false
+!
+
+isIf
+
+	^ false
+!
+
+isInBlock
+	| irs |
+	irs := self method allInstructionsMatching: [:each | each isJumpOverBlock ].
+	irs detect: [:each | each blockSequence == self sequence ] ifNone: [^false].
+	^true
+!
+
+isInstVarAccess
+	^false.
+!
+
+isInstVarRead
+	^self isInstVarAccess and: [self isRead].
+!
+
+isInstVarStore
+	^self isInstVarAccess and: [self isStore].
+!
+
+isJump
+	"goto or if"
+
+	^ false
+!
+
+isJumpOrReturn
+
+	^ self isJump or: [self isReturn]
+!
+
+isJumpOverBlock
+	^false
+!
+
+isLiteralVariable
+	^false
+!
+
+isLiteralVariableAccess
+	^false
+!
+
+isLiteralVariableRead
+	^false
+!
+
+isLiteralVariableStore
+	^false
+!
+
+isPop
+
+	^ false
+!
+
+isReturn
+
+	^ false
+!
+
+isSelf
+	^false
+!
+
+isSend
+	^false.
+!
+
+isTemp
+	^false
+!
+
+isTempAccess
+	^false
+!
+
+isTempRead
+	^false
+!
+
+isTempStore
+	^false
+! !
+
+!IRInstruction class methodsFor:'documentation'!
+
+version
+    ^'$Id$'
+! !