StgCmmHpc.hs 2.27 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
-----------------------------------------------------------------------------
--
-- Code generation for coverage
--
-- (c) Galois Connections, Inc. 2006
--
-----------------------------------------------------------------------------

module StgCmmHpc ( initHpc, mkTickBox ) where

import StgCmmUtils
import StgCmmMonad
import StgCmmForeign

import MkZipCfgCmm
import Cmm
import CLabel
import Module
import CmmUtils
import FastString
import HscTypes
Ian Lynagh's avatar
Ian Lynagh committed
22
import Data.Char
23
import StaticFlags
Ian Lynagh's avatar
Ian Lynagh committed
24
import BasicTypes
25 26 27 28 29 30 31 32 33 34

mkTickBox :: Module -> Int -> CmmAGraph
mkTickBox mod n 
  = mkStore tick_box (CmmMachOp (MO_Add W64)
                                [ CmmLoad tick_box b64
                                , CmmLit (CmmInt 1 W64)
                                ])
  where
    tick_box = cmmIndex W64
                        (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
35
                        n
36 37 38

initHpc :: Module -> HpcInfo -> FCode CmmAGraph
-- Emit top-level tables for HPC and return code to initialise
Ian Lynagh's avatar
Ian Lynagh committed
39
initHpc _ (NoHpcInfo {})
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
  = 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)
              ] ++
              [ CmmStaticLit (CmmInt 0 W64)
              | _ <- take tickCount [0::Int ..]
              ]

    	; id <- newTemp bWord -- TODO FIXME NOW
        ; emitCCall
               [(id,NoHint)]
58
               (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
               [ (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