Tests moved to separate subpackage to follow St/X conventions.
"{ Package: 'ctu:ircompiler' }"
Object subclass:#IRBuilder
instanceVariableNames:'ir jumpBackTargetStacks jumpAheadStacks currentSequence
sourceMapNodes sourceMapByteIndex lastLine'
classVariableNames:''
poolDictionaries:''
category:'IR Compiler-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'!
for: anIRFunction
^ self basicNew initializeFor: anIRFunction.
"Created: / 30-03-2009 / 18:28:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
forClosure
^ self basicNew initializeFor: IRClosure new.
"Created: / 30-03-2009 / 18:28:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
forMethod
^ self basicNew initializeFor: IRMethod new.
"Created: / 30-03-2009 / 18:28:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
new
^ self forMethod
"Created: / 11-06-2008 / 00:51:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 30-03-2009 / 18:28:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
numRargs: numRargs tempNames: tempNames
^ self forMethod
numRargs: numRargs;
addTemps: tempNames;
yourself
"Created: / 17-08-2009 / 14:19:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBuilder methodsFor:'accessing'!
closureBuilder
^IRBuilder forClosure
environmentIr: ir;
yourself
"Created: / 30-03-2009 / 18:29:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
currentSequence
^currentSequence
!
environmentIr: anIRFunction
ir environmentIr: anIRFunction
"Created: / 30-03-2009 / 18:30:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
properties: aDict
ir properties: aDict
! !
!IRBuilder methodsFor:'decompiling'!
addJumpBackTarget: label to: sequence
(jumpBackTargetStacks at: label ifAbsentPut: [OrderedCollection new])
addLast: sequence
!
addTemps: newKeys
ir addTemps: newKeys
"Modified: / 30-03-2009 / 11:15:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testJumpAheadTarget: label
jumpAheadStacks at: label ifPresent: [:stack |
[stack isEmpty] whileFalse: [self jumpAheadTarget: label]
]
! !
!IRBuilder methodsFor:'initialize'!
addTemp: tempKey
self addTemps: {tempKey}
!
initialize
^self initializeFor: IRMethod new.
"Modified: / 30-03-2009 / 18:27:31 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
initializeFor: anIRFunction
ir := anIRFunction.
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)
"Created: / 30-03-2009 / 18:27:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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"
| jumpInstrs |
self startNewSequence.
jumpInstrs := (jumpAheadStacks at: labelSymbol ifAbsent: [
self error: 'Missing jumpAheadTo: ', labelSymbol printString]).
jumpInstrs do:[:jumpInstr | jumpInstr destination: currentSequence].
jumpInstrs removeLast.
"Modified: / 03-11-2008 / 12:00:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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.
!
line:line
lastLine ~= line ifTrue:
[self add:(IRInstruction line:line).
lastLine := line].
"Modified: / 12-05-2009 / 16:11:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
popTop
self add: IRInstruction popTop
!
pushBlock: irClosure
self
assert: irClosure isIRClosure
message: 'Argument must be an instance of irClosure'.
self add: (IRInstruction pushBlock: irClosure)
"Modified: / 30-03-2009 / 16:49:07 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushBlockUsingBuilder: oneArgBlock
| closureBuilder |
closureBuilder := self closureBuilder.
oneArgBlock value: closureBuilder.
^self pushBlock: closureBuilder ir
"Created: / 30-03-2009 / 18:32:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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
self add: (ir pushTemp: key in: ir level: 0)
"Modified: / 30-03-2009 / 12:00:08 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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 numArgs: numArgs
self add: (IRInstruction send: selector numArgs: numArgs)
"Created: / 01-12-2008 / 19:56:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
send: selector numArgs: numArgs toSuperOf: behavior
self add: (IRInstruction send: selector numArgs: numArgs toSuperOf: behavior)
"Created: / 01-12-2008 / 19:56:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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
self add: (ir storeTemp: key in: ir level: 0)
"Modified: / 30-03-2009 / 12:00:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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
"Modified: / 28-03-2009 / 21:01:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBuilder class methodsFor:'documentation'!
version_CVS
^ '$eader: /cvs/stx/cvut/stx/goodies/newcompiler/IRBuilder.st,v 1.3 2009/10/08 11:57:58 fm Exp$'
!
version_SVN
^ '$Id:: $'
! !