"{ Package: 'ctu:ircompiler' }"

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
    ^ '$Id$'
!

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::                                                                                                                        $'
! !