"{ 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

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

! !