diff --git a/src/Tinyrossa-POWER/TRPPC64PSABILinkage.class.st b/src/Tinyrossa-POWER/TRPPC64PSABILinkage.class.st index 923a471..75d9b8a 100644 --- a/src/Tinyrossa-POWER/TRPPC64PSABILinkage.class.st +++ b/src/Tinyrossa-POWER/TRPPC64PSABILinkage.class.st @@ -43,7 +43,7 @@ TRPPC64PSABILinkage class >> initialize [ { #category : #accessing } TRPPC64PSABILinkage >> allocatableRegisters [ - ^ self preservedRegisters reversed + ^ self preservedRegisters reversed , self parameterRegisters reversed ] { #category : #'code generation' } diff --git a/src/Tinyrossa-RISCV/TRRV64GCodeEvaluator.class.st b/src/Tinyrossa-RISCV/TRRV64GCodeEvaluator.class.st index b79276b..dbcfc10 100644 --- a/src/Tinyrossa-RISCV/TRRV64GCodeEvaluator.class.st +++ b/src/Tinyrossa-RISCV/TRRV64GCodeEvaluator.class.st @@ -88,20 +88,45 @@ TRRV64GCodeEvaluator >> commonMul: node [ ] ifFalse:[ child2 constant == -1 ifTrue:[ dstReg := self codegen allocateRegister. - generate sub: dstReg, zero, src1Reg - ]]]. + generate sub: dstReg, zero, src1Reg + ]]]. ] ifFalse:[ - src2Reg := self evaluate: child2. + src2Reg := self evaluate: child2. dstReg := self codegen allocateRegister. - node type == Int64 ifTrue:[ - generate mul: dstReg, src1Reg , src2Reg - ] ifFalse:[ - generate mulw: dstReg, src1Reg , src2Reg - ]. + + codegen compilation config stressRA ifTrue: [ + "User requested to put more stress on RA (presumably for + RA debugging purposes). + + So here we force argument and return value to be in + certain real register." + + | real insn deps | + + real := t0. + deps := TRRegisterDependencies new. + deps pre addDependency: src1Reg on: real. + deps post addDependency: dstReg on: real. + + node type == Int64 ifTrue:[ + insn := generate mul: real, real , src2Reg + ] ifFalse:[ + insn := generate mulw: real, real , src2Reg + ]. + insn dependencies: deps. + ] ifFalse: [ + node type == Int64 ifTrue:[ + generate mul: dstReg, src1Reg , src2Reg + ] ifFalse:[ + generate mulw: dstReg, src1Reg , src2Reg + ]. + ]. + + + ]. ^dstReg - ] { #category : #'evaluation-helpers' } diff --git a/src/Tinyrossa-RISCV/TRRV64GCodeGenerator.class.st b/src/Tinyrossa-RISCV/TRRV64GCodeGenerator.class.st index fffa629..13543b6 100644 --- a/src/Tinyrossa-RISCV/TRRV64GCodeGenerator.class.st +++ b/src/Tinyrossa-RISCV/TRRV64GCodeGenerator.class.st @@ -128,6 +128,7 @@ TRRV64GCodeGenerator >> registerLoad: reg from: sym [ self assert: reg isTRRegister. self assert: sym isTRAutomaticSymbol. + self assert: sym useCount > 0. self assert: sym type == Address. offset := AcDSLSymbol value: sym name. @@ -140,6 +141,7 @@ TRRV64GCodeGenerator >> registerStore: reg to: sym [ self assert: reg isTRRegister. self assert: sym isTRAutomaticSymbol. + self assert: sym useCount > 0. self assert: sym type == Address. offset := AcDSLSymbol value: sym name. diff --git a/src/Tinyrossa-RISCV/TRRV64GPSABILinkage.class.st b/src/Tinyrossa-RISCV/TRRV64GPSABILinkage.class.st index 43980cb..bc3aecd 100644 --- a/src/Tinyrossa-RISCV/TRRV64GPSABILinkage.class.st +++ b/src/Tinyrossa-RISCV/TRRV64GPSABILinkage.class.st @@ -26,13 +26,13 @@ TRRV64GPSABILinkage >> allocatableRegisters [ over preserved registers. This might save us a need to spill / reload (preserved) registers in prologue / epilogue for small methods." - ^ self volatileRegisters , self preservedRegisters + ^ self volatileRegisters , (self parameterRegisters reversed) , self preservedRegisters ] ifFalse:[ "For non-leaf methods we prefer preserved registers over volatile registers. This might save us a need to spill / reload (volatile) registers at call instructions for small functions." - ^ self preservedRegisters , self volatileRegisters + ^ self preservedRegisters , self volatileRegisters , (self parameterRegisters reversed) ] ] diff --git a/src/Tinyrossa-Tests/TRCompilationTestCase.class.st b/src/Tinyrossa-Tests/TRCompilationTestCase.class.st index e6aaa3f..971dd2b 100644 --- a/src/Tinyrossa-Tests/TRCompilationTestCase.class.st +++ b/src/Tinyrossa-Tests/TRCompilationTestCase.class.st @@ -57,7 +57,8 @@ TRCompilationTestCase >> int64Values [ { #category : #accessing } TRCompilationTestCase >> parametersIterator [ ^ super parametersIterator , - (self parameter: #target values: { self target }) + (self parameter: #target values: { self target }), + (self parameter: #stressRA values: { true . false }) ] { #category : #running } @@ -67,6 +68,7 @@ TRCompilationTestCase >> setUp [ target := testParameters at:#target. compilation := TRCompilation forTarget: target. + compilation config stressRA: (testParameters at: #stressRA). shell := TRCompilationTestShell forCompilation: compilation. ] diff --git a/src/Tinyrossa/TRMemoryReference.class.st b/src/Tinyrossa/TRMemoryReference.class.st new file mode 100644 index 0000000..93e3562 --- /dev/null +++ b/src/Tinyrossa/TRMemoryReference.class.st @@ -0,0 +1,5 @@ +Class { + #name : #TRMemoryReference, + #superclass : #AcDSLMemRef, + #category : #'Tinyrossa-Codegen' +} diff --git a/src/Tinyrossa/TRRealRegister.class.st b/src/Tinyrossa/TRRealRegister.class.st index 138221b..9dcc74a 100644 --- a/src/Tinyrossa/TRRealRegister.class.st +++ b/src/Tinyrossa/TRRealRegister.class.st @@ -17,6 +17,16 @@ TRRealRegister class >> value: value kind: kind [ ^ self basicNew initializeWithValue: value kind: kind ] +{ #category : #arithmetic } +TRRealRegister >> + offset [ + ^ TRMemoryReference base: self offset: offset asAcDSLOperand +] + +{ #category : #arithmetic } +TRRealRegister >> - offset [ + ^ TRMemoryReference base: self offset: offset negated asAcDSLOperand +] + { #category : #accessing } TRRealRegister >> allocation [ ^ self diff --git a/src/Tinyrossa/TRRegisterDependency.class.st b/src/Tinyrossa/TRRegisterDependency.class.st index 6b37039..bb9629a 100644 --- a/src/Tinyrossa/TRRegisterDependency.class.st +++ b/src/Tinyrossa/TRRegisterDependency.class.st @@ -32,13 +32,22 @@ TRRegisterDependency >> initializeWithVirtual: aTRVirtualRegister real: aTRRealR ] { #category : #testing } -TRRegisterDependency >> isDependency [ - ^ vreg notNil +TRRegisterDependency >> isTrash [ + ^ vreg isNil ] { #category : #testing } -TRRegisterDependency >> isTrash [ - ^ vreg isNil +TRRegisterDependency >> isUnsatisfiedDependency [ + "Return true, if + (1) this dependency express dependency on + real register (a value of virtual register has to be + in specified real register) + AND + (ii) this dependecy is not satisfied, that is + the virtual register is allocated a different register + than required real register" + + ^ vreg notNil and: [ vreg allocation ~~ rreg ] ] { #category : #'printing & storing' } diff --git a/src/Tinyrossa/TRRegisterLiveInterval.class.st b/src/Tinyrossa/TRRegisterLiveInterval.class.st index 96675aa..269eabe 100644 --- a/src/Tinyrossa/TRRegisterLiveInterval.class.st +++ b/src/Tinyrossa/TRRegisterLiveInterval.class.st @@ -1,8 +1,16 @@ " -`TRRegisterLiveInterval` is a helper structure used by -(reverse) linear scan allocators. It keeps information -required by the allocator as it progresses and allocates -registers. +`TRRegisterLiveInterval` represent (virtual) register live interval. + +For given (virtual) register it keeps track of all def positions +(i.e., positions where a register was written to) and use positions +(i.e., positions where register value was read). It also knows +spill slot, if any. + +Internally, def and use positions are kept in single ordered +`uses` array where + + * each def position `d` is encoded as `(d * 2) + 1` and + * each use position `u` is encoded as `(u * 2)` " Class { @@ -10,9 +18,7 @@ Class { #superclass : #Object, #instVars : [ 'register', - 'start', - 'stop', - 'spilled', + 'uses', 'spillSlot' ], #category : #'Tinyrossa-Codegen-Register Allocation' @@ -28,14 +34,153 @@ TRRegisterLiveInterval class >> new [ ^ self shouldNotImplement. "Use #forRegister: instead" ] +{ #category : #private } +TRRegisterLiveInterval >> decodePosition: encodedPosition [ + ^ encodedPosition // 2 +] + +{ #category : #utilities } +TRRegisterLiveInterval >> defdAt: position [ + | positionEncoding | + + self assert: position isInteger. + + positionEncoding := self encodeDefPosition: position. + uses isEmpty ifTrue: [ + uses := Array with: positionEncoding. + ] ifFalse: [ + (uses includes: positionEncoding) ifFalse: [ + uses := (uses copyWith: positionEncoding) sort. + ]. + ]. +] + +{ #category : #enumerating } +TRRegisterLiveInterval >> defdDo: aBlock [ + "Evaluate `aBlock` for each instruction index where this virtual + registers is defined." + + uses do: [:i | + (self encodesDefPosition: i) ifTrue: [ + aBlock value: (self decodePosition: i) + ]. + ]. +] + +{ #category : #private } +TRRegisterLiveInterval >> encodeDefPosition: position [ + ^ (position * 2) + 1 +] + +{ #category : #private } +TRRegisterLiveInterval >> encodeUsePosition: position [ + ^ (position * 2) +] + +{ #category : #private } +TRRegisterLiveInterval >> encodesDefPosition: encodedPosition [ + ^ encodedPosition odd. +] + +{ #category : #private } +TRRegisterLiveInterval >> encodesUsePosition: encodedPosition [ + ^ encodedPosition even. +] + +{ #category : #accessing } +TRRegisterLiveInterval >> firstDef [ + "Return the first def position for this interval." + + uses do: [:encodedPosition | + (self encodesDefPosition: encodedPosition) ifTrue: [ + ^ self decodePosition: encodedPosition + ]. + ]. + ^ nil +] + { #category : #initialization } TRRegisterLiveInterval >> initializeWithRegister: aTRVirtualRegister [ self assert: aTRVirtualRegister isTRVirtualRegister. register := aTRVirtualRegister. - start := SmallInteger maxVal. - stop := 0. - spilled := false. + uses := #(). +] + +{ #category : #testing } +TRRegisterLiveInterval >> isDefdAt: position [ + | positionEncoding | + + positionEncoding := self encodeDefPosition: position. + ^ uses includes: positionEncoding. +] + +{ #category : #testing } +TRRegisterLiveInterval >> isDefdOrUsedAt: position [ + ^ (self isDefdAt: position) or: [ self isUsedAt: position ] +] + +{ #category : #testing } +TRRegisterLiveInterval >> isUsedAt: position [ + | positionEncoding | + + positionEncoding := self encodeUsePosition: position. + ^ uses includes: positionEncoding. +] + +{ #category : #accessing } +TRRegisterLiveInterval >> lastDef [ + "Return the last def position for this interval." + + uses reverseDo: [:encodedPosition | + (self encodesDefPosition: encodedPosition) ifTrue: [ + ^ self decodePosition: encodedPosition + ]. + ]. + ^ nil +] + +{ #category : #accessing } +TRRegisterLiveInterval >> lastUse [ + "Return the last use position for this interval." + + uses reverseDo: [:encodedPosition | + (self encodesUsePosition: encodedPosition) ifTrue: [ + ^ self decodePosition: encodedPosition + ]. + ]. + ^ nil +] + +{ #category : #accessing } +TRRegisterLiveInterval >> lastUseOrDefBefore: position [ + "Return the last use position for this interval smaller than `position`" + + | encodedPosition | + + encodedPosition := self encodeUsePosition: position. + uses reverseDo: [ :i | + i < encodedPosition ifTrue: [ + ^ self decodePosition: i. + ]. + ]. + ^ nil. +] + +{ #category : #accessing } +TRRegisterLiveInterval >> length [ + ^ self stop - self start + 1 +] + +{ #category : #queries } +TRRegisterLiveInterval >> needsToBeSpilledAt: position [ + ^ spillSlot notNil and: [ position = self lastDef ] +] + +{ #category : #queries } +TRRegisterLiveInterval >> needsToBeSpilled [ + "Return true, if this interval (register) has to be spilled after its definition" + ^ spillSlot notNil ] { #category : #'printing & storing' } @@ -45,10 +190,16 @@ TRRegisterLiveInterval >> printOn:aStream [ super printOn:aStream. aStream nextPut: $(. aStream nextPutAll: register name. + register allocation isNil ifTrue: [ + aStream nextPutAll:', *'. + ] ifFalse: [ + aStream nextPutAll:', '. + aStream nextPutAll: register allocation name. + ]. aStream nextPutAll:', <'. - start printOn:aStream. + self start printOn:aStream. aStream nextPutAll:', '. - stop printOn:aStream. + self stop printOn:aStream. aStream nextPutAll:'>)'. ] @@ -64,44 +215,46 @@ TRRegisterLiveInterval >> spillSlot [ { #category : #accessing } TRRegisterLiveInterval >> spillSlot: aTRAutomaticSymbol [ - self assert: aTRAutomaticSymbol isTRAutomaticSymbol. - self assert: spillSlot isNil. + self assert: (aTRAutomaticSymbol isTRAutomaticSymbol and: [spillSlot isNil]) + | (aTRAutomaticSymbol isNil and: [spillSlot isTRAutomaticSymbol]). spillSlot := aTRAutomaticSymbol. ] -{ #category : #accessing } -TRRegisterLiveInterval >> spilled [ - ^ spilled -] - -{ #category : #accessing } -TRRegisterLiveInterval >> spilled: aBoolean [ - self assert: aBoolean = spilled not. - self assert: spillSlot isTRAutomaticSymbol. - - spilled := aBoolean. - spilled ifTrue: [ - spillSlot incUseCount. - ]. -] - { #category : #accessing } TRRegisterLiveInterval >> start [ - ^ start + ^ self decodePosition: uses first ] { #category : #accessing } TRRegisterLiveInterval >> stop [ - ^ stop + ^ self decodePosition: uses last ] { #category : #utilities } -TRRegisterLiveInterval >> used: anInteger [ - anInteger < start ifTrue:[ - start := anInteger. - ]. - anInteger > stop ifTrue: [ - stop := anInteger. +TRRegisterLiveInterval >> usedAt: position [ + | positionEncoding | + + self assert: position isInteger. + + positionEncoding := self encodeUsePosition: position. + uses isEmpty ifTrue: [ + uses := Array with: positionEncoding. + ] ifFalse: [ + (uses includes: positionEncoding) ifFalse: [ + uses := (uses copyWith: positionEncoding) sort. + ]. ]. ] + +{ #category : #enumerating } +TRRegisterLiveInterval >> usedDo: aBlock [ + "Evaluate `aBlock` for each instruction index where this virtual + registers is used (read)." + + uses do: [:i | + (self encodesUsePosition: i) ifTrue: [ + aBlock value: (self decodePosition: i) + ]. + ]. +] diff --git a/src/Tinyrossa/TRReverseLinearScanRegisterAllocator.class.st b/src/Tinyrossa/TRReverseLinearScanRegisterAllocator.class.st index d92c213..67664fe 100644 --- a/src/Tinyrossa/TRReverseLinearScanRegisterAllocator.class.st +++ b/src/Tinyrossa/TRReverseLinearScanRegisterAllocator.class.st @@ -1,9 +1,48 @@ " `TRReverseLinearScanRegisterAllocator` is the default allocator used in Tinyrossa. -It's straightforward reimplementation from original 1999 paper [1] with one -small change: the allocation progresses in reverse order. That is, from last -instruction towards first one. +It is a more or less straightforward reimplementation from original 1999 paper +[1] with few changes. + +First, as name suggests, allocation progresses backwards, from the last +instruction in sequence towards the first. This way, we can insert more +instructions in already processed part without a need to update indexes. +Second, the way it implements spilling is more along the lines of [2]. + +# Spilling and reloading + +Each interval one more 'defined position' (or 'defd pos') and +zero or more `used positions` (no use position of an interval might be +a result of interval splitting, see below). + +When there's no free register (`#pickRegister` fails) then one live +interval is chosen (`#pickSplit:`) and split (`#splitRegister:at:`). +If interval is split between first 'def position' and following 'use position' +the new interval has no 'use positions' and spans only one instruction. + +When an interval is split into two intervals, they're both assigned +same spill slot. The value is spilled at closest prior def position +and reloaded at split position (see `#splitRegister:at:`) + +# Satisfying dependencies + +Dependencies are satisfied by interval splitting too: + + * Intervals allocated to thrashed registers are split at instruction + that thrashes them, this forces spill and reload. + + * Unsatisfied post-dependencies are solved by moving the value + to required real register. If that real register is already + allocated to some other interval, that interval is split which + makes it free (and therefore value can be freely moved there). + + * Unsatisfied pre-dependencies on currently allocated real registers + are trickier and solved by either re-allocating the conflicting + interval to a free register (if any) or swapping allocations + or splitting. For details, see comments in relevant part of + allocateRegistersAt: + +--- Note that there's no need to deal with virtual registers being used across basic block boundary - in Tinyrossa (as well as in Testarossa), the only way @@ -13,13 +52,16 @@ to transfer value from one (extended) block to another is via `?store` and [1]: MASSIMILIANO POLETTO and VIVEK SARKAR: Linear Scan Register Allocation http://web.cs.ucla.edu/~palsberg/course/cs132/linearscan.pdf +[2]: Christian Wimmer, Hanspeter Mossenbock: Optimized Interval Splitting + in a Linear Scan Register Allocator + " Class { #name : #TRReverseLinearScanRegisterAllocator, #superclass : #TRRegisterAllocator, #instVars : [ 'instructions', - 'intervals', + 'todo', 'live', 'allocatableRegisters', 'availableRegisters' @@ -40,17 +82,37 @@ TRReverseLinearScanRegisterAllocator >> allocateRegister: interval [ self assert: interval register allocation isNil. assigned := self pickRegister: interval. - assigned isNil ifTrue: [ self error: 'No available register!' ]. + assigned isNil ifTrue: [ + "No free registers so pick and split some interval to free + some. Then try to allocate register again (this should succeed) + `interval` and then try to allocate it." + + | split | + + split := self pickSplit: interval. + split isNil ifTrue: [ + self error: 'Cannot allocate register for ', interval vreg name, ': no free registers and no interval to split!' + ]. + self splitRegister: split at: interval stop. + + assigned := self pickRegister: interval. + ]. + self assert: assigned notNil. + + interval register allocation: assigned. + self takeRegister: interval. live add: interval. ] { #category : #allocation } TRReverseLinearScanRegisterAllocator >> allocateRegisters [ + | intervals | + instructions := codegen instructions. allocatableRegisters := codegen linkage allocatableRegisters. codegen compilation config stressRA ifTrue: [ - "allocatableRegisters := allocatableRegisters copyFrom: 1 to: 2." + allocatableRegisters := allocatableRegisters copyFrom: 1 to: 2. ]. availableRegisters := allocatableRegisters asSet. live := SortedCollection sortBlock: [ :a :b | a start < b start ]. @@ -66,17 +128,30 @@ TRReverseLinearScanRegisterAllocator >> allocateRegisters [ | insn | insn := instructions at: i. - codegen virtualRegistersUsedBy: insn do: [:vreg | + codegen virtualRegistersReadBy: insn do: [:vreg | + | interval | + + interval := intervals at: vreg. + interval usedAt: i. + ]. + codegen virtualRegistersAssignedBy: insn do: [:vreg | | interval | interval := intervals at: vreg. - interval used: i. + interval defdAt: i. ]. ]. intervals do: [:interval | self assert: interval start < interval stop. ]. - intervals := intervals values asOrderedCollection sort: [ :a :b | a stop < b stop ]. + + "Create todo (work) list. The list is sorted by interval's end position (#stop). + + Within the same end positions, intervals are sorted by start position. This is so + to make sure short live intervals are allocated first (see #allocateRegistersAt: + which allocates registers one by one, taking them off the end of `todo` list. + " + todo := intervals values asSortedCollection: [ :a :b | (a stop < b stop) or:[a stop == b stop and:[a start < b start]]]. " Step 2. Walk instructions in reverse order and allocate @@ -96,7 +171,7 @@ TRReverseLinearScanRegisterAllocator >> allocateRegistersAt: insnIndex [ When reading this code, keep in mind that we progress in reverse order, from last to first instruction! " - | insn deps liveAcross thrashed | + | insn deps liveAcross | insn := instructions at: insnIndex. deps := insn dependencies. @@ -104,29 +179,35 @@ TRReverseLinearScanRegisterAllocator >> allocateRegistersAt: insnIndex [ "Satisfy post-dependencies, i.e., (i) move values from fixed (real) registers to desired (virtual) registers and... - (ii) ...reload all trashed registers live across - this instruction + (ii) ...force-split all thrashed registers live across + current position (`insnIndex`) " + codegen cursor: insnIndex. deps notEmptyOrNil ifTrue: [ "Compute 'live-across' intervals, that is intervals that are assigned before this instruction and used after this instruction." liveAcross := Set new: live size. live do: [:i | (i start < insnIndex and: [ i stop > insnIndex ]) ifTrue:[liveAcross add:i] ]. - thrashed := OrderedCollection new: deps post size. - codegen cursor: insnIndex. deps post do: [:dep | - dep isDependency ifTrue:[ + dep isUnsatisfiedDependency ifTrue:[ + "Move value from real register to its virtual register." self insertMoveFrom: dep rreg to: dep vreg. + + live copy do: [:i | + (i register allocation == dep rreg) ifTrue: [ + "Live-across register is trashed, we have to spill and reload. + We do it by forcefully splitting the interval." + self splitRegister: i at: insnIndex. + ]. + ]. ]. dep isTrash ifTrue: [ liveAcross do:[:i | (i register allocation == dep rreg) ifTrue: [ "Live-across register is trashed, we have to spill and reload. - So reload here and note the it has to be spilled before this - instruction executes (see handling of pre-dependencies below)" - self insertReload: i. - thrashed add: i. + We do it by forcefully splitting the interval." + self splitRegister: i at: insnIndex. ]. ] ]. @@ -140,10 +221,35 @@ TRReverseLinearScanRegisterAllocator >> allocateRegistersAt: insnIndex [ the interval from the list so we do not need to always search the list for intervals starting at this point. In other words, `intervals` collection serve as a worklist." - [ intervals notEmpty and: [ intervals last stop == insnIndex ] ] whileTrue: [ - self allocateRegister: intervals removeLast. + [ todo notEmpty and: [ todo last stop == insnIndex ] ] whileTrue: [ + | interval | + + interval := todo removeLast. + + self allocateRegister: interval. + interval length == 1 ifTrue: [ + "We have just allocated an register interval of length 1 - + such interval may be result of a split between its + definition and first use. In this case, this interval is + defined at this interval get immediatelly spilled so + we can expire it right now to free the register for + possibly other intervals that go live here." + self assert: (interval needsToBeSpilledAt: insnIndex). + + self insertSpill: interval. + self expireRegister: interval. + ] ]. + "Spill all live registers that have to spilled at this + point." + live do: [:interval | + (interval needsToBeSpilledAt: insnIndex) ifTrue: [ + self insertSpill: interval. + ]. + ]. + + "Satisfy pre-dependencies, i.e., (i) move values from (virtual) registers to desired (real) registers and... @@ -151,34 +257,94 @@ TRReverseLinearScanRegisterAllocator >> allocateRegistersAt: insnIndex [ Moves and spills must be placed placed *before* the instruction being processed, hence the `insnIndex - 1`" + codegen cursor: insnIndex - 1. deps notEmptyOrNil ifTrue: [ - codegen cursor: insnIndex - 1. deps pre reverseDo: [:dep | - dep isDependency ifTrue:[ - self insertMoveFrom: dep vreg to: dep rreg. - ]. - dep isTrash ifTrue: [ - thrashed do:[:i | - (i register allocation == dep rreg) ifTrue: [ - "Live register is trashed and has to be spilled. - See handling of post-dependencies above where `spilled` set - is populated." - self insertSpill: i. + dep isUnsatisfiedDependency ifTrue:[ + | conflicting | + + conflicting := live detect: [:each | each register allocation == dep rreg ] ifNone: nil. + conflicting notNil ifTrue: [ + "There's a dependency on a real register but (another) live interval (`conflicting`) + is allocated to that very real register (so the real register is not free)." + + "If conflicting interval have just gone live..." + conflicting stop == insnIndex ifTrue: [ + | free | + + free := self pickRegister: conflicting. + free notNil ifTrue:[ + "...and there's a free register, we can just reassign conflicting register + to this free one." + self freeRegister: conflicting register allocation. + conflicting register allocation: free. + self takeRegister: free. + + "Now the real register is free so we can simply move + value from virtual to (now free) real register." + self insertMoveFrom: dep vreg to: dep rreg. + ] ifFalse: [ + "If there's no free register, then we swap allocations for + conflicting and dependent registers. However, we can do this + safely only if dependent register has also gone live at this + position." + + | dependent | + + dependent := live detect: [:each | each register == dep vreg ]. + dependent stop == insnIndex ifFalse: [ + "So if it doesn't (has alreadt been live at this point), se + split it and allocate it right back to the same register. + This way, we can easily swap allocations without possibly + creating conflict in already allocated intervals." + + self splitRegister: dependent at: insnIndex. + self allocateRegister: (dependent := todo removeLast). + ]. + + self assert: dependent stop == insnIndex. + + "Now, swap allocations" + conflicting register allocation: dependent register allocation. + dependent register allocation: dep rreg. + + "Since dependent (virtual) register is allocated to required (real) register, + there's no need to move values." + ]. + ] ifFalse: [ + "Ouch, what to do here?" + self notYetImplemented. ]. - ] + ] ifFalse: [ + "There's no conflict, i.e., there's no live register currently allocated + to required real register. Therefore we can simply move value from + virtual register to real register." + self insertMoveFrom: dep vreg to: dep rreg. + ]. ]. + "Note that there's no need to handle thrashed registers here + as all thrashed intervals have been split, see above." ]. ]. ] +{ #category : #allocation } +TRReverseLinearScanRegisterAllocator >> expireRegister: interval [ + "Expire given interval" + + interval spillSlot notNil ifTrue: [ + codegen cursor: interval start. + self insertSpill: interval. + ]. + self freeRegister: interval. + live remove: interval. +] + { #category : #allocation } TRReverseLinearScanRegisterAllocator >> expireRegistersAt: insnIndex [ "Expire all registers no longer live at given instruction (index)." [ live notEmpty and:[ live last start >= insnIndex ] ] whileTrue: [ - | expired | - - expired := live removeLast. - self freeRegister: expired. + self expireRegister: live last. ]. ] @@ -193,53 +359,39 @@ TRReverseLinearScanRegisterAllocator >> freeRegister: interval [ ] { #category : #utilities } -TRReverseLinearScanRegisterAllocator >> insertReload: interval [ - | slot | +TRReverseLinearScanRegisterAllocator >> insertReload: interval from: spillSlot [ - self assert: interval spilled not. self assert: interval register kind == GPR description: 'FIXME: FPRs not yet supported'. self assert: interval register allocation notNil. + self assert: spillSlot isTRAutomaticSymbol. - slot := interval spillSlot. - slot isNil ifTrue: [ - slot := codegen compilation symbolManager defineAutomatic: nil type: Address. - interval spillSlot: slot. - ]. - codegen registerLoad: interval register from: slot. - interval spilled: true. + spillSlot incUseCount. + codegen registerLoad: interval register from: spillSlot. ] { #category : #utilities } TRReverseLinearScanRegisterAllocator >> insertSpill: interval [ - | slot | + | spillSlot | - self assert: interval spilled. self assert: interval spillSlot isTRAutomaticSymbol. self assert: interval register kind == GPR description: 'FIXME: FPRs not yet supported'. - slot := interval spillSlot. - codegen registerStore: interval register to: slot. - interval spilled: false. + spillSlot := interval spillSlot. + interval spillSlot: nil. + codegen registerStore: interval register to: spillSlot. ] { #category : #utilities } TRReverseLinearScanRegisterAllocator >> pickRegister: interval [ - "Pick (choose) and assign the best real register for given live interval. - Return the chosen register. - - Internal list of currently available registers is updated accordingly. + "Pick (choose) and return the best real register to assign to given (about to + going live) `interval`. Chosen register is NOT assigned. If there's no available register at this point, return `nil`. Caller is responsible for handling this case and schedule a spill / reload. " - self assert: interval register allocation isNil. - availableRegisters isEmpty ifTrue: [ ^ nil ]. - allocatableRegisters do: [:rReg | (availableRegisters includes: rReg) ifTrue: [ - interval register allocation: rReg. - self takeRegister: interval. ^ rReg ]. ]. @@ -247,21 +399,102 @@ TRReverseLinearScanRegisterAllocator >> pickRegister: interval [ ] { #category : #utilities } -TRReverseLinearScanRegisterAllocator >> pickSpill: interval [ - "Pick (choose) and return the best spill FIXME: TBW" +TRReverseLinearScanRegisterAllocator >> pickSpillSlot: interval [ + "Pick (choose) a spill slot to use when splitting given `interval`." + + self assert: interval register kind == GPR description: 'FIXME: FPRs not yet supported'. + + ^ codegen compilation symbolManager defineAutomatic: nil type: Address. +] + +{ #category : #utilities } +TRReverseLinearScanRegisterAllocator >> pickSplit: interval [ + "Pick (choose) and return 'good enough' live interval to split + (and therefore spill) in order to allocate given (about to go live) + `interval`. + + Preferably, choose among intervals that are not not defined not + used at current position. If there's none such that, choose among + ones that are used but not defined. + + Among multiple candidates to split, prefer the one whose previous + (since we go backwards) use/def is the furthest from current position. + This frees the register for longest possible time. + + Above process may not be the best, but it is 'good enough'. - | insn candidates | + [1]: Christian Wimmer, Hanspeter Mossenbock: Optimized Interval Splitting + in a Linear Scan Register Allocator + " + + | candidates candidate candidatePrevUse | - insn := instructions at: interval stop. + "1. Select candidates" + candidates := live reject: [:each | each isDefdOrUsedAt: interval stop ]. + candidates isEmpty ifTrue: [ + candidates := live reject: [:each | each isDefdAt: interval stop ]. + ]. - candidates := live reject: [:each | each spilled ]. - codegen virtualRegistersReadBy: insn do: [:vReg | - live do: [:e | e register == vReg ifTrue:[ candidates remove: e ifAbsent:nil] ] + "2. Among candidates, select the one one whose previous use/def + is the furthest." + candidatePrevUse := SmallInteger maxVal. + candidate := nil. + candidates reverseDo: [ :each | + | eachPrevUse | + + eachPrevUse := each lastUseOrDefBefore: interval stop. + (eachPrevUse notNil and: [ eachPrevUse < candidatePrevUse ]) ifTrue: [ + candidate := each. + candidatePrevUse := eachPrevUse. + ]. ]. - candidates isEmpty ifTrue: [ - ^ nil. + + ^ candidate +] + +{ #category : #allocation } +TRReverseLinearScanRegisterAllocator >> splitRegister: interval at: insnIndex [ + "Split given live `interval` at given `position`. + After interval is split. given `interval` is no + longer live (but may become live at `position` - 1) + and the part of interval before `position` is added to + the worklist (`todo`). " + + | before regmap spillSlot | + + self assert: (live includes: interval). + + before := TRRegisterLiveInterval forRegister: (codegen allocateRegister: interval register kind). + + "Create new interval representing the first part of original interval + up to current position. While walking definitions and uses, + update instructions to use new virtual registers" + regmap := Dictionary new at: interval register name put: before register name; yourself. + interval defdDo: [ :i | + before defdAt:i. + instructions at: i put: ((instructions at: i) inEnvironment: regmap). ]. - ^ candidates first. + interval usedDo: [:i | i <= insnIndex ifTrue: [ + before usedAt:i. + instructions at: i put: ((instructions at: i) inEnvironment: regmap). + ]]. + + "Allocate spill slot for being-splitted `interval`. Insert reload + and arrange `before` interval so that value is spilled when + defined." + spillSlot := self pickSpillSlot: interval. + self insertReload: interval from: spillSlot. + before spillSlot: spillSlot. + + "Finally, expire `interval` and push `before` to + worklist." + self expireRegister: interval. + todo add: before. + + "Just a sanity check." + self assert: (live includes: interval) not. + self assert: (availableRegisters includes: interval register allocation). + self assert: (todo includes: before). ] { #category : #utilities } diff --git a/src/Tinyrossa/TRVirtualRegister.class.st b/src/Tinyrossa/TRVirtualRegister.class.st index c11722e..b978343 100644 --- a/src/Tinyrossa/TRVirtualRegister.class.st +++ b/src/Tinyrossa/TRVirtualRegister.class.st @@ -19,12 +19,12 @@ TRVirtualRegister class >> named: aString kind: aTRRegisterKind codeGenerator: a { #category : #arithmetic } TRVirtualRegister >> + offset [ - ^ AcDSLMemRef base: self offset: offset asAcDSLOperand + ^ TRMemoryReference base: self offset: offset asAcDSLOperand ] { #category : #arithmetic } TRVirtualRegister >> - offset [ - ^ AcDSLMemRef base: self offset: offset negated asAcDSLOperand + ^ TRMemoryReference base: self offset: offset negated asAcDSLOperand ] { #category : #accessing } @@ -34,8 +34,7 @@ TRVirtualRegister >> allocation [ { #category : #accessing } TRVirtualRegister >> allocation: realReg [ - self assert: allocation isNil. - self assert: (realReg isKindOf: TRRealRegister). + self assert: realReg isTRRealRegister. self assert: kind == realReg kind. allocation := realReg