"{ Package: 'stx:goodies/newcompiler' }"

IRInterpreter subclass:#IRTranslator
	instanceVariableNames:'pending gen currentInstr trailerBytes'
	classVariableNames:''
	poolDictionaries:''
	category:'NewCompiler-IR'
!

IRTranslator comment:'I interpret IRMethod instructions, sending the appropriate bytecode messages to my BytecodeGenerator (gen).  I hold some messages back in pending awaiting certain sequences of them that can be consolidated into single bytecode instructions, otherwise the pending messages are executed in order as if they were executed when they first appeared.'
!


!IRTranslator class methodsFor:'instance creation'!

new
    ^ self basicNew initialize.

    "Created: / 11-06-2008 / 09:24:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!IRTranslator methodsFor:'initialize'!

initialize

        gen := IRBytecodeGenerator new

    "Modified: / 17-09-2008 / 12:19:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
!

trailer: bytes

        trailerBytes := bytes

    "Modified: / 17-09-2008 / 12:20:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!IRTranslator methodsFor:'instructions'!

addLiteral: literal
	gen addLiteral: literal.
!

blockReturnTop

	self doPending.
	gen blockReturnTop.
!

goto: seqNum

	self doPending.
	gen goto: seqNum.
!

if: bool goto: seqNum1 otherwise: seqNum2

	self doPending.
	gen if: bool goto: seqNum1 otherwise: seqNum2.
!

jumpOverBlock:  blockNum to: seqNum

	self doPending.
	gen jumpOverBlock: seqNum.
!

label: seqNum

        pending := OrderedCollection new.
        gen label: seqNum.

    "Modified: / 11-06-2008 / 10:13:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
!

popTop

	"if last was storeTemp,  storeInstVar storeIntoLiteralVariable then convert to storePopTemp, storePopInstVar storePopIntoLiteralVariable"
	#storeTemp: == self pendingSelector ifTrue: [
		^ self pendingSelector: #storePopTemp:].
	#storeInstVar: == self pendingSelector ifTrue: [
		^ self pendingSelector: #storePopInstVar:].
	#storeIntoLiteralVariable: == self pendingSelector ifTrue:[
		^self pendingSelector: #storePopIntoLiteralVariable:].
	"otherwise do normal pop"
	self doPending.
	gen popTop.
!

pushBlock: irMethod

        | meth block |
        meth := irMethod compiledMethodWith: trailerBytes.
        meth isBlockMethod: true.
        block := meth createBlock: nil.
        self addPending: (Message selector: #pushLiteral: argument: block)

    "Modified: / 17-09-2008 / 12:19:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
!

pushBlockMethod: irMethod

	| meth |
	meth _ irMethod compiledMethodWith: trailerBytes.
	meth isBlockMethod: true.
	self addPending: (Message selector: #pushLiteral: argument: meth)
!

pushDup

	self doPending.
	gen pushDup.
!

pushInstVar: index

	"self doPending.
	gen pushInstVar: index."
	self addPending: (Message selector: #pushInstVar: argument: index)
!

pushLiteral: object

	self addPending: (Message selector: #pushLiteral: argument: object)
!

pushLiteralVariable: object

	self addPending: (Message selector: #pushLiteralVariable: argument: object)
!

pushTemp: index

	index = 0 ifTrue: [^ self addPending: (Message selector: #pushReceiver)].

	(self pendingMatches: {
		[:m | m selector == #storePopTemp: and: [m argument = index]]}
		) ifTrue: [^ self pendingSelector: #storeTemp:].

	self doPending.

	index = -2 ifTrue: [^ gen pushThisContext].
	index = -1 ifTrue: [
		^ gen pushThisContext;
			pushLiteral: MethodContext myEnvFieldIndex;
			send: #privGetInstVar:].

	gen pushTemp: index.
!

remoteReturn

	self doPending.
	gen remoteReturn.
!

returnTop

	#pushReceiver == self pendingSelector ifTrue: [
		self pendingSelector: #returnReceiver.
		^ self doPending
	].
	#pushLiteral: == self pendingSelector ifTrue: [
		self pendingSelector: #returnConstant:.
		^ self doPending
	].
	#pushInstVar: == self pendingSelector ifTrue: [
		self pendingSelector: #returnInstVar:.
		^ self doPending
	].
	self doPending.
	gen returnTop.
!

send: selector

	"If get/set inst var, access it directly"
	| index |
	
	((#(privGetInstVar: #privStoreIn:instVar:) identityIncludes: selector) and:
	 [self pendingMatches: {
		[:m | m selector == #pushReceiver].
		[:m | m selector == #pushLiteral: and: [m argument isInteger]]}]
	) ifTrue: [
		index _ self popPending argument.
		self popPending.  "pop pushReceiver"
		self addPending: (Message
			selector: (selector == #privGetInstVar:
				ifTrue: [#pushInstVar:] ifFalse: [#storeInstVar:])
			argument: index).
		(self pendingMatches: {
			[:m | m selector == #storePopInstVar: and: [m argument = index]].
			[:m | m selector == #pushInstVar: and: [m argument = index]]}
		) ifTrue: [
			self popPending.
			self pendingSelector: #storeInstVar:.
		].
		^ self
	].
	"otherwise do normal send"
	self doPending.
	gen send: selector.
!

send: selector toSuperOf: behavior

	self doPending.
	gen send: selector toSuperOf: behavior.
!

storeInstVar: index 
	"self doPending.
	gen storeInstVar: index"
	self addPending: (Message selector: #storeInstVar: argument: index)
!

storeIntoLiteralVariable: assoc

	"self doPending.
	gen storeIntoLiteralVariable: assoc."
	
	self addPending: (Message selector: #storeIntoLiteralVariable: argument: assoc)
!

storeTemp: index

	index = -1 "thisEnv" ifTrue: [
		self doPending.
		^ gen pushThisContext;
			pushLiteral: MethodContext myEnvFieldIndex;
			send: #privStoreIn:instVar:].

	self addPending: (Message selector: #storeTemp: argument: index)
! !

!IRTranslator methodsFor:'interpret'!

interpret: ir

	ir optimize.
	gen primitiveNode: ir primitiveNode.
	gen numArgs: ir numArgs.
	gen properties: ir properties.
	ir additionalLiterals do: [:lit | gen addLiteral: lit].
	super interpret: ir.
!

interpretAll: irSequences

	irSequences withIndexDo: [:seq :i | seq orderNumber: i].
	super interpretAll: irSequences.
!

interpretInstruction: irInstruction

        currentInstr := irInstruction.
        super interpretInstruction: irInstruction.

    "Modified: / 11-06-2008 / 09:20:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!IRTranslator methodsFor:'priv pending'!

addPending: message

	pending addLast: currentInstr -> message
!

doPending
	"execute pending instructions"

	| assoc |
	[pending isEmpty] whileFalse: [
		assoc _ pending removeFirst.
		gen mapBytesTo: assoc key "instr".
		assoc value "message" sendTo: gen.
	].
	gen mapBytesTo: currentInstr.
!

pendingMatches: blocks
	"Return true if each message at end of pending list satisfies its corresponding block.  The number of elements tested equals the number of blocks.  If not enough elements return false"

	| messages i |
	messages _ pending collect: [:assoc | assoc value].
	blocks size > messages size ifTrue: [^ false].
	i _ messages size - blocks size.
	blocks do: [:b |
		(b value: (messages at: (i _ i + 1))) ifFalse: [^ false].
	].
	^ true
!

pendingSelector

	pending isEmpty ifTrue: [^ nil].
	^ pending last value "message" selector
!

pendingSelector: selector

	pending last value "message" setSelector: selector
!

popPending

	^ pending removeLast value "message"
! !

!IRTranslator methodsFor:'results'!

compiledMethod

	^ gen compiledMethodWith: trailerBytes
!

compiledMethodUsing: aCompiledMethodClass

        ^ gen compiledMethodUsing: aCompiledMethodClass

    "Modified: / 17-09-2008 / 12:18:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
!

compiledMethodWith: trailer

	^ gen compiledMethodWith: trailer
!

compiledMethodWith: trailer using: aCompiledMethodClass

	^ gen compiledMethodWith: trailer using: aCompiledMethodClass
! !

!IRTranslator class methodsFor:'documentation'!

version
    ^'$Id$'
! !