"{ Package: 'stx:goodies/newcompiler' }"
Object subclass:#IRMethod
instanceVariableNames:'startSequence primitiveNode tempKeys numRargs compiledMethod
properties additionalLiterals maxOrderNumber sourceMap'
classVariableNames:''
poolDictionaries:''
category:'NewCompiler-IR'
!
IRMethod comment:'I am a method in the IR (intermediate representation) language consisting of IRInstructions grouped by IRSequence (basic block). The IRSequences form a control graph (therefore I only have to hold onto the starting sequence). #compiledMethod will convert me to a CompiledMethod. #methodNode will convert me back to a parse tree.
'
!
!IRMethod class methodsFor:'instance creation'!
new
^ self basicNew initialize.
"Created: / 11-06-2008 / 00:52:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRMethod methodsFor:'accessing'!
addLiteral: aSymbol
additionalLiterals add: aSymbol.
!
addLiterals: anArray
additionalLiterals addAll: anArray.
!
addTemps: newKeys
tempKeys addAll: newKeys.
!
additionalLiterals
^additionalLiterals.
!
allInstructions
" return irNodes as a flat collection "
| irInstructions |
irInstructions := OrderedCollection new.
startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | irInstructions add: bc]].
^irInstructions
!
allInstructionsMatching: aBlock
" return irNodes as a flat collection "
| irInstructions |
irInstructions := OrderedCollection new.
startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | (aBlock value: bc) ifTrue: [irInstructions add: bc]]].
^irInstructions
!
allSendInstructions
^self allInstructionsMatching: [:bc | bc isSend].
!
allSequences
^ startSequence withAllSuccessors
!
allTempAccessInstructions
^self allInstructionsMatching: [:bc | bc isTempAccess].
!
allTempReadInstructions
^self allInstructionsMatching: [:bc | bc isTempRead].
!
allTempWriteInstructions
^self allInstructionsMatching: [:bc | bc isTempStore].
!
ir
^self.
!
method
^self.
!
numArgs
^ self numRargs - 1
!
numRargs
^ numRargs
!
primitiveNode
^ primitiveNode
!
properties
^properties
!
properties: propDict
properties := propDict.
!
startSequence
^ startSequence
!
tempKeys
^ tempKeys
!
tempNames
"All temp names in context order"
| varNames |
varNames _ OrderedCollection new.
self tempKeys do: [:var | | name |
name _ var asString.
"vars are unique but inlined to:do: loop vars may have the same name, so munge the names to make them different"
[varNames includes: name] whileTrue: [name _ name, 'X'].
varNames add: name.
].
^ varNames asArray
! !
!IRMethod methodsFor:'debugging support'!
inspector2TabIRCode
^Tools::Inspector2Tab new
label: 'IR Code';
priority: 75;
view: ((ScrollableView for:TextView) contents: self longPrintString; yourself)
"Created: / 11-06-2008 / 01:05:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRMethod methodsFor:'decompiling'!
ast
^ IRDecompiler new decompileIR: self
! !
!IRMethod methodsFor:'initialize'!
initialize
primitiveNode := PrimitiveNode primitiveNumber: 0.
tempKeys := OrderedCollection new.
properties := Dictionary new.
additionalLiterals := OrderedCollection new.
"Modified: / 11-06-2008 / 00:55:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
numRargs: n
numRargs _ n
!
primitiveNode: aPrimitiveNode
primitiveNode _ aPrimitiveNode
!
startSequence: irSequence
startSequence _ irSequence.
irSequence method: self.
!
tempKeys: objects
tempKeys _ objects
! !
!IRMethod methodsFor:'inlining'!
addInstructionsAfter: aCollection
| returningSeqs lastInstr |
aCollection ifEmpty: [^self].
returningSeqs := self allSequences select: [:each | each last isReturn].
lastInstr := returningSeqs last last.
lastInstr addInstructionsBefore: aCollection.
!
addInstructionsBefore: aCollection
(self startSequence nextSequence first) addInstructionsBefore: aCollection.
!
methodForInlining
^self removeReturnSelf removeEmptyStart.
!
removeReturn
self allSequences last removeLast.
!
removeReturnSelf
self removeReturn.
self allSequences last removeLast.
! !
!IRMethod methodsFor:'mapping'!
sourceMap
"Return a mapping from bytecode pcs to source code ranges"
| start map |
"Besides getting start position, make sure bytecodeIndices are filled in"
start _ self compiledMethod initialPC - 1.
map _ OrderedCollection new.
self allSequences do: [:seq |
seq do: [:instr | | node |
((node _ instr sourceNode) notNil and:
[node debugHighlightStart notNil and:
[node debugHighlightStop notNil and:
[instr bytecodeIndex notNil]]]) ifTrue: [
map add:
instr bytecodeIndex + start
-> (node debugHighlightStart to: node debugHighlightStop)]
]
].
^ map
! !
!IRMethod methodsFor:'optimizing'!
absorbConstantConditionalJumps
startSequence absorbConstantConditionalJumps: IdentitySet new
!
absorbJumpsToSingleInstrs
startSequence absorbJumpToSingleInstr: IdentitySet new
!
absorbSinglePredecessor
| predecessor |
startSequence
detectSinglePredecessor: (predecessor := IdentityDictionary new)
seen: IdentitySet new.
startSequence collapseSinglePredecessor: predecessor seen: IdentitySet new
!
maxOrderNumber
maxOrderNumber ifNil: [
maxOrderNumber := self startSequence orderNumber.
self startSequence withAllSuccessorsDo: [:seq | maxOrderNumber := maxOrderNumber max: seq orderNumber].
].
^ maxOrderNumber.
!
newSeq
maxOrderNumber _ self maxOrderNumber +1.
^ IRSequence new orderNumber:maxOrderNumber
!
optimize
self removeEmptyStart.
self absorbJumpsToSingleInstrs.
self absorbConstantConditionalJumps.
self absorbJumpsToSingleInstrs
!
removeEmptyStart
startSequence size = 1 ifTrue: [
"startSeq is just unconditional jump, forget it"
startSequence _ startSequence last destination].
! !
!IRMethod methodsFor:'printing'!
longPrintOn: stream
IRPrinter new
indent: 0;
stream: stream;
interpret: self
!
longPrintString
| s |
s := String new writeStream.
self longPrintOn: s.
^s contents.
"Created: / 11-06-2008 / 01:05:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRMethod methodsFor:'testing'!
isSend
^false.
! !
!IRMethod methodsFor:'translating'!
bytecodes
^ compiledMethod
ifNotNil:
[compiledMethod byteCode]
ifNil:
[IRTranslator new
interpret: self;
bytecodes]
"Created: / 03-11-2008 / 08:38:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
compiledMethod
^ compiledMethod ifNil: [self compiledMethodUsing: Method]
"Modified: / 11-06-2008 / 11:06:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
compiledMethodUsing: aCompiledMethodClass
^ compiledMethod := IRTranslator new
interpret: self;
compiledMethodUsing: aCompiledMethodClass
"Created: / 11-06-2008 / 11:06:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
literals
^(IRTranslator new
interpret: self;
literals)
"Created: / 03-11-2008 / 09:08:23 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
setCompiledMethod:aCompiledMethod
compiledMethod := aCompiledMethod
"Created: / 11-06-2008 / 11:05:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRMethod class methodsFor:'documentation'!
version
^'$Id$'
! !