Remove CPP from nativeGen/RegAlloc/Graph/TrivColorable.hs

[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Graph / Main.hs

diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 94b18ae..cdbe987 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -11,7 +11,6 @@ module RegAlloc.Graph.Main (
 where
 
 import qualified GraphColor    as Color
-import qualified GraphBase     as Color
 import RegAlloc.Liveness
 import RegAlloc.Graph.Spill
 import RegAlloc.Graph.SpillClean
@@ -44,7 +43,6 @@ maxSpinCount  = 10
 
 
 -- | The top level of the graph coloring register allocator.
---     
 regAlloc
        :: (Outputable instr, Instruction instr)
        => DynFlags
@@ -170,15 +168,14 @@ regAlloc_spin
                --      and rewrite SPILL/RELOAD pseudos into real instructions along the way
                let code_final          = map stripLive code_spillclean
 
---             let spillNatTop         = mapGenBlockTop spillNatBlock
---             let code_final          = map spillNatTop code_nat
-               
                -- record what happened in this stage for debugging
                let stat                =
                        RegAllocStatsColored
-                       { raGraph               = graph
+                       { raCode                = code
+                       , raGraph               = graph
                        , raGraphColored        = graph_colored_lint
                        , raCoalesced           = rmCoalesce
+                       , raCodeCoalesced       = code_coalesced
                        , raPatched             = code_patched
                        , raSpillClean          = code_spillclean
                        , raFinal               = code_final
@@ -211,13 +208,16 @@ regAlloc_spin
                        <- regSpill code_coalesced slotsFree rsSpill
 
                -- recalculate liveness
-               let code_nat    = map stripLive code_spilled
-               code_relive     <- mapM regLiveness code_nat
+               -- NOTE: we have to reverse the SCCs here to get them back into the reverse-dependency
+               --       order required by computeLiveness. If they're not in the correct order
+               --       that function will panic.
+               code_relive     <- mapM (regLiveness . reverseBlocksInTops) code_spilled
 
                -- record what happened in this stage for debugging
                let stat        =
                        RegAllocStatsSpill
-                       { raGraph       = graph_colored_lint
+                       { raCode        = code
+                       , raGraph       = graph_colored_lint
                        , raCoalesced   = rmCoalesce
                        , raSpillStats  = spillStats
                        , raSpillCosts  = spillCosts
@@ -236,9 +236,7 @@ regAlloc_spin
                        code_relive
 
 
-
 -- | Build a graph from the liveness and coalesce information in this code.
-
 buildGraph 
        :: Instruction instr
        => [LiveCmmTop instr]
@@ -266,7 +264,6 @@ buildGraph code
 
 -- | Add some conflict edges to the graph.
 --     Conflicts between virtual and real regs are recorded as exclusions.
---
 graphAddConflictSet 
        :: UniqSet Reg
        -> Color.Graph VirtualReg RegClass RealReg
@@ -289,7 +286,6 @@ graphAddConflictSet set graph
 
 -- | Add some coalesence edges to the graph
 --     Coalesences between virtual and real regs are recorded as preferences.
---
 graphAddCoalesce 
        :: (Reg, Reg) 
        -> Color.Graph VirtualReg RegClass RealReg
@@ -311,9 +307,16 @@ graphAddCoalesce (r1, r2) graph
                (vr2, classOfVirtualReg vr2) 
                graph
 
-       | otherwise
-       = panic "RegAlloc.Graph.Main.graphAddCoalesce: can't coalesce two real regs"
+       -- We can't coalesce two real regs, but there could well be existing
+       --      hreg,hreg moves in the input code. We'll just ignore these
+       --      for coalescing purposes.
+       | RegReal _             <- r1
+       , RegReal _             <- r2
+       = graph
 
+graphAddCoalesce _ _
+       = panic "graphAddCoalesce: bogus"
+       
 
 -- | Patch registers in code using the reg -> reg mapping in this graph.
 patchRegsFromGraph 
@@ -374,25 +377,13 @@ seqNode node
        `seq` (seqVirtualRegList (uniqSetToList (Color.nodeCoalesce node)))
 
 seqVirtualReg :: VirtualReg -> ()
-seqVirtualReg reg
- = case reg of
-       VirtualRegI _   -> ()
-       VirtualRegHi _  -> ()
-       VirtualRegF _   -> ()
-       VirtualRegD _   -> ()
+seqVirtualReg reg = reg `seq` ()
 
 seqRealReg :: RealReg -> ()
-seqRealReg reg
- = case reg of
-       RealRegSingle _ -> ()
-       RealRegPair _ _ -> ()
+seqRealReg reg = reg `seq` ()
 
 seqRegClass :: RegClass -> ()
-seqRegClass c
- = case c of
-       RcInteger       -> ()
-       RcFloat         -> ()
-       RcDouble        -> ()
+seqRegClass c = c `seq` ()
 
 seqMaybeRealReg :: Maybe RealReg -> ()
 seqMaybeRealReg mr