Merge branch 'master' of http://darcs.haskell.org/ghc
authorIan Lynagh <igloo@earth.li>
Fri, 2 Dec 2011 22:30:58 +0000 (22:30 +0000)
committerIan Lynagh <igloo@earth.li>
Fri, 2 Dec 2011 22:30:58 +0000 (22:30 +0000)
1  2 
compiler/codeGen/CgProf.hs
compiler/codeGen/StgCmmProf.hs

@@@ -35,7 -35,7 +35,7 @@@ module CgProf 
  #include "../includes/rts/Constants.h"
        -- For LDV_CREATE_MASK, LDV_STATE_USE
        -- which are StgWords
 -#include "../includes/DerivedConstants.h"
 +#include "../includes/dist-derivedconstants/header/DerivedConstants.h"
        -- For REP_xxx constants, which are MachReps
  
  import ClosureInfo
@@@ -170,11 -170,15 +170,15 @@@ emitCostCentreDecl cc = d
                  -- 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
@@@ -36,7 -36,7 +36,7 @@@ module StgCmmProf 
  #include "../includes/rts/Constants.h"
        -- For LDV_CREATE_MASK, LDV_STATE_USE
        -- which are StgWords
 -#include "../includes/DerivedConstants.h"
 +#include "../includes/dist-derivedconstants/header/DerivedConstants.h"
        -- For REP_xxx constants, which are MachReps
  
  import StgCmmClosure
@@@ -58,6 -58,7 +58,7 @@@ import Constants        -- Lots of fiel
  import Outputable
  
  import Control.Monad
+ import Data.Char (ord)
  
  -----------------------------------------------------------------------------
  --
@@@ -217,18 -218,25 +218,25 @@@ emitCostCentreDecl cc = d
    ; 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