1 -----------------------------------------------------------------------------
3 -- Code generation for ticky-ticky profiling
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
19 tickyUpdateFrameOmitted,
30 tickyUnboxedTupleReturn, tickyVectoredReturn,
31 tickyReturnOldCon, tickyReturnNewCon,
33 tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs,
34 tickyUnknownCall, tickySlowCallPat,
39 #include "HsVersions.h"
40 #include "../includes/DerivedConstants.h"
41 -- For REP_xxx constants, which are MachReps
61 -- Turgid imports for showTypeCategory
68 -----------------------------------------------------------------------------
70 -- Ticky-ticky profiling
72 -----------------------------------------------------------------------------
74 staticTickyHdr :: [CmmLit]
75 -- The ticky header words in a static closure
76 -- Was SET_STATIC_TICKY_HDR
78 | not opt_DoTickyProfiling = []
79 | otherwise = [zeroCLit]
81 emitTickyCounter :: ClosureInfo -> [Id] -> Int -> Code
82 emitTickyCounter cl_info args on_stk
84 do { mod_name <- getModuleName
85 ; fun_descr_lit <- mkStringCLit (fun_descr mod_name)
86 ; arg_descr_lit <- mkStringCLit arg_descr
87 ; emitDataLits ticky_ctr_label -- Must match layout of StgEntCounter
89 CmmInt (fromIntegral (length args)) I16, -- Arity
90 CmmInt (fromIntegral on_stk) I16, -- Words passed on stack
91 CmmInt 0 I16, -- 2-byte gap
94 zeroCLit, -- Entry count
99 name = closureName cl_info
100 ticky_ctr_label = mkRednCountsLabel name
101 arg_descr = map (showTypeCategory . idType) args
102 fun_descr mod_name = ppr_for_ticky_name mod_name name
104 -- When printing the name of a thing in a ticky file, we want to
105 -- give the module name even for *local* things. We print
106 -- just "x (M)" rather that "M.x" to distinguish them from the global kind.
107 ppr_for_ticky_name mod_name name
108 | isInternalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name)))
109 | otherwise = showSDocDebug (ppr name)
111 -- -----------------------------------------------------------------------------
112 -- Ticky stack frames
114 tickyPushUpdateFrame = ifTicky $ bumpTickyCounter SLIT("UPDF_PUSHED_ctr")
115 tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter SLIT("UPDF_OMITTED_ctr")
117 -- -----------------------------------------------------------------------------
120 tickyEnterDynCon = ifTicky $ bumpTickyCounter SLIT("ENT_DYN_CON_ctr")
121 tickyEnterDynThunk = ifTicky $ bumpTickyCounter SLIT("ENT_DYN_THK_ctr")
122 tickyEnterStaticCon = ifTicky $ bumpTickyCounter SLIT("ENT_STATIC_CON_ctr")
123 tickyEnterStaticThunk = ifTicky $ bumpTickyCounter SLIT("ENT_STATIC_THK_ctr")
124 tickyEnterViaNode = ifTicky $ bumpTickyCounter SLIT("ENT_VIA_NODE_ctr")
126 tickyEnterThunk :: ClosureInfo -> Code
127 tickyEnterThunk cl_info
128 | isStaticClosure cl_info = tickyEnterStaticThunk
129 | otherwise = tickyEnterDynThunk
131 tickyBlackHole :: Bool{-updatable-} -> Code
132 tickyBlackHole updatable
133 = ifTicky (bumpTickyCounter ctr)
135 ctr | updatable = SLIT("UPD_BH_SINGLE_ENTRY_ctr")
136 | otherwise = SLIT("UPD_BH_UPDATABLE_ctr")
138 tickyUpdateBhCaf cl_info
139 = ifTicky (bumpTickyCounter ctr)
141 ctr | closureUpdReqd cl_info = SLIT("UPD_CAF_BH_SINGLE_ENTRY_ctr")
142 | otherwise = SLIT("UPD_CAF_BH_UPDATABLE_ctr")
144 tickyEnterFun :: ClosureInfo -> Code
145 tickyEnterFun cl_info
147 do { bumpTickyCounter ctr
148 ; fun_ctr_lbl <- getTickyCtrLabel
149 ; registerTickyCtr fun_ctr_lbl
150 ; bumpTickyCounter' fun_ctr_lbl }
152 ctr | isStaticClosure cl_info = SLIT("TICK_ENT_STATIC_FUN_DIRECT")
153 | otherwise = SLIT("TICK_ENT_DYN_FUN_DIRECT")
155 registerTickyCtr :: CLabel -> Code
156 -- Register a ticky counter
157 -- if ( ! f_ct.registeredp ) {
158 -- f_ct.link = ticky_entry_ctrs; /* hook this one onto the front of the list */
159 -- ticky_entry_ctrs = & (f_ct); /* mark it as "registered" */
160 -- f_ct.registeredp = 1 }
161 registerTickyCtr ctr_lbl
162 = emitIf test (stmtsC register_stmts)
164 test = CmmMachOp (MO_Not I16)
165 [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl
166 oFFSET_StgEntCounter_registeredp)) I16]
168 = [ CmmStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_link))
169 (CmmLoad ticky_entry_ctrs wordRep)
170 , CmmStore ticky_entry_ctrs (mkLblExpr ctr_lbl)
171 , CmmStore (CmmLit (cmmLabelOffB ctr_lbl
172 oFFSET_StgEntCounter_registeredp))
173 (CmmLit (mkIntCLit 1)) ]
174 ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel SLIT("ticky_entry_ctrs"))
176 tickyReturnOldCon, tickyReturnNewCon :: Arity -> Code
177 tickyReturnOldCon arity
178 = ifTicky $ do { bumpTickyCounter SLIT("RET_OLD_ctr")
179 ; bumpHistogram SLIT("RET_OLD_hst") arity }
180 tickyReturnNewCon arity
181 | not opt_DoTickyProfiling = nopC
183 = ifTicky $ do { bumpTickyCounter SLIT("RET_NEW_ctr")
184 ; bumpHistogram SLIT("RET_NEW_hst") arity }
186 tickyUnboxedTupleReturn :: Int -> Code
187 tickyUnboxedTupleReturn arity
188 = ifTicky $ do { bumpTickyCounter SLIT("RET_UNBOXED_TUP_ctr")
189 ; bumpHistogram SLIT("RET_UNBOXED_TUP_hst") arity }
191 tickyVectoredReturn :: Int -> Code
192 tickyVectoredReturn family_size
193 = ifTicky $ do { bumpTickyCounter SLIT("VEC_RETURN_ctr")
194 ; bumpHistogram SLIT("RET_VEC_RETURN_hst") family_size }
196 -- -----------------------------------------------------------------------------
199 -- Ticks at a *call site*:
200 tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_TOO_FEW_ARGS_ctr")
201 tickyKnownCallExact = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_ctr")
202 tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_EXTRA_ctr")
203 tickyUnknownCall = ifTicky $ bumpTickyCounter SLIT("UNKNOWN_CALL_ctr")
205 -- Tick for the call pattern at slow call site (i.e. in addition to
206 -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.)
207 tickySlowCallPat :: [CgRep] -> Code
208 tickySlowCallPat args = return ()
209 {- LATER: (introduces recursive module dependency now).
210 case callPattern args of
211 (str, True) -> bumpTickyCounter' (mkRtsSlowTickyCtrLabel pat)
212 (str, False) -> bumpTickyCounter SLIT("TICK_SLOW_CALL_OTHER")
214 callPattern :: [CgRep] -> (String,Bool)
216 | match == length reps = (chars, True)
217 | otherwise = (chars, False)
218 where (_,match) = findMatch reps
219 chars = map argChar reps
221 argChar VoidArg = 'v'
223 argChar NonPtrArg = 'n'
224 argChar LongArg = 'l'
225 argChar FloatArg = 'f'
226 argChar DoubleArg = 'd'
229 -- -----------------------------------------------------------------------------
232 tickyDynAlloc :: ClosureInfo -> Code
233 -- Called when doing a dynamic heap allocation
234 tickyDynAlloc cl_info
236 case smRepClosureType (closureSMRep cl_info) of
237 Constr -> tick_alloc_con
238 ConstrNoCaf -> tick_alloc_con
239 Fun -> tick_alloc_fun
240 Thunk -> tick_alloc_thk
241 ThunkSelector -> tick_alloc_thk
243 -- will be needed when we fill in stubs
244 cl_size = closureSize cl_info
245 slop_size = slopSize cl_info
248 | closureUpdReqd cl_info = tick_alloc_up_thk
249 | otherwise = tick_alloc_se_thk
251 tick_alloc_con = panic "ToDo: tick_alloc"
252 tick_alloc_fun = panic "ToDo: tick_alloc"
253 tick_alloc_up_thk = panic "ToDo: tick_alloc"
254 tick_alloc_se_thk = panic "ToDo: tick_alloc"
256 tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> Code
257 tickyAllocPrim hdr goods slop = ifTicky $ panic "ToDo: tickyAllocPrim"
259 tickyAllocThunk :: CmmExpr -> CmmExpr -> Code
260 tickyAllocThunk goods slop = ifTicky $ panic "ToDo: tickyAllocThunk"
262 tickyAllocPAP :: CmmExpr -> CmmExpr -> Code
263 tickyAllocPAP goods slop = ifTicky $ panic "ToDo: tickyAllocPAP"
265 tickyAllocHeap :: VirtualHpOffset -> Code
266 -- Called when doing a heap check [TICK_ALLOC_HEAP]
269 do { ticky_ctr <- getTickyCtrLabel
271 if hp == 0 then [] -- Inside the stmtC to avoid control
272 else [ -- dependency on the argument
273 -- Bump the allcoation count in the StgEntCounter
274 addToMem REP_StgEntCounter_allocs
275 (CmmLit (cmmLabelOffB ticky_ctr
276 oFFSET_StgEntCounter_allocs)) hp,
277 -- Bump ALLOC_HEAP_ctr
278 addToMemLbl cLongRep (mkRtsDataLabel SLIT("ALLOC_HEAP_ctr")) 1,
279 -- Bump ALLOC_HEAP_tot
280 addToMemLbl cLongRep (mkRtsDataLabel SLIT("ALLOC_HEAP_tot")) hp] }
282 -- -----------------------------------------------------------------------------
285 ifTicky :: Code -> Code
287 | opt_DoTickyProfiling = code
290 addToMemLbl :: MachRep -> CLabel -> Int -> CmmStmt
291 addToMemLbl rep lbl n = addToMem rep (CmmLit (CmmLabel lbl)) n
293 -- All the ticky-ticky counters are declared "unsigned long" in C
294 bumpTickyCounter :: LitString -> Code
295 bumpTickyCounter lbl = bumpTickyCounter' (mkRtsDataLabel lbl)
297 bumpTickyCounter' :: CLabel -> Code
298 bumpTickyCounter' lbl = stmtC (addToMemLbl cLongRep lbl 1)
300 addToMemLong = addToMem cLongRep
302 bumpHistogram :: LitString -> Int -> Code
304 = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLongRep))
306 bumpHistogramE :: LitString -> CmmExpr -> Code
308 = do t <- newTemp cLongRep
309 stmtC (CmmAssign t n)
310 emitIf (CmmMachOp (MO_U_Le cLongRep) [CmmReg t, eight]) $
311 stmtC (CmmAssign t eight)
312 stmtC (addToMemLong (cmmIndexExpr cLongRep
313 (CmmLit (CmmLabel (mkRtsDataLabel lbl)))
317 eight = CmmLit (CmmInt 8 cLongRep)
319 ------------------------------------------------------------------
320 -- Showing the "type category" for ticky-ticky profiling
322 showTypeCategory :: Type -> Char
323 {- {C,I,F,D} char, int, float, double
325 S other single-constructor type
326 {c,i,f,d} unboxed ditto
328 s *unpacked" single-cons...
334 + dictionary, unless it's a ...
337 M other (multi-constructor) data-con type
339 - reserved for others to mark as "uninteresting"
345 case tcSplitTyConApp_maybe ty of
346 Nothing -> if isJust (tcSplitFunTy_maybe ty)
351 let utc = getUnique tycon in
352 if utc == charDataConKey then 'C'
353 else if utc == intDataConKey then 'I'
354 else if utc == floatDataConKey then 'F'
355 else if utc == doubleDataConKey then 'D'
356 else if utc == smallIntegerDataConKey ||
357 utc == largeIntegerDataConKey then 'J'
358 else if utc == charPrimTyConKey then 'c'
359 else if (utc == intPrimTyConKey || utc == wordPrimTyConKey
360 || utc == addrPrimTyConKey) then 'i'
361 else if utc == floatPrimTyConKey then 'f'
362 else if utc == doublePrimTyConKey then 'd'
363 else if isPrimTyCon tycon {- array, we hope -} then 'A' -- Bogus
364 else if isEnumerationTyCon tycon then 'E'
365 else if isTupleTyCon tycon then 'T'
366 else if isJust (maybeTyConSingleCon tycon) then 'S'
367 else if utc == listTyConKey then 'L'
368 else 'M' -- oh, well...