"{ 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

!

line: line

        ^ IRLine new

                line: line

    "Created: / 02-12-2008 / 08:59:56 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

new

	^super basicNew.

!

popTop

	^ IRPop new

!

pushBlock: irMethod

	^ IRConstant new

		constant: irMethod;

		type: #block

!

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 kind: #Special

    "Modified: / 30-03-2009 / 14:08:49 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

pushTemp: index kind: kind 

        ^ self pushTemp: index kind: kind level: 0

    "Created: / 30-03-2009 / 14:09:21 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

pushTemp: index kind: kind level: level

        ^ IRTempRead new

                number: index;

                kind: kind;

                level: level;

                yourself

    "Created: / 30-03-2009 / 13:58:53 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

pushThisContext

        ^IRInstruction pushTemp: -2 kind: #Special

    "Modified: / 30-03-2009 / 14:08:39 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

remoteReturn

	^ IRReturn new

		isRemote: true

!

returnTop

	^ IRReturn new

		isRemote: false

!

send: selector

	^ IRSend new

		selector: selector

!

send: selector numArgs: numArgs

        ^ IRSend new

                selector: selector;

                numArgs: numArgs

    "Created: / 01-12-2008 / 19:56:55 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

send: selector numArgs: numArgs toSuperOf: behavior

        behavior ifNil: [self error: 'super of nil does not exist'].

        ^ IRSend new

                selector: selector;

                numArgs: numArgs;

                superOf: behavior

    "Created: / 01-12-2008 / 19:57:06 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

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 kind: kind level: level

        ^ IRTempStore new

                number: index;

                kind: kind;

                level: level;

                yourself

    "Created: / 30-03-2009 / 13:59:39 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!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 compiledCode 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$'

! !