X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmHpc.hs;h=fae3bef016f172f182d2935cff1cd23f20b45335;hp=f53c5c68392d01ecf011817e7bed9f00d064aef8;hb=f537dd87c4a07526e2b1fc1bd1c125d652833641;hpb=7cc3fc34f519d250ab1e85e570e691b94d516b23

diff --git a/compiler/codeGen/StgCmmHpc.hs b/compiler/codeGen/StgCmmHpc.hs
index f53c5c6..fae3bef 100644
--- a/compiler/codeGen/StgCmmHpc.hs
+++ b/compiler/codeGen/StgCmmHpc.hs
@@ -8,18 +8,15 @@
 
 module StgCmmHpc ( initHpc, mkTickBox ) where
 
-import StgCmmUtils
 import StgCmmMonad
-import StgCmmForeign
 
-import MkZipCfgCmm
-import Cmm
+import MkGraph
+import CmmDecl
+import CmmExpr
 import CLabel
 import Module
 import CmmUtils
-import FastString
 import HscTypes
-import Char
 import StaticFlags
 
 mkTickBox :: Module -> Int -> CmmAGraph
@@ -31,43 +28,17 @@ mkTickBox mod n
   where
     tick_box = cmmIndex W64
                         (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
-                        (fromIntegral n)
+                        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 False)
-               [ (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
-
-
-