Add -dasm-lint

When -dasm-lint is turned on the register conflict graph is checked for 
internal consistency after each build/color pass. Make sure that all 
edges point to valid nodes, that nodes are colored differently to their
neighbours, and if the graph is supposed to be colored, that all nodes
actually have a color.
parent 72db4d05
......@@ -156,6 +156,7 @@ data DynFlag
| Opt_DoCoreLinting
| Opt_DoStgLinting
| Opt_DoCmmLinting
| Opt_DoAsmLinting
| Opt_WarnIsError -- -Werror; makes warnings fatal
| Opt_WarnDuplicateExports
......@@ -1089,6 +1090,7 @@ dynamic_flags = [
, ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting))
, ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting))
, ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting))
, ( "dasm-lint", NoArg (setDynFlag Opt_DoAsmLinting))
, ( "dshow-passes", NoArg (do setDynFlag Opt_ForceRecomp
setVerbosity (Just 2)) )
, ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats))
......
......@@ -139,8 +139,16 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
-- see if we've found a coloring
if isEmptyUniqSet rsSpill
then do
-- if -fasm-lint is turned on then validate the graph
let graph_colored_lint =
if dopt Opt_DoAsmLinting dflags
then Color.validateGraph (text "")
True -- require all nodes to be colored
graph_colored
else graph_colored
-- patch the registers using the info in the graph
let code_patched = map (patchRegsFromGraph graph_colored) code_coalesced2
let code_patched = map (patchRegsFromGraph graph_colored_lint) code_coalesced2
-- clean out unneeded SPILL/RELOADs
let code_spillclean = map cleanSpills code_patched
......@@ -155,7 +163,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
-- record what happened in this stage for debugging
let stat =
RegAllocStatsColored
{ raGraph = graph_colored
{ raGraph = graph_colored_lint
, raCoalesced = rmCoalesce
, raPatched = code_patched
, raSpillClean = code_spillclean
......@@ -172,10 +180,18 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
return ( code_final
, statList
, graph_colored)
, graph_colored_lint)
-- we couldn't find a coloring, time to spill something
else do
-- if -fasm-lint is turned on then validate the graph
let graph_colored_lint =
if dopt Opt_DoAsmLinting dflags
then Color.validateGraph (text "")
False -- don't require nodes to be colored
graph_colored
else graph_colored
-- spill the uncolored regs
(code_spilled, slotsFree', spillStats)
<- regSpill code_coalesced2 slotsFree rsSpill
......@@ -187,7 +203,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
-- record what happened in this stage for debugging
let stat =
RegAllocStatsSpill
{ raGraph = graph_colored
{ raGraph = graph_colored_lint
, raCoalesced = rmCoalesce
, raSpillStats = spillStats
, raSpillCosts = spillCosts
......
......@@ -499,30 +499,76 @@ scanGraph match graph
-- | validate the internal structure of a graph
-- all its edges should point to valid nodes
-- if they don't then throw an error
-- If they don't then throw an error
--
validateGraph
:: (Uniquable k, Outputable k)
=> SDoc
-> Graph k cls color
-> Graph k cls color
:: (Uniquable k, Outputable k, Eq color)
=> SDoc -- ^ extra debugging info to display on error
-> Bool -- ^ whether this graph is supposed to be colored.
-> Graph k cls color -- ^ graph to validate
-> Graph k cls color -- ^ validated graph
validateGraph doc isColored graph
-- Check that all edges point to valid nodes.
| edges <- unionManyUniqSets
( (map nodeConflicts $ eltsUFM $ graphMap graph)
++ (map nodeCoalesce $ eltsUFM $ graphMap graph))
, nodes <- mkUniqSet $ map nodeId $ eltsUFM $ graphMap graph
, badEdges <- minusUniqSet edges nodes
, not $ isEmptyUniqSet badEdges
= pprPanic "GraphOps.validateGraph"
( text "Graph has edges that point to non-existant nodes"
$$ text " bad edges: " <> vcat (map ppr $ uniqSetToList badEdges)
$$ doc )
-- Check that no conflicting nodes have the same color
| badNodes <- filter (not . (checkNode graph))
$ eltsUFM $ graphMap graph
, not $ null badNodes
= pprPanic "GraphOps.validateGraph"
( text "Node has same color as one of it's conflicts"
$$ text " bad nodes: " <> hcat (map (ppr . nodeId) badNodes)
$$ doc)
-- If this is supposed to be a colored graph,
-- check that all nodes have a color.
| isColored
, badNodes <- filter (\n -> isNothing $ nodeColor n)
$ eltsUFM $ graphMap graph
, not $ null badNodes
= pprPanic "GraphOps.validateGraph"
( text "Supposably colored graph has uncolored nodes."
$$ text " uncolored nodes: " <> hcat (map (ppr . nodeId) badNodes)
$$ doc )
-- graph looks ok
| otherwise
= graph
validateGraph doc graph
= let edges = unionManyUniqSets
( (map nodeConflicts $ eltsUFM $ graphMap graph)
++ (map nodeCoalesce $ eltsUFM $ graphMap graph))
nodes = mkUniqSet $ map nodeId $ eltsUFM $ graphMap graph
-- | If this node is colored, check that all the nodes which
-- conflict with it have different colors.
checkNode
:: (Uniquable k, Eq color)
=> Graph k cls color
-> Node k cls color
-> Bool -- ^ True if this node is ok
badEdges = minusUniqSet edges nodes
checkNode graph node
| Just color <- nodeColor node
, Just neighbors <- sequence $ map (lookupNode graph)
$ uniqSetToList $ nodeConflicts node
, neighbourColors <- catMaybes $ map nodeColor neighbors
, elem color neighbourColors
= False
in if isEmptyUniqSet badEdges
then graph
else pprPanic "GraphOps.validateGraph"
( text "-- bad edges"
$$ vcat (map ppr $ uniqSetToList badEdges)
$$ text "----------------------------"
$$ doc)
| otherwise
= True
-- | Slurp out a map of how many nodes had a certain number of conflict neighbours
......
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