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

IRInterpreter subclass:#IRTranslator

	instanceVariableNames:'pending gen currentInstr'

	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:'accessing'!

getCode

    ^gen getCode

    "Created: / 30-03-2009 / 19:08:21 / 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>"

! !

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

!

line: line

        self doPending.

        gen line: line

    "Created: / 02-12-2008 / 09:01:47 / 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: irClosure

    gen makeBlock: irClosure

    "

        | meth block |

        meth := irMethod compiledMethodWith: trailerBytes.

        meth isBlockMethod: true.

        block := meth createBlock: nil.

        self addPending: (Message selector: #pushLiteral: argument: block)

    "

    "Modified: / 30-03-2009 / 18:15:29 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

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

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

        (self pendingMatches: (Array with:

                [:m | m selector == #storePopTemp: and: [m argument = index]])

                ) ifTrue: [^ self pendingSelector: #storeTemp:].

        self doPending.

        index = -2 ifTrue: [^ gen pushThisContext].

        index = -1 ifTrue: [

                self halt:'Not supported'

                "

                ^ gen pushThisContext;

                        pushLiteral: MethodContext myEnvFieldIndex;

                        send: #privGetInstVar:"].

        "Bad bad bad!! Type switch"

        kind == #MArg ifTrue:[^gen pushMethodArg: index].

        kind == #MVar ifTrue:[^gen pushMethodVar: index].

        kind == #BArg ifTrue:[^gen pushBlockArg: index].

        kind == #BVar ifTrue:[^gen pushBlockVar: index].

        self halt:'Should never be reached'.

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

    "Modified: / 30-03-2009 / 19:02:32 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

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 numArgs: numArgs

        "If get/set inst var, access it directly"

        | index |

        ((#(privGetInstVar: #privStoreIn:instVar:) identityIncludes: selector) and:

         [self pendingMatches: (Array 

                with:[:m | m selector == #pushReceiver]

                with:[: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: (Array

                        with:[:m | m selector == #storePopInstVar: and: [m argument = index]]

                        with:[:m | m selector == #pushInstVar: and: [m argument = index]])

                ) ifTrue: [

                        self popPending.

                        self pendingSelector: #storeInstVar:.

                ].

                ^ self

        ].

        "otherwise do normal send"

        self doPending.

        gen send: selector numArgs: numArgs

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

!

send: selector numArgs: numArgs toSuperOf: behavior

        self doPending.

        gen send: selector numArgs: numArgs toSuperOf: behavior.

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

!

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

        index = -1 "thisEnv" ifTrue: [

                self halt:'Not supported'

                "

                self doPending.

                ^ gen pushThisContext;

                        pushLiteral: MethodContext myEnvFieldIndex;

                        send: #privStoreIn:instVar:"].

    kind == #MArg ifTrue:[^self error:'Cannot store to method argument!!'].

    kind == #MVar ifTrue:[^self addPending: (Message selector: #storeMethodVar: argument: index)].

    kind == #BArg ifTrue:[^self addPending: (Message selector: #storeBlockArg: argument: index)].

    kind == #BVar ifTrue:[^self addPending: (Message selector: #storeBlockVar: argument: index)].

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

    "Modified: / 30-03-2009 / 19:03:21 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!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.

    "Modified: / 28-03-2009 / 20:33:26 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

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

bytecodes

    ^gen bytecodes

    "Created: / 03-11-2008 / 09:23:01 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

compiledCodeUsing:aCompiledMethodClass 

    ^ gen compiledCodeUsing:aCompiledMethodClass

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

!

literals

    ^gen literals

    "Created: / 03-11-2008 / 09:23:08 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!IRTranslator class methodsFor:'documentation'!

version

    ^'$Id$'

! !