Merge branch 'master' of http://darcs.haskell.org/ghc

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 3ae2996..55a5b73 100644 (file)
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -42,8 +42,8 @@ data CmmExpr
   | CmmRegOff CmmReg Int       
        -- CmmRegOff reg i
        --        ** is shorthand only, meaning **
-       -- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
-       --      where rep = cmmRegType reg
+       -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]
+       --      where rep = typeWidth (cmmRegType reg)
 
 instance Eq CmmExpr where      -- Equality ignores the types
   CmmLit l1                == CmmLit l2         = l1==l2
@@ -124,6 +124,8 @@ cmmExprType (CmmReg reg)            = cmmRegType reg
 cmmExprType (CmmMachOp op args) = machOpResultType op (map cmmExprType args)
 cmmExprType (CmmRegOff reg _)   = cmmRegType reg
 cmmExprType (CmmStackSlot _ _)  = bWord -- an address
+-- Careful though: what is stored at the stack slot may be bigger than
+-- an address
 
 cmmLitType :: CmmLit -> CmmType
 cmmLitType (CmmInt _ width)     = cmmBits  width

diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs
index 8d3a06b..f624c1c 100644 (file)
--- a/compiler/cmm/OptimizationFuel.hs
+++ b/compiler/cmm/OptimizationFuel.hs
@@ -21,9 +21,7 @@ import Data.IORef
 import Control.Monad
 import StaticFlags (opt_Fuel)
 import UniqSupply
-#ifdef DEBUG
 import Panic
-#endif
 
 import Compiler.Hoopl
 import Compiler.Hoopl.GHC (getFuel, setFuel)
@@ -53,7 +51,6 @@ anyFuelLeft :: OptimizationFuel -> Bool
 oneLessFuel :: OptimizationFuel -> OptimizationFuel
 unlimitedFuel :: OptimizationFuel
 
-#ifdef DEBUG
 newtype OptimizationFuel = OptimizationFuel Int
   deriving Show
 
@@ -63,17 +60,6 @@ amountOfFuel (OptimizationFuel f) = f
 anyFuelLeft (OptimizationFuel f) = f > 0
 oneLessFuel (OptimizationFuel f) = ASSERT (f > 0) (OptimizationFuel (f - 1))
 unlimitedFuel = OptimizationFuel infiniteFuel
-#else
--- type OptimizationFuel = State# () -- would like this, but it won't work
-data OptimizationFuel = OptimizationFuel
-  deriving Show
-tankFilledTo _ = OptimizationFuel
-amountOfFuel _ = maxBound
-
-anyFuelLeft _ = True
-oneLessFuel _ = OptimizationFuel
-unlimitedFuel = OptimizationFuel
-#endif
 
 data FuelState = FuelState { fs_fuel :: OptimizationFuel, fs_lastpass :: String }
 newtype FuelUniqSM a = FUSM { unFUSM :: FuelState -> UniqSM (a, FuelState) }

diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index 388b968..1fa4199 100644 (file)
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -61,14 +61,14 @@ addNode k node graph
        -- add back conflict edges from other nodes to this one
        map_conflict    
                = foldUniqSet 
-                       (adjustUFM (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
+                       (adjustUFM_C (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
                        (graphMap graph)
                        (nodeConflicts node)
                        
        -- add back coalesce edges from other nodes to this one
        map_coalesce
                = foldUniqSet
-                       (adjustUFM (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
+                       (adjustUFM_C (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
                        map_conflict
                        (nodeCoalesce node)
        
@@ -434,7 +434,7 @@ freezeNode k
                else node       -- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
                                -- If the edge isn't actually in the coelesce set then just ignore it.
 
-       fm2     = foldUniqSet (adjustUFM (freezeEdge k)) fm1
+       fm2     = foldUniqSet (adjustUFM_C (freezeEdge k)) fm1
                        $ nodeCoalesce node
 
     in fm2
@@ -604,7 +604,7 @@ setColor
        
 setColor u color
        = graphMapModify
-       $ adjustUFM
+       $ adjustUFM_C
                (\n -> n { nodeColor = Just color })
                u 
        
@@ -621,13 +621,14 @@ adjustWithDefaultUFM f def k map
                map
                k def
                
-{-# INLINE adjustUFM #-}
-adjustUFM 
+-- Argument order different from UniqFM's adjustUFM
+{-# INLINE adjustUFM_C #-}
+adjustUFM_C 
        :: Uniquable k
        => (a -> a)
        -> k -> UniqFM a -> UniqFM a
 
-adjustUFM f k map
+adjustUFM_C f k map
  = case lookupUFM map k of
        Nothing -> map
        Just a  -> addToUFM map k (f a)

diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 31d1e87..7302b02 100644 (file)
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -36,6 +36,8 @@ module UniqFM (
        addListToUFM,addListToUFM_C,
        addToUFM_Directly,
        addListToUFM_Directly,
+       adjustUFM,
+       adjustUFM_Directly,
        delFromUFM,
        delFromUFM_Directly,
        delListFromUFM,
@@ -53,12 +55,15 @@ module UniqFM (
        lookupUFM, lookupUFM_Directly,
        lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
        eltsUFM, keysUFM, splitUFM,
-       ufmToList 
+       ufmToList,
+       joinUFM
     ) where
 
 import Unique           ( Uniquable(..), Unique, getKey )
 import Outputable
 
+import Compiler.Hoopl   hiding (Unique)
+
 import qualified Data.IntMap as M
 \end{code}
 
@@ -103,6 +108,9 @@ addListToUFM_C      :: Uniquable key => (elt -> elt -> elt)
                           -> UniqFM elt -> [(key,elt)]
                           -> UniqFM elt
 
+adjustUFM      :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt
+adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt
+
 delFromUFM     :: Uniquable key => UniqFM elt -> key    -> UniqFM elt
 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
@@ -175,6 +183,9 @@ addToUFM_Acc exi new (UFM m) k v =
   UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
 addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)
 
+adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)
+adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
+
 delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
 delListFromUFM = foldl delFromUFM
 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
@@ -207,6 +218,16 @@ keysUFM (UFM m) = map getUnique $ M.keys m
 eltsUFM (UFM m) = M.elems m
 ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
 
+-- Hoopl
+joinUFM :: JoinFun v -> JoinFun (UniqFM v)
+joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, old) new
+    where add k new_v (ch, joinmap) =
+            case lookupUFM_Directly joinmap k of
+                Nothing -> (SomeChange, addToUFM_Directly joinmap k new_v)
+                Just old_v -> case eltJoin l (OldFact old_v) (NewFact new_v) of
+                                (SomeChange, v') -> (SomeChange, addToUFM_Directly joinmap k v')
+                                (NoChange, _) -> (ch, joinmap)
+
 \end{code}
 
 %************************************************************************

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index d0dd44d..05bc8f2 100644 (file)
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -643,8 +643,12 @@ GarbageCollect (rtsBool force_major_gc,
   // zero the scavenged static object list 
   if (major_gc) {
       nat i;
-      for (i = 0; i < n_gc_threads; i++) {
-          zero_static_object_list(gc_threads[i]->scavenged_static_objects);
+      if (n_gc_threads == 1) {
+          zero_static_object_list(gct->scavenged_static_objects);
+      } else {
+          for (i = 0; i < n_gc_threads; i++) {
+              zero_static_object_list(gc_threads[i]->scavenged_static_objects);
+          }
       }
   }