module RegAllocLinear (
regAlloc,
- RegAllocStats
+ RegAllocStats, pprStats
) where
#include "HsVersions.h"
import UniqFM
import UniqSupply
import Outputable
+import State
#ifndef DEBUG
import Data.Maybe ( fromJust )
#endif
-import Data.List ( nub, partition, mapAccumL)
+import Data.List ( nub, partition, mapAccumL, foldl')
import Control.Monad ( when )
import Data.Word
import Data.Bits
-- (j) free up stack slots for dead spilled regs
-- TODO (can't be bothered right now)
- return (patched_instr : w_spills ++ reverse r_spills
+ -- erase reg->reg moves where the source and destination are the same.
+ -- If the src temp didn't die in this instr but happened to be allocated
+ -- to the same real reg as the destination, then we can erase the move anyway.
+ squashed_instr = case isRegRegMove patched_instr of
+ Just (src, dst)
+ | src == dst -> []
+ _ -> [patched_instr]
+
+ return (squashed_instr ++ w_spills ++ reverse r_spills
++ clobber_saves ++ new_instrs,
fixup_blocks)
}}
-- | Record that a spill instruction was inserted, for profiling.
recordSpill :: SpillReason -> RegM ()
recordSpill spill
- = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)
+ = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)
-- -----------------------------------------------------------------------------
SpillJoinRM r -> (r, [0, 0, 0, 0, 1])) reasons)
+-- | Count reg-reg moves remaining in this code.
+countRegRegMovesNat :: NatCmmTop -> Int
+countRegRegMovesNat cmm
+ = execState (mapGenBlockTopM countBlock cmm) 0
+ where
+ countBlock b@(BasicBlock i instrs)
+ = do instrs' <- mapM countInstr instrs
+ return b
+
+ countInstr instr
+ | Just _ <- isRegRegMove instr
+ = do modify (+ 1)
+ return instr
+
+ | otherwise
+ = return instr
+
+
+-- | Pretty print some RegAllocStats
+pprStats :: [NatCmmTop] -> [RegAllocStats] -> SDoc
+pprStats code statss
+ = let -- sum up all the instrs inserted by the spiller
+ spills = foldl' (plusUFM_C (zipWith (+)))
+ emptyUFM
+ $ map ra_spillInstrs statss
+
+ spillTotals = foldl' (zipWith (+))
+ [0, 0, 0, 0, 0]
+ $ eltsUFM spills
+
+ -- count how many reg-reg-moves remain in the code
+ moves = sum $ map countRegRegMovesNat code
+
+ pprSpill (reg, spills)
+ = parens $ (hcat $ punctuate (text ", ") (doubleQuotes (ppr reg) : map ppr spills))
+
+ in ( text "-- spills-added-total"
+ $$ text "-- (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
+ $$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
+ $$ text ""
+ $$ text "-- spills-added"
+ $$ text "-- (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
+ $$ (vcat $ map pprSpill
+ $ ufmToList spills)
+ $$ text "")
+
+
-- -----------------------------------------------------------------------------
-- Utils