Don't try and coalesce nodes with themselves

diff --git a/compiler/nativeGen/GraphColor.hs b/compiler/nativeGen/GraphColor.hs
index dfb2d17..307803a 100644 (file)
--- a/compiler/nativeGen/GraphColor.hs
+++ b/compiler/nativeGen/GraphColor.hs
@@ -154,7 +154,10 @@ colorScan_spin iterative triv spill graph
                        $ graph
 
        , ksTrivFound   <- map nodeId nsTrivFound
-       , graph3        <- foldr delNode graph ksTrivFound
+       , graph3        <- foldr (\k g -> let Just g' = delNode k g
+                                         in  g')
+                               graph ksTrivFound
+
        = colorScan_spin iterative triv spill graph3
                (ksTrivFound ++ ksTriv)
                ksSpill
@@ -204,8 +207,8 @@ colorScan_spin iterative triv spill graph
 colorScan_spill iterative triv spill graph
        ksTriv ksSpill kksCoalesce
 
- = let kSpill  = spill graph
-       graph'  = delNode kSpill graph
+ = let kSpill          = spill graph
+       Just graph'     = delNode kSpill graph
    in  colorScan_spin iterative triv spill graph'
                ksTriv (kSpill : ksSpill) kksCoalesce
        

diff --git a/compiler/nativeGen/GraphOps.hs b/compiler/nativeGen/GraphOps.hs
index c494e63..414abe4 100644 (file)
--- a/compiler/nativeGen/GraphOps.hs
+++ b/compiler/nativeGen/GraphOps.hs
@@ -78,28 +78,28 @@ addNode k node graph
        { graphMap      = addToUFM map_coalesce k node}
                
 
-
 -- | Delete a node and all its edges from the graph.
---     Throws an error if it's not there.
-delNode :: Uniquable k
-       => k -> Graph k cls color -> Graph k cls color
+delNode :: (Uniquable k, Outputable k)
+       => k -> Graph k cls color -> Maybe (Graph k cls color)
 
 delNode k graph
- = let Just node       = lookupNode graph k
-
-       -- delete conflict edges from other nodes to this one.
-       graph1          = foldl' (\g k1 -> let Just g' = delConflict k1 k g in g') graph
+       | Just node     <- lookupNode graph k
+       = let   -- delete conflict edges from other nodes to this one.
+               graph1  = foldl' (\g k1 -> let Just g' = delConflict k1 k g in g') graph
                        $ uniqSetToList (nodeConflicts node)
        
-       -- delete coalesce edge from other nodes to this one.
-       graph2          = foldl' (\g k1 -> let Just g' = delCoalesce k1 k g in g') graph1
+               -- delete coalesce edge from other nodes to this one.
+               graph2  = foldl' (\g k1 -> let Just g' = delCoalesce k1 k g in g') graph1
                        $ uniqSetToList (nodeCoalesce node)
        
-       -- delete the node
-       graph3          = graphMapModify (\fm -> delFromUFM fm k) graph2
+               -- delete the node
+               graph3  = graphMapModify (\fm -> delFromUFM fm k) graph2
        
-  in   graph3
+         in    Just graph3
                
+       | otherwise
+       = Nothing
+
 
 -- | Modify a node in the graph.
 --     returns Nothing if the node isn't present.
@@ -350,6 +350,9 @@ coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
        | not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax))
        = error "GraphOps.coalesceNodes: can't coalesce colored nodes."
 
+       | nodeId nMin == nodeId nMax
+       = error "GraphOps.coalesceNodes: can't coalesce the same node."
+
        ---
        | otherwise
        = let
@@ -387,12 +390,11 @@ coalesceNodes_check aggressive triv graph kMin kMax node
 
        | otherwise
        = let -- delete the old nodes from the graph and add the new one
-               graph'  = addNode kMin node
-                       $ delNode kMin
-                       $ delNode kMax
-                       $ graph
+               Just graph1     = delNode kMax graph
+               Just graph2     = delNode kMin graph1
+               graph3          = addNode kMin node graph2
 
-         in    (graph', Just (kMax, kMin))
+         in    (graph3, Just (kMax, kMin))
 
 
 -- | Freeze a node

diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs
index 5f8db17..b55d8c0 100644 (file)
--- a/compiler/nativeGen/RegLiveness.hs
+++ b/compiler/nativeGen/RegLiveness.hs
@@ -283,7 +283,10 @@ slurpReloadCoalesce live
                -- add an edge betwen the this reg and the last one stored into the slot
                | RELOAD slot reg       <- instr
                = case lookupUFM slotMap slot of
-                       Just reg2       -> (slotMap, Just (reg, reg2))
+                       Just reg2
+                        | reg /= reg2  -> (slotMap, Just (reg, reg2))
+                        | otherwise    -> (slotMap, Nothing)
+
                        Nothing         -> (slotMap, Nothing)
 
                | otherwise