Initial revision. All tests pass.
"{ Package: 'stx:goodies/newcompiler' }"
Object subclass:#IRBuilder
instanceVariableNames:'ir tempMap jumpBackTargetStacks jumpAheadStacks currentSequence
sourceMapNodes sourceMapByteIndex'
classVariableNames:''
poolDictionaries:''
category:'NewCompiler-IR'
!
IRBuilder comment:'I provide a simple interface for constructing an IRMethod. For example, to create an ir method that compares first instVar to first arg and returns ''yes'' or ''no'' (same example as in BytecodeGenerator), do:
IRBuilder new
numRargs: 2;
addTemps: #(self a z); "rcvr, arg, & extra temp (not used here)"
pushTemp: #self;
pushInstVar: 1;
pushTemp: #a;
send: #>;
jumpAheadTo: #else if: false;
pushLiteral: ''yes'';
returnTop;
jumpAheadTarget: #else;
pushLiteral: ''no'';
returnTop;
ir
Sending #compiledMethod to an ir method will generate its compiledMethod. Sending #methodNode to it will decompile to its parse tree.
'
!
!IRBuilder class methodsFor:'instance creation'!
new
^ self basicNew initialize.
"Created: / 11-06-2008 / 00:51:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBuilder methodsFor:'accessing'!
currentSequence
^currentSequence
!
properties: aDict
ir properties: aDict
! !
!IRBuilder methodsFor:'decompiling'!
addJumpBackTarget: label to: sequence
(jumpBackTargetStacks at: label ifAbsentPut: [OrderedCollection new])
addLast: sequence
!
addTemps: newKeys
| keys i new |
keys := ir tempKeys.
i := keys size - 1. "zero-based (index 0 equals receiver)"
new := OrderedCollection new.
newKeys do: [:key |
tempMap at: key ifAbsentPut: [
new add: key.
i := i + 1]
].
ir tempKeys: keys, new.
!
testJumpAheadTarget: label
jumpAheadStacks at: label ifPresent: [:stack |
[stack isEmpty] whileFalse: [self jumpAheadTarget: label]
]
! !
!IRBuilder methodsFor:'initialize'!
addTemp: tempKey
self addTemps: {tempKey}
!
initialize
ir := IRMethod new.
tempMap := Dictionary new.
jumpAheadStacks := IdentityDictionary new.
jumpBackTargetStacks := IdentityDictionary new.
sourceMapNodes := OrderedCollection new. "stack"
"Leave an empty sequence up front (guaranteed not to be in loop)"
ir startSequence:((IRSequence new orderNumber:0) method:ir).
currentSequence := (IRSequence new orderNumber:1) method:ir.
ir startSequence add:(IRJump new destination: currentSequence)
!
numRargs: n
ir numRargs: n.
!
primitiveNode: primNode
ir primitiveNode: primNode
! !
!IRBuilder methodsFor:'instr - old blocks'!
blockReturnTop
| retInst newSequence |
retInst _ IRInstruction blockReturnTop.
self add:retInst.
newSequence _ IRSequence new orderNumber:currentSequence orderNumber +1.
newSequence method:ir.
currentSequence last isJumpOrReturn
ifFalse:[self add:(IRJump new destination:newSequence)].
currentSequence _ newSequence.
retInst successor:currentSequence
!
jumpOverBlockTo: labelSymbol
"Conditional jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self. This and its corresponding target is only good for one use. Other jumpAheadTo:... with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called."
| instr |
"jumpAheadTarget: label will pop this and replace destination with its basic block"
(jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
addLast: (instr _ self add: (IRJumpOverBlock new)).
self startNewSequence.
instr blockSequence: currentSequence.
! !
!IRBuilder methodsFor:'instructions'!
jumpAheadTarget: labelSymbol
"Pop latest jumpAheadTo: with this labelSymbol and have it point to this new instruction sequence"
| jumpInstr |
self startNewSequence.
jumpInstr := (jumpAheadStacks at: labelSymbol ifAbsent: [
self error: 'Missing jumpAheadTo: ', labelSymbol printString]) removeLast.
jumpInstr destination: currentSequence.
!
jumpAheadTo: labelSymbol
"Jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self. This is and its corresponding target is only good for one use. Other jumpAheadTo: with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called."
"jumpAheadTarget: label will pop this and replace destination with its basic block"
(jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
addLast: (self add: IRJump new).
self startNewSequence.
!
jumpAheadTo: labelSymbol if: boolean
"Conditional jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self. This and its corresponding target is only good for one use. Other jumpAheadTo:... with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called."
| instr |
"jumpAheadTarget: label will pop this and replace destination with its basic block"
(jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
addLast: (instr _ self add: (IRJumpIf new boolean: boolean)).
self startNewSequence.
instr otherwise: currentSequence.
!
jumpBackTarget: labelSymbol
"Remember this basic block for a future jumpBackTo: labelSymbol. Stack up remembered targets with same name and remove them from stack for each jumpBackTo: called with same name."
self startNewSequence.
(jumpBackTargetStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
addLast: currentSequence.
!
jumpBackTo: labelSymbol
"Pop last remembered position with this label and write an unconditional jump to it"
| sequence |
sequence _ (jumpBackTargetStacks at: labelSymbol ifAbsent: [self error: 'Missing jumpBackTarget: ', labelSymbol printString]) removeLast.
self add: (IRJump new destination: sequence).
self startNewSequence.
!
popTop
self add: IRInstruction popTop
!
pushBlock: irMethod
self add: (IRInstruction pushBlock: irMethod)
!
pushBlockMethod: irMethod
self add: (IRInstruction pushBlockMethod: irMethod)
!
pushDup
self add: IRInstruction pushDup
!
pushGlobal: object
self pushLiteralVariable: object
"Created: / 11-06-2008 / 11:21:23 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushInstVar: instVarIndex
"Receiver must be on top"
self add: (IRInstruction pushInstVar: instVarIndex).
"
self pushLiteral: instVarIndex.
self send: #privGetField:.
"
!
pushLiteral: object
self add: (IRInstruction pushLiteral: object)
!
pushLiteralVariable: object
self add: (IRInstruction pushLiteralVariable: object)
!
pushReceiver
self add: (IRInstruction pushReceiver)
!
pushTemp: key
| index |
index := tempMap at: key.
self add: (IRInstruction pushTemp: index)
!
pushThisContext
self add: (IRInstruction pushThisContext)
!
pushThisEnv
self add: (IRInstruction pushTemp: -1)
!
remoteReturn
self add: IRInstruction remoteReturn.
self startNewSequence.
!
returnTop
self add: IRInstruction returnTop.
self startNewSequence.
!
send: selector
self add: (IRInstruction send: selector)
!
send: selector toSuperOf: behavior
self add: (IRInstruction send: selector toSuperOf: behavior)
!
storeInstVar: instVarIndex
"receiver must be on top with new field value underneath"
self add: (IRInstruction storeInstVar: instVarIndex).
"self pushLiteral: instVarIndex.
self send: #privStoreIn:field:."
!
storeIntoLiteralVariable: object
self add: (IRInstruction storeIntoLiteralVariable: object)
!
storeTemp: key
| index |
index := tempMap at: key.
self add: (IRInstruction storeTemp: index)
!
storeThisEnv
self add: (IRInstruction storeTemp: -1)
! !
!IRBuilder methodsFor:'mapping'!
mapToByteIndex: index
"decompiling"
sourceMapByteIndex _ index
!
mapToNode: object
"new instructions will be associated with object"
sourceMapNodes addLast: object
!
popMap
sourceMapNodes removeLast
!
sourceByteIndex
"decompiling"
^ sourceMapByteIndex
!
sourceNode
^ sourceMapNodes isEmpty
ifTrue: [nil]
ifFalse: [sourceMapNodes last]
! !
!IRBuilder methodsFor:'private'!
add: instr
"Associate instr with current parse node or byte range"
instr sourceNode: self sourceNode.
instr bytecodeIndex: self sourceByteIndex.
^ currentSequence add: instr
!
addLiteral: aSymbol
ir addLiteral: aSymbol
!
addLiterals: aSymbol
ir addLiterals: aSymbol
!
startNewSequence
"End current instruction sequence and start a new sequence to add instructions to. If ending block just falls through to new block then add an explicit jump to it so they stay linked"
| newSequence |
currentSequence isEmpty ifTrue:[^ self]. "block is still empty, continue using it"
newSequence _ IRSequence new orderNumber:currentSequence orderNumber +1.
newSequence method:ir.
currentSequence last isJumpOrReturn
ifFalse:[self add:(IRJump new destination:newSequence)].
currentSequence _ newSequence
! !
!IRBuilder methodsFor:'results'!
ir
^ ir
! !
!IRBuilder class methodsFor:'documentation'!
version
^'$Id$'
! !