Add spill/reload pseudo instrs to MachInstrs

[ghc-hetmet.git] / compiler / nativeGen / RegAllocColor.hs

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 5ce2a6c..92efc4a 100644 (file)
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -50,12 +50,12 @@ maxSpinCount        = 10
 -- | The top level of the graph coloring register allocator.
 --     
 regAlloc
-       :: UniqFM (UniqSet Reg)                         -- ^ the registers we can use for allocation
-       -> UniqSet Int                                  -- ^ the set of available spill slots.
-       -> [LiveCmmTop]                                 -- ^ code annotated with liveness information.
+       :: UniqFM (UniqSet Reg)         -- ^ the registers we can use for allocation
+       -> UniqSet Int                  -- ^ the set of available spill slots.
+       -> [LiveCmmTop]                 -- ^ code annotated with liveness information.
        -> UniqSM 
-               ( [NatCmmTop]                           -- ^ code with registers allocated.
-               , [RegAllocStats] )                     -- ^ stats for each stage of allocation
+               ( [NatCmmTop]           -- ^ code with registers allocated.
+               , [RegAllocStats] )     -- ^ stats for each stage of allocation
                
 regAlloc regsFree slotsFree code
  = do
@@ -79,8 +79,8 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
        -- build a conflict graph from the code.
        graph           <- buildGraph code
 
-       -- build a map of how many instructions each reg lives for
-       --      this lazy, it won't be computed unless we need to spill
+       -- build a map of how many instructions each reg lives for.
+       --      this is lazy, it won't be computed unless we need to spill
        let fmLife      = plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
                        $ map lifetimeCount code
 
@@ -105,8 +105,12 @@ 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 code_nat            = map stripLive code_patched
+
+               let spillNatTop         = mapGenBlockTop spillNatBlock
+               let code_nat            = map (spillNatTop . stripLive) code_patched
+
                
                -- record what happened in this stage for debugging
                let stat                =
@@ -115,7 +119,7 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
                        , raPatchedCmm  = code_patched }
 
                return  ( code_nat
-                       , maybeToList stat1 ++ [stat] ++ debug_codeGraphs
+                       , [stat] ++ maybeToList stat1 ++ debug_codeGraphs
                        , graph_colored)
 
         else do
@@ -137,7 +141,7 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
                                
                -- try again
                regAlloc_spin (spinCount + 1) triv regsFree slotsFree' 
-                       (maybeToList stat1 ++ [stat] ++ debug_codeGraphs)
+                       ([stat] ++ maybeToList stat1 ++ debug_codeGraphs)
                        code_relive
 
  
@@ -202,7 +206,7 @@ buildGraph code
 
 
 -- | Add some conflict edges to the graph.
---     Conflicts between virtual and real regs are recorded as exlusions.
+--     Conflicts between virtual and real regs are recorded as exclusions.
 --
 graphAddConflictSet 
        :: UniqSet Reg
@@ -223,7 +227,7 @@ graphAddConflictSet set graph
    in  graph2
        
 
--- | Add some coalesences edges to the graph
+-- | Add some coalesence edges to the graph
 --     Coalesences between virtual and real regs are recorded as preferences.
 --
 graphAddCoalesce