#ifndef DEBUG
import Data.Maybe ( fromJust )
#endif
-import Data.Maybe ( fromMaybe )
import Data.List ( nub, partition, mapAccumL, groupBy )
import Control.Monad ( when )
import Data.Word
liveness liveregs blockmap done [] = (liveregs, done)
liveness liveregs blockmap done (instr:instrs)
- = liveness liveregs2 blockmap ((instr,r_dying,w_dying):done) instrs
+ | not_a_branch = liveness liveregs1 blockmap
+ ((instr,r_dying,w_dying):done) instrs
+ | otherwise = liveness liveregs_br blockmap
+ ((instr,r_dying_br,w_dying):done) instrs
where
RU read written = regUsage instr
liveregs1 = (liveregs `delListFromUniqSet` written)
`addListToUniqSet` read
+ -- registers that are not live beyond this point, are recorded
+ -- as dying here.
+ r_dying = [ reg | reg <- read, reg `notElem` written,
+ not (elementOfUniqSet reg liveregs) ]
+
+ w_dying = [ reg | reg <- written,
+ not (elementOfUniqSet reg liveregs) ]
+
-- union in the live regs from all the jump destinations of this
-- instruction.
targets = jumpDests instr [] -- where we go from here
- liveregs2 = unionManyUniqSets
- (liveregs1 : map targetLiveRegs targets)
+ not_a_branch = null targets
targetLiveRegs target = case lookupUFM blockmap target of
Just ra -> ra
Nothing -> emptyBlockMap
- -- registers that are not live beyond this point, are recorded
- -- as dying here.
- r_dying = [ reg | reg <- read, reg `notElem` written,
- not (elementOfUniqSet reg liveregs) ]
+ live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
- w_dying = [ reg | reg <- written,
- not (elementOfUniqSet reg liveregs) ]
+ liveregs_br = liveregs1 `unionUniqSets` live_from_branch
+ -- registers that are live only in the branch targets should
+ -- be listed as dying here.
+ live_branch_only = live_from_branch `minusUniqSet` liveregs
+ r_dying_br = uniqSetToList (mkUniqSet r_dying `unionUniqSets`
+ live_branch_only)
-- -----------------------------------------------------------------------------
-- Linear sweep to allocate registers
(CyclicSCC blocks : sccs)
= getUs `thenUs` \us ->
let
- ((block_assig', stack', us'), blocks') = mapAccumL processBlock
+ ((block_assig', stack', _), blocks') = mapAccumL processBlock
(block_assig, stack, us)
({-reverse-} blocks)
in
(# s{ra_stack=stack'}, (instr,slot) #)
loadR :: Reg -> Int -> RegM Instr
-loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
+loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
(# s, mkLoadInstr reg delta slot #)
getFreeRegsR :: RegM FreeRegs
setAssigR assig = RegM $ \ s ->
(# s{ra_assig=assig}, () #)
-getStackR :: RegM StackMap
-getStackR = RegM $ \ s@RA_State{ra_stack = stack} ->
- (# s, stack #)
-
-setStackR :: StackMap -> RegM ()
-setStackR stack = RegM $ \ s ->
- (# s{ra_stack=stack}, () #)
-
getBlockAssigR :: RegM BlockAssignment
getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
(# s, assig #)