comment wibbles

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index a2b98f1..35550dd 100644 (file)
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -18,6 +18,7 @@ import RegLiveness
 import RegSpill
 import RegSpillClean
 import RegAllocStats
 import RegSpill
 import RegSpillClean
 import RegAllocStats

+-- import RegCoalesce

 import MachRegs
 import MachInstrs
 import PprMach
 import MachRegs
 import MachInstrs
 import PprMach

@@ -70,7 +71,6 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
                , dopt Opt_D_dump_asm_stats dflags
                , dopt Opt_D_dump_asm_conflicts dflags ]
 
                , dopt Opt_D_dump_asm_stats dflags
                , dopt Opt_D_dump_asm_conflicts dflags ]
 

-

        -- check that we're not running off down the garden path.
        when (spinCount > maxSpinCount)
         $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
        -- check that we're not running off down the garden path.
        when (spinCount > maxSpinCount)
         $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."

@@ -80,8 +80,21 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
                                                $ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree)
                $$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
 
                                                $ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree)
                $$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
 

+
+       -- Brig's algorithm does reckless coalescing for all but the first allocation stage
+       --      Doing this seems to reduce the number of reg-reg moves, but at the cost-
+       --      of creating more spills. Probably better just to stick with conservative 
+       --      coalescing in Color.colorGraph for now.
+       --
+       {- code_coalesced1      <- if (spinCount > 0) 
+                               then regCoalesce code
+                               else return code -}
+
+       let code_coalesced1     = code
+
+

        -- build a conflict graph from the code.
        -- build a conflict graph from the code.

-       graph           <- {-# SCC "BuildGraph" #-} buildGraph code
+       graph           <- {-# SCC "BuildGraph" #-} buildGraph code_coalesced1

 
        -- VERY IMPORTANT:
        --      We really do want the graph to be fully evaluated _before_ we start coloring.
 
        -- VERY IMPORTANT:
        --      We really do want the graph to be fully evaluated _before_ we start coloring.

@@ -95,7 +108,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
        --      this is lazy, it won't be computed unless we need to spill
 
        let fmLife      = {-# SCC "LifetimeCount" #-} plusUFMs_C (\(r1, l1) (_, l2) -> (r1, l1 + l2))
        --      this is lazy, it won't be computed unless we need to spill
 
        let fmLife      = {-# SCC "LifetimeCount" #-} plusUFMs_C (\(r1, l1) (_, l2) -> (r1, l1 + l2))

-                       $ map lifetimeCount code
+                       $ map lifetimeCount code_coalesced1

 
        -- record startup state
        let stat1       =
 
        -- record startup state
        let stat1       =

@@ -115,21 +128,22 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
                        = {-# SCC "ColorGraph" #-}
                           Color.colorGraph
                                (dopt Opt_RegsIterative dflags)
                        = {-# SCC "ColorGraph" #-}
                           Color.colorGraph
                                (dopt Opt_RegsIterative dflags)

+                               spinCount

                                regsFree triv spill graph
 
        -- rewrite regs in the code that have been coalesced
        let patchF reg  = case lookupUFM rmCoalesce reg of
                                Just reg'       -> patchF reg'
                                Nothing         -> reg
                                regsFree triv spill graph
 
        -- rewrite regs in the code that have been coalesced
        let patchF reg  = case lookupUFM rmCoalesce reg of
                                Just reg'       -> patchF reg'
                                Nothing         -> reg

-       let code_coalesced
-                       = map (patchEraseLive patchF) code
+       let code_coalesced2
+                       = map (patchEraseLive patchF) code_coalesced1

 
 
        -- see if we've found a coloring
        if isEmptyUniqSet rsSpill
         then do
                -- patch the registers using the info in the graph
 
 
        -- see if we've found a coloring
        if isEmptyUniqSet rsSpill
         then do
                -- patch the registers using the info in the graph

-               let code_patched        = map (patchRegsFromGraph graph_colored) code_coalesced
+               let code_patched        = map (patchRegsFromGraph graph_colored) code_coalesced2

 
                -- clean out unneeded SPILL/RELOADs
                let code_spillclean     = map cleanSpills code_patched
 
                -- clean out unneeded SPILL/RELOADs
                let code_spillclean     = map cleanSpills code_patched

@@ -166,7 +180,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
         else do
                -- spill the uncolored regs
                (code_spilled, slotsFree', spillStats)
         else do
                -- spill the uncolored regs
                (code_spilled, slotsFree', spillStats)

-                       <- regSpill code_coalesced slotsFree rsSpill
+                       <- regSpill code_coalesced2 slotsFree rsSpill

 
                -- recalculate liveness
                let code_nat    = map stripLive code_spilled
 
                -- recalculate liveness
                let code_nat    = map stripLive code_spilled

@@ -257,7 +271,7 @@ buildGraph code
        let moveBag             = unionBags (unionManyBags moveList2) (unionManyBags moveList)
        let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict moveBag
                        
        let moveBag             = unionBags (unionManyBags moveList2) (unionManyBags moveList)
        let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict moveBag
                        

-       return  $ Color.validateGraph (text "urk") graph_coalesce
+       return  graph_coalesce

 
 
 -- | Add some conflict edges to the graph.
 
 
 -- | Add some conflict edges to the graph.

diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs
index 307803a..10852d4 100644 (file)
--- a/compiler/utils/GraphColor.hs
+++ b/compiler/utils/GraphColor.hs
@@ -39,6 +39,7 @@ colorGraph
           , Eq color, Eq cls, Ord k
           , Outputable k, Outputable cls, Outputable color)
        => Bool                         -- ^ whether to do iterative coalescing
           , Eq color, Eq cls, Ord k
           , Outputable k, Outputable cls, Outputable color)
        => Bool                         -- ^ whether to do iterative coalescing

+       -> Int                          -- ^ how many times coloring has been called so far

        -> UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).
        -> Triv   k cls color           -- ^ fn to decide whether a node is trivially colorable.
        -> (Graph k cls color -> k)     -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
        -> UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).
        -> Triv   k cls color           -- ^ fn to decide whether a node is trivially colorable.
        -> (Graph k cls color -> k)     -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.

@@ -49,11 +50,10 @@ colorGraph
           , UniqFM  k )                -- map of regs (r1 -> r2) that were coaleced
                                        --       r1 should be replaced by r2 in the source
 
           , UniqFM  k )                -- map of regs (r1 -> r2) that were coaleced
                                        --       r1 should be replaced by r2 in the source
 

-colorGraph iterative colors triv spill graph0
+colorGraph iterative spinCount colors triv spill graph0

  = let
  = let

-       -- if we're not doing iterative coalescing, then just do a single coalescing
-       --      pass at the front. This won't be as good but should still eat up a
-       --      lot of the reg-reg moves.
+       -- If we're not doing iterative coalescing then just do a conservative
+       --      coalescing stage at the front.

        (graph_coalesced, kksCoalesce1)
                = if not iterative
                        then coalesceGraph False triv graph0
        (graph_coalesced, kksCoalesce1)
                = if not iterative
                        then coalesceGraph False triv graph0

@@ -154,23 +154,23 @@ colorScan_spin iterative triv spill graph
                        $ graph
 
        , ksTrivFound   <- map nodeId nsTrivFound
                        $ graph
 
        , ksTrivFound   <- map nodeId nsTrivFound

-       , graph3        <- foldr (\k g -> let Just g' = delNode k g
+       , graph2        <- foldr (\k g -> let Just g' = delNode k g

                                          in  g')
                                graph ksTrivFound
 
                                          in  g')
                                graph ksTrivFound
 

-       = colorScan_spin iterative triv spill graph3
+       = colorScan_spin iterative triv spill graph2

                (ksTrivFound ++ ksTriv)
                ksSpill
                kksCoalesce
 
        -- Coalesce:
        --      If we're doing iterative coalescing and no triv nodes are avaliable
                (ksTrivFound ++ ksTriv)
                ksSpill
                kksCoalesce
 
        -- Coalesce:
        --      If we're doing iterative coalescing and no triv nodes are avaliable

-       --      then it's type for a coalescing pass.
+       --      then it's time for a coalescing pass.

        | iterative
        = case coalesceGraph False triv graph of
 
                -- we were able to coalesce something
        | iterative
        = case coalesceGraph False triv graph of
 
                -- we were able to coalesce something

-               --      go back and see if this frees up more nodes to be trivially colorable.
+               --      go back to Simplify and see if this frees up more nodes to be trivially colorable.

                (graph2, kksCoalesceFound @(_:_))
                 -> colorScan_spin iterative triv spill graph2
                        ksTriv ksSpill (kksCoalesceFound ++ kksCoalesce)
                (graph2, kksCoalesceFound @(_:_))
                 -> colorScan_spin iterative triv spill graph2
                        ksTriv ksSpill (kksCoalesceFound ++ kksCoalesce)