Remove export of remove_entry_label

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

diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs
index 5601350..067a8ec 100644 (file)
--- a/compiler/cmm/CmmSpillReload.hs
+++ b/compiler/cmm/CmmSpillReload.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
 
 module CmmSpillReload
   ( ExtendWithSpills(..)
@@ -12,21 +11,23 @@ module CmmSpillReload
   , cmmAvailableReloads
   )
 where
+
 import CmmExpr
 import CmmTx
 import CmmLiveZ
 import DFMonad
+import MkZipCfg
+import PprCmm()
+import ZipCfg
+import ZipCfgCmmRep
+import ZipDataflow
+
 import FastString
 import Maybe
-import MkZipCfg
 import Outputable hiding (empty)
 import qualified Outputable as PP
 import Panic
-import PprCmm()
 import UniqSet
-import ZipCfg
-import ZipCfgCmm
-import ZipDataflow
 
 -- The point of this module is to insert spills and reloads to
 -- establish the invariant that at a call (or at any proc point with
@@ -79,7 +80,6 @@ dualLiveLattice =
 dualLivenessWithInsertion :: BPass M Last DualLive
 dualLivenessWithInsertion = a_ft_b_unlimited dualLiveness insertSpillsAndReloads
 
-
 dualLiveness :: BAnalysis M Last DualLive
 dualLiveness = BComp "dual liveness" exit last middle first
     where exit   = empty
@@ -94,36 +94,31 @@ dualLiveness = BComp "dual liveness" exit last middle first
             -- this pass again
 
 middleDualLiveness :: DualLive -> M -> DualLive
-middleDualLiveness live m@(Spill regs) =
+middleDualLiveness live (Spill regs) = live'
     -- live-in on-stack requirements are satisfied;
     -- live-out in-regs obligations are created
-      my_trace "before" (f4sep [ppr m, text "liveness is", ppr live']) $
-      live'
     where live' = DualLive { on_stack = on_stack live `minusRegSet` regs
-                           , in_regs = in_regs live `plusRegSet` regs }
+                           , in_regs  = in_regs  live `plusRegSet`  regs }
 
-middleDualLiveness live m@(Reload regs) =
+middleDualLiveness live (Reload regs) = live'
     -- live-in in-regs requirements are satisfied;
     -- live-out on-stack obligations are created
-      my_trace "before" (f4sep [ppr m, text "liveness is", ppr live']) $
-      live'
-    where live' = DualLive { on_stack = on_stack live `plusRegSet` regs
-                           , in_regs = in_regs live `minusRegSet` regs }
+    where live' = DualLive { on_stack = on_stack live `plusRegSet`  regs
+                           , in_regs  = in_regs  live `minusRegSet` regs }
 
 middleDualLiveness live (NotSpillOrReload m) = changeRegs (middleLiveness m) live
 
 lastDualLiveness :: (BlockId -> DualLive) -> Last -> DualLive
 lastDualLiveness env l = last l
-  where last (LastReturn ress)            = changeRegs (gen ress) empty
-        last (LastJump e args)            = changeRegs (gen e . gen args) empty
-        last (LastBranch id args)         = changeRegs (gen args) $ env id
-        last (LastCall tgt args Nothing)  = changeRegs (gen tgt. gen args) empty
-        last (LastCall tgt args (Just k)) = 
+  where last (LastReturn)            = empty
+        last (LastJump e)            = changeRegs (gen e) empty
+        last (LastBranch id)         = env id
+        last (LastCall tgt Nothing)  = changeRegs (gen tgt) empty
+        last (LastCall tgt (Just k)) = 
             -- nothing can be live in registers at this point
-            -- only 'formals' can be in regs at this point
             let live = env k in
             if  isEmptyUniqSet (in_regs live) then
-                DualLive (on_stack live) (gen tgt $ gen args emptyRegSet)
+                DualLive (on_stack live) (gen tgt emptyRegSet)
             else
                 panic "live values in registers at call continuation"
         last (LastCondBranch e t f) = changeRegs (gen e) $ dualUnion (env t) (env f)
@@ -265,6 +260,7 @@ middleAvail (NotSpillOrReload m) = middle m
         middle (CopyOut {})                    = id
 
 lastAvail :: AvailRegs -> Last -> LastOutFacts AvailRegs
+lastAvail _ (LastCall _ (Just k)) = LastOutFacts [(k, AvailRegs emptyRegSet)]
 lastAvail avail l = LastOutFacts $ map (\id -> (id, avail)) $ succs l