summaryrefslogtreecommitdiff
path: root/compiler/profiling
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/profiling')
-rw-r--r--compiler/profiling/CostCentre.lhs39
-rw-r--r--compiler/profiling/SCCfinal.lhs2
2 files changed, 40 insertions, 1 deletions
diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs
index 8d9c269305..7e6959baaa 100644
--- a/compiler/profiling/CostCentre.lhs
+++ b/compiler/profiling/CostCentre.lhs
@@ -29,6 +29,7 @@ module CostCentre (
cmpCostCentre -- used for removing dups in a list
) where
+import Binary
import Var
import Name
import Module
@@ -294,4 +295,42 @@ costCentreUserNameFS (NormalCC {cc_name = name, cc_is_caf = is_caf})
costCentreSrcSpan :: CostCentre -> SrcSpan
costCentreSrcSpan = cc_loc
+
+instance Binary IsCafCC where
+ put_ bh CafCC = do
+ putByte bh 0
+ put_ bh NotCafCC = do
+ putByte bh 1
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do return CafCC
+ _ -> do return NotCafCC
+
+instance Binary CostCentre where
+ put_ bh (NormalCC aa ab ac _ad ae) = do
+ putByte bh 0
+ put_ bh aa
+ put_ bh ab
+ put_ bh ac
+ put_ bh ae
+ put_ bh (AllCafsCC ae _af) = do
+ putByte bh 1
+ put_ bh ae
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do aa <- get bh
+ ab <- get bh
+ ac <- get bh
+ ae <- get bh
+ return (NormalCC aa ab ac noSrcSpan ae)
+ _ -> do ae <- get bh
+ return (AllCafsCC ae noSrcSpan)
+
+ -- We ignore the SrcSpans in CostCentres when we serialise them,
+ -- and set the SrcSpans to noSrcSpan when deserialising. This is
+ -- ok, because we only need the SrcSpan when declaring the
+ -- CostCentre in the original module, it is not used by importing
+ -- modules.
\end{code}
diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs
index 77e2cb78c0..5417ad491e 100644
--- a/compiler/profiling/SCCfinal.lhs
+++ b/compiler/profiling/SCCfinal.lhs
@@ -91,7 +91,7 @@ stgMassageForProfiling dflags mod_name _us stg_binds
do_top_rhs _ (StgRhsClosure _ _ _ _ _ []
(StgSCC _cc False{-not tick-} _push (StgConApp con args)))
- | not (isDllConApp dflags con args)
+ | not (isDllConApp dflags mod_name con args)
-- Trivial _scc_ around nothing but static data
-- Eliminate _scc_ ... and turn into StgRhsCon