Commit 1de43f7c authored by Ian Lynagh's avatar Ian Lynagh
Browse files

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

parents 7960c828 592b33e2
......@@ -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
......
......@@ -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) }
......
......@@ -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)
......
......@@ -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}
%************************************************************************
......
......@@ -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);
}
}
}
......
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