mkHpcTicksLabel,
mkHpcModuleNameLabel,
- mkHpcModuleOffsetLabel,
infoLblToEntryLbl, entryLblToInfoLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
| HpcTicksLabel Module -- Per-module table of tick locations
| HpcModuleNameLabel -- Per-module name of the module for Hpc
- | HpcModuleOffsetLabel Module-- Per-module offset of the module for Hpc (dynamically generated)
deriving (Eq, Ord)
mkHpcTicksLabel = HpcTicksLabel
mkHpcModuleNameLabel = HpcModuleNameLabel
-mkHpcModuleOffsetLabel = HpcModuleOffsetLabel
-- Dynamic linking
needsCDecl (CC_Label _) = True
needsCDecl (CCS_Label _) = True
needsCDecl (HpcTicksLabel _) = True
-needsCDecl (HpcModuleOffsetLabel _) = True
needsCDecl HpcModuleNameLabel = False
-- Whether the label is an assembler temporary:
externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
externallyVisibleCLabel (HpcTicksLabel _) = True
-externallyVisibleCLabel (HpcModuleOffsetLabel _) = True
externallyVisibleCLabel HpcModuleNameLabel = False
-- -----------------------------------------------------------------------------
pprCLbl (HpcTicksLabel mod)
= ptext SLIT("_hpc_tickboxes_") <> ppr mod <> ptext SLIT("_hpc")
-pprCLbl (HpcModuleOffsetLabel mod)
- = ptext SLIT("_hpc_module_offset_") <> ppr mod <> ptext SLIT("_hpc")
-
pprCLbl HpcModuleNameLabel
= ptext SLIT("_hpc_module_name_str")
, CmmLit (CmmInt 1 I64)
])
]
- let ext_tick_box = CmmLit $ CmmLabel $ mkHpcModuleOffsetLabel $ mod
-
- whenC (opt_Hpc_Tracer) $ do
- emitForeignCall'
- PlayRisky -- ??
- []
- (CmmForeignCall
- (CmmLit $ CmmLabel $ mkForeignLabel visible_tick Nothing False)
- CCallConv
- )
- [ (CmmMachOp (MO_Add I32)
- [ CmmLoad ext_tick_box I32
- , CmmLit (CmmInt (fromIntegral n) I32)
- ]
- , NoHint)
- , ( CmmReg (CmmGlobal CurrentTSO)
- , PtrHint
- )
- ]
- (Just [])
where
visible_tick = mkFastString "hs_hpc_tick"
(module_name_str)
++ [0]
]
- emitData Data -- change Offset => Data or Info
- [ CmmDataLabel (mkHpcModuleOffsetLabel this_mod)
- , CmmStaticLit (CmmInt 0 I32) -- stored offset?
- ]
emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 I64)
, (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
]
(Just [])
- ; let ext_tick_box = CmmLit $ CmmLabel $ mkHpcModuleOffsetLabel $ this_mod
- ; stmtsC [ CmmStore ext_tick_box (CmmReg id) ]
}
where
mod_alloc = mkFastString "hs_hpc_module"