never executed always true always false
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE MultiWayIf #-}
3
4 -----------------------------------------------------------------------------
5 --
6 -- Code generation for ticky-ticky profiling
7 --
8 -- (c) The University of Glasgow 2004-2006
9 --
10 -----------------------------------------------------------------------------
11
12 {- OVERVIEW: ticky ticky profiling
13
14 Please see
15 https://gitlab.haskell.org/ghc/ghc/wikis/debugging/ticky-ticky and also
16 edit it and the rest of this comment to keep them up-to-date if you
17 change ticky-ticky. Thanks!
18
19 *** All allocation ticky numbers are in bytes. ***
20
21 Some of the relevant source files:
22
23 ***not necessarily an exhaustive list***
24
25 * some codeGen/ modules import this one
26
27 * this module imports GHC.Cmm.CLabel to manage labels
28
29 * GHC.Cmm.Parser expands some macros using generators defined in
30 this module
31
32 * rts/include/stg/Ticky.h declares all of the global counters
33
34 * rts/include/rts/Ticky.h declares the C data type for an
35 STG-declaration's counters
36
37 * some macros defined in rts/include/Cmm.h (and used within the RTS's
38 CMM code) update the global ticky counters
39
40 * at the end of execution rts/Ticky.c generates the final report
41 +RTS -r<report-file> -RTS
42
43 The rts/Ticky.c function that generates the report includes an
44 STG-declaration's ticky counters if
45
46 * that declaration was entered, or
47
48 * it was allocated (if -ticky-allocd)
49
50 On either of those events, the counter is "registered" by adding it to
51 a linked list; cf the CMM generated by registerTickyCtr.
52
53 Ticky-ticky profiling has evolved over many years. Many of the
54 counters from its most sophisticated days are no longer
55 active/accurate. As the RTS has changed, sometimes the ticky code for
56 relevant counters was not accordingly updated. Unfortunately, neither
57 were the comments.
58
59 As of March 2013, there still exist deprecated code and comments in
60 the code generator as well as the RTS because:
61
62 * I don't know what is out-of-date versus merely commented out for
63 momentary convenience, and
64
65 * someone else might know how to repair it!
66
67 -}
68
69 module GHC.StgToCmm.Ticky (
70 withNewTickyCounterFun,
71 withNewTickyCounterLNE,
72 withNewTickyCounterThunk,
73 withNewTickyCounterStdThunk,
74 withNewTickyCounterCon,
75
76 tickyDynAlloc,
77 tickyAllocHeap,
78
79 tickyAllocPrim,
80 tickyAllocThunk,
81 tickyAllocPAP,
82 tickyHeapCheck,
83 tickyStackCheck,
84
85 tickyDirectCall,
86
87 tickyPushUpdateFrame,
88 tickyUpdateFrameOmitted,
89
90 tickyEnterDynCon,
91
92 tickyEnterFun,
93 tickyEnterThunk,
94 tickyEnterLNE,
95
96 tickyUpdateBhCaf,
97 tickyUnboxedTupleReturn,
98 tickyReturnOldCon, tickyReturnNewCon,
99
100 tickySlowCall
101 ) where
102
103 import GHC.Prelude
104
105 import GHC.Driver.Session
106
107 import GHC.Platform
108 import GHC.Platform.Profile
109
110 import GHC.StgToCmm.ArgRep ( slowCallPattern , toArgRep , argRepString )
111 import GHC.StgToCmm.Closure
112 import {-# SOURCE #-} GHC.StgToCmm.Foreign ( emitPrimCall )
113 import GHC.StgToCmm.Lit ( newStringCLit )
114 import GHC.StgToCmm.Monad
115 import GHC.StgToCmm.Utils
116
117 import GHC.Stg.Syntax
118 import GHC.Cmm.Expr
119 import GHC.Cmm.Graph
120 import GHC.Cmm.Utils
121 import GHC.Cmm.CLabel
122 import GHC.Runtime.Heap.Layout
123
124 import GHC.Types.Name
125 import GHC.Types.Id
126 import GHC.Types.Basic
127 import GHC.Data.FastString
128 import GHC.Utils.Outputable
129 import GHC.Utils.Panic
130 import GHC.Utils.Misc
131
132 -- Turgid imports for showTypeCategory
133 import GHC.Builtin.Names
134 import GHC.Tc.Utils.TcType
135 import GHC.Core.DataCon
136 import GHC.Core.TyCon
137 import GHC.Core.Predicate
138
139 import Data.Maybe
140 import qualified Data.Char
141 import Control.Monad ( when )
142
143 -----------------------------------------------------------------------------
144 --
145 -- Ticky-ticky profiling
146 --
147 -----------------------------------------------------------------------------
148
149 data TickyClosureType
150 = TickyFun
151 Bool -- True <-> single entry
152 | TickyCon
153 DataCon -- the allocated constructor
154 | TickyThunk
155 Bool -- True <-> updateable
156 Bool -- True <-> standard thunk (AP or selector), has no entry counter
157 | TickyLNE
158
159 withNewTickyCounterFun :: Bool -> Name -> [NonVoid Id] -> FCode a -> FCode a
160 withNewTickyCounterFun single_entry = withNewTickyCounter (TickyFun single_entry)
161
162 withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode a -> FCode a
163 withNewTickyCounterLNE nm args code = do
164 b <- tickyLNEIsOn
165 if not b then code else withNewTickyCounter TickyLNE nm args code
166
167 thunkHasCounter :: Bool -> FCode Bool
168 thunkHasCounter isStatic = do
169 b <- tickyDynThunkIsOn
170 pure (not isStatic && b)
171
172 withNewTickyCounterThunk
173 :: Bool -- ^ static
174 -> Bool -- ^ updateable
175 -> Name
176 -> FCode a
177 -> FCode a
178 withNewTickyCounterThunk isStatic isUpdatable name code = do
179 has_ctr <- thunkHasCounter isStatic
180 if not has_ctr
181 then code
182 else withNewTickyCounter (TickyThunk isUpdatable False) name [] code
183
184 withNewTickyCounterStdThunk
185 :: Bool -- ^ updateable
186 -> Name
187 -> FCode a
188 -> FCode a
189 withNewTickyCounterStdThunk isUpdatable name code = do
190 has_ctr <- thunkHasCounter False
191 if not has_ctr
192 then code
193 else withNewTickyCounter (TickyThunk isUpdatable True) name [] code
194
195 withNewTickyCounterCon
196 :: Name
197 -> DataCon
198 -> FCode a
199 -> FCode a
200 withNewTickyCounterCon name datacon code = do
201 has_ctr <- thunkHasCounter False
202 if not has_ctr
203 then code
204 else withNewTickyCounter (TickyCon datacon) name [] code
205
206 -- args does not include the void arguments
207 withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode a -> FCode a
208 withNewTickyCounter cloType name args m = do
209 lbl <- emitTickyCounter cloType name args
210 setTickyCtrLabel lbl m
211
212 emitTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode CLabel
213 emitTickyCounter cloType name args
214 = let ctr_lbl = mkRednCountsLabel name in
215 (>> return ctr_lbl) $
216 ifTicky $ do
217 { dflags <- getDynFlags
218 ; platform <- getPlatform
219 ; parent <- getTickyCtrLabel
220 ; mod_name <- getModuleName
221
222 -- When printing the name of a thing in a ticky file, we
223 -- want to give the module name even for *local* things. We
224 -- print just "x (M)" rather that "M.x" to distinguish them
225 -- from the global kind.
226 ; let ppr_for_ticky_name :: SDoc
227 ppr_for_ticky_name =
228 let n = ppr name
229 ext = case cloType of
230 TickyFun single_entry -> parens $ hcat $ punctuate comma $
231 [text "fun"] ++ [text "se"|single_entry]
232 TickyCon datacon -> parens (text "con:" <+> ppr (dataConName datacon))
233 TickyThunk upd std -> parens $ hcat $ punctuate comma $
234 [text "thk"] ++ [text "se"|not upd] ++ [text "std"|std]
235 TickyLNE | isInternalName name -> parens (text "LNE")
236 | otherwise -> panic "emitTickyCounter: how is this an external LNE?"
237 p = case hasHaskellName parent of
238 -- NB the default "top" ticky ctr does not
239 -- have a Haskell name
240 Just pname -> text "in" <+> ppr (nameUnique pname)
241 _ -> empty
242 in if isInternalName name
243 then n <+> parens (ppr mod_name) <+> ext <+> p
244 else n <+> ext <+> p
245
246 ; let ctx = (initSDocContext dflags defaultDumpStyle)
247 { sdocPprDebug = True }
248 ; fun_descr_lit <- newStringCLit $ renderWithContext ctx ppr_for_ticky_name
249 ; arg_descr_lit <- newStringCLit $ map (showTypeCategory . idType . fromNonVoid) args
250 ; emitDataLits ctr_lbl
251 -- Must match layout of rts/include/rts/Ticky.h's StgEntCounter
252 --
253 -- krc: note that all the fields are I32 now; some were I16
254 -- before, but the code generator wasn't handling that
255 -- properly and it led to chaos, panic and disorder.
256 [ mkIntCLit platform 0, -- registered?
257 mkIntCLit platform (length args), -- Arity
258 mkIntCLit platform 0, -- Heap allocated for this thing
259 fun_descr_lit,
260 arg_descr_lit,
261 zeroCLit platform, -- Entries into this thing
262 zeroCLit platform, -- Heap allocated by this thing
263 zeroCLit platform -- Link to next StgEntCounter
264 ]
265 }
266
267 -- -----------------------------------------------------------------------------
268 -- Ticky stack frames
269
270 tickyPushUpdateFrame, tickyUpdateFrameOmitted :: FCode ()
271 tickyPushUpdateFrame = ifTicky $ bumpTickyCounter (fsLit "UPDF_PUSHED_ctr")
272 tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (fsLit "UPDF_OMITTED_ctr")
273
274 -- -----------------------------------------------------------------------------
275 -- Ticky entries
276
277 -- NB the name-specific entries are only available for names that have
278 -- dedicated Cmm code. As far as I know, this just rules out
279 -- constructor thunks. For them, there is no CMM code block to put the
280 -- bump of name-specific ticky counter into. On the other hand, we can
281 -- still track allocation their allocation.
282
283 tickyEnterDynCon :: FCode ()
284 tickyEnterDynCon = ifTicky $ bumpTickyCounter (fsLit "ENT_DYN_CON_ctr")
285
286 tickyEnterThunk :: ClosureInfo -> FCode ()
287 tickyEnterThunk cl_info
288 = ifTicky $ do
289 { bumpTickyCounter ctr
290 ; has_ctr <- thunkHasCounter static
291 ; when has_ctr $ do
292 ticky_ctr_lbl <- getTickyCtrLabel
293 registerTickyCtrAtEntryDyn ticky_ctr_lbl
294 bumpTickyEntryCount ticky_ctr_lbl }
295 where
296 updatable = not (closureUpdReqd cl_info)
297 static = isStaticClosure cl_info
298
299 ctr | static = if updatable then fsLit "ENT_STATIC_THK_SINGLE_ctr"
300 else fsLit "ENT_STATIC_THK_MANY_ctr"
301 | otherwise = if updatable then fsLit "ENT_DYN_THK_SINGLE_ctr"
302 else fsLit "ENT_DYN_THK_MANY_ctr"
303
304 tickyUpdateBhCaf :: ClosureInfo -> FCode ()
305 tickyUpdateBhCaf cl_info
306 = ifTicky (bumpTickyCounter ctr)
307 where
308 ctr | closureUpdReqd cl_info = (fsLit "UPD_CAF_BH_SINGLE_ENTRY_ctr")
309 | otherwise = (fsLit "UPD_CAF_BH_UPDATABLE_ctr")
310
311 tickyEnterFun :: ClosureInfo -> FCode ()
312 tickyEnterFun cl_info = ifTicky $ do
313 ctr_lbl <- getTickyCtrLabel
314
315 if isStaticClosure cl_info
316 then do bumpTickyCounter (fsLit "ENT_STATIC_FUN_DIRECT_ctr")
317 registerTickyCtr ctr_lbl
318 else do bumpTickyCounter (fsLit "ENT_DYN_FUN_DIRECT_ctr")
319 registerTickyCtrAtEntryDyn ctr_lbl
320
321 bumpTickyEntryCount ctr_lbl
322
323 tickyEnterLNE :: FCode ()
324 tickyEnterLNE = ifTicky $ do
325 bumpTickyCounter (fsLit "ENT_LNE_ctr")
326 ifTickyLNE $ do
327 ctr_lbl <- getTickyCtrLabel
328 registerTickyCtr ctr_lbl
329 bumpTickyEntryCount ctr_lbl
330
331 -- needn't register a counter upon entry if
332 --
333 -- 1) it's for a dynamic closure, and
334 --
335 -- 2) -ticky-allocd is on
336 --
337 -- since the counter was registered already upon being alloc'd
338 registerTickyCtrAtEntryDyn :: CLabel -> FCode ()
339 registerTickyCtrAtEntryDyn ctr_lbl = do
340 already_registered <- tickyAllocdIsOn
341 when (not already_registered) $ registerTickyCtr ctr_lbl
342
343 -- | Register a ticky counter.
344 --
345 -- It's important that this does not race with other entries of the same
346 -- closure, lest the ticky_entry_ctrs list may become cyclic. However, we also
347 -- need to make sure that this is reasonably efficient. Consequently, we first
348 -- perform a normal load of the counter's "registered" flag to check whether
349 -- registration is necessary. If so, then we do a compare-and-swap to lock the
350 -- counter for registration and use an atomic-exchange to add the counter to the list.
351 --
352 -- @
353 -- if ( f_ct.registeredp == 0 ) {
354 -- if (cas(f_ct.registeredp, 0, 1) == 0) {
355 -- old_head = xchg(ticky_entry_ctrs, f_ct);
356 -- f_ct.link = old_head;
357 -- }
358 -- }
359 -- @
360 registerTickyCtr :: CLabel -> FCode ()
361 registerTickyCtr ctr_lbl = do
362 platform <- getPlatform
363 let constants = platformConstants platform
364 word_width = wordWidth platform
365 registeredp = CmmLit (cmmLabelOffB ctr_lbl (pc_OFFSET_StgEntCounter_registeredp constants))
366
367 register_stmts <- getCode $ do
368 old_head <- newTemp (bWord platform)
369 let ticky_entry_ctrs = mkLblExpr (mkRtsCmmDataLabel (fsLit "ticky_entry_ctrs"))
370 link = CmmLit (cmmLabelOffB ctr_lbl (pc_OFFSET_StgEntCounter_link constants))
371 emitPrimCall [old_head] (MO_Xchg word_width) [ticky_entry_ctrs, mkLblExpr ctr_lbl]
372 emitStore link (CmmReg $ CmmLocal old_head)
373
374 cas_test <- getCode $ do
375 old <- newTemp (bWord platform)
376 emitPrimCall [old] (MO_Cmpxchg word_width)
377 [registeredp, zeroExpr platform, mkIntExpr platform 1]
378 let locked = cmmEqWord platform (CmmReg $ CmmLocal old) (zeroExpr platform)
379 emit =<< mkCmmIfThen locked register_stmts
380
381 let test = cmmEqWord platform (CmmLoad registeredp (bWord platform)) (zeroExpr platform)
382 emit =<< mkCmmIfThen test cas_test
383
384 tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode ()
385 tickyReturnOldCon arity
386 = ifTicky $ do { bumpTickyCounter (fsLit "RET_OLD_ctr")
387 ; bumpHistogram (fsLit "RET_OLD_hst") arity }
388 tickyReturnNewCon arity
389 = ifTicky $ do { bumpTickyCounter (fsLit "RET_NEW_ctr")
390 ; bumpHistogram (fsLit "RET_NEW_hst") arity }
391
392 tickyUnboxedTupleReturn :: RepArity -> FCode ()
393 tickyUnboxedTupleReturn arity
394 = ifTicky $ do { bumpTickyCounter (fsLit "RET_UNBOXED_TUP_ctr")
395 ; bumpHistogram (fsLit "RET_UNBOXED_TUP_hst") arity }
396
397 -- -----------------------------------------------------------------------------
398 -- Ticky calls
399
400 -- Ticks at a *call site*:
401 tickyDirectCall :: RepArity -> [StgArg] -> FCode ()
402 tickyDirectCall arity args
403 | args `lengthIs` arity = tickyKnownCallExact
404 | otherwise = do tickyKnownCallExtraArgs
405 tickySlowCallPat (map argPrimRep (drop arity args))
406
407 tickyKnownCallTooFewArgs :: FCode ()
408 tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_TOO_FEW_ARGS_ctr")
409
410 tickyKnownCallExact :: FCode ()
411 tickyKnownCallExact = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_ctr")
412
413 tickyKnownCallExtraArgs :: FCode ()
414 tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_EXTRA_ARGS_ctr")
415
416 tickyUnknownCall :: FCode ()
417 tickyUnknownCall = ifTicky $ bumpTickyCounter (fsLit "UNKNOWN_CALL_ctr")
418
419 -- Tick for the call pattern at slow call site (i.e. in addition to
420 -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.)
421 tickySlowCall :: LambdaFormInfo -> [StgArg] -> FCode ()
422 tickySlowCall _ [] = return ()
423 tickySlowCall lf_info args = do
424 -- see Note [Ticky for slow calls]
425 if isKnownFun lf_info
426 then tickyKnownCallTooFewArgs
427 else tickyUnknownCall
428 tickySlowCallPat (map argPrimRep args)
429
430 tickySlowCallPat :: [PrimRep] -> FCode ()
431 tickySlowCallPat args = ifTicky $ do
432 platform <- profilePlatform <$> getProfile
433 let argReps = map (toArgRep platform) args
434 (_, n_matched) = slowCallPattern argReps
435 if n_matched > 0 && args `lengthIs` n_matched
436 then bumpTickyLbl $ mkRtsSlowFastTickyCtrLabel $ concatMap (map Data.Char.toLower . argRepString) argReps
437 else bumpTickyCounter $ fsLit "VERY_SLOW_CALL_ctr"
438
439 {-
440
441 Note [Ticky for slow calls]
442 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
443 Terminology is unfortunately a bit mixed up for these calls. codeGen
444 uses "slow call" to refer to unknown calls and under-saturated known
445 calls.
446
447 Nowadays, though (ie as of the eval/apply paper), the significantly
448 slower calls are actually just a subset of these: the ones with no
449 built-in argument pattern (cf GHC.StgToCmm.ArgRep.slowCallPattern)
450
451 So for ticky profiling, we split slow calls into
452 "SLOW_CALL_fast_<pattern>_ctr" (those matching a built-in pattern) and
453 VERY_SLOW_CALL_ctr (those without a built-in pattern; these are very
454 bad for both space and time).
455
456 -}
457
458 -- -----------------------------------------------------------------------------
459 -- Ticky allocation
460
461 tickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo -> FCode ()
462 -- Called when doing a dynamic heap allocation; the LambdaFormInfo
463 -- used to distinguish between closure types
464 --
465 -- TODO what else to count while we're here?
466 tickyDynAlloc mb_id rep lf = ifTicky $ do
467 profile <- getProfile
468 let platform = profilePlatform profile
469 bytes = platformWordSizeInBytes platform * heapClosureSizeW profile rep
470
471 countGlobal tot ctr = do
472 bumpTickyCounterBy tot bytes
473 bumpTickyCounter ctr
474 countSpecific = ifTickyAllocd $ case mb_id of
475 Nothing -> return ()
476 Just id -> do
477 let ctr_lbl = mkRednCountsLabel (idName id)
478 registerTickyCtr ctr_lbl
479 bumpTickyAllocd ctr_lbl bytes
480
481 -- TODO are we still tracking "good stuff" (_gds) versus
482 -- administrative (_adm) versus slop (_slp)? I'm going with all _gds
483 -- for now, since I don't currently know neither if we do nor how to
484 -- distinguish. NSF Mar 2013
485
486 if | isConRep rep ->
487 ifTickyDynThunk countSpecific >>
488 countGlobal (fsLit "ALLOC_CON_gds") (fsLit "ALLOC_CON_ctr")
489 | isThunkRep rep ->
490 ifTickyDynThunk countSpecific >>
491 if lfUpdatable lf
492 then countGlobal (fsLit "ALLOC_THK_gds") (fsLit "ALLOC_UP_THK_ctr")
493 else countGlobal (fsLit "ALLOC_THK_gds") (fsLit "ALLOC_SE_THK_ctr")
494 | isFunRep rep ->
495 countSpecific >>
496 countGlobal (fsLit "ALLOC_FUN_gds") (fsLit "ALLOC_FUN_ctr")
497 | otherwise -> panic "How is this heap object not a con, thunk, or fun?"
498
499
500
501 tickyAllocHeap ::
502 Bool -> -- is this a genuine allocation? As opposed to
503 -- GHC.StgToCmm.Layout.adjustHpBackwards
504 VirtualHpOffset -> FCode ()
505 -- Called when doing a heap check [TICK_ALLOC_HEAP]
506 -- Must be lazy in the amount of allocation!
507 tickyAllocHeap genuine hp
508 = ifTicky $
509 do { platform <- getPlatform
510 ; ticky_ctr <- getTickyCtrLabel
511 ; emit $ catAGraphs $
512 -- only test hp from within the emit so that the monadic
513 -- computation itself is not strict in hp (cf knot in
514 -- GHC.StgToCmm.Monad.getHeapUsage)
515 if hp == 0 then []
516 else let !bytes = platformWordSizeInBytes platform * hp in [
517 -- Bump the allocation total in the closure's StgEntCounter
518 addToMem (rEP_StgEntCounter_allocs platform)
519 (CmmLit (cmmLabelOffB ticky_ctr (pc_OFFSET_StgEntCounter_allocs (platformConstants platform))))
520 bytes,
521 -- Bump the global allocation total ALLOC_HEAP_tot
522 addToMemLbl (bWord platform)
523 (mkRtsCmmDataLabel (fsLit "ALLOC_HEAP_tot"))
524 bytes,
525 -- Bump the global allocation counter ALLOC_HEAP_ctr
526 if not genuine then mkNop
527 else addToMemLbl (bWord platform)
528 (mkRtsCmmDataLabel (fsLit "ALLOC_HEAP_ctr"))
529 1
530 ]}
531
532
533 --------------------------------------------------------------------------------
534 -- these three are only called from GHC.Cmm.Parser (ie ultimately from the RTS)
535
536 -- the units are bytes
537
538 tickyAllocPrim :: CmmExpr -- ^ size of the full header, in bytes
539 -> CmmExpr -- ^ size of the payload, in bytes
540 -> CmmExpr -> FCode ()
541 tickyAllocPrim _hdr _goods _slop = ifTicky $ do
542 bumpTickyCounter (fsLit "ALLOC_PRIM_ctr")
543 bumpTickyCounterByE (fsLit "ALLOC_PRIM_adm") _hdr
544 bumpTickyCounterByE (fsLit "ALLOC_PRIM_gds") _goods
545 bumpTickyCounterByE (fsLit "ALLOC_PRIM_slp") _slop
546
547 tickyAllocThunk :: CmmExpr -> CmmExpr -> FCode ()
548 tickyAllocThunk _goods _slop = ifTicky $ do
549 -- TODO is it ever called with a Single-Entry thunk?
550 bumpTickyCounter (fsLit "ALLOC_UP_THK_ctr")
551 bumpTickyCounterByE (fsLit "ALLOC_THK_gds") _goods
552 bumpTickyCounterByE (fsLit "ALLOC_THK_slp") _slop
553
554 tickyAllocPAP :: CmmExpr -> CmmExpr -> FCode ()
555 tickyAllocPAP _goods _slop = ifTicky $ do
556 bumpTickyCounter (fsLit "ALLOC_PAP_ctr")
557 bumpTickyCounterByE (fsLit "ALLOC_PAP_gds") _goods
558 bumpTickyCounterByE (fsLit "ALLOC_PAP_slp") _slop
559
560 tickyHeapCheck :: FCode ()
561 tickyHeapCheck = ifTicky $ bumpTickyCounter (fsLit "HEAP_CHK_ctr")
562
563 tickyStackCheck :: FCode ()
564 tickyStackCheck = ifTicky $ bumpTickyCounter (fsLit "STK_CHK_ctr")
565
566 -- -----------------------------------------------------------------------------
567 -- Ticky utils
568
569 ifTicky :: FCode () -> FCode ()
570 ifTicky code =
571 getDynFlags >>= \dflags -> when (gopt Opt_Ticky dflags) code
572
573 tickyAllocdIsOn :: FCode Bool
574 tickyAllocdIsOn = gopt Opt_Ticky_Allocd `fmap` getDynFlags
575
576 tickyLNEIsOn :: FCode Bool
577 tickyLNEIsOn = gopt Opt_Ticky_LNE `fmap` getDynFlags
578
579 tickyDynThunkIsOn :: FCode Bool
580 tickyDynThunkIsOn = gopt Opt_Ticky_Dyn_Thunk `fmap` getDynFlags
581
582 ifTickyAllocd :: FCode () -> FCode ()
583 ifTickyAllocd code = tickyAllocdIsOn >>= \b -> when b code
584
585 ifTickyLNE :: FCode () -> FCode ()
586 ifTickyLNE code = tickyLNEIsOn >>= \b -> when b code
587
588 ifTickyDynThunk :: FCode () -> FCode ()
589 ifTickyDynThunk code = tickyDynThunkIsOn >>= \b -> when b code
590
591 bumpTickyCounter :: FastString -> FCode ()
592 bumpTickyCounter lbl = bumpTickyLbl (mkRtsCmmDataLabel lbl)
593
594 bumpTickyCounterBy :: FastString -> Int -> FCode ()
595 bumpTickyCounterBy lbl = bumpTickyLblBy (mkRtsCmmDataLabel lbl)
596
597 bumpTickyCounterByE :: FastString -> CmmExpr -> FCode ()
598 bumpTickyCounterByE lbl = bumpTickyLblByE (mkRtsCmmDataLabel lbl)
599
600 bumpTickyEntryCount :: CLabel -> FCode ()
601 bumpTickyEntryCount lbl = do
602 platform <- getPlatform
603 bumpTickyLit (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_entry_count (platformConstants platform)))
604
605 bumpTickyAllocd :: CLabel -> Int -> FCode ()
606 bumpTickyAllocd lbl bytes = do
607 platform <- getPlatform
608 bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_allocd (platformConstants platform))) bytes
609
610 bumpTickyLbl :: CLabel -> FCode ()
611 bumpTickyLbl lhs = bumpTickyLitBy (cmmLabelOffB lhs 0) 1
612
613 bumpTickyLblBy :: CLabel -> Int -> FCode ()
614 bumpTickyLblBy lhs = bumpTickyLitBy (cmmLabelOffB lhs 0)
615
616 bumpTickyLblByE :: CLabel -> CmmExpr -> FCode ()
617 bumpTickyLblByE lhs = bumpTickyLitByE (cmmLabelOffB lhs 0)
618
619 bumpTickyLit :: CmmLit -> FCode ()
620 bumpTickyLit lhs = bumpTickyLitBy lhs 1
621
622 bumpTickyLitBy :: CmmLit -> Int -> FCode ()
623 bumpTickyLitBy lhs n = do
624 platform <- getPlatform
625 emit (addToMem (bWord platform) (CmmLit lhs) n)
626
627 bumpTickyLitByE :: CmmLit -> CmmExpr -> FCode ()
628 bumpTickyLitByE lhs e = do
629 platform <- getPlatform
630 emit (addToMemE (bWord platform) (CmmLit lhs) e)
631
632 bumpHistogram :: FastString -> Int -> FCode ()
633 bumpHistogram lbl n = do
634 platform <- getPlatform
635 let offset = n `min` (pc_TICKY_BIN_COUNT (platformConstants platform) - 1)
636 emit (addToMem (bWord platform)
637 (cmmIndexExpr platform
638 (wordWidth platform)
639 (CmmLit (CmmLabel (mkRtsCmmDataLabel lbl)))
640 (CmmLit (CmmInt (fromIntegral offset) (wordWidth platform))))
641 1)
642
643 ------------------------------------------------------------------
644 -- Showing the "type category" for ticky-ticky profiling
645
646 showTypeCategory :: Type -> Char
647 {-
648 + dictionary
649
650 > function
651
652 {C,I,F,D,W} char, int, float, double, word
653 {c,i,f,d,w} unboxed ditto
654
655 T tuple
656
657 P other primitive type
658 p unboxed ditto
659
660 L list
661 E enumeration type
662 S other single-constructor type
663 M other multi-constructor data-con type
664
665 . other type
666
667 - reserved for others to mark as "uninteresting"
668
669 Accurate as of Mar 2013, but I eliminated the Array category instead
670 of updating it, for simplicity. It's in P/p, I think --NSF
671
672 -}
673 showTypeCategory ty
674 | isDictTy ty = '+'
675 | otherwise = case tcSplitTyConApp_maybe ty of
676 Nothing -> '.'
677 Just (tycon, _) ->
678 (if isUnliftedTyCon tycon then Data.Char.toLower else id) $
679 let anyOf us = getUnique tycon `elem` us in
680 case () of
681 _ | anyOf [funTyConKey] -> '>'
682 | anyOf [charPrimTyConKey, charTyConKey] -> 'C'
683 | anyOf [doublePrimTyConKey, doubleTyConKey] -> 'D'
684 | anyOf [floatPrimTyConKey, floatTyConKey] -> 'F'
685 | anyOf [intPrimTyConKey, int32PrimTyConKey, int64PrimTyConKey,
686 intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey
687 ] -> 'I'
688 | anyOf [wordPrimTyConKey, word32PrimTyConKey, word64PrimTyConKey, wordTyConKey,
689 word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey
690 ] -> 'W'
691 | anyOf [listTyConKey] -> 'L'
692 | isTupleTyCon tycon -> 'T'
693 | isPrimTyCon tycon -> 'P'
694 | isEnumerationTyCon tycon -> 'E'
695 | isJust (tyConSingleDataCon_maybe tycon) -> 'S'
696 | otherwise -> 'M' -- oh, well...