Show spill/reload pseudo instrs in regalloc stage dump

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 92efc4a..ecb5faf 100644 (file)
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -105,18 +105,21 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
        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

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 798af02..a762f83 100644 (file)
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -21,6 +21,7 @@ import qualified GraphColor as Color
 import RegLiveness
 import RegSpill
 import MachRegs
+import MachInstrs
 
 import Outputable
 import UniqFM
@@ -46,8 +47,8 @@ data RegAllocStats
        -- 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
 
@@ -77,6 +78,10 @@ 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

diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs
index 8f313ae..1ba241f 100644 (file)
--- a/compiler/nativeGen/RegLiveness.hs
+++ b/compiler/nativeGen/RegLiveness.hs
@@ -178,9 +178,6 @@ mapGenBlockTopM f (CmmProc header label params blocks)
        return  $ CmmProc header label params blocks'
 
 
-
-
-
 -- | Slurp out the list of register conflicts from this top level thing.
 
 slurpConflicts :: LiveCmmTop -> Bag (UniqSet Reg)
@@ -248,22 +245,25 @@ spillNatBlock :: NatBasicBlock -> NatBasicBlock
 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.