if isEmptyUniqSet rsSpill
then do
-- patch the registers using the info in the graph
- -- also rewrite SPILL/REALOAD pseudos into real instructions
let code_patched = map (patchRegsFromGraph graph_colored) code
- let spillNatTop = mapGenBlockTop spillNatBlock
- let code_nat = map (spillNatTop . stripLive) code_patched
+ -- strip off liveness information
+ let code_nat = map stripLive code_patched
+ -- rewrite SPILL/REALOAD pseudos into real instructions
+ let spillNatTop = mapGenBlockTop spillNatBlock
+ let code_final = map spillNatTop code_nat
-- record what happened in this stage for debugging
let stat =
RegAllocStatsColored
{ raGraph = graph_colored
- , raPatchedCmm = code_patched }
+ , raPatchedCmm = code_patched
+ , raFinalCmm = code_final }
return ( code_nat
, [stat] ++ maybeToList stat1 ++ debug_codeGraphs
import RegLiveness
import RegSpill
import MachRegs
+import MachInstrs
import Outputable
import UniqFM
-- a successful coloring
| RegAllocStatsColored
{ raGraph :: Color.Graph Reg RegClass Reg -- ^ the colored graph
- , raPatchedCmm :: [LiveCmmTop] } -- ^ code after register allocation
-
+ , raPatchedCmm :: [LiveCmmTop] -- ^ code after register allocation
+ , raFinalCmm :: [NatCmmTop] } -- ^ final code
instance Outputable RegAllocStats where
$$ text ""
$$ text "# Native code after register allocation."
$$ ppr (raPatchedCmm s)
+ $$ text ""
+ $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
+ $$ ppr (raFinalCmm s)
+ $$ text ""
-- | Do all the different analysis on this list of RegAllocStats
return $ CmmProc header label params blocks'
-
-
-
-- | Slurp out the list of register conflicts from this top level thing.
slurpConflicts :: LiveCmmTop -> Bag (UniqSet Reg)
spillNatBlock (BasicBlock i instrs)
= BasicBlock i instrs'
where (instrs', _)
- = runState (mapM spillNat instrs) 0
+ = runState (spillNat [] instrs) 0
+
+ spillNat acc []
+ = return (reverse acc)
- spillNat instr@(DELTA i)
+ spillNat acc (instr@(DELTA i) : instrs)
= do put i
- return instr
+ spillNat acc instrs
- spillNat (SPILL reg slot)
+ spillNat acc (SPILL reg slot : instrs)
= do delta <- get
- return $ mkSpillInstr reg delta slot
+ spillNat (mkSpillInstr reg delta slot : acc) instrs
- spillNat (RELOAD slot reg)
+ spillNat acc (RELOAD slot reg : instrs)
= do delta <- get
- return $ mkLoadInstr reg delta slot
+ spillNat (mkLoadInstr reg delta slot : acc) instrs
- spillNat instr
- = return instr
+ spillNat acc (instr : instrs)
+ = spillNat (instr : acc) instrs
-- | Slurp out a map of how many times each register was live upon entry to an instruction.