"{ Package: 'cvut:stx/goodies/newcompiler' }"
Object subclass:#IRSequence
instanceVariableNames:'sequence orderNumber method'
classVariableNames:''
poolDictionaries:''
category:'NewCompiler-IR'
!
!IRSequence class methodsFor:'instance creation'!
new
^ self basicNew initialize.
"Created: / 11-06-2008 / 00:52:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRSequence methodsFor:'accessing'!
after: o
^sequence after: o
!
at: index
^sequence at: index
!
first
^sequence first
!
last
^sequence last
!
method
^method
!
method: aIRMethod
method := aIRMethod
!
orderNumber
"Sequences are sorted by this number"
^ orderNumber
!
orderNumber: num
"Sequences are sorted by this number"
orderNumber := num.
!
sequence
^sequence
!
size
^sequence size.
! !
!IRSequence methodsFor:'adding'!
add: anInstruction
sequence add: anInstruction.
anInstruction sequence: self.
^anInstruction.
!
add: instr after: another
sequence add: instr after: another.
instr sequence: self.
^instr.
!
add: instr before: another
sequence add: instr before: another.
instr sequence: self.
^instr.
!
addAll: aCollection
^sequence addAll: aCollection
!
addAllFirst: aCollection
^sequence addAllFirst: aCollection.
!
addInstructions: aCollection
^aCollection do: [:instr | self add: instr].
!
addInstructions: aCollection after: anInstruction
^aCollection reverseDo: [:instr | self add: instr after: anInstruction].
!
addInstructions: aCollection before: anInstruction
aCollection do: [:instr | self add: instr before: anInstruction].
!
addLast: anInstruction
^self add: anInstruction.
! !
!IRSequence methodsFor:'copying'!
, otherCollection
^sequence, otherCollection
! !
!IRSequence methodsFor:'enumerating'!
detect: aBlock
^sequence detect: aBlock
!
do: aBlock
^sequence do: aBlock.
!
reverseDo: aBlock
^sequence reverseDo: aBlock.
!
select: aBlock
^sequence select: aBlock.
! !
!IRSequence methodsFor:'initialize-release'!
initialize
sequence := OrderedCollection new.
! !
!IRSequence methodsFor:'manipulating'!
setSuccessor: suc
"find the blockReturnTops, set successor "
self withAllSuccessorsDo: [:succ | succ notEmpty ifTrue: [
| last |
last := succ last.
last isBlockReturnTop ifTrue: [
last successor: suc.
]
]].
!
splitAfter: instruction
| newSeq index next |
next := self nextSequence.
next := next
ifNil: [self orderNumber + 1]
ifNotNil: [(next orderNumber + self orderNumber) / 2].
newSeq := self class new orderNumber: next.
newSeq method: self method.
"Split after instruction"
index := sequence indexOf: instruction.
(sequence last: sequence size - index) do: [:instr | newSeq add: instr].
sequence := sequence first: index.
sequence add: (IRJump new destination: newSeq).
^ newSeq
!
splitAfterNoJump: instruction
| newSeq next index |
next := self nextSequence.
next := next
ifNil: [self orderNumber + 1]
ifNotNil: [(next orderNumber + self orderNumber) / 2].
newSeq := self class new orderNumber: next.
newSeq method: self method.
"Split after instruction"
index := sequence indexOf: instruction.
(sequence last: sequence size - index) do: [:instr | newSeq add: instr].
sequence := sequence first: index.
^ newSeq
!
tranformToBlockSequence
| last |
" fix: if last jump --> follow jumps, remove returns and add blockReturnTop on leafs."
self withAllSuccessorsDo: [:succ |
succ notEmpty ifTrue: [
last := succ last.
last isJump ifFalse: [
last isReturn ifTrue: [succ removeLast].
succ addLast: IRInstruction blockReturnTop.
]
].
succ ifEmpty: [succ addLast: IRInstruction blockReturnTop].
].
! !
!IRSequence methodsFor:'optimizing'!
absorbConstantConditionalJumps: alreadySeen
"Collapse sequences that look like:
[if] goto s1
...
s1: pushConst: true/false
goto s2
s2: if true/false goto s3 else s4
into:
[if] goto s3/s4
These sequences are produced by and:/or: messages"
| seq bool if |
(alreadySeen includes: self) ifTrue: [^ self].
alreadySeen add: self.
[(seq := self successorSequences) size > 0 "not return"
and: [(seq := seq first "destination") size = 2
and: [(seq first isConstant: [:obj | (bool := obj) isKindOf: Boolean])
and: [seq last isGoto
and: [(if := seq last destination first) isIf]]]]
] whileTrue: [ "absorb"
self last destination: (bool == if boolean
ifTrue: [if destination]
ifFalse: [if otherwise]).
].
self successorSequences do: [:instrs | instrs absorbConstantConditionalJumps: alreadySeen].
!
absorbJumpToSingleInstr: alreadySeen
"Collapse jumps to single return instructions into caller"
| seqs seq |
(alreadySeen includes: self) ifTrue: [^ self].
alreadySeen add: self.
[ (seqs := self successorSequences) size = 1 "unconditional jump..."
and: [(seq := seqs first) size = 1 "...to single instruction..."
and: [seq successorSequences size < 2
and: [self last isBlockReturnTop not]]] "...but don't collapse conditional jumps so their otherwiseSequences can stay right after them"
] whileTrue: [ "replace goto with single instruction"
self removeLast.
seq do: [:instr | self add: instr copy].
].
seqs do: [:instrs | instrs absorbJumpToSingleInstr: alreadySeen].
"Modified: / 11-06-2008 / 13:28:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
collapseSinglePredecessor: predecessorList seen: alreadySeen
| seqs seq |
(alreadySeen includes: self) ifTrue: [^ self].
alreadySeen add: self.
[(seqs := self successorSequences) size = 1
and: [(predecessorList at: (seq := seqs first) ifAbsent:[0]) = 1]
and: [seq orderNumber > self orderNumber]]
whileTrue:[
self removeLast.
seq do: [:instr | self add: instr copy]].
seqs do: [:instrs | instrs collapseSinglePredecessor: predecessorList seen: alreadySeen].
!
detectSinglePredecessor: sequencesPredecessor seen: alreadySeen
| seqs |
(alreadySeen includes: self) ifTrue: [^ self].
alreadySeen add: self.
seqs := self successorSequences.
seqs do: [:seq | sequencesPredecessor
at: seq
put: (sequencesPredecessor at: seq ifAbsent:[0]) + 1].
seqs do: [:instrs | instrs detectSinglePredecessor: sequencesPredecessor seen: alreadySeen].
! !
!IRSequence methodsFor:'printing'!
longPrintOn: stream
[IRPrinter new
indent: 0;
stream: stream;
interpretSequence: self
] onDNU: #orderNumber do: [:ex | ex resume: ex receiver]
!
printOn: stream
stream nextPutAll: 'an '.
self class printOn: stream.
stream space.
stream nextPut: $(.
self orderNumber printOn: stream.
stream nextPut: $).
! !
!IRSequence methodsFor:'removing'!
removeFirst
^sequence removeFirst.
!
removeLast
^sequence removeLast.
! !
!IRSequence methodsFor:'replacing'!
remove: aNode
aNode sequence: nil.
sequence remove: aNode ifAbsent: [self error].
!
replaceNode: aNode withNode: anotherNode
self add: anotherNode before: aNode.
sequence remove: aNode ifAbsent: [self error].
!
replaceNode: aNode withNodes: aCollection
self addInstructions: aCollection before: aNode.
sequence remove: aNode ifAbsent: [self error].
! !
!IRSequence methodsFor:'successor sequences'!
instructionsDo: aBlock
^self withAllSuccessorsDo: [:seq | seq do: aBlock].
!
nextSequence
| sequences i |
sequences := self withAllSuccessors.
i := sequences findFirst: [:seq | seq orderNumber = self orderNumber].
(i = 0 or: [i = sequences size]) ifTrue: [^ nil].
^ sequences at: i + 1
!
successorSequences
sequence isEmpty ifTrue: [^ #()].
^ sequence last successorSequences
!
withAllSuccessors
"Return me and all my successors sorted by sequence orderNumber"
| list |
list := OrderedCollection new: 20.
self withAllSuccessorsDo: [:seq | list add: seq].
^ list asSortedCollection: [:x :y | x orderNumber <= y orderNumber]
!
withAllSuccessorsDo: block
"Iterate over me and all my successors only once"
self withAllSuccessorsDo: block alreadySeen: IdentitySet new
!
withAllSuccessorsDo: block alreadySeen: set
"Iterate over me and all my successors only once"
(set includes: self) ifTrue: [^ self].
set add: self.
block value: self.
self successorSequences do: [:seq |
seq ifNotNil: [seq withAllSuccessorsDo: block alreadySeen: set]].
! !
!IRSequence methodsFor:'testing'!
ifEmpty: aBlock
^sequence ifEmpty: aBlock
!
ifNotEmpty: aBlock
^sequence ifNotEmpty: aBlock
!
isEmpty
^sequence isEmpty
!
notEmpty
^sequence notEmpty
! !
!IRSequence class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRSequence.st,v 1.3 2009/10/08 11:59:45 fm Exp $'
!
version_CVS
^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRSequence.st,v 1.3 2009/10/08 11:59:45 fm Exp $'
!
version_SVN
^ '$Id$'
! !