Add iterative coalescing to graph coloring allocator

Iterative coalescing interleaves conservative coalesing with the regular
simplify/scan passes. This increases the chance that nodes will be coalesced
as they will have a lower degree than at the beginning of simplify. The end
result is that more register to register moves will be eliminated in the
output code, though the iterative nature of the algorithm makes it slower
compared to non-iterative coloring.

Use -fregs-iterative  for graph coloring allocation with iterative coalescing
    -fregs-graph      for non-iterative coalescing.

The plan is for iterative coalescing to be enabled with -O2 and have a 
quicker, non-iterative algorithm otherwise. The time/benefit tradeoff
between iterative and not is still being tuned - optimal graph coloring
is NP-hard, afterall..
parent 18f671cc
......@@ -246,7 +246,8 @@ data DynFlag
| Opt_DictsCheap
| Opt_RewriteRules
| Opt_Vectorise
| Opt_RegsGraph
| Opt_RegsGraph -- do graph coloring register allocation
| Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
-- misc opts
| Opt_Cpp
......@@ -1195,6 +1196,7 @@ fFlags = [
( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack),
( "vectorise", Opt_Vectorise ),
( "regs-graph", Opt_RegsGraph),
( "regs-iterative", Opt_RegsIterative),
-- Deprecated in favour of -XTemplateHaskell:
( "th", Opt_TemplateHaskell ),
-- Deprecated in favour of -XForeignFunctionInterface:
......
......@@ -196,9 +196,9 @@ cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc
then native
else []
-- force evaulation of imports and lsPprNative to avoid space leak
-- force evaulation all this stuff to avoid space leaks
seqString (showSDoc $ vcat $ map ppr imports) `seq` return ()
lsPprNative `seq` return ()
lsPprNative `seq` return ()
cmmNativeGens dflags h us' cmms
(imports : impAcc)
......@@ -214,15 +214,16 @@ cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc
cmmNativeGen
:: DynFlags
-> UniqSupply
-> RawCmmTop
-> RawCmmTop -- ^ the cmm to generate code for
-> IO ( UniqSupply
, [NatCmmTop]
, [CLabel]
, Maybe [Color.RegAllocStats]
, Maybe [Linear.RegAllocStats])
, [NatCmmTop] -- native code
, [CLabel] -- things imported by this cmm
, Maybe [Color.RegAllocStats] -- stats for the coloring register allocator
, Maybe [Linear.RegAllocStats]) -- stats for the linear register allocators
cmmNativeGen dflags us cmm
= do
-- rewrite assignments to global regs
let (fixed_cmm, usFix) =
{-# SCC "fixAssignsTop" #-}
......@@ -259,7 +260,8 @@ cmmNativeGen dflags us cmm
-- allocate registers
(alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <-
if dopt Opt_RegsGraph dflags
if ( dopt Opt_RegsGraph dflags
|| dopt Opt_RegsIterative dflags)
then do
-- the regs usable for allocation
let alloc_regs
......@@ -268,20 +270,12 @@ cmmNativeGen dflags us cmm
emptyUFM
$ map RealReg allocatableRegs
-- if any of these dump flags are turned on we want to hang on to
-- intermediate structures in the allocator - otherwise tell the
-- allocator to ditch them early so we don't end up creating space leaks.
let generateRegAllocStats = or
[ dopt Opt_D_dump_asm_regalloc_stages dflags
, dopt Opt_D_dump_asm_stats dflags
, dopt Opt_D_dump_asm_conflicts dflags ]
-- graph coloring register allocation
let ((alloced, regAllocStats), usAlloc)
= {-# SCC "RegAlloc" #-}
initUs usLive
$ Color.regAlloc
generateRegAllocStats
dflags
alloc_regs
(mkUniqSet [0..maxSpillSlots])
withLiveness
......@@ -294,7 +288,7 @@ cmmNativeGen dflags us cmm
dumpIfSet_dyn dflags
Opt_D_dump_asm_regalloc_stages "Build/spill stages"
(vcat $ map (\(stage, stats)
-> text "-- Stage " <> int stage
-> text " Stage " <> int stage
$$ ppr stats)
$ zip [0..] regAllocStats)
......
......@@ -16,6 +16,7 @@ where
import UniqSet
import UniqFM
-- | A fn to check if a node is trivially colorable
-- For graphs who's color classes are disjoint then a node is 'trivially colorable'
-- when it has less neighbors and exclusions than available colors for that node.
......@@ -45,6 +46,7 @@ data Graph k cls color
-- | All active nodes in the graph.
graphMap :: UniqFM (Node k cls color) }
-- | An empty graph.
initGraph :: Graph k cls color
initGraph
......@@ -106,3 +108,4 @@ newNode k cls
......@@ -38,7 +38,8 @@ colorGraph
:: ( Uniquable k, Uniquable cls, Uniquable color
, Eq color, Eq cls, Ord k
, Outputable k, Outputable cls, Outputable color)
=> UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
=> Bool -- ^ whether to do iterative coalescing
-> 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.
-> Graph k cls color -- ^ the graph to color.
......@@ -48,27 +49,42 @@ colorGraph
, UniqFM k ) -- map of regs (r1 -> r2) that were coaleced
-- r1 should be replaced by r2 in the source
colorGraph colors triv spill graph0
colorGraph iterative colors triv spill graph0
= let
-- do aggressive coalesing on the graph
(graph_coalesced, rsCoalesce)
= coalesceGraph triv graph0
-- 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.
(graph_coalesced, kksCoalesce1)
= if not iterative
then coalesceGraph False triv graph0
else (graph0, [])
-- run the scanner to slurp out all the trivially colorable nodes
(ksTriv, ksProblems)
= colorScan triv spill graph_coalesced
-- (and do coalescing if iterative coalescing is enabled)
(ksTriv, ksProblems, kksCoalesce2)
= colorScan iterative triv spill graph_coalesced
-- If iterative coalescing is enabled, the scanner will coalesce the graph as does its business.
-- We need to apply all the coalescences found by the scanner to the original
-- graph before doing assignColors.
(graph_scan_coalesced, _)
= mapAccumL (coalesceNodes False triv) graph_coalesced kksCoalesce2
-- color the trivially colorable nodes
-- as the keys were added to the front of the list while they were scanned,
-- this colors them in the reverse order they were found, as required by the algorithm.
-- during scanning, keys of triv nodes were added to the front of the list as they were found
-- this colors them in the reverse order, as required by the algorithm.
(graph_triv, ksNoTriv)
= assignColors colors graph_coalesced ksTriv
= assignColors colors graph_scan_coalesced ksTriv
-- try and color the problem nodes
(graph_prob, ksNoColor) = assignColors colors graph_triv ksProblems
-- problem nodes are the ones that were left uncolored because they weren't triv.
-- theres a change we can color them here anyway.
(graph_prob, ksNoColor)
= assignColors colors graph_triv ksProblems
-- if the trivially colorable nodes didn't color then something is wrong
-- if the trivially colorable nodes didn't color then something is probably wrong
-- with the provided triv function.
--
in if not $ null ksNoTriv
then pprPanic "colorGraph: trivially colorable nodes didn't color!" empty
{- ( empty
......@@ -78,8 +94,10 @@ colorGraph colors triv spill graph0
$$ dotGraph (\x -> text "white") triv graph1) -}
else ( graph_prob
, mkUniqSet ksNoColor
, listToUFM rsCoalesce)
, mkUniqSet ksNoColor -- the nodes that didn't color (spills)
, if iterative
then (listToUFM kksCoalesce2)
else (listToUFM kksCoalesce1))
-- | Scan through the conflict graph separating out trivially colorable and
......@@ -94,100 +112,99 @@ colorGraph colors triv spill graph0
-- at once the more likely it is that nodes we've already checked will become trivially colorable
-- for the next pass.
--
-- TODO: add work lists to finding triv nodes is easier.
-- If we've just scanned the graph, and removed triv nodes, then the only
-- nodes that we need to rescan are the ones we've removed edges from.
colorScan
:: ( Uniquable k, Uniquable cls, Uniquable color)
=> Triv k cls color -- ^ fn to decide whether a node is trivially colorable
:: ( Uniquable k, Uniquable cls, Uniquable color
, Ord k, Eq cls
, Outputable k, Outputable color)
=> Bool -- ^ whether to do iterative coalescing
-> 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.
-> Graph k cls color -- ^ the graph to scan
-> ([k], [k]) -- triv colorable, problem nodes
-> ([k], [k], [(k, k)]) -- triv colorable nodes, problem nodes, pairs of nodes to coalesce
colorScan triv spill graph
= colorScan' triv spill graph
[] []
[]
(eltsUFM $ graphMap graph)
colorScan iterative triv spill graph
= colorScan_spin iterative triv spill graph [] [] []
-- we've reached the end of the candidates list
colorScan' triv spill graph
ksTriv ksTrivFound
ksSpill
[]
colorScan_spin iterative triv spill graph
ksTriv ksSpill kksCoalesce
-- if the graph is empty then we're done
| isNullUFM $ graphMap graph
= (ksTrivFound ++ ksTriv, ksSpill)
-- if we haven't found a trivially colorable node then we'll have to
-- choose a spill candidate and leave it uncolored
| [] <- ksTrivFound
, kSpill <- spill graph -- choose a spill candiate
, graph' <- delNode kSpill graph -- remove it from the graph
, nsRest' <- eltsUFM $ graphMap graph' -- graph has changed, so get new node list
= colorScan' triv spill graph'
ksTriv ksTrivFound
(kSpill : ksSpill)
nsRest'
-- we're at the end of the candidates list but we've found some triv nodes
-- along the way. We can delete them from the graph and go back for more.
| graph' <- foldr delNode graph ksTrivFound
, nsRest' <- eltsUFM $ graphMap graph'
= colorScan' triv spill graph'
(ksTrivFound ++ ksTriv) []
ksSpill
nsRest'
-- check if the current node is triv colorable
colorScan' triv spill graph
ksTriv ksTrivFound
ksSpill
(node : nsRest)
-- node is trivially colorable
-- add it to the found nodes list and carry on.
| k <- nodeId node
, triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)
= colorScan' triv spill graph
ksTriv (k : ksTrivFound)
= (ksTriv, ksSpill, kksCoalesce)
-- Simplify:
-- Look for trivially colorable nodes.
-- If we can find some then remove them from the graph and go back for more.
--
| nsTrivFound@(_:_)
<- scanGraph (\node -> triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)
-- for iterative coalescing we only want non-move related
-- nodes here
&& (not iterative || isEmptyUniqSet (nodeCoalesce node)))
$ graph
, ksTrivFound <- map nodeId nsTrivFound
, graph3 <- foldr delNode graph ksTrivFound
= colorScan_spin iterative triv spill graph3
(ksTrivFound ++ ksTriv)
ksSpill
nsRest
-- node wasn't trivially colorable, skip over it and look in the rest of the list
kksCoalesce
-- Coalesce:
-- If we're doing iterative coalescing and no triv nodes are avaliable
-- then it's type for a coalescing pass.
| 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.
(graph2, kksCoalesceFound @(_:_))
-> colorScan_spin iterative triv spill graph2
ksTriv ksSpill (kksCoalesceFound ++ kksCoalesce)
-- Freeze:
-- nothing could be coalesced (or was triv),
-- time to choose a node to freeze and give up on ever coalescing it.
(graph2, [])
-> case freezeOneInGraph graph2 of
-- we were able to freeze something
-- hopefully this will free up something for Simplify
(graph3, True)
-> colorScan_spin iterative triv spill graph3
ksTriv ksSpill kksCoalesce
-- we couldn't find something to freeze either
-- time for a spill
(graph3, False)
-> colorScan_spill iterative triv spill graph3
ksTriv ksSpill kksCoalesce
-- spill time
| otherwise
= colorScan' triv spill graph
ksTriv ksTrivFound
ksSpill
nsRest
= colorScan_spill iterative triv spill graph
ksTriv ksSpill kksCoalesce
{- -- This is cute and easy to understand, but too slow.. BL 2007/09
colorScan colors triv spill safe prob graph
-- Select:
-- we couldn't find any triv nodes or things to freeze or coalesce,
-- and the graph isn't empty yet.. We'll have to choose a spill
-- candidate and leave it uncolored.
--
colorScan_spill iterative triv spill graph
ksTriv ksSpill kksCoalesce
-- empty graphs are easy to color.
| isNullUFM $ graphMap graph
= (safe, prob)
-- Try and find a trivially colorable node.
| Just node <- find (\node -> triv (nodeClass node)
(nodeConflicts node)
(nodeExclusions node))
$ eltsUFM $ graphMap graph
, k <- nodeId node
= colorScan colors triv spill
(k : safe) prob (delNode k graph)
= let kSpill = spill graph
graph' = delNode kSpill graph
in colorScan_spin iterative triv spill graph'
ksTriv (kSpill : ksSpill) kksCoalesce
-- There was no trivially colorable node,
-- Choose one to potentially leave uncolored. We /might/ be able to find
-- a color for this later on, but no guarantees.
| k <- spill graph
= colorScan colors triv spill
safe (addOneToUniqSet prob k) (delNode k graph)
-}
-- | Try to assign a color to all these nodes.
......
-- | Basic operations on graphs.
--
-- TODO: refine coalescing crieteria
{-# OPTIONS -fno-warn-missing-signatures #-}
module GraphOps (
......@@ -10,8 +12,9 @@ module GraphOps (
addCoalesce, delCoalesce,
addExclusion,
addPreference,
coalesceGraph,
coalesceNodes,
coalesceNodes, coalesceGraph,
freezeNode, freezeOneInGraph, freezeAllInGraph,
scanGraph,
setColor,
validateGraph,
slurpNodeConflictCount
......@@ -117,6 +120,7 @@ modNode f k graph
Nothing -> Nothing
-- | Get the size of the graph, O(n)
size :: Uniquable k
=> Graph k cls color -> Int
......@@ -132,8 +136,6 @@ union :: Uniquable k
union graph1 graph2
= Graph
{ graphMap = plusUFM (graphMap graph1) (graphMap graph2) }
-- | Add a conflict between nodes to the graph, creating the nodes required.
......@@ -267,11 +269,16 @@ addPreference (u, c) color
--
coalesceGraph
:: (Uniquable k, Ord k, Eq cls, Outputable k)
=> Triv k cls color
=> Bool -- ^ If True, coalesce nodes even if this might make the graph
-- less colorable (aggressive coalescing)
-> Triv k cls color
-> Graph k cls color
-> (Graph k cls color, [(k, k)])
coalesceGraph triv graph
coalesceGraph aggressive triv graph
= coalesceGraph' aggressive triv graph []
coalesceGraph' aggressive triv graph kkPairsAcc
= let
-- find all the nodes that have coalescence edges
cNodes = filter (\node -> not $ isEmptyUniqSet (nodeCoalesce node))
......@@ -290,9 +297,12 @@ coalesceGraph triv graph
-- do the coalescing, returning the new graph and a list of pairs of keys
-- that got coalesced together.
(graph', mPairs)
= mapAccumL (coalesceNodes False triv) graph cList
= mapAccumL (coalesceNodes aggressive triv) graph cList
in (graph', catMaybes mPairs)
-- keep running until there are no more coalesces can be found
in case catMaybes mPairs of
[] -> (graph', kkPairsAcc)
pairs -> coalesceGraph' aggressive triv graph' (pairs ++ kkPairsAcc)
-- | Coalesce this pair of nodes unconditionally / agressively.
......@@ -318,8 +328,8 @@ coalesceNodes aggressive triv graph (k1, k2)
else (k2, k1)
-- the nodes being coalesced must be in the graph
, Just nMin <- lookupNode graph kMin
, Just nMax <- lookupNode graph kMax
, Just nMin <- lookupNode graph kMin
, Just nMax <- lookupNode graph kMax
-- can't coalesce conflicting modes
, not $ elementOfUniqSet kMin (nodeConflicts nMax)
......@@ -384,7 +394,107 @@ coalesceNodes_check aggressive triv graph kMin kMax node
in (graph', Just (kMax, kMin))
-- | Freeze a node
-- This is for the iterative coalescer.
-- By freezing a node we give up on ever coalescing it.
-- Move all its coalesce edges into the frozen set - and update
-- back edges from other nodes.
--
freezeNode
:: Uniquable k
=> k -- ^ key of the node to freeze
-> Graph k cls color -- ^ the graph
-> Graph k cls color -- ^ graph with that node frozen
freezeNode k
= graphMapModify
$ \fm ->
let
-- freeze all the edges in the node to be frozen
Just node = lookupUFM fm k
node' = node
{ nodeCoalesce = emptyUniqSet }
fm1 = addToUFM fm k node'
-- update back edges pointing to this node
freezeEdge k node
= if elementOfUniqSet k (nodeCoalesce node)
then node
{ nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k }
else panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
fm2 = foldUniqSet (adjustUFM (freezeEdge k)) fm1
$ nodeCoalesce node
in fm2
-- | Freeze one node in the graph
-- This if for the iterative coalescer.
-- Look for a move related node of low degree and freeze it.
--
-- We probably don't need to scan the whole graph looking for the node of absolute
-- lowest degree. Just sample the first few and choose the one with the lowest
-- degree out of those. Also, we don't make any distinction between conflicts of different
-- classes.. this is just a heuristic, after all.
--
-- IDEA: freezing a node might free it up for Simplify.. would be good to check for triv
-- right here, and add it to a worklist if known triv/non-move nodes.
--
freezeOneInGraph
:: (Uniquable k, Outputable k)
=> Graph k cls color
-> ( Graph k cls color -- the new graph
, Bool ) -- whether we found a node to freeze
freezeOneInGraph graph
= let compareNodeDegree n1 n2
= compare (sizeUniqSet $ nodeConflicts n1) (sizeUniqSet $ nodeConflicts n2)
candidates
= sortBy compareNodeDegree
$ take 5 -- 5 isn't special, it's just a small number.
$ scanGraph (\node -> not $ isEmptyUniqSet (nodeCoalesce node)) graph
in case candidates of
-- there wasn't anything available to freeze
[] -> (graph, False)
-- we found something to freeze
(n : _)
-> ( freezeNode (nodeId n) graph
, True)
-- | Freeze all the nodes in the graph
-- for debugging the iterative allocator.
--
freezeAllInGraph
:: (Uniquable k, Outputable k)
=> Graph k cls color
-> Graph k cls color
freezeAllInGraph graph
= foldr freezeNode graph
$ map nodeId
$ eltsUFM $ graphMap graph
-- | Find all the nodes in the graph that meet some criteria
--
scanGraph
:: Uniquable k
=> (Node k cls color -> Bool)
-> Graph k cls color
-> [Node k cls color]
scanGraph match graph
= filter match $ eltsUFM $ graphMap graph
-- | validate the internal structure of a graph
-- all its edges should point to valid nodes
-- if they don't then throw an error
......@@ -396,12 +506,10 @@ validateGraph
-> Graph k cls color
validateGraph doc graph
= let edges = unionUniqSets
(unionManyUniqSets
(map nodeConflicts $ eltsUFM $ graphMap graph))
(unionManyUniqSets
(map nodeCoalesce $ eltsUFM $ graphMap graph))
= let edges = unionManyUniqSets
( (map nodeConflicts $ eltsUFM $ graphMap graph)
++ (map nodeCoalesce $ eltsUFM $ graphMap graph))
nodes = mkUniqSet $ map nodeId $ eltsUFM $ graphMap graph
badEdges = minusUniqSet edges nodes
......
......@@ -27,6 +27,7 @@ import UniqSet
import UniqFM
import Bag
import Outputable
import DynFlags
import Data.List
import Data.Maybe
......@@ -43,7 +44,7 @@ maxSpinCount = 10
-- | The top level of the graph coloring register allocator.
--
regAlloc
:: Bool -- ^ whether to generate RegAllocStats, or not.
:: DynFlags
-> UniqFM (UniqSet Reg) -- ^ the registers we can use for allocation
-> UniqSet Int -- ^ the set of available spill slots.
-> [LiveCmmTop] -- ^ code annotated with liveness information.
......@@ -51,16 +52,25 @@ regAlloc
( [NatCmmTop] -- ^ code with registers allocated.
, [RegAllocStats] ) -- ^ stats for each stage of allocation
regAlloc dump regsFree slotsFree code
regAlloc dflags regsFree slotsFree code
= do
(code_final, debug_codeGraphs, _)
<- regAlloc_spin dump 0 trivColorable regsFree slotsFree [] code
<- regAlloc_spin dflags 0 trivColorable regsFree slotsFree [] code
return ( code_final
, reverse debug_codeGraphs )
regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
= do
-- if any of these dump flags are turned on we want to hang on to
-- intermediate structures in the allocator - otherwise tell the
-- allocator to ditch them early so we don't end up creating space leaks.
let dump = or
[ dopt Opt_D_dump_asm_regalloc_stages 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."
......@@ -102,7 +112,10 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
-- try and color the graph
let (graph_colored, rsSpill, rmCoalesce)
= {-# SCC "ColorGraph" #-} Color.colorGraph regsFree triv spill graph
= {-# SCC "ColorGraph" #-}
Color.colorGraph
(dopt Opt_RegsIterative dflags)
regsFree triv spill graph
-- rewrite regs in the code that have been coalesced
let patchF reg = case lookupUFM rmCoalesce reg of
......@@ -176,7 +189,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
-- space leak avoidance
seqList statList `seq` return ()
regAlloc_spin dump (spinCount + 1) triv regsFree slotsFree'
regAlloc_spin dflags (spinCount + 1) triv regsFree slotsFree'
statList
code_relive
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment