"{ Package: 'cvut: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>"
!
getGenerator
^gen
"Created: / 30-03-2009 / 23:08:34 / 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
self doPending.
gen makeBlock: irClosure
"
| meth block |
meth := irMethod compiledMethodWith: trailerBytes.
meth isBlockMethod: true.
block := meth createBlock: nil.
self addPending: (Message selector: #pushLiteral: argument: block)
"
"Modified: / 11-05-2009 / 22:13:39 / 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$'
!
version_CVS
^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTranslator.st,v 1.3 2009/10/08 12:04:47 fm Exp §'
!
version_SVN
^ '$Id:: $'
! !