A new IRLine pseudoinstruction added to include debugging info into the bytecode.
See IRBuilderTests for examples.
"{ 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>"
!
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: 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 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
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'!
bytecodes
^gen bytecodes
"Created: / 03-11-2008 / 09:23:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
compiledMethod
^ gen compiledMethod
"Modified: / 03-11-2008 / 09:22:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
compiledMethodUsing: aCompiledMethodClass
^ gen compiledMethodUsing: 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$'
! !