diff options
Diffstat (limited to 'compiler/codeGen/StgCmmHpc.hs')
| -rw-r--r-- | compiler/codeGen/StgCmmHpc.hs | 41 |
1 files changed, 5 insertions, 36 deletions
diff --git a/compiler/codeGen/StgCmmHpc.hs b/compiler/codeGen/StgCmmHpc.hs index a93af34961..fae3bef016 100644 --- a/compiler/codeGen/StgCmmHpc.hs +++ b/compiler/codeGen/StgCmmHpc.hs @@ -8,9 +8,7 @@ module StgCmmHpc ( initHpc, mkTickBox ) where -import StgCmmUtils import StgCmmMonad -import StgCmmForeign import MkGraph import CmmDecl @@ -18,11 +16,8 @@ import CmmExpr import CLabel import Module import CmmUtils -import FastString import HscTypes -import Data.Char import StaticFlags -import BasicTypes mkTickBox :: Module -> Int -> CmmAGraph mkTickBox mod n @@ -35,41 +30,15 @@ mkTickBox mod n (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod) n -initHpc :: Module -> HpcInfo -> FCode CmmAGraph +initHpc :: Module -> HpcInfo -> FCode () -- Emit top-level tables for HPC and return code to initialise initHpc _ (NoHpcInfo {}) - = return mkNop -initHpc this_mod (HpcInfo tickCount hashNo) - = getCode $ whenC opt_Hpc $ - do { emitData ReadOnlyData - [ CmmDataLabel mkHpcModuleNameLabel - , CmmString $ map (fromIntegral . ord) - (full_name_str) - ++ [0] - ] - ; emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod) + = return () +initHpc this_mod (HpcInfo tickCount _hashNo) + = whenC opt_Hpc $ + do { emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod) ] ++ [ CmmStaticLit (CmmInt 0 W64) | _ <- take tickCount [0::Int ..] ] - - ; id <- newTemp bWord -- TODO FIXME NOW - ; emitCCall - [(id,NoHint)] - (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction) - [ (mkLblExpr mkHpcModuleNameLabel,AddrHint) - , (CmmLit $ mkIntCLit tickCount,NoHint) - , (CmmLit $ mkIntCLit hashNo,NoHint) - , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,AddrHint) - ] } - where - mod_alloc = mkFastString "hs_hpc_module" - module_name_str = moduleNameString (Module.moduleName this_mod) - full_name_str = if modulePackageId this_mod == mainPackageId - then module_name_str - else packageIdString (modulePackageId this_mod) ++ "/" ++ - module_name_str - - - |