Generalized assignment rewriting pass.

[ghc-hetmet.git] / compiler / cmm / CmmSpillReload.hs

diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs
index d39bfa1..814bef1 100644 (file)
--- a/compiler/cmm/CmmSpillReload.hs
+++ b/compiler/cmm/CmmSpillReload.hs
@@ -421,9 +421,22 @@ deleteSinks n m = foldRegsUsed (adjustUFM f) m n
 
 -- Invalidates any expressions that use a register.
 invalidateUsersOf :: CmmReg -> AssignmentMap -> AssignmentMap
+-- foldUFM_Directly :: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
+invalidateUsersOf reg m = foldUFM_Directly f m m -- [foldUFM performance]
+    where f u (xassign -> Just e) m | reg `regUsedIn` e = addToUFM_Directly m u NeverOptimize
+          f _ _ m = m
+{- This requires the entire spine of the map to be continually rebuilt,
+ - which causes crazy memory usage!
 invalidateUsersOf reg = mapUFM (invalidateUsers' reg)
   where invalidateUsers' reg (xassign -> Just e) | reg `regUsedIn` e = NeverOptimize
         invalidateUsers' _ old = old
+-}
+
+-- Note [foldUFM performance]
+-- These calls to fold UFM no longer leak memory, but they do cause
+-- pretty killer amounts of allocation.  So they'll be something to
+-- optimize; we need an algorithmic change to prevent us from having to
+-- traverse the /entire/ map continually.
 
 middleAssignment :: WithRegUsage CmmNode O O -> AssignmentMap -> AssignmentMap
 
@@ -462,6 +475,11 @@ middleAssignment (Plain (CmmAssign (CmmLocal _) _)) assign = assign
 --  2. Look for all assignments that load from memory locations that
 --     were clobbered by this store and invalidate them.
 middleAssignment (Plain n@(CmmStore lhs rhs)) assign
+    = let m = deleteSinks n assign
+      in foldUFM_Directly f m m -- [foldUFM performance]
+      where f u (xassign -> Just x) m | (lhs, rhs) `clobbers` (u, x) = addToUFM_Directly m u NeverOptimize
+            f _ _ m = m
+{- Also leaky
     = mapUFM_Directly p . deleteSinks n $ assign
       -- ToDo: There's a missed opportunity here: even if a memory
       -- access we're attempting to sink gets clobbered at some
@@ -470,6 +488,7 @@ middleAssignment (Plain n@(CmmStore lhs rhs)) assign
       -- Unfortunately, it's too late to change the assignment...
       where p r (xassign -> Just x) | (lhs, rhs) `clobbers` (r, x) = NeverOptimize
             p _ old = old
+-}
 
 -- Assumption: Unsafe foreign calls don't clobber memory
 middleAssignment (Plain n@(CmmUnsafeForeignCall{})) assign
@@ -525,7 +544,7 @@ lastAssignment :: WithRegUsage CmmNode O C -> AssignmentMap -> [(Label, Assignme
 -- Variables are dead across calls, so invalidating all mappings is justified
 lastAssignment (Plain (CmmCall _ (Just k) _ _ _)) assign = [(k, mapUFM (const NeverOptimize) assign)]
 lastAssignment (Plain (CmmForeignCall {succ=k}))  assign = [(k, mapUFM (const NeverOptimize) assign)]
-lastAssignment l assign = map (\id -> (id, assign)) $ successors l
+lastAssignment l assign = map (\id -> (id, deleteSinks l assign)) $ successors l
 
 assignmentTransfer :: FwdTransfer (WithRegUsage CmmNode) AssignmentMap
 assignmentTransfer = mkFTransfer3 (flip const) middleAssignment ((mkFactBase assignmentLattice .) . lastAssignment)