diff options
author | Simon Marlow <marlowsd@gmail.com> | 2011-09-16 13:38:29 +0100 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2011-09-16 13:38:29 +0100 |
commit | 418140bd3d18331de697b8d27e2cf2fe762e5696 (patch) | |
tree | 7270340608fee094a440e70dea865e6c19ea4eb6 | |
parent | d60c977e7d92a11a1750cea8693fd386d3a7104e (diff) | |
download | haskell-418140bd3d18331de697b8d27e2cf2fe762e5696.tar.gz |
another snapshot
-rw-r--r-- | compiler/codeGen/CgProf.hs | 8 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 6 | ||||
-rw-r--r-- | compiler/coreSyn/CoreSyn.lhs | 5 | ||||
-rw-r--r-- | rts/Profiling.c | 21 |
4 files changed, 18 insertions, 22 deletions
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs index 472ec6a2a0..efd170aa10 100644 --- a/compiler/codeGen/CgProf.hs +++ b/compiler/codeGen/CgProf.hs @@ -158,15 +158,11 @@ emitCostCentreDecl cc = do modl, -- char *module, zero, -- StgWord time_ticks zero64, -- StgWord64 mem_alloc - subsumed, -- StgInt is_caf - zero -- struct _CostCentre *link + zero -- struct _CostCentre *link ] ; emitDataLits (mkCCLabel cc) lits } - where - subsumed | isCafCC cc = mkIntCLit (ord 'c') -- 'c' == is a CAF - | otherwise = mkIntCLit (ord 'B') -- 'B' == is boring - + emitCostCentreStackDecl :: CostCentreStack diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index 2b7660dd5c..29bfcccde2 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -219,14 +219,10 @@ emitCostCentreDecl cc = do modl, -- char *module, zero, -- StgWord time_ticks zero64, -- StgWord64 mem_alloc - subsumed, -- StgInt is_caf - zero -- struct _CostCentre *link + zero -- struct _CostCentre *link ] ; emitDataLits (mkCCLabel cc) lits } - where - subsumed | isCafCC cc = mkIntCLit (ord 'c') -- 'c' == is a CAF - | otherwise = mkIntCLit (ord 'B') -- 'B' == is boring emitCostCentreStackDecl :: CostCentreStack -> FCode () emitCostCentreStackDecl ccs diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index dc867009ed..c0b84e01eb 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -365,7 +365,10 @@ tickishCounts Breakpoint{} = True tickishScoped :: Tickish id -> Bool tickishScoped n@ProfNote{} = profNoteScope n tickishScoped HpcTick{} = False -tickishScoped Breakpoint{} = True -- we're going to do stacks +tickishScoped Breakpoint{} = True + -- Breakpoints are scoped: eventually we're going to do call + -- stacks, but also this helps prevent the simplifier from moving + -- breakpoints around and changing their result type (see #1531). mkNoTick :: Tickish id -> Tickish id mkNoTick n@ProfNote{} = n {profNoteCount = False} diff --git a/rts/Profiling.c b/rts/Profiling.c index 454195b112..930792b0da 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -541,10 +541,11 @@ decBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs ) static rtsBool ignoreCC (CostCentre *cc) { - if ( cc == CC_OVERHEAD + if (RtsFlags.CcFlags.doCostCentres < COST_CENTRES_ALL && + ( cc == CC_OVERHEAD || cc == CC_DONT_CARE || cc == CC_GC - || cc == CC_SYSTEM) { + || cc == CC_SYSTEM)) { return rtsTrue; } else { return rtsFalse; @@ -554,11 +555,12 @@ ignoreCC (CostCentre *cc) static rtsBool ignoreCCS (CostCentreStack *ccs) { - if ( ccs == CCS_OVERHEAD - || ccs == CCS_DONT_CARE - || ccs == CCS_GC - || ccs == CCS_SYSTEM) { - return rtsTrue; + if (RtsFlags.CcFlags.doCostCentres < COST_CENTRES_ALL && + ( ccs == CCS_OVERHEAD + || ccs == CCS_DONT_CARE + || ccs == CCS_GC + || ccs == CCS_SYSTEM)) { + return rtsTrue; } else { return rtsFalse; } @@ -756,9 +758,8 @@ logCCS(CostCentreStack *ccs, nat indent, nat max_label_len, nat max_module_len) /* Only print cost centres with non 0 data ! */ - if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL || - ! ignoreCCS(ccs)) - /* force printing of *all* cost centres if -P -P */ + if (!ignoreCCS(ccs)) + /* force printing of *all* cost centres if -Pa */ { fprintf(prof_file, "%-*s%-*s %-*s", |