diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2011-12-02 13:09:14 +0000 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2011-12-02 15:11:33 +0000 |
| commit | 1469f1eb7817fbc46b17e994498450a9a6b12ea7 (patch) | |
| tree | 698f0eadb98ed4276f2faf183492e9bfc2276b6b /compiler/codeGen | |
| parent | 6f4bde149e46146125d688d9ff719c2e5e0800c2 (diff) | |
| download | haskell-1469f1eb7817fbc46b17e994498450a9a6b12ea7.tar.gz | |
More changes aimed at improving call stacks.
- Attach a SrcSpan to every CostCentre. This had the side effect
that CostCentres that used to be merged because they had the same
name are now considered distinct; so I had to add a Unique to
CostCentre to give them distinct object-code symbols.
- New flag: -fprof-auto-calls. This flag adds an automatic SCC to
every call site (application, to be precise). This is typically
more useful for call stacks than annotating whole functions.
Various tidy-ups at the same time: removed unused NoCostCentre
constructor, and refactored a bit in Coverage.lhs.
The call stack we get from traceStack now looks like this:
Stack trace:
Main.CAF (<entire-module>)
Main.main.xs (callstack002.hs:18:12-24)
Main.map (callstack002.hs:13:12-16)
Main.map.go (callstack002.hs:15:21-34)
Main.map.go (callstack002.hs:15:21-23)
Main.f (callstack002.hs:10:7-43)
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgProf.hs | 6 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 12 |
2 files changed, 15 insertions, 3 deletions
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs index 3e247ff4d6..92adf1afa7 100644 --- a/compiler/codeGen/CgProf.hs +++ b/compiler/codeGen/CgProf.hs @@ -170,11 +170,15 @@ emitCostCentreDecl cc = do -- All cost centres will be in the main package, since we -- don't normally use -auto-all or add SCCs to other packages. -- Hence don't emit the package name in the module here. + ; loc <- newByteStringCLit $ bytesFS $ mkFastString $ + showSDoc (ppr (costCentreSrcSpan cc)) + -- XXX going via FastString to get UTF-8 encoding is silly ; let lits = [ zero, -- StgInt ccID, label, -- char *label, modl, -- char *module, - zero, -- StgWord time_ticks + loc, -- char *srcloc, + zero, -- StgWord time_ticks zero64, -- StgWord64 mem_alloc is_caf, -- StgInt is_caf zero -- struct _CostCentre *link diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index d9b3583382..8ce1d5b372 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -58,6 +58,7 @@ import Constants -- Lots of field offsets import Outputable import Control.Monad +import Data.Char (ord) ----------------------------------------------------------------------------- -- @@ -217,18 +218,25 @@ emitCostCentreDecl cc = do ; modl <- newByteStringCLit (bytesFS $ Module.moduleNameFS $ Module.moduleName $ cc_mod cc) + ; loc <- newStringCLit (showSDoc (ppr (costCentreSrcSpan cc))) + -- XXX should UTF-8 encode -- All cost centres will be in the main package, since we -- don't normally use -auto-all or add SCCs to other packages. -- Hence don't emit the package name in the module here. ; let lits = [ zero, -- StgInt ccID, label, -- char *label, - modl, -- char *module, - zero, -- StgWord time_ticks + modl, -- char *module, + loc, -- char *srcloc, + zero, -- StgWord time_ticks zero64, -- StgWord64 mem_alloc + is_caf, -- StgInt is_caf zero -- struct _CostCentre *link ] ; emitDataLits (mkCCLabel cc) lits } + where + is_caf | isCafCC cc = mkIntCLit (ord 'c') -- 'c' == is a CAF + | otherwise = zero emitCostCentreStackDecl :: CostCentreStack -> FCode () emitCostCentreStackDecl ccs |