Cure space leak in coloring register allocator

We now do a deep seq on the graph after it is 'built', but before coloring.
Without this, the colorer will just force bits of it and the heap will
fill up with half evaluated pieces of graph from previous build/spill
stages and zillions of apply thunks.
parent 94368126
......@@ -78,7 +78,7 @@ colorGraph colors triv spill graph0
$$ dotGraph (\x -> text "white") triv graph1) -}
else ( graph_prob
, mkUniqSet ksNoColor
, mkUniqSet ksNoColor
, listToUFM rsCoalesce)
......
......@@ -187,13 +187,13 @@ addConflicts conflicts getClass
| otherwise
= graphMapModify
$ (\fm -> foldr (\u -> addConflictSet1 u getClass conflicts) fm
$ (\fm -> foldl' (\g u -> addConflictSet1 u getClass conflicts g) fm
$ uniqSetToList conflicts)
addConflictSet1 u getClass set
= let set' = delOneFromUniqSet set u
in adjustWithDefaultUFM
= case delOneFromUniqSet set u of
set' -> adjustWithDefaultUFM
(\node -> node { nodeConflicts = unionUniqSets set' (nodeConflicts node) } )
(newNode u (getClass u)) { nodeConflicts = set' }
u
......@@ -468,5 +468,4 @@ adjustUFM f k map
= case lookupUFM map k of
Nothing -> map
Just a -> addToUFM map k (f a)
-- | Graph coloring register allocator.
--
-- TODO:
-- Live range splitting:
-- At the moment regs that are spilled are spilled for all time, even though
-- we might be able to allocate them a hardreg in different parts of the code.
--
-- As we're aggressively coalescing before register allocation proper we're not currently
-- using the coalescence information present in the graph.
--
-- The function that choosing the potential spills could be a bit cleverer.
--
-- Colors in graphviz graphs could be nicer.
--
{-# OPTIONS -fno-warn-missing-signatures #-}
......@@ -35,7 +27,6 @@ import UniqSet
import UniqFM
import Bag
import Outputable
import Util
import Data.List
import Data.Maybe
......@@ -82,6 +73,14 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
-- build a conflict graph from the code.
graph <- {-# SCC "BuildGraph" #-} buildGraph code
-- VERY IMPORTANT:
-- We really do want the graph to be fully evaluated _before_ we start coloring.
-- If we don't do this now then when the call to Color.colorGraph forces bits of it,
-- the heap will be filled with half evaluated pieces of graph and zillions of apply thunks.
--
seqGraph graph `seq` return ()
-- build a map of how many instructions each reg lives for.
-- this is lazy, it won't be computed unless we need to spill
......@@ -137,7 +136,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
, raPatched = code_patched
, raSpillClean = code_spillclean
, raFinal = code_final
, raSRMs = foldl addSRM (0, 0, 0) $ map countSRMs code_spillclean }
, raSRMs = foldl' addSRM (0, 0, 0) $ map countSRMs code_spillclean }
let statList =
......@@ -145,7 +144,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
else []
-- space leak avoidance
seqList statList $! return ()
seqList statList `seq` return ()
return ( code_final
, statList
......@@ -175,7 +174,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
else []
-- space leak avoidance
seqList statList $! return ()
seqList statList `seq` return ()
regAlloc_spin dump (spinCount + 1) triv regsFree slotsFree'
statList
......@@ -320,6 +319,63 @@ patchRegsFromGraph graph code
plusUFMs_C :: (elt -> elt -> elt) -> [UniqFM elt] -> UniqFM elt
plusUFMs_C f maps
= foldl (plusUFM_C f) emptyUFM maps
= foldl' (plusUFM_C f) emptyUFM maps
-----
-- for when laziness just isn't what you wanted...
--
seqGraph :: Color.Graph Reg RegClass Reg -> ()
seqGraph graph = seqNodes (eltsUFM (Color.graphMap graph))
seqNodes :: [Color.Node Reg RegClass Reg] -> ()
seqNodes ns
= case ns of
[] -> ()
(n : ns) -> seqNode n `seq` seqNodes ns
seqNode :: Color.Node Reg RegClass Reg -> ()
seqNode node
= seqReg (Color.nodeId node)
`seq` seqRegClass (Color.nodeClass node)
`seq` seqMaybeReg (Color.nodeColor node)
`seq` (seqRegList (uniqSetToList (Color.nodeConflicts node)))
`seq` (seqRegList (uniqSetToList (Color.nodeExclusions node)))
`seq` (seqRegList (Color.nodePreference node))
`seq` (seqRegList (uniqSetToList (Color.nodeCoalesce node)))
seqReg :: Reg -> ()
seqReg reg
= case reg of
RealReg _ -> ()
VirtualRegI _ -> ()
VirtualRegHi _ -> ()
VirtualRegF _ -> ()
VirtualRegD _ -> ()
seqRegClass :: RegClass -> ()
seqRegClass c
= case c of
RcInteger -> ()
RcFloat -> ()
RcDouble -> ()
seqMaybeReg :: Maybe Reg -> ()
seqMaybeReg mr
= case mr of
Nothing -> ()
Just r -> seqReg r
seqRegList :: [Reg] -> ()
seqRegList rs
= case rs of
[] -> ()
(r : rs) -> seqReg r `seq` seqRegList rs
seqList :: [a] -> ()
seqList ls
= case ls of
[] -> ()
(r : rs) -> r `seq` seqList rs
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