ticky enhancements
authorNicolas Frisby <nicolas.frisby@gmail.com>
Wed, 6 Mar 2013 21:46:14 +0000 (21:46 +0000)
committerNicolas Frisby <nicolas.frisby@gmail.com>
Fri, 29 Mar 2013 15:20:50 +0000 (15:20 +0000)
  * the new StgCmmArgRep module breaks a dependency cycle; I also
    untabified it, but made no real changes

  * updated the documentation in the wiki and change the user guide to
    point there

  * moved the allocation enters for ticky and CCS to after the heap check

    * I left LDV where it was, which was before the heap check at least
      once, since I have no idea what it is

  * standardized all (active?) ticky alloc totals to bytes

  * in order to avoid double counting StgCmmLayout.adjustHpBackwards
    no longer bumps ALLOC_HEAP_ctr

  * I resurrected the SLOW_CALL counters

    * the new module StgCmmArgRep breaks cyclic dependency between
      Layout and Ticky (which the SLOW_CALL counters cause)

    * renamed them SLOW_CALL_fast_<pattern> and VERY_SLOW_CALL

  * added ALLOC_RTS_ctr and _tot ticky counters

    * eg allocation by Storage.c:allocate or a BUILD_PAP in stg_ap_*_info

    * resurrected ticky counters for ALLOC_THK, ALLOC_PAP, and
      ALLOC_PRIM

    * added -ticky and -DTICKY_TICKY in ways.mk for debug ways

  * added a ticky counter for total LNE entries

  * new flags for ticky: -ticky-allocd -ticky-dyn-thunk -ticky-LNE

    * all off by default

    * -ticky-allocd: tracks allocation *of* closure in addition to
       allocation *by* that closure

    * -ticky-dyn-thunk tracks dynamic thunks as if they were functions

    * -ticky-LNE tracks LNEs as if they were functions

  * updated the ticky report format, including making the argument
    categories (more?) accurate again

  * the printed name for things in the report include the unique of
    their ticky parent as well as if they are not top-level

25 files changed:
compiler/cmm/CLabel.hs
compiler/cmm/CmmType.hs
compiler/codeGen/StgCmmArgRep.hs [new file with mode: 0644]
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmClosure.hs
compiler/codeGen/StgCmmEnv.hs
compiler/codeGen/StgCmmExpr.hs
compiler/codeGen/StgCmmHeap.hs
compiler/codeGen/StgCmmLayout.hs
compiler/codeGen/StgCmmTicky.hs
compiler/codeGen/StgCmmUtils.hs
compiler/ghc.cabal.in
compiler/main/DynFlags.hs
docs/users_guide/profiling.xml
includes/Cmm.h
includes/rts/Ticky.h
includes/stg/Ticky.h
mk/ways.mk
rts/AutoApply.h
rts/Exception.cmm
rts/Linker.c
rts/RaiseAsync.c
rts/Ticky.c
rts/sm/Storage.c
utils/deriveConstants/DeriveConstants.hs

index ebc9e53..8fe8c3c 100644 (file)
@@ -61,7 +61,7 @@ module CLabel (
         mkCAFBlackHoleInfoTableLabel,
         mkCAFBlackHoleEntryLabel,
         mkRtsPrimOpLabel,
-        mkRtsSlowTickyCtrLabel,
+        mkRtsSlowFastTickyCtrLabel,
 
         mkSelectorInfoLabel,
         mkSelectorEntryLabel,
@@ -99,7 +99,7 @@ module CLabel (
         isCFunctionLabel, isGcPtrLabel, labelDynamic,
 
         -- * Conversions
-        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl,
+        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl, hasHaskellName,
 
         pprCLabel
     ) where
@@ -313,7 +313,7 @@ data RtsLabelInfo
 
   | RtsPrimOp PrimOp
   | RtsApFast     FastString    -- ^ _fast versions of generic apply
-  | RtsSlowTickyCtr String
+  | RtsSlowFastTickyCtr String
 
   deriving (Eq, Ord)
   -- NOTE: Eq on LitString compares the pointer only, so this isn't
@@ -356,9 +356,10 @@ mkTopSRTLabel     :: Unique -> CLabel
 mkTopSRTLabel u = SRTLabel u
 
 mkSRTLabel        :: Name -> CafInfo -> CLabel
-mkRednCountsLabel :: Name -> CafInfo -> CLabel
+mkRednCountsLabel :: Name -> CLabel
 mkSRTLabel              name c  = IdLabel name  c SRT
-mkRednCountsLabel       name c  = IdLabel name  c RednCounts
+mkRednCountsLabel       name    =
+  IdLabel name NoCafRefs RednCounts  -- Note [ticky for LNE]
 
 -- These have local & (possibly) external variants:
 mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
@@ -503,8 +504,8 @@ mkCCSLabel          ccs         = CCS_Label ccs
 mkRtsApFastLabel :: FastString -> CLabel
 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
 
-mkRtsSlowTickyCtrLabel :: String -> CLabel
-mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
+mkRtsSlowFastTickyCtrLabel :: String -> CLabel
+mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
 
 
 -- Constructing Code Coverage Labels
@@ -549,10 +550,6 @@ toSlowEntryLbl :: CLabel -> CLabel
 toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
 toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
 
-toRednCountsLbl :: CLabel -> CLabel
-toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts
-toRednCountsLbl l = pprPanic "toRednCountsLbl" (ppr l)
-
 toEntryLbl :: CLabel -> CLabel
 toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
 toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
@@ -574,12 +571,38 @@ toInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
 toInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
 toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
 
+toRednCountsLbl :: CLabel -> Maybe CLabel
+toRednCountsLbl = fmap mkRednCountsLabel . hasHaskellName
+
+hasHaskellName :: CLabel -> Maybe Name
+hasHaskellName (IdLabel n _ _) = Just n
+hasHaskellName _               = Nothing
+
 -- -----------------------------------------------------------------------------
--- Does a CLabel refer to a CAF?
+-- Does a CLabel's referent itself refer to a CAF?
 hasCAF :: CLabel -> Bool
+hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
 hasCAF (IdLabel _ MayHaveCafRefs _) = True
 hasCAF _                            = False
 
+-- Note [ticky for LNE]
+-- ~~~~~~~~~~~~~~~~~~~~~
+
+-- Until 14 Feb 2013, every ticky counter was associated with a
+-- closure. Thus, ticky labels used IdLabel. It is odd that
+-- CmmBuildInfoTables.cafTransfers would consider such a ticky label
+-- reason to add the name to the CAFEnv (and thus eventually the SRT),
+-- but it was harmless because the ticky was only used if the closure
+-- was also.
+--
+-- Since we now have ticky counters for LNEs, it is no longer the case
+-- that every ticky counter has an actual closure. So I changed the
+-- generation of ticky counters' CLabels to not result in their
+-- associated id ending up in the SRT.
+--
+-- NB IdLabel is still appropriate for ticky ids (as opposed to
+-- CmmLabel) because the LNE's counter is still related to an .hs Id,
+-- that Id just isn't for a proper closure.
 
 -- -----------------------------------------------------------------------------
 -- Does a CLabel need declaring before use or not?
@@ -1051,8 +1074,8 @@ pprCLbl (CmmLabel _ fs CmmClosure)
 pprCLbl (RtsLabel (RtsPrimOp primop))
   = ptext (sLit "stg_") <> ppr primop
 
-pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
-  = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
+pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))
+  = ptext (sLit "SLOW_CALL_fast_") <> text pat <> ptext (sLit "_ctr")
 
 pprCLbl (ForeignLabel str _ _ _)
   = ftext str
index 49a2dc1..8eac8c9 100644 (file)
@@ -15,6 +15,7 @@ module CmmType
     , rEP_CostCentreStack_mem_alloc
     , rEP_CostCentreStack_scc_count
     , rEP_StgEntCounter_allocs
+    , rEP_StgEntCounter_allocd
 
     , ForeignHint(..)
 
@@ -337,6 +338,11 @@ rEP_StgEntCounter_allocs dflags
     = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))
     where pc = sPlatformConstants (settings dflags)
 
+rEP_StgEntCounter_allocd :: DynFlags -> CmmType
+rEP_StgEntCounter_allocd dflags
+    = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))
+    where pc = sPlatformConstants (settings dflags)
+
 -------------------------------------------------------------------------
 {-      Note [Signed vs unsigned]
         ~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/codeGen/StgCmmArgRep.hs b/compiler/codeGen/StgCmmArgRep.hs
new file mode 100644 (file)
index 0000000..bd228d4
--- /dev/null
@@ -0,0 +1,135 @@
+-----------------------------------------------------------------------------
+--
+-- Argument representations used in StgCmmLayout.
+--
+-- (c) The University of Glasgow 2013
+--
+-----------------------------------------------------------------------------
+
+module StgCmmArgRep (
+        ArgRep(..), toArgRep, argRepSizeW,
+
+        argRepString, isNonV, idArgRep,
+
+        slowCallPattern,
+
+        ) where
+
+import StgCmmClosure    ( idPrimRep )
+
+import SMRep            ( WordOff )
+import Id               ( Id )
+import TyCon            ( PrimRep(..), primElemRepSizeB )
+import BasicTypes       ( RepArity )
+import Constants        ( wORD64_SIZE )
+import DynFlags
+
+import Outputable
+import FastString
+
+-- I extricated this code as this new module in order to avoid a
+-- cyclic dependency between StgCmmLayout and StgCmmTicky.
+--
+-- NSF 18 Feb 2013
+
+-------------------------------------------------------------------------
+--      Classifying arguments: ArgRep
+-------------------------------------------------------------------------
+
+-- ArgRep is re-exported by StgCmmLayout, but only for use in the
+-- byte-code generator which also needs to know about the
+-- classification of arguments.
+
+data ArgRep = P   -- GC Ptr
+            | N   -- Word-sized non-ptr
+            | L   -- 64-bit non-ptr (long)
+            | V   -- Void
+            | F   -- Float
+            | D   -- Double
+            | V16 -- 16-byte (128-bit) vectors of Float/Double/Int8/Word32/etc.
+instance Outputable ArgRep where ppr = text . argRepString
+
+argRepString :: ArgRep -> String
+argRepString P = "P"
+argRepString N = "N"
+argRepString L = "L"
+argRepString V = "V"
+argRepString F = "F"
+argRepString D = "D"
+argRepString V16 = "V16"
+
+toArgRep :: PrimRep -> ArgRep
+toArgRep VoidRep           = V
+toArgRep PtrRep            = P
+toArgRep IntRep            = N
+toArgRep WordRep           = N
+toArgRep AddrRep           = N
+toArgRep Int64Rep          = L
+toArgRep Word64Rep         = L
+toArgRep FloatRep          = F
+toArgRep DoubleRep         = D
+toArgRep (VecRep len elem)
+    | len*primElemRepSizeB elem == 16 = V16
+    | otherwise                       = error "toArgRep: bad vector primrep"
+
+isNonV :: ArgRep -> Bool
+isNonV V = False
+isNonV _ = True
+
+argRepSizeW :: DynFlags -> ArgRep -> WordOff                -- Size in words
+argRepSizeW _      N   = 1
+argRepSizeW _      P   = 1
+argRepSizeW _      F   = 1
+argRepSizeW dflags L   = wORD64_SIZE        `quot` wORD_SIZE dflags
+argRepSizeW dflags D   = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags
+argRepSizeW _      V   = 0
+argRepSizeW dflags V16 = 16                 `quot` wORD_SIZE dflags
+
+idArgRep :: Id -> ArgRep
+idArgRep = toArgRep . idPrimRep
+
+-- This list of argument patterns should be kept in sync with at least
+-- the following:
+--
+--  * StgCmmLayout.stdPattern maybe to some degree?
+--
+--  * the RTS_RET(stg_ap_*) and RTS_FUN_DECL(stg_ap_*_fast)
+--  declarations in includes/stg/MiscClosures.h
+--
+--  * the SLOW_CALL_*_ctr declarations in includes/stg/Ticky.h,
+--
+--  * the TICK_SLOW_CALL_*() #defines in includes/Cmm.h,
+--
+--  * the PR_CTR(SLOW_CALL_*_ctr) calls in rts/Ticky.c,
+--
+--  * and the SymI_HasProto(stg_ap_*_{ret,info,fast}) calls and
+--  SymI_HasProto(SLOW_CALL_*_ctr) calls in rts/Linker.c
+--
+-- There may be more places that I haven't found; I merely igrep'd for
+-- pppppp and excluded things that seemed ghci-specific.
+--
+-- Also, it seems at the moment that ticky counters with void
+-- arguments will never be bumped, but I'm still declaring those
+-- counters, defensively.
+--
+-- NSF 6 Mar 2013
+
+-- These cases were found to cover about 99% of all slow calls:
+slowCallPattern :: [ArgRep] -> (FastString, RepArity)
+-- Returns the generic apply function and arity
+slowCallPattern (P: P: P: P: P: P: _) = (fsLit "stg_ap_pppppp", 6)
+slowCallPattern (P: P: P: P: P: _)    = (fsLit "stg_ap_ppppp", 5)
+slowCallPattern (P: P: P: P: _)       = (fsLit "stg_ap_pppp", 4)
+slowCallPattern (P: P: P: V: _)       = (fsLit "stg_ap_pppv", 4)
+slowCallPattern (P: P: P: _)          = (fsLit "stg_ap_ppp", 3)
+slowCallPattern (P: P: V: _)          = (fsLit "stg_ap_ppv", 3)
+slowCallPattern (P: P: _)             = (fsLit "stg_ap_pp", 2)
+slowCallPattern (P: V: _)             = (fsLit "stg_ap_pv", 2)
+slowCallPattern (P: _)                = (fsLit "stg_ap_p", 1)
+slowCallPattern (V: _)                = (fsLit "stg_ap_v", 1)
+slowCallPattern (N: _)                = (fsLit "stg_ap_n", 1)
+slowCallPattern (F: _)                = (fsLit "stg_ap_f", 1)
+slowCallPattern (D: _)                = (fsLit "stg_ap_d", 1)
+slowCallPattern (L: _)                = (fsLit "stg_ap_l", 1)
+slowCallPattern (V16: _)              = (fsLit "stg_ap_v16", 1)
+slowCallPattern []                    = (fsLit "stg_ap_0", 0)
index 136bb52..1e5d6b9 100644 (file)
@@ -296,7 +296,7 @@ mkRhsClosure    dflags bndr _cc _bi
                 (StgApp fun_id args)
 
   | args `lengthIs` (arity-1)
-        && all (isGcPtrRep . idPrimRep . stripNV) fvs
+        && all (isGcPtrRep . idPrimRep . unsafe_stripNV) fvs
         && isUpdatable upd_flag
         && arity <= mAX_SPEC_AP_SIZE dflags
         && not (gopt Opt_SccProfilingOn dflags)
@@ -344,7 +344,7 @@ mkRhsClosure _ bndr cc _ fvs upd_flag args body
                 fv_details :: [(NonVoid Id, VirtualHpOffset)]
                 (tot_wds, ptr_wds, fv_details)
                    = mkVirtHeapOffsets dflags (isLFThunk lf_info)
-                                       (addIdReps (map stripNV reduced_fvs))
+                                       (addIdReps (map unsafe_stripNV reduced_fvs))
                 closure_info = mkClosureInfo dflags False       -- Not static
                                              bndr lf_info tot_wds ptr_wds
                                              descr
@@ -369,11 +369,6 @@ mkRhsClosure _ bndr cc _ fvs upd_flag args body
         -- RETURN
         ; return (mkRhsInit dflags reg lf_info hp_plus_n) }
 
-
--- Use with care; if used inappropriately, it could break invariants.
-stripNV :: NonVoid a -> a
-stripNV (NonVoid a) = a
-
 -------------------------
 cgRhsStdThunk
         :: Id
@@ -418,10 +413,10 @@ mkClosureLFInfo :: Id           -- The binder
                 -> [Id]         -- Args
                 -> FCode LambdaFormInfo
 mkClosureLFInfo bndr top fvs upd_flag args
-  | null args = return (mkLFThunk (idType bndr) top (map stripNV fvs) upd_flag)
+  | null args = return (mkLFThunk (idType bndr) top (map unsafe_stripNV fvs) upd_flag)
   | otherwise =
       do { arg_descr <- mkArgDescr (idName bndr) args
-         ; return (mkLFReEntrant top (map stripNV fvs) args arg_descr) }
+         ; return (mkLFReEntrant top (map unsafe_stripNV fvs) args arg_descr) }
 
 
 ------------------------------------------------------------------------
@@ -453,7 +448,8 @@ closureCodeBody :: Bool            -- whether this is a top-level binding
 
 closureCodeBody top_lvl bndr cl_info cc _args arity body fv_details
   | arity == 0 -- No args i.e. thunk
-  = emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl [] $
+  = withNewTickyCounterThunk cl_info $
+    emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl [] $
       \(_, node, _) -> thunkCode cl_info fv_details cc node arity body
    where
      lf_info  = closureLFInfo cl_info
@@ -461,12 +457,7 @@ closureCodeBody top_lvl bndr cl_info cc _args arity body fv_details
 
 closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
   = -- Note: args may be [], if all args are Void
-    do  { -- Allocate the global ticky counter,
-          -- and establish the ticky-counter
-          -- label for this block
-          let ticky_ctr_lbl = closureRednCountsLabel cl_info
-        ; emitTickyCounter cl_info (map stripNV args)
-        ; setTickyCtrLabel ticky_ctr_lbl $ do
+    withNewTickyCounterFun (closureName cl_info) args $ do {
 
         ; let
              lf_info  = closureLFInfo cl_info
@@ -479,20 +470,20 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
                 { mkSlowEntryCode bndr cl_info arg_regs
 
                 ; dflags <- getDynFlags
-                ; let lf_info = closureLFInfo cl_info
-                      node_points = nodeMustPointToIt dflags lf_info
+                ; let node_points = nodeMustPointToIt dflags lf_info
                       node' = if node_points then Just node else Nothing
-                ; tickyEnterFun cl_info
-                ; enterCostCentreFun cc
-                    (CmmMachOp (mo_wordSub dflags)
-                         [ CmmReg nodeReg
-                         , mkIntExpr dflags (funTag dflags cl_info) ])
                 ; when node_points (ldvEnterClosure cl_info)
                 ; granYield arg_regs node_points
 
                 -- Main payload
                 ; entryHeapCheck cl_info node' arity arg_regs $ do
-                { fv_bindings <- mapM bind_fv fv_details
+                { -- ticky after heap check to avoid double counting
+                  tickyEnterFun cl_info
+                ; enterCostCentreFun cc
+                    (CmmMachOp (mo_wordSub dflags)
+                         [ CmmReg nodeReg
+                         , mkIntExpr dflags (funTag dflags cl_info) ])
+                ; fv_bindings <- mapM bind_fv fv_details
                 -- Load free vars out of closure *after*
                 -- heap check, to reduce live vars over check
                 ; when node_points $ load_fvs node lf_info fv_bindings
@@ -545,7 +536,6 @@ thunkCode cl_info fv_details _cc node arity body
   = do { dflags <- getDynFlags
        ; let node_points = nodeMustPointToIt dflags (closureLFInfo cl_info)
              node'       = if node_points then Just node else Nothing
-        ; tickyEnterThunk cl_info
         ; ldvEnterClosure cl_info -- NB: Node always points when profiling
         ; granThunk node_points
 
@@ -562,7 +552,8 @@ thunkCode cl_info fv_details _cc node arity body
             -- that cc of enclosing scope will be recorded
             -- in update frame CAF/DICT functions will be
             -- subsumed by this enclosing cc
-            do { enterCostCentreThunk (CmmReg nodeReg)
+            do { tickyEnterThunk cl_info
+               ; enterCostCentreThunk (CmmReg nodeReg)
                ; let lf_info = closureLFInfo cl_info
                ; fv_bindings <- mapM bind_fv fv_details
                ; load_fvs node lf_info fv_bindings
index 7f44f67..a057484 100644 (file)
@@ -49,7 +49,7 @@ module StgCmmClosure (
         -- ** Labels
         -- These just need the info table label
         closureInfoLabel, staticClosureLabel,
-        closureRednCountsLabel, closureSlowEntryLabel, closureLocalEntryLabel,
+        closureSlowEntryLabel, closureLocalEntryLabel,
 
         -- ** Predicates
         -- These are really just functions on LambdaFormInfo
@@ -772,9 +772,6 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
 staticClosureLabel :: ClosureInfo -> CLabel
 staticClosureLabel = toClosureLbl .  closureInfoLabel
 
-closureRednCountsLabel :: ClosureInfo -> CLabel
-closureRednCountsLabel = toRednCountsLbl . closureInfoLabel
-
 closureSlowEntryLabel :: ClosureInfo -> CLabel
 closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
 
index 42e4da0..1fdb364 100644 (file)
@@ -13,7 +13,7 @@ module StgCmmEnv (
         litIdInfo, lneIdInfo, rhsIdInfo, mkRhsInit,
         idInfoToAmode,
 
-        NonVoid(..), isVoidId, nonVoidIds,
+        NonVoid(..), unsafe_stripNV, isVoidId, nonVoidIds,
 
         addBindC, addBindsC,
 
@@ -55,6 +55,10 @@ import Outputable
 newtype NonVoid a = NonVoid a
   deriving (Eq, Show)
 
+-- Use with care; if used inappropriately, it could break invariants.
+unsafe_stripNV :: NonVoid a -> a
+unsafe_stripNV (NonVoid a) = a
+
 instance (Outputable a) => Outputable (NonVoid a) where
   ppr (NonVoid a) = ppr a
 
index f4186f7..7808021 100644 (file)
@@ -161,10 +161,11 @@ cgLetNoEscapeClosure bndr cc_slot _unused_cc args body
        return ( lneIdInfo dflags bndr args
               , code )
   where
-   code = forkProc $ do
-                  { restoreCurrentCostCentre cc_slot
-                  ; arg_regs <- bindArgsToRegs args
-                  ; void $ noEscapeHeapCheck arg_regs (cgExpr body) }
+   code = forkProc $ do {
+            ; withNewTickyCounterLNE (idName bndr) args $ do
+            ; restoreCurrentCostCentre cc_slot
+            ; arg_regs <- bindArgsToRegs args
+            ; void $ noEscapeHeapCheck arg_regs (tickyEnterLNE >> cgExpr body) }
 
 
 ------------------------------------------------------------------------
@@ -416,6 +417,7 @@ cgCase scrut bndr alt_type alts
                     | isSingleton alts = False
                     | up_hp_usg > 0    = False
                     | otherwise        = True
+               -- cf Note [Compiling case expressions]
              gc_plan = if do_gc then GcInAlts alt_regs else NoGcInAlts
 
        ; mb_cc <- maybeSaveCostCentre simple_scrut
index b1cddbe..50fcfdc 100644 (file)
@@ -100,7 +100,7 @@ allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets
 
         -- SAY WHAT WE ARE ABOUT TO DO
         ; let rep = cit_rep info_tbl
-        ; tickyDynAlloc rep lf_info
+        ; tickyDynAlloc (toRednCountsLbl $ cit_lbl info_tbl) rep lf_info
         ; profDynAlloc rep use_cc
 
         -- FIND THE OFFSET OF THE INFO-PTR WORD
@@ -215,7 +215,6 @@ mkStaticClosure dflags info_lbl ccs payload padding static_link_field saved_info
         =  staticGranHdr
         ++ staticParHdr
         ++ staticProfHdr dflags ccs
-        ++ staticTickyHdr
 
 -- JD: Simon had ellided this padding, but without it the C back end asserts
 -- failure. Maybe it's a bad assertion, and this padding is indeed unnecessary?
@@ -527,7 +526,7 @@ heapCheck checkStack checkYield do_gc code
               stk_hwm | checkStack = Just (CmmLit CmmHighStackMark)
                       | otherwise  = Nothing
         ; codeOnly $ do_checks stk_hwm checkYield mb_alloc_bytes do_gc
-        ; tickyAllocHeap hpHw
+        ; tickyAllocHeap True hpHw
         ; doGranAllocate hpHw
         ; setRealHp hpHw
         ; code }
index a3bbefe..06a47c1 100644 (file)
@@ -24,7 +24,7 @@ module StgCmmLayout (
 
        mkVirtHeapOffsets, mkVirtConstrOffsets, getHpRelOffset, hpRel,
 
-        ArgRep(..), toArgRep, argRepSizeW
+        ArgRep(..), toArgRep, argRepSizeW -- re-exported from StgCmmArgRep
   ) where
 
 
@@ -32,6 +32,7 @@ module StgCmmLayout (
 
 import StgCmmClosure
 import StgCmmEnv
+import StgCmmArgRep -- notably: ( slowCallPattern )
 import StgCmmTicky
 import StgCmmMonad
 import StgCmmUtils
@@ -46,12 +47,11 @@ import CLabel
 import StgSyn
 import Id
 import Name
-import TyCon           ( PrimRep(..), primElemRepSizeB )
+import TyCon           ( PrimRep(..) )
 import BasicTypes      ( RepArity )
 import DynFlags
 import Module
 
-import Constants
 import Util
 import Data.List
 import Outputable
@@ -148,7 +148,7 @@ adjustHpBackwards
                then mkNop
                else mkAssign hpReg new_hp)     -- Generates nothing when vHp==rHp
 
-       ; tickyAllocHeap adjust_words           -- ...ditto
+       ; tickyAllocHeap False adjust_words             -- ...ditto
 
        ; setRealHp vHp
        }
@@ -298,82 +298,6 @@ slowArgs dflags args -- careful: reps contains voids (V), but args does not
     save_cccs  = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just curCCS)]
     save_cccs_lbl = mkCmmRetInfoLabel rtsPackageId (fsLit "stg_restore_cccs")
 
-
-
--- These cases were found to cover about 99% of all slow calls:
-slowCallPattern :: [ArgRep] -> (FastString, RepArity)
--- Returns the generic apply function and arity
-slowCallPattern (P: P: P: P: P: P: _) = (fsLit "stg_ap_pppppp", 6)
-slowCallPattern (P: P: P: P: P: _)    = (fsLit "stg_ap_ppppp", 5)
-slowCallPattern (P: P: P: P: _)       = (fsLit "stg_ap_pppp", 4)
-slowCallPattern (P: P: P: V: _)       = (fsLit "stg_ap_pppv", 4)
-slowCallPattern (P: P: P: _)          = (fsLit "stg_ap_ppp", 3)
-slowCallPattern (P: P: V: _)          = (fsLit "stg_ap_ppv", 3)
-slowCallPattern (P: P: _)            = (fsLit "stg_ap_pp", 2)
-slowCallPattern (P: V: _)            = (fsLit "stg_ap_pv", 2)
-slowCallPattern (P: _)               = (fsLit "stg_ap_p", 1)
-slowCallPattern (V: _)               = (fsLit "stg_ap_v", 1)
-slowCallPattern (N: _)               = (fsLit "stg_ap_n", 1)
-slowCallPattern (F: _)               = (fsLit "stg_ap_f", 1)
-slowCallPattern (D: _)               = (fsLit "stg_ap_d", 1)
-slowCallPattern (L: _)               = (fsLit "stg_ap_l", 1)
-slowCallPattern (V16: _)             = (fsLit "stg_ap_v16", 1)
-slowCallPattern []                   = (fsLit "stg_ap_0", 0)
-
-
--------------------------------------------------------------------------
---      Classifying arguments: ArgRep
--------------------------------------------------------------------------
-
--- ArgRep is exported, but only for use in the byte-code generator which
--- also needs to know about the classification of arguments.
-
-data ArgRep = P   -- GC Ptr
-            | N   -- Word-sized non-ptr
-            | L   -- 64-bit non-ptr (long)
-            | V   -- Void
-            | F   -- Float
-            | D   -- Double
-            | V16 -- 16-byte (128-bit) vectors of Float/Double/Int8/Word32/etc.
-instance Outputable ArgRep where
-  ppr P   = text "P"
-  ppr N   = text "N"
-  ppr L   = text "L"
-  ppr V   = text "V"
-  ppr F   = text "F"
-  ppr D   = text "D"
-  ppr V16 = text "V16"
-
-toArgRep :: PrimRep -> ArgRep
-toArgRep VoidRep           = V
-toArgRep PtrRep            = P
-toArgRep IntRep            = N
-toArgRep WordRep           = N
-toArgRep AddrRep           = N
-toArgRep Int64Rep          = L
-toArgRep Word64Rep         = L
-toArgRep FloatRep          = F
-toArgRep DoubleRep         = D
-toArgRep (VecRep len elem)
-    | len*primElemRepSizeB elem == 16 = V16
-    | otherwise                       = error "toArgRep: bad vector primrep"
-
-isNonV :: ArgRep -> Bool
-isNonV V = False
-isNonV _ = True
-
-argRepSizeW :: DynFlags -> ArgRep -> WordOff                -- Size in words
-argRepSizeW _      N   = 1
-argRepSizeW _      P   = 1
-argRepSizeW _      F   = 1
-argRepSizeW dflags L   = wORD64_SIZE        `quot` wORD_SIZE dflags
-argRepSizeW dflags D   = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags
-argRepSizeW _      V   = 0
-argRepSizeW dflags V16 = 16                 `quot` wORD_SIZE dflags
-
-idArgRep :: Id -> ArgRep
-idArgRep = toArgRep . idPrimRep
-
 -------------------------------------------------------------------------
 ----   Laying out objects on the heap and stack
 -------------------------------------------------------------------------
index 2bca544..09938a6 100644 (file)
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
+{- OVERVIEW: ticky ticky profiling
+
+Please see
+http://hackage.haskell.org/trac/ghc/wiki/Debugging/TickyTicky and also
+edit it and the rest of this comment to keep them up-to-date if you
+change ticky-ticky. Thanks!
+
+ *** All allocation ticky numbers are in bytes. ***
+
+Some of the relevant source files:
+
+       ***not necessarily an exhaustive list***
+
+  * some codeGen/ modules import this one
+
+  * this module imports cmm/CLabel.hs to manage labels
+
+  * cmm/CmmParse.y expands some macros using generators defined in
+    this module
+
+  * includes/stg/Ticky.h declares all of the global counters
+
+  * includes/rts/Ticky.h declares the C data type for an
+    STG-declaration's counters
+
+  * some macros defined in includes/Cmm.h (and used within the RTS's
+    CMM code) update the global ticky counters
+
+  * at the end of execution rts/Ticky.c generates the final report
+    +RTS -r<report-file> -RTS
+
+The rts/Ticky.c function that generates the report includes an
+STG-declaration's ticky counters if
+
+  * that declaration was entered, or
+
+  * it was allocated (if -ticky-allocd)
+
+On either of those events, the counter is "registered" by adding it to
+a linked list; cf the CMM generated by registerTickyCtr.
+
+Ticky-ticky profiling has evolved over many years. Many of the
+counters from its most sophisticated days are no longer
+active/accurate. As the RTS has changed, sometimes the ticky code for
+relevant counters was not accordingly updated. Unfortunately, neither
+were the comments.
+
+As of March 2013, there still exist deprecated code and comments in
+the code generator as well as the RTS because:
+
+  * I don't know what is out-of-date versus merely commented out for
+    momentary convenience, and
+
+  * someone else might know how to repair it!
+
+-}
 
 module StgCmmTicky (
-       emitTickyCounter,
+  withNewTickyCounterFun,
+  withNewTickyCounterThunk,
+  withNewTickyCounterLNE,
 
-       tickyDynAlloc,
-       tickyAllocHeap,
-       tickyAllocPrim,
-       tickyAllocThunk,
-       tickyAllocPAP,
-       
-       tickySlowCall, tickyDirectCall,
+  tickyDynAlloc,
+  tickyAllocHeap,
+  tickyAllocPrim,
+  tickyAllocThunk,
+  tickyAllocPAP,
 
-       tickyPushUpdateFrame,
-       tickyUpdateFrameOmitted,
+  tickyUnknownCall, tickyDirectCall,
 
-       tickyEnterDynCon,
-       tickyEnterStaticCon,
-       tickyEnterViaNode,
+  tickyPushUpdateFrame,
+  tickyUpdateFrameOmitted,
 
-       tickyEnterFun, 
-       tickyEnterThunk,
+  tickyEnterDynCon,
+  tickyEnterStaticCon,
+  tickyEnterViaNode,
 
-       tickyUpdateBhCaf,
-       tickyBlackHole,
-       tickyUnboxedTupleReturn, tickyVectoredReturn,
-       tickyReturnOldCon, tickyReturnNewCon,
+  tickyEnterFun,
+  tickyEnterThunk,
+  tickyEnterLNE,
 
-       tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs,
-       tickyUnknownCall, tickySlowCallPat,
+  tickyUpdateBhCaf,
+  tickyBlackHole,
+  tickyUnboxedTupleReturn, tickyVectoredReturn,
+  tickyReturnOldCon, tickyReturnNewCon,
 
-       staticTickyHdr,
+  tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs,
+  tickySlowCall, tickySlowCallPat,
   ) where
 
 #include "HsVersions.h"
 
+import StgCmmArgRep    ( slowCallPattern , toArgRep , argRepString )
+import StgCmmEnv       ( NonVoid, unsafe_stripNV )
 import StgCmmClosure
 import StgCmmUtils
 import StgCmmMonad
@@ -74,52 +127,87 @@ import Type
 import TyCon
 
 import Data.Maybe
+import qualified Data.Char
+import Control.Monad ( when )
 
 -----------------------------------------------------------------------------
 --
---             Ticky-ticky profiling
+-- Ticky-ticky profiling
 --
 -----------------------------------------------------------------------------
 
-staticTickyHdr :: [CmmLit]
--- krc: not using this right now --
--- in the new version of ticky-ticky, we
--- don't change the closure layout.
--- leave it defined, though, to avoid breaking
--- other things.
-staticTickyHdr = []
-
-emitTickyCounter :: ClosureInfo -> [Id] -> FCode ()
-emitTickyCounter cl_info args
-  = ifTicky $
-    do { dflags <- getDynFlags
+data TickyClosureType = TickyFun | TickyThunk | TickyLNE
+
+withNewTickyCounterFun, withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode () -> FCode ()
+withNewTickyCounterFun = withNewTickyCounter TickyFun
+
+withNewTickyCounterLNE nm args code = do
+  b <- tickyLNEIsOn
+  if not b then code else withNewTickyCounter TickyLNE nm args code
+
+withNewTickyCounterThunk :: ClosureInfo -> FCode () -> FCode ()
+withNewTickyCounterThunk cl_info code
+  | isStaticClosure cl_info = code -- static thunks are uninteresting
+  | otherwise = do
+    b <- tickyDynThunkIsOn
+    if not b then code else withNewTickyCounter TickyThunk (closureName cl_info) [] code
+
+-- args does not include the void arguments
+withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode () -> FCode ()
+withNewTickyCounter cloType name args m = do
+  lbl <- emitTickyCounter cloType name args
+  setTickyCtrLabel lbl m
+
+emitTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode CLabel
+emitTickyCounter cloType name args
+  = let ctr_lbl = mkRednCountsLabel name in
+    (>> return ctr_lbl) $
+    ifTicky $ do
+        { dflags <- getDynFlags
+        ; parent <- getTickyCtrLabel
         ; mod_name <- getModuleName
-        ; let ticky_ctr_label = closureRednCountsLabel cl_info
-              arg_descr = map (showTypeCategory . idType) args
-              fun_descr mod_name = ppr_for_ticky_name dflags mod_name (closureName cl_info)
-       ; fun_descr_lit <- newStringCLit (fun_descr mod_name)
-       ; arg_descr_lit <- newStringCLit arg_descr
-       ; emitDataLits ticky_ctr_label  -- Must match layout of StgEntCounter
--- krc: note that all the fields are I32 now; some were I16 before, 
--- but the code generator wasn't handling that properly and it led to chaos, 
--- panic and disorder.
-           [ mkIntCLit dflags 0,
-             mkIntCLit dflags (length args),   -- Arity
-             mkIntCLit dflags 0,               -- XXX: we no longer know this!  Words passed on stack
-             fun_descr_lit,
-             arg_descr_lit,
-             zeroCLit dflags,          -- Entry count
-             zeroCLit dflags,          -- Allocs
-             zeroCLit dflags                   -- Link
-           ] }
-
--- When printing the name of a thing in a ticky file, we want to
--- give the module name even for *local* things.   We print
--- just "x (M)" rather that "M.x" to distinguish them from the global kind.
-ppr_for_ticky_name :: DynFlags -> Module -> Name -> String
-ppr_for_ticky_name dflags mod_name name
-  | isInternalName name = showSDocDebug dflags (ppr name <+> (parens (ppr mod_name)))
-  | otherwise           = showSDocDebug dflags (ppr name)
+
+          -- When printing the name of a thing in a ticky file, we
+          -- want to give the module name even for *local* things.  We
+          -- print just "x (M)" rather that "M.x" to distinguish them
+          -- from the global kind.
+        ; let ppr_for_ticky_name :: SDoc
+              ppr_for_ticky_name =
+                let n = ppr name
+                    p = case hasHaskellName parent of
+                            -- NB the default "top" ticky ctr does not
+                            -- have a Haskell name
+                          Just pname -> text "in" <+> ppr (nameUnique pname)
+                          _ -> empty
+                in (<+> p) $ if isInternalName name
+                   then let s = n <+> (parens (ppr mod_name))
+                        in case cloType of
+                          TickyFun -> s
+                          TickyThunk -> s <+> parens (text "thk")
+                          TickyLNE -> s <+> parens (text "LNE")
+                  else case cloType of
+                         TickyFun -> n
+                         TickyThunk -> n <+> parens (text "thk")
+                         TickyLNE -> panic "emitTickyCounter: how is this an external LNE?"
+
+        ; fun_descr_lit <- newStringCLit $ showSDocDebug dflags ppr_for_ticky_name
+        ; arg_descr_lit <- newStringCLit $ map (showTypeCategory . idType . unsafe_stripNV) args
+        ; emitDataLits ctr_lbl
+        -- Must match layout of includes/rts/Ticky.h's StgEntCounter
+        --
+        -- krc: note that all the fields are I32 now; some were I16
+        -- before, but the code generator wasn't handling that
+        -- properly and it led to chaos, panic and disorder.
+            [ mkIntCLit dflags 0,               -- registered?
+              mkIntCLit dflags (length args),   -- Arity
+              mkIntCLit dflags 0,               -- Heap allocated for this thing
+              fun_descr_lit,
+              arg_descr_lit,
+              zeroCLit dflags,          -- Entries into this thing
+              zeroCLit dflags,          -- Heap allocated by this thing
+              zeroCLit dflags                   -- Link to next StgEntCounter
+            ]
+        }
 
 -- -----------------------------------------------------------------------------
 -- Ticky stack frames
@@ -131,10 +219,9 @@ tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (fsLit "UPDF_OMITTED_ctr")
 -- -----------------------------------------------------------------------------
 -- Ticky entries
 
-tickyEnterDynCon, tickyEnterDynThunk, tickyEnterStaticCon,
+tickyEnterDynCon, tickyEnterStaticCon,
     tickyEnterStaticThunk, tickyEnterViaNode :: FCode ()
 tickyEnterDynCon      = ifTicky $ bumpTickyCounter (fsLit "ENT_DYN_CON_ctr")
-tickyEnterDynThunk    = ifTicky $ bumpTickyCounter (fsLit "ENT_DYN_THK_ctr")
 tickyEnterStaticCon   = ifTicky $ bumpTickyCounter (fsLit "ENT_STATIC_CON_ctr")
 tickyEnterStaticThunk = ifTicky $ bumpTickyCounter (fsLit "ENT_STATIC_THK_ctr")
 tickyEnterViaNode     = ifTicky $ bumpTickyCounter (fsLit "ENT_VIA_NODE_ctr")
@@ -142,41 +229,65 @@ tickyEnterViaNode     = ifTicky $ bumpTickyCounter (fsLit "ENT_VIA_NODE_ctr")
 tickyEnterThunk :: ClosureInfo -> FCode ()
 tickyEnterThunk cl_info
   | isStaticClosure cl_info = tickyEnterStaticThunk
-  | otherwise              = tickyEnterDynThunk
+  | otherwise               = ifTicky $ do
+ bumpTickyCounter (fsLit "ENT_DYN_THK_ctr")
+ ifTickyDynThunk $ do
+   ticky_ctr_lbl <- getTickyCtrLabel
+   registerTickyCtrAtEntryDyn ticky_ctr_lbl
+   bumpTickyEntryCount ticky_ctr_lbl
 
 tickyBlackHole :: Bool{-updatable-} -> FCode ()
 tickyBlackHole updatable
   = ifTicky (bumpTickyCounter ctr)
   where
     ctr | updatable = (fsLit "UPD_BH_SINGLE_ENTRY_ctr")
-       | otherwise = (fsLit "UPD_BH_UPDATABLE_ctr")
+        | otherwise = (fsLit "UPD_BH_UPDATABLE_ctr")
 
 tickyUpdateBhCaf :: ClosureInfo -> FCode ()
 tickyUpdateBhCaf cl_info
   = ifTicky (bumpTickyCounter ctr)
   where
     ctr | closureUpdReqd cl_info = (fsLit "UPD_CAF_BH_SINGLE_ENTRY_ctr")
-       | otherwise              = (fsLit "UPD_CAF_BH_UPDATABLE_ctr")
+        | otherwise              = (fsLit "UPD_CAF_BH_UPDATABLE_ctr")
 
 tickyEnterFun :: ClosureInfo -> FCode ()
-tickyEnterFun cl_info
-  = ifTicky $ 
-    do  { dflags <- getDynFlags
-        ; bumpTickyCounter ctr
-       ; fun_ctr_lbl <- getTickyCtrLabel
-       ; registerTickyCtr fun_ctr_lbl
-       ; bumpTickyCounter' (cmmLabelOffB fun_ctr_lbl (oFFSET_StgEntCounter_entry_count dflags))
-        }
-  where
-    ctr | isStaticClosure cl_info = (fsLit "ENT_STATIC_FUN_DIRECT_ctr")
-       | otherwise               = (fsLit "ENT_DYN_FUN_DIRECT_ctr")
+tickyEnterFun cl_info = ifTicky $ do
+  ctr_lbl <- getTickyCtrLabel
+
+  if isStaticClosure cl_info
+    then do bumpTickyCounter (fsLit "ENT_STATIC_FUN_DIRECT_ctr")
+            registerTickyCtr ctr_lbl
+    else do bumpTickyCounter (fsLit "ENT_DYN_FUN_DIRECT_ctr")
+            registerTickyCtrAtEntryDyn ctr_lbl
+
+  bumpTickyEntryCount ctr_lbl
+
+tickyEnterLNE :: FCode ()
+tickyEnterLNE = ifTicky $ do
+  bumpTickyCounter (fsLit "ENT_LNE_ctr")
+  ifTickyLNE $ do
+    ctr_lbl <- getTickyCtrLabel
+    registerTickyCtr ctr_lbl
+    bumpTickyEntryCount ctr_lbl
+
+-- needn't register a counter upon entry if
+--
+-- 1) it's for a dynamic closure, and
+--
+-- 2) -ticky-allocd is on
+--
+-- since the counter was registered already upon being alloc'd
+registerTickyCtrAtEntryDyn :: CLabel -> FCode ()
+registerTickyCtrAtEntryDyn ctr_lbl = do
+  already_registered <- tickyAllocdIsOn
+  when (not already_registered) $ registerTickyCtr ctr_lbl
 
 registerTickyCtr :: CLabel -> FCode ()
 -- Register a ticky counter
 --   if ( ! f_ct.registeredp ) {
---         f_ct.link = ticky_entry_ctrs;       /* hook this one onto the front of the list */
---         ticky_entry_ctrs = & (f_ct);        /* mark it as "registered" */
---         f_ct.registeredp = 1 }
+--          f_ct.link = ticky_entry_ctrs;       /* hook this one onto the front of the list */
+--          ticky_entry_ctrs = & (f_ct);        /* mark it as "registered" */
+--          f_ct.registeredp = 1 }
 registerTickyCtr ctr_lbl = do
   dflags <- getDynFlags
   let
@@ -196,22 +307,22 @@ registerTickyCtr ctr_lbl = do
   emit =<< mkCmmIfThen test (catAGraphs register_stmts)
 
 tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode ()
-tickyReturnOldCon arity 
+tickyReturnOldCon arity
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_OLD_ctr")
-                ; bumpHistogram    (fsLit "RET_OLD_hst") arity }
-tickyReturnNewCon arity 
+                 ; bumpHistogram    (fsLit "RET_OLD_hst") arity }
+tickyReturnNewCon arity
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_NEW_ctr")
-                ; bumpHistogram    (fsLit "RET_NEW_hst") arity }
+                 ; bumpHistogram    (fsLit "RET_NEW_hst") arity }
 
 tickyUnboxedTupleReturn :: RepArity -> FCode ()
 tickyUnboxedTupleReturn arity
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_UNBOXED_TUP_ctr")
-                ; bumpHistogram    (fsLit "RET_UNBOXED_TUP_hst") arity }
+                 ; bumpHistogram    (fsLit "RET_UNBOXED_TUP_hst") arity }
 
 tickyVectoredReturn :: Int -> FCode ()
-tickyVectoredReturn family_size 
+tickyVectoredReturn family_size
   = ifTicky $ do { bumpTickyCounter (fsLit "VEC_RETURN_ctr")
-                ; bumpHistogram    (fsLit "RET_VEC_RETURN_hst") family_size }
+                 ; bumpHistogram    (fsLit "RET_VEC_RETURN_hst") family_size }
 
 -- -----------------------------------------------------------------------------
 -- Ticky calls
@@ -221,7 +332,7 @@ tickyDirectCall :: RepArity -> [StgArg] -> FCode ()
 tickyDirectCall arity args
   | arity == length args = tickyKnownCallExact
   | otherwise = do tickyKnownCallExtraArgs
-                  tickySlowCallPat (map argPrimRep (drop arity args))
+                   tickySlowCallPat (map argPrimRep (drop arity args))
 
 tickyKnownCallTooFewArgs :: FCode ()
 tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_TOO_FEW_ARGS_ctr")
@@ -238,130 +349,224 @@ tickyUnknownCall         = ifTicky $ bumpTickyCounter (fsLit "UNKNOWN_CALL_ctr")
 -- Tick for the call pattern at slow call site (i.e. in addition to
 -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.)
 tickySlowCall :: LambdaFormInfo -> [StgArg] -> FCode ()
-tickySlowCall _ []
-  = return ()
-tickySlowCall lf_info args 
-  = do { if (isKnownFun lf_info) 
-               then tickyKnownCallTooFewArgs
-               else tickyUnknownCall
-       ; tickySlowCallPat (map argPrimRep args) }
+tickySlowCall _ [] = return ()
+tickySlowCall lf_info args = do
+ -- see Note [Ticky for slow calls]
+ if isKnownFun lf_info
+   then tickyKnownCallTooFewArgs
+   else tickyUnknownCall
+ tickySlowCallPat (map argPrimRep args)
 
 tickySlowCallPat :: [PrimRep] -> FCode ()
-tickySlowCallPat _args = return ()
-{- LATER: (introduces recursive module dependency now).
-  case callPattern args of
-    (str, True)  -> bumpTickyCounter' (mkRtsSlowTickyCtrLabel pat)
-    (str, False) -> bumpTickyCounter  (sLit "TICK_SLOW_CALL_OTHER")
-
--- Don't use CgRep; put this function in StgCmmLayout
-callPattern :: [CgRep] -> (String,Bool)
-callPattern reps 
-  | match == length reps = (chars, True)
-  | otherwise            = (chars, False)
-  where (_,match) = findMatch reps
-       chars     = map argChar reps
-
-argChar VoidArg   = 'v'
-argChar PtrArg    = 'p'
-argChar NonPtrArg = 'n'
-argChar LongArg   = 'l'
-argChar FloatArg  = 'f'
-argChar DoubleArg = 'd'
--}
+tickySlowCallPat args = ifTicky $
+  let argReps = map toArgRep args
+      (_, n_matched) = slowCallPattern argReps
+  in if n_matched > 0 && n_matched == length args
+     then bumpTickyLbl $ mkRtsSlowFastTickyCtrLabel $ concatMap (map Data.Char.toLower . argRepString) argReps
+     else bumpTickyCounter $ fsLit "VERY_SLOW_CALL_ctr"
 
--- -----------------------------------------------------------------------------
--- Ticky allocation
-
-tickyDynAlloc :: SMRep -> LambdaFormInfo -> FCode ()
--- Called when doing a dynamic heap allocation
--- LambdaFormInfo only needed to distinguish between updatable/non-updatable thunks
-tickyDynAlloc rep lf
-  = ifTicky $
-    case () of
-      _ | isConRep rep   -> tick_alloc_con
-        | isThunkRep rep -> tick_alloc_thk
-        | isFunRep   rep -> tick_alloc_fun
-        | otherwise      -> return ()
-  where
-        -- will be needed when we fill in stubs
---    _cl_size   = heapClosureSize rep
---    _slop_size = slopSize cl_info
+{-
 
-    tick_alloc_thk 
-        | lfUpdatable lf = tick_alloc_up_thk
-        | otherwise      = tick_alloc_se_thk
+Note [Ticky for slow calls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Terminology is unfortunately a bit mixed up for these calls. codeGen
+uses "slow call" to refer to unknown calls and under-saturated known
+calls.
 
-    -- krc: changed from panic to return () 
-    -- just to get something working
-    tick_alloc_con = return ()
-    tick_alloc_fun = return ()
-    tick_alloc_up_thk = return ()
-    tick_alloc_se_thk = return ()
+Nowadays, though (ie as of the eval/apply paper), the significantly
+slower calls are actually just a subset of these: the ones with no
+built-in argument pattern (cf StgCmmArgRep.slowCallPattern)
 
+So for ticky profiling, we split slow calls into
+"SLOW_CALL_fast_<pattern>_ctr" (those matching a built-in pattern) and
+VERY_SLOW_CALL_ctr (those without a built-in pattern; these are very
+bad for both space and time).
 
-tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
-tickyAllocPrim _hdr _goods _slop = ifTicky $ pprTrace "ToDo: tickyAllocPrim" empty (return ())
-
-tickyAllocThunk :: CmmExpr -> CmmExpr -> FCode ()
-tickyAllocThunk _goods _slop = ifTicky $ pprTrace "ToDo: tickyAllocThunk" empty (return ())
+-}
 
-tickyAllocPAP :: CmmExpr -> CmmExpr -> FCode ()
-tickyAllocPAP _goods _slop = ifTicky $ pprTrace "ToDo: tickyAllocPAP" empty (return ())
+-- -----------------------------------------------------------------------------
+-- Ticky allocation
 
-tickyAllocHeap :: VirtualHpOffset -> FCode ()
+tickyDynAlloc :: Maybe CLabel -> SMRep -> LambdaFormInfo -> FCode ()
+-- Called when doing a dynamic heap allocation; the LambdaFormInfo
+-- used to distinguish between closure types
+--
+-- TODO what else to count while we're here?
+tickyDynAlloc mb_ctr_lbl rep lf = ifTicky $ getDynFlags >>= \dflags ->
+  let bytes = wORD_SIZE dflags * heapClosureSize dflags rep
+
+      countGlobal tot ctr = do
+        bumpTickyCounterBy tot bytes
+        bumpTickyCounter   ctr
+      countSpecific = ifTickyAllocd $ case mb_ctr_lbl of
+        Nothing -> return ()
+        Just ctr_lbl -> do
+          registerTickyCtr ctr_lbl
+          bumpTickyAllocd ctr_lbl bytes
+
+  -- TODO are we still tracking "good stuff" (_gds) versus
+  -- administrative (_adm) versus slop (_slp)? I'm going with all _gds
+  -- for now, since I don't currently know neither if we do nor how to
+  -- distinguish. NSF Mar 2013
+
+  in case () of
+    _ | isConRep rep   ->
+          countGlobal (fsLit "ALLOC_CON_gds") (fsLit "ALLOC_CON_ctr")
+      | isThunkRep rep ->
+          ifTickyDynThunk countSpecific >>
+          if lfUpdatable lf
+          then countGlobal (fsLit "ALLOC_THK_gds") (fsLit "ALLOC_UP_THK_ctr")
+          else countGlobal (fsLit "ALLOC_THK_gds") (fsLit "ALLOC_SE_THK_ctr")
+      | isFunRep   rep ->
+          countSpecific >>
+          countGlobal (fsLit "ALLOC_FUN_gds") (fsLit "ALLOC_FUN_ctr")
+      | otherwise      -> panic "How is this heap object not a con, thunk, or fun?"
+
+
+
+tickyAllocHeap ::
+  Bool -> -- is this a genuine allocation? As opposed to
+          -- StgCmmLayout.adjustHpBackwards
+  VirtualHpOffset -> FCode ()
 -- Called when doing a heap check [TICK_ALLOC_HEAP]
 -- Must be lazy in the amount of allocation!
-tickyAllocHeap hp
+tickyAllocHeap genuine hp
   = ifTicky $
     do  { dflags <- getDynFlags
         ; ticky_ctr <- getTickyCtrLabel
-       ; emit $ catAGraphs $
-         if hp == 0 then []    -- Inside the emitMiddle to avoid control
-         else [                -- dependency on the argument
-               -- Bump the allcoation count in the StgEntCounter
-           addToMem (rEP_StgEntCounter_allocs dflags)
-                       (CmmLit (cmmLabelOffB ticky_ctr 
-                               (oFFSET_StgEntCounter_allocs dflags))) hp,
-               -- Bump ALLOC_HEAP_ctr
-           addToMemLbl (cLong dflags) (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_ctr")) 1,
-               -- Bump ALLOC_HEAP_tot
-           addToMemLbl (cLong dflags) (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_tot")) hp] }
+        ; emit $ catAGraphs $
+            -- only test hp from within the emit so that the monadic
+            -- computation itself is not strict in hp (cf knot in
+            -- StgCmmMonad.getHeapUsage)
+          if hp == 0 then []
+          else let !bytes = wORD_SIZE dflags * hp in [
+            -- Bump the allocation total in the closure's StgEntCounter
+            addToMem (rEP_StgEntCounter_allocs dflags)
+                     (CmmLit (cmmLabelOffB ticky_ctr (oFFSET_StgEntCounter_allocs dflags)))
+                     bytes,
+            -- Bump the global allocation total ALLOC_HEAP_tot
+            addToMemLbl (cLong dflags)
+                        (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_tot"))
+                        bytes,
+            -- Bump the global allocation counter ALLOC_HEAP_ctr
+            if not genuine then mkNop
+            else addToMemLbl (cLong dflags)
+                             (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_ctr"))
+                             1
+            ]}
+
+
+--------------------------------------------------------------------------------
+-- these three are only called from CmmParse.y (ie ultimately from the RTS)
+
+-- the units are bytes
+
+tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
+tickyAllocPrim _hdr _goods _slop = ifTicky $ do
+  bumpTickyCounter    (fsLit "ALLOC_PRIM_ctr")
+  bumpTickyCounterByE (fsLit "ALLOC_PRIM_adm") _hdr
+  bumpTickyCounterByE (fsLit "ALLOC_PRIM_gds") _goods
+  bumpTickyCounterByE (fsLit "ALLOC_PRIM_slp") _slop
+
+tickyAllocThunk :: CmmExpr -> CmmExpr -> FCode ()
+tickyAllocThunk _goods _slop = ifTicky $ do
+    -- TODO is it ever called with a Single-Entry thunk?
+  bumpTickyCounter    (fsLit "ALLOC_UP_THK_ctr")
+  bumpTickyCounterByE (fsLit "ALLOC_THK_gds") _goods
+  bumpTickyCounterByE (fsLit "ALLOC_THK_slp") _slop
+
+tickyAllocPAP :: CmmExpr -> CmmExpr -> FCode ()
+tickyAllocPAP _goods _slop = ifTicky $ do
+  bumpTickyCounter    (fsLit "ALLOC_PAP_ctr")
+  bumpTickyCounterByE (fsLit "ALLOC_PAP_gds") _goods
+  bumpTickyCounterByE (fsLit "ALLOC_PAP_slp") _slop
 
 -- -----------------------------------------------------------------------------
 -- Ticky utils
 
 ifTicky :: FCode () -> FCode ()
-ifTicky code = do dflags <- getDynFlags
-                  if gopt Opt_Ticky dflags then code
-                                           else return ()
+ifTicky code =
+  getDynFlags >>= \dflags -> when (gopt Opt_Ticky dflags) code
+
+tickyAllocdIsOn :: FCode Bool
+tickyAllocdIsOn = gopt Opt_Ticky_Allocd `fmap` getDynFlags
+
+tickyLNEIsOn :: FCode Bool
+tickyLNEIsOn = gopt Opt_Ticky_LNE `fmap` getDynFlags
+
+tickyDynThunkIsOn :: FCode Bool
+tickyDynThunkIsOn = gopt Opt_Ticky_Dyn_Thunk `fmap` getDynFlags
+
+ifTickyAllocd :: FCode () -> FCode ()
+ifTickyAllocd code = tickyAllocdIsOn >>= \b -> when b code
+
+ifTickyLNE :: FCode () -> FCode ()
+ifTickyLNE code = tickyLNEIsOn >>= \b -> when b code
+
+ifTickyDynThunk :: FCode () -> FCode ()
+ifTickyDynThunk code = tickyDynThunkIsOn >>= \b -> when b code
 
--- All the ticky-ticky counters are declared "unsigned long" in C
 bumpTickyCounter :: FastString -> FCode ()
-bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkCmmDataLabel rtsPackageId lbl) 0)
+bumpTickyCounter lbl = bumpTickyLbl (mkCmmDataLabel rtsPackageId lbl)
+
+bumpTickyCounterBy :: FastString -> Int -> FCode ()
+bumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsPackageId lbl)
 
-bumpTickyCounter' :: CmmLit -> FCode ()
--- krc: note that we're incrementing the _entry_count_ field of the ticky counter
-bumpTickyCounter' lhs = do dflags <- getDynFlags
-                           emit (addToMem (cLong dflags) (CmmLit lhs) 1)
+bumpTickyCounterByE :: FastString -> CmmExpr -> FCode ()
+bumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsPackageId lbl)
+
+bumpTickyEntryCount :: CLabel -> FCode ()
+bumpTickyEntryCount lbl = do
+  dflags <- getDynFlags
+  bumpTickyLit (cmmLabelOffB lbl (oFFSET_StgEntCounter_entry_count dflags))
+
+bumpTickyAllocd :: CLabel -> Int -> FCode ()
+bumpTickyAllocd lbl bytes = do
+  dflags <- getDynFlags
+  bumpTickyLitBy (cmmLabelOffB lbl (oFFSET_StgEntCounter_allocd dflags)) bytes
+
+bumpTickyLbl :: CLabel -> FCode ()
+bumpTickyLbl lhs = bumpTickyLitBy (cmmLabelOffB lhs 0) 1
+
+bumpTickyLblBy :: CLabel -> Int -> FCode ()
+bumpTickyLblBy lhs = bumpTickyLitBy (cmmLabelOffB lhs 0)
+
+bumpTickyLblByE :: CLabel -> CmmExpr -> FCode ()
+bumpTickyLblByE lhs = bumpTickyLitByE (cmmLabelOffB lhs 0)
+
+bumpTickyLit :: CmmLit -> FCode ()
+bumpTickyLit lhs = bumpTickyLitBy lhs 1
+
+bumpTickyLitBy :: CmmLit -> Int -> FCode ()
+bumpTickyLitBy lhs n = do
+  dflags <- getDynFlags
+  -- All the ticky-ticky counters are declared "unsigned long" in C
+  emit (addToMem (cLong dflags) (CmmLit lhs) n)
+
+bumpTickyLitByE :: CmmLit -> CmmExpr -> FCode ()
+bumpTickyLitByE lhs e = do
+  dflags <- getDynFlags
+  -- All the ticky-ticky counters are declared "unsigned long" in C
+  emit (addToMemE (cLong dflags) (CmmLit lhs) e)
 
 bumpHistogram :: FastString -> Int -> FCode ()
 bumpHistogram _lbl _n
 --  = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLongWidth))
-    = return ()           -- TEMP SPJ Apr 07
+    = return ()    -- TEMP SPJ Apr 07
 
 {-
 bumpHistogramE :: LitString -> CmmExpr -> FCode ()
-bumpHistogramE lbl n 
+bumpHistogramE lbl n
   = do  t <- newTemp cLong
         emitAssign (CmmLocal t) n
-       emit (mkCmmIfThen (CmmMachOp (MO_U_Le cLongWidth) [CmmReg (CmmLocal t), eight])
-                         (mkAssign (CmmLocal t) eight))
-       emit (addToMem cLong
-                      (cmmIndexExpr cLongWidth
-                               (CmmLit (CmmLabel (mkRtsDataLabel lbl)))
-                               (CmmReg (CmmLocal t)))
-                      1)
-  where 
+        emit (mkCmmIfThen (CmmMachOp (MO_U_Le cLongWidth) [CmmReg (CmmLocal t), eight])
+                          (mkAssign (CmmLocal t) eight))
+        emit (addToMem cLong
+                       (cmmIndexExpr cLongWidth
+                                (CmmLit (CmmLabel (mkRtsDataLabel lbl)))
+                                (CmmReg (CmmLocal t)))
+                       1)
+  where
    eight = CmmLit (CmmInt 8 cLongWidth)
 -}
 
@@ -369,47 +574,53 @@ bumpHistogramE lbl n
 -- Showing the "type category" for ticky-ticky profiling
 
 showTypeCategory :: Type -> Char
-  {-   {C,I,F,D}   char, int, float, double
-       T           tuple
-       S           other single-constructor type
-       {c,i,f,d}   unboxed ditto
-       t           *unpacked* tuple
-       s           *unpacked" single-cons...
-
-       v           void#
-       a           primitive array
-
-       E           enumeration type
-       +           dictionary, unless it's a ...
-       L           List
-       >           function
-       M           other (multi-constructor) data-con type
-       .           other type
-       -           reserved for others to mark as "uninteresting"
+  {-
+        +           dictionary
+
+        >           function
+
+        {C,I,F,D,W} char, int, float, double, word
+        {c,i,f,d,w} unboxed ditto
+
+        T           tuple
+
+        P           other primitive type
+        p           unboxed ditto
+
+        L           list
+        E           enumeration type
+        S           other single-constructor type
+        M           other multi-constructor data-con type
+
+        .           other type
+
+        -           reserved for others to mark as "uninteresting"
+
+  Accurate as of Mar 2013, but I eliminated the Array category instead
+  of updating it, for simplicity. It's in P/p, I think --NSF
+
     -}
 showTypeCategory ty
-  = if isDictTy ty
-    then '+'
-    else
-      case tcSplitTyConApp_maybe ty of
-       Nothing -> if isJust (tcSplitFunTy_maybe ty)
-                  then '>'
-                  else '.'
-
-       Just (tycon, _) ->
-          let utc = getUnique tycon in
-         if      utc == charDataConKey    then 'C'
-         else if utc == intDataConKey     then 'I'
-         else if utc == floatDataConKey   then 'F'
-         else if utc == doubleDataConKey  then 'D'
-         else if utc == charPrimTyConKey  then 'c'
-         else if (utc == intPrimTyConKey || utc == wordPrimTyConKey
-               || utc == addrPrimTyConKey)                then 'i'
-         else if utc  == floatPrimTyConKey                then 'f'
-         else if utc  == doublePrimTyConKey               then 'd'
-         else if isPrimTyCon tycon {- array, we hope -}   then 'A'     -- Bogus
-         else if isEnumerationTyCon tycon                 then 'E'
-         else if isTupleTyCon tycon                       then 'T'
-         else if isJust (tyConSingleDataCon_maybe tycon)  then 'S'
-         else if utc == listTyConKey                      then 'L'
-         else 'M' -- oh, well...
+  | isDictTy ty = '+'
+  | otherwise = case tcSplitTyConApp_maybe ty of
+  Nothing -> '.'
+  Just (tycon, _) ->
+    (if isUnLiftedTyCon tycon then Data.Char.toLower else \x -> x) $
+    let anyOf us = getUnique tycon `elem` us in
+    case () of
+      _ | anyOf [funTyConKey] -> '>'
+        | anyOf [charPrimTyConKey, charTyConKey] -> 'C'
+        | anyOf [doublePrimTyConKey, doubleTyConKey] -> 'D'
+        | anyOf [floatPrimTyConKey, floatTyConKey] -> 'F'
+        | anyOf [intPrimTyConKey, int32PrimTyConKey, int64PrimTyConKey,
+                 intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey
+                ] -> 'I'
+        | anyOf [wordPrimTyConKey, word32PrimTyConKey, word64PrimTyConKey, wordTyConKey,
+                 word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey
+                ] -> 'W'
+        | anyOf [listTyConKey] -> 'L'
+        | isTupleTyCon tycon       -> 'T'
+        | isPrimTyCon tycon        -> 'P'
+        | isEnumerationTyCon tycon -> 'E'
+        | isJust (tyConSingleDataCon_maybe tycon) -> 'S'
+        | otherwise -> 'M' -- oh, well...
index af5e957..3df75ce 100644 (file)
@@ -33,7 +33,7 @@ module StgCmmUtils (
 
         cmmUntag, cmmIsTagged,
 
-        addToMem, addToMemE, addToMemLbl,
+        addToMem, addToMemE, addToMemLblE, addToMemLbl,
         mkWordCLit,
         newStringCLit, newByteStringCLit,
         blankWord
@@ -118,6 +118,9 @@ mkSimpleLit _ other             = pprPanic "mkSimpleLit" (ppr other)
 addToMemLbl :: CmmType -> CLabel -> Int -> CmmAGraph
 addToMemLbl rep lbl n = addToMem rep (CmmLit (CmmLabel lbl)) n
 
+addToMemLblE :: CmmType -> CLabel -> CmmExpr -> CmmAGraph
+addToMemLblE rep lbl = addToMemE rep (CmmLit (CmmLabel lbl))
+
 addToMem :: CmmType     -- rep of the counter
          -> CmmExpr     -- Address
          -> Int         -- What to add (a word)
index a69e25e..cf105a0 100644 (file)
@@ -209,6 +209,7 @@ Library
         StgCmmGran
         StgCmmHeap
         StgCmmHpc
+        StgCmmArgRep
         StgCmmLayout
         StgCmmMonad
         StgCmmPrim
index 2f76c35..ba86062 100644 (file)
@@ -341,6 +341,9 @@ data GeneralFlag
    | Opt_PIC
    | Opt_SccProfilingOn
    | Opt_Ticky
+   | Opt_Ticky_Allocd
+   | Opt_Ticky_LNE
+   | Opt_Ticky_Dyn_Thunk
    | Opt_Static
    | Opt_RPath
    | Opt_RelativeDynlibPaths
@@ -2086,6 +2089,9 @@ dynamic_flags = [
   , Flag "hpcdir"         (SepArg setOptHpcDir)
   , Flag "ghci-script"    (hasArg addGhciScript)
   , Flag "interactive-print" (hasArg setInteractivePrint)
+  , Flag "ticky-allocd"      (NoArg (setGeneralFlag Opt_Ticky_Allocd))
+  , Flag "ticky-LNE"         (NoArg (setGeneralFlag Opt_Ticky_LNE))
+  , Flag "ticky-dyn-thunk"   (NoArg (setGeneralFlag Opt_Ticky_Dyn_Thunk))
         ------- recompilation checker --------------------------------------
   , Flag "recomp"         (NoArg (do unSetGeneralFlag Opt_ForceRecomp
                                      deprecate "Use -fno-force-recomp instead"))
index 3937642..a776382 100644 (file)
@@ -1769,164 +1769,12 @@ Options:
     <title>Using &ldquo;ticky-ticky&rdquo; profiling (for implementors)</title>
     <indexterm><primary>ticky-ticky profiling</primary></indexterm>
 
-    <para>(ToDo: document properly.)</para>
-
-    <para>It is possible to compile Haskell programs so that
-    they will count lots and lots of interesting things, e.g., number
-    of updates, number of data constructors entered, etc., etc.  We
-    call this &ldquo;ticky-ticky&rdquo;
-    profiling,<indexterm><primary>ticky-ticky
-    profiling</primary></indexterm> <indexterm><primary>profiling,
-    ticky-ticky</primary></indexterm> because that's the sound a CPU
-    makes when it is running up all those counters
-    (<emphasis>slowly</emphasis>).</para>
-
-    <para>Ticky-ticky profiling is mainly intended for implementors;
-    it is quite separate from the main &ldquo;cost-centre&rdquo;
-    profiling system, intended for all users everywhere.</para>
-
-    <para>
-      You don't need to build GHC, the libraries, or the RTS a special
-      way in order to use ticky-ticky profiling.  You can decide on a
-      module-by-module basis which parts of a program have the
-      counters compiled in, using the
-      compile-time <option>-ticky</option> option.  Those modules that
-      were not compiled with <option>-ticky</option> won't contribute
-      to the ticky-ticky profiling results, and that will normally
-      include all the pre-compiled packages that your program links
-      with.
-    </para>
-
-    <para>
-      To get your compiled program to spit out the ticky-ticky
-      numbers:
-
-      <itemizedlist>
-        <listitem>
-          <para>
-            Link the program with <option>-debug</option>
-            (<option>-ticky</option> is a synonym
-            for <option>-debug</option> at link-time).  This links in
-            the debug version of the RTS, which includes the code for
-            aggregating and reporting the results of ticky-ticky
-            profiling.
-          </para>
-        </listitem>
-        <listitem>
-          <para>
-            Run the program with the <option>-r</option> RTS
-            option<indexterm><primary>-r RTS option</primary></indexterm>.
-            See <xref linkend="runtime-control"/>.
-          </para>
-        </listitem>
-      </itemizedlist>
-    </para>
-
-    <para>
-      Here is a sample ticky-ticky statistics file, generated by
-      the invocation
-      <command>foo +RTS -rfoo.ticky</command>.
-      </para>
-
-<screen>
- foo +RTS -rfoo.ticky
-
-ALLOCATIONS: 3964631 (11330900 words total: 3999476 admin, 6098829 goods, 1232595 slop)
-                                total words:        2     3     4     5    6+
-  69647 (  1.8%) function values                 50.0  50.0   0.0   0.0   0.0
-2382937 ( 60.1%) thunks                           0.0  83.9  16.1   0.0   0.0
-1477218 ( 37.3%) data values                     66.8  33.2   0.0   0.0   0.0
-      0 (  0.0%) big tuples
-      2 (  0.0%) black holes                      0.0 100.0   0.0   0.0   0.0
-      0 (  0.0%) prim things
-  34825 (  0.9%) partial applications             0.0   0.0   0.0 100.0   0.0
-      2 (  0.0%) thread state objects             0.0   0.0   0.0   0.0 100.0
-
-Total storage-manager allocations: 3647137 (11882004 words)
-        [551104 words lost to speculative heap-checks]
-
-STACK USAGE:
-
-ENTERS: 9400092  of which 2005772 (21.3%) direct to the entry code
-                  [the rest indirected via Node's info ptr]
-1860318 ( 19.8%) thunks
-3733184 ( 39.7%) data values
-3149544 ( 33.5%) function values
-                  [of which 1999880 (63.5%) bypassed arg-satisfaction chk]
- 348140 (  3.7%) partial applications
- 308906 (  3.3%) normal indirections
-      0 (  0.0%) permanent indirections
-
-RETURNS: 5870443
-2137257 ( 36.4%) from entering a new constructor
-                  [the rest from entering an existing constructor]
-2349219 ( 40.0%) vectored [the rest unvectored]
-
-RET_NEW:         2137257:  32.5% 46.2% 21.3%  0.0%  0.0%  0.0%  0.0%  0.0%  0.0%
-RET_OLD:         3733184:   2.8% 67.9% 29.3%  0.0%  0.0%  0.0%  0.0%  0.0%  0.0%
-RET_UNBOXED_TUP:       2:   0.0%  0.0%100.0%  0.0%  0.0%  0.0%  0.0%  0.0%  0.0%
-
-RET_VEC_RETURN : 2349219:   0.0%  0.0%100.0%  0.0%  0.0%  0.0%  0.0%  0.0%  0.0%
-
-UPDATE FRAMES: 2241725 (0 omitted from thunks)
-SEQ FRAMES:    1
-CATCH FRAMES:  1
-UPDATES: 2241725
-      0 (  0.0%) data values
-  34827 (  1.6%) partial applications
-                  [2 in place, 34825 allocated new space]
-2206898 ( 98.4%) updates to existing heap objects (46 by squeezing)
-UPD_CON_IN_NEW:         0:       0      0      0      0      0      0      0      0      0
-UPD_PAP_IN_NEW:     34825:       0      0      0  34825      0      0      0      0      0
-
-NEW GEN UPDATES: 2274700 ( 99.9%)
-
-OLD GEN UPDATES: 1852 (  0.1%)
-
-Total bytes copied during GC: 190096
-
-**************************************************
-3647137 ALLOC_HEAP_ctr
-11882004 ALLOC_HEAP_tot
-  69647 ALLOC_FUN_ctr
-  69647 ALLOC_FUN_adm
-  69644 ALLOC_FUN_gds
-  34819 ALLOC_FUN_slp
-  34831 ALLOC_FUN_hst_0
-  34816 ALLOC_FUN_hst_1
-      0 ALLOC_FUN_hst_2
-      0 ALLOC_FUN_hst_3
-      0 ALLOC_FUN_hst_4
-2382937 ALLOC_UP_THK_ctr
-      0 ALLOC_SE_THK_ctr
- 308906 ENT_IND_ctr
-      0 E!NT_PERM_IND_ctr requires +RTS -Z
-[... lots more info omitted ...]
-      0 GC_SEL_ABANDONED_ctr
-      0 GC_SEL_MINOR_ctr
-      0 GC_SEL_MAJOR_ctr
-      0 GC_FAILED_PROMOTION_ctr
-  47524 GC_WORDS_COPIED_ctr
-</screen>
-
-    <para>The formatting of the information above the row of asterisks
-    is subject to change, but hopefully provides a useful
-    human-readable summary.  Below the asterisks <emphasis>all
-    counters</emphasis> maintained by the ticky-ticky system are
-    dumped, in a format intended to be machine-readable: zero or more
-    spaces, an integer, a space, the counter name, and a newline.</para>
-
-    <para>In fact, not <emphasis>all</emphasis> counters are
-    necessarily dumped; compile- or run-time flags can render certain
-    counters invalid.  In this case, either the counter will simply
-    not appear, or it will appear with a modified counter name,
-    possibly along with an explanation for the omission (notice
-    <literal>ENT&lowbar;PERM&lowbar;IND&lowbar;ctr</literal> appears
-    with an inserted <literal>!</literal> above).  Software analysing
-    this output should always check that it has the counters it
-    expects.  Also, beware: some of the counters can have
-    <emphasis>large</emphasis> values!</para>
-
+    <para>Because ticky-ticky profiling requires a certain familiarity
+    with GHC internals, we have moved the documentation to the
+    wiki. Take a look at its <ulink
+    url="http://hackage.haskell.org/trac/ghc/wiki/Commentary/Profiling">overview
+    of the profiling options</ulink>, which includeds a link to the
+    ticky-ticky profiling page.</para>
   </sect1>
 
 </chapter>
index ca8e51a..7e051c1 100644 (file)
 /* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
 #define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), CCCS)
 
-#define HP_CHK_GEN_TICKY(alloc)                 \
-   HP_CHK_GEN(alloc);                           \
-   TICK_ALLOC_HEAP_NOCTR(alloc);
+#define HP_CHK_GEN_TICKY(bytes)                 \
+   HP_CHK_GEN(bytes);                           \
+   TICK_ALLOC_HEAP_NOCTR(bytes);
 
 #define HP_CHK_P(bytes, fun, arg)               \
    HEAP_CHECK(bytes, GC_PRIM_P(fun,arg))
 
-#define ALLOC_P_TICKY(alloc, fun, arg)          \
-   HP_CHK_P(alloc);                             \
-   TICK_ALLOC_HEAP_NOCTR(alloc);
+// TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed?
+//         -NSF March 2013
+#define ALLOC_P_TICKY(bytes, fun, arg)         \
+   HP_CHK_P(bytes);                            \
+   TICK_ALLOC_HEAP_NOCTR(bytes);
 
 #define CHECK_GC()                                                      \
   (bdescr_link(CurrentNursery) == NULL ||                               \
 #define TICK_ENT_AP()                          TICK_BUMP(ENT_AP_ctr)
 #define TICK_ENT_AP_STACK()            TICK_BUMP(ENT_AP_STACK_ctr)
 #define TICK_ENT_BH()                          TICK_BUMP(ENT_BH_ctr)
+#define TICK_ENT_LNE()                         TICK_BUMP(ENT_LNE_ctr)
 #define TICK_UNKNOWN_CALL()            TICK_BUMP(UNKNOWN_CALL_ctr)
 #define TICK_UPDF_PUSHED()             TICK_BUMP(UPDF_PUSHED_ctr)
 #define TICK_CATCHF_PUSHED()           TICK_BUMP(CATCHF_PUSHED_ctr)
 #define TICK_SLOW_CALL_PAP_CORRECT()   TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)
 #define TICK_SLOW_CALL_PAP_TOO_MANY()  TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)
 
-#define TICK_SLOW_CALL_v()             TICK_BUMP(SLOW_CALL_v_ctr)
-#define TICK_SLOW_CALL_p()             TICK_BUMP(SLOW_CALL_p_ctr)
-#define TICK_SLOW_CALL_pv()            TICK_BUMP(SLOW_CALL_pv_ctr)
-#define TICK_SLOW_CALL_pp()            TICK_BUMP(SLOW_CALL_pp_ctr)
-#define TICK_SLOW_CALL_ppp()           TICK_BUMP(SLOW_CALL_ppp_ctr)
-#define TICK_SLOW_CALL_pppp()                  TICK_BUMP(SLOW_CALL_pppp_ctr)
-#define TICK_SLOW_CALL_ppppp()         TICK_BUMP(SLOW_CALL_ppppp_ctr)
-#define TICK_SLOW_CALL_pppppp()        TICK_BUMP(SLOW_CALL_pppppp_ctr)
+#define TICK_SLOW_CALL_fast_v16()      TICK_BUMP(SLOW_CALL_fast_v16_ctr)
+#define TICK_SLOW_CALL_fast_v()        TICK_BUMP(SLOW_CALL_fast_v_ctr)
+#define TICK_SLOW_CALL_fast_p()        TICK_BUMP(SLOW_CALL_fast_p_ctr)
+#define TICK_SLOW_CALL_fast_pv()       TICK_BUMP(SLOW_CALL_fast_pv_ctr)
+#define TICK_SLOW_CALL_fast_pp()       TICK_BUMP(SLOW_CALL_fast_pp_ctr)
+#define TICK_SLOW_CALL_fast_ppv()      TICK_BUMP(SLOW_CALL_fast_ppv_ctr)
+#define TICK_SLOW_CALL_fast_ppp()      TICK_BUMP(SLOW_CALL_fast_ppp_ctr)
+#define TICK_SLOW_CALL_fast_pppv()     TICK_BUMP(SLOW_CALL_fast_pppv_ctr)
+#define TICK_SLOW_CALL_fast_pppp()     TICK_BUMP(SLOW_CALL_fast_pppp_ctr)
+#define TICK_SLOW_CALL_fast_ppppp()    TICK_BUMP(SLOW_CALL_fast_ppppp_ctr)
+#define TICK_SLOW_CALL_fast_pppppp()   TICK_BUMP(SLOW_CALL_fast_pppppp_ctr)
+#define TICK_VERY_SLOW_CALL()                  TICK_BUMP(VERY_SLOW_CALL_ctr)
 
 /* NOTE: TICK_HISTO_BY and TICK_HISTO 
    currently have no effect.
   TICK_BUMP(UPD_CON_IN_NEW_ctr);               \
   TICK_HISTO(UPD_CON_IN_NEW,n)
 
-#define TICK_ALLOC_HEAP_NOCTR(n)               \
-    TICK_BUMP(ALLOC_HEAP_ctr);                 \
-    TICK_BUMP_BY(ALLOC_HEAP_tot,n)
+#define TICK_ALLOC_HEAP_NOCTR(bytes)           \
+    TICK_BUMP(ALLOC_RTS_ctr);                  \
+    TICK_BUMP_BY(ALLOC_RTS_tot,bytes)
 
 /* -----------------------------------------------------------------------------
    Saving and restoring STG registers
index 7045854..304baf7 100644 (file)
@@ -23,7 +23,7 @@ typedef struct _StgEntCounter {
      generators make trouble if you try to pack things tighter */
     StgWord    registeredp;    /* 0 == no, 1 == yes */
     StgInt     arity;          /* arity (static info) */
-    StgInt     stk_args;       /* # of args off stack */
+    StgInt     allocd;         /* # allocation of this closure */
                                /* (rest of args are in registers) */
     char       *str;           /* name of the thing */
     char       *arg_kinds;     /* info about the args types */
index a811aec..32a7f20 100644 (file)
@@ -59,24 +59,26 @@ EXTERN StgInt ENT_PAP_ctr INIT(0);
 EXTERN StgInt ENT_AP_ctr INIT(0);
 EXTERN StgInt ENT_AP_STACK_ctr INIT(0);
 EXTERN StgInt ENT_BH_ctr INIT(0);
+EXTERN StgInt ENT_LNE_ctr INIT(0);
 
 EXTERN StgInt UNKNOWN_CALL_ctr INIT(0);
 
-EXTERN StgInt SLOW_CALL_v_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_f_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_d_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_l_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_n_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_p_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_pv_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_pp_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_ppv_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_ppp_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_pppv_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_pppp_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_ppppp_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_pppppp_ctr INIT(0);
-EXTERN StgInt SLOW_CALL_OTHER_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_v16_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_v_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_f_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_d_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_l_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_n_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_p_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_pv_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_pp_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_ppv_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_ppp_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_pppv_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_pppp_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_ppppp_ctr INIT(0);
+EXTERN StgInt SLOW_CALL_fast_pppppp_ctr INIT(0);
+EXTERN StgInt VERY_SLOW_CALL_ctr INIT(0);
 
 EXTERN StgInt ticky_slow_call_unevald;
 EXTERN StgInt SLOW_CALL_ctr INIT(0);
@@ -107,12 +109,15 @@ EXTERN StgInt UPD_PAP_IN_NEW_ctr INIT(0);
 EXTERN StgInt UPD_PAP_IN_PLACE_ctr INIT(0);
 
 EXTERN StgInt ALLOC_HEAP_ctr INIT(0);
-EXTERN StgInt ALLOC_HEAP_tot;
+EXTERN StgInt ALLOC_HEAP_tot INIT(0);
+
+EXTERN StgInt ALLOC_RTS_ctr INIT(0);
+EXTERN StgInt ALLOC_RTS_tot INIT(0);
 
 EXTERN StgInt ALLOC_FUN_ctr INIT(0);
-EXTERN StgInt ALLOC_FUN_adm;
-EXTERN StgInt ALLOC_FUN_gds;
-EXTERN StgInt ALLOC_FUN_slp;
+EXTERN StgInt ALLOC_FUN_adm INIT(0);
+EXTERN StgInt ALLOC_FUN_gds INIT(0);
+EXTERN StgInt ALLOC_FUN_slp INIT(0);
 
 EXTERN StgInt UPD_NEW_IND_ctr INIT(0);
 EXTERN StgInt UPD_NEW_PERM_IND_ctr INIT(0);
@@ -184,11 +189,14 @@ EXTERN StgInt RET_SEMI_loads_avoided INIT(0);
    TICKY_TICKY is defined or not. */
   
 #ifndef CMINUSMINUS
+#define TICK_BUMP_BY(ctr,n) ctr = (StgInt) ctr + n
+#define TICK_BUMP(ctr)      TICK_BUMP_BY(ctr,1)
+
 #define TICK_ALLOC_PRIM(x,y,z)
 #define TICK_UPD_OLD_IND()
 #define TICK_UPD_NEW_IND()
 #define TICK_UPD_SQUEEZED()
-#define TICK_ALLOC_HEAP_NOCTR(x)
+#define TICK_ALLOC_HEAP_NOCTR(bytes)
 #define TICK_GC_FAILED_PROMOTION()
 #define TICK_ALLOC_TSO()
 #define TICK_ALLOC_STACK(g)
index 5608dbd..cbe035b 100644 (file)
@@ -70,7 +70,7 @@ WAY_thr_l_HC_OPTS= -static -optc-DTHREADED_RTS -eventlog
 
 # Way 'debug':
 WAY_debug_NAME=debug
-WAY_debug_HC_OPTS= -static -optc-DDEBUG
+WAY_debug_HC_OPTS= -static -optc-DDEBUG -ticky -DTICKY_TICKY
 
 # Way 'debug_p':
 WAY_debug_p_NAME=debug profiled
@@ -104,7 +104,7 @@ WAY_thr_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DTHREADED_RTS -optc-DDEBUG
 
 # Way 'debug_dyn':
 WAY_debug_dyn_NAME=debug_dyn
-WAY_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DDEBUG
+WAY_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DDEBUG -ticky -DTICKY_TICKY
 
 # Way 'l_dyn':
 WAY_l_dyn_NAME=event logging dynamic
index c5dbbcd..c48bdf4 100644 (file)
@@ -19,8 +19,7 @@
     W_ i;                                              \
     size = SIZEOF_StgPAP + WDS(n);                     \
     HP_CHK_NP_ASSIGN_SP0(size,f);                      \
-    TICK_ALLOC_HEAP_NOCTR(BYTES_TO_WDS(size));         \
-    TICK_ALLOC_PAP(n+1 /* +1 for the FUN */, 0);       \
+    TICK_ALLOC_PAP(size, 0);                           \
     pap = Hp + WDS(1) - size;                          \
     SET_HDR(pap, stg_PAP_info, CCCS);                   \
     StgPAP_arity(pap) = HALF_W_(arity - m);            \
@@ -49,8 +48,7 @@
      pap = R1;                                                 \
      size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(pap))) + WDS(n);   \
      HP_CHK_NP_ASSIGN_SP0(size,f);                             \
-     TICK_ALLOC_HEAP_NOCTR(BYTES_TO_WDS(size));                        \
-     TICK_ALLOC_PAP(n+1 /* +1 for the FUN */, 0);              \
+     TICK_ALLOC_PAP(size, 0);                                  \
      new_pap = Hp + WDS(1) - size;                             \
      SET_HDR(new_pap, stg_PAP_info, CCCS);                      \
      StgPAP_arity(new_pap) = HALF_W_(arity - m);               \
index 5b656fa..25da0d6 100644 (file)
@@ -150,7 +150,7 @@ stg_maskAsyncExceptionszh /* explicit stack */
         TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX | TSO_INTERRUPTIBLE);
 
     TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_v();
+    TICK_SLOW_CALL_fast_v();
     jump stg_ap_v_fast [R1];
 }
 
@@ -178,7 +178,7 @@ stg_maskUninterruptiblezh /* explicit stack */
         (TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX) & ~TSO_INTERRUPTIBLE);
 
     TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_v();
+    TICK_SLOW_CALL_fast_v();
     jump stg_ap_v_fast [R1];
 }
 
@@ -253,7 +253,7 @@ stg_unmaskAsyncExceptionszh /* explicit stack */
 
     }
     TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_v();
+    TICK_SLOW_CALL_fast_v();
     R1 = io;
     jump stg_ap_v_fast [R1];
 }
@@ -394,7 +394,7 @@ stg_catchzh ( P_ io,      /* :: IO a */
 
     /* Apply R1 to the realworld token */
     TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_v();
+    TICK_SLOW_CALL_fast_v();
 
     jump stg_ap_v_fast
         (CATCH_FRAME_FIELDS(,,stg_catch_frame_info, CCCS, 0,
@@ -612,7 +612,7 @@ retry_pop_stack:
     R1 = handler;
     Sp_adj(-1);
     TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_pv();
+    TICK_SLOW_CALL_fast_pv();
     jump RET_LBL(stg_ap_pv) [R1];
 }
 
index db27c3f..3f66313 100644 (file)
@@ -914,22 +914,24 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(ENT_AP_ctr)                         \
       SymI_HasProto(ENT_AP_STACK_ctr)                   \
       SymI_HasProto(ENT_BH_ctr)                         \
+      SymI_HasProto(ENT_LNE_ctr)                        \
       SymI_HasProto(UNKNOWN_CALL_ctr)                   \
-      SymI_HasProto(SLOW_CALL_v_ctr)                    \
-      SymI_HasProto(SLOW_CALL_f_ctr)                    \
-      SymI_HasProto(SLOW_CALL_d_ctr)                    \
-      SymI_HasProto(SLOW_CALL_l_ctr)                    \
-      SymI_HasProto(SLOW_CALL_n_ctr)                    \
-      SymI_HasProto(SLOW_CALL_p_ctr)                    \
-      SymI_HasProto(SLOW_CALL_pv_ctr)                   \
-      SymI_HasProto(SLOW_CALL_pp_ctr)                   \
-      SymI_HasProto(SLOW_CALL_ppv_ctr)                  \
-      SymI_HasProto(SLOW_CALL_ppp_ctr)                  \
-      SymI_HasProto(SLOW_CALL_pppv_ctr)                 \
-      SymI_HasProto(SLOW_CALL_pppp_ctr)                 \
-      SymI_HasProto(SLOW_CALL_ppppp_ctr)                \
-      SymI_HasProto(SLOW_CALL_pppppp_ctr)               \
-      SymI_HasProto(SLOW_CALL_OTHER_ctr)                \
+      SymI_HasProto(SLOW_CALL_fast_v16_ctr)                  \
+      SymI_HasProto(SLOW_CALL_fast_v_ctr)                    \
+      SymI_HasProto(SLOW_CALL_fast_f_ctr)                    \
+      SymI_HasProto(SLOW_CALL_fast_d_ctr)                    \
+      SymI_HasProto(SLOW_CALL_fast_l_ctr)                    \
+      SymI_HasProto(SLOW_CALL_fast_n_ctr)                    \
+      SymI_HasProto(SLOW_CALL_fast_p_ctr)                    \
+      SymI_HasProto(SLOW_CALL_fast_pv_ctr)                   \
+      SymI_HasProto(SLOW_CALL_fast_pp_ctr)                   \
+      SymI_HasProto(SLOW_CALL_fast_ppv_ctr)                  \
+      SymI_HasProto(SLOW_CALL_fast_ppp_ctr)                  \
+      SymI_HasProto(SLOW_CALL_fast_pppv_ctr)                 \
+      SymI_HasProto(SLOW_CALL_fast_pppp_ctr)                 \
+      SymI_HasProto(SLOW_CALL_fast_ppppp_ctr)                \
+      SymI_HasProto(SLOW_CALL_fast_pppppp_ctr)               \
+      SymI_HasProto(VERY_SLOW_CALL_ctr)                \
       SymI_HasProto(ticky_slow_call_unevald)            \
       SymI_HasProto(SLOW_CALL_ctr)                      \
       SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr)          \
@@ -956,6 +958,8 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(UPD_PAP_IN_PLACE_ctr)               \
       SymI_HasProto(ALLOC_HEAP_ctr)                     \
       SymI_HasProto(ALLOC_HEAP_tot)                     \
+      SymI_HasProto(ALLOC_RTS_ctr)                      \
+      SymI_HasProto(ALLOC_RTS_tot)                      \
       SymI_HasProto(ALLOC_FUN_ctr)                      \
       SymI_HasProto(ALLOC_FUN_adm)                      \
       SymI_HasProto(ALLOC_FUN_gds)                      \
index f5669cb..11f518a 100644 (file)
@@ -829,7 +829,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            
            SET_HDR(ap,&stg_AP_STACK_info,
                    ((StgClosure *)frame)->header.prof.ccs /* ToDo */); 
-           TICK_ALLOC_UP_THK(words+1,0);
+           TICK_ALLOC_UP_THK(WDS(words+1),0);
            
            //IF_DEBUG(scheduler,
            //       debugBelch("sched: Updating ");
@@ -880,7 +880,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            
             SET_HDR(ap,&stg_AP_STACK_NOUPD_info,
                    ((StgClosure *)frame)->header.prof.ccs /* ToDo */); 
-            TICK_ALLOC_SE_THK(words+1,0);
+            TICK_ALLOC_SE_THK(WDS(words+1),0);
 
             stack->sp = sp;
             threadStackUnderflow(cap,tso);
@@ -916,7 +916,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            // handler in this frame.
            //
            raise = (StgThunk *)allocate(cap,sizeofW(StgThunk)+1);
-           TICK_ALLOC_SE_THK(1,0);
+           TICK_ALLOC_SE_THK(WDS(1),0);
            SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs);
            raise->payload[0] = exception;
            
index af33805..243897f 100644 (file)
@@ -142,14 +142,14 @@ PrintTickyInfo(void)
        (PC(INTAVG(ALLOC_##categ##_hst[3], ALLOC_##categ##_ctr))), \
        (PC(INTAVG(ALLOC_##categ##_hst[4], ALLOC_##categ##_ctr)))
 
-  fprintf(tf,"%7ld (%5.1f%%) function values",
+  fprintf(tf,"%11ld (%5.1f%%) function values",
        ALLOC_FUN_ctr,
        PC(INTAVG(ALLOC_FUN_ctr, tot_allocs)));
   if (ALLOC_FUN_ctr != 0)
       fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FUN));
  
 
-  fprintf(tf,"\n%7ld (%5.1f%%) thunks",
+  fprintf(tf,"\n%11ld (%5.1f%%) thunks",
        ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr,
        PC(INTAVG(ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr, tot_allocs)));
 
@@ -159,37 +159,37 @@ PrintTickyInfo(void)
       fprintf(tf,"\t\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(THK));
 #undef ALLOC_THK_ctr
 
-  fprintf(tf,"\n%7ld (%5.1f%%) data values",
+  fprintf(tf,"\n%11ld (%5.1f%%) data values",
        ALLOC_CON_ctr,
        PC(INTAVG(ALLOC_CON_ctr, tot_allocs)));
   if (ALLOC_CON_ctr != 0)
       fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(CON));
 
-  fprintf(tf,"\n%7ld (%5.1f%%) big tuples",
+  fprintf(tf,"\n%11ld (%5.1f%%) big tuples",
        ALLOC_TUP_ctr,
        PC(INTAVG(ALLOC_TUP_ctr, tot_allocs)));
   if (ALLOC_TUP_ctr != 0)
       fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TUP));
 
-  fprintf(tf,"\n%7ld (%5.1f%%) black holes",
+  fprintf(tf,"\n%11ld (%5.1f%%) black holes",
        ALLOC_BH_ctr,
        PC(INTAVG(ALLOC_BH_ctr, tot_allocs)));
   if (ALLOC_BH_ctr != 0)
       fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BH));
 
-  fprintf(tf,"\n%7ld (%5.1f%%) prim things",
+  fprintf(tf,"\n%11ld (%5.1f%%) prim things",
        ALLOC_PRIM_ctr,
        PC(INTAVG(ALLOC_PRIM_ctr, tot_allocs)));
   if (ALLOC_PRIM_ctr != 0)
       fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PRIM));
 
-  fprintf(tf,"\n%7ld (%5.1f%%) partial applications",
+  fprintf(tf,"\n%11ld (%5.1f%%) partial applications",
        ALLOC_PAP_ctr,
        PC(INTAVG(ALLOC_PAP_ctr, tot_allocs)));
   if (ALLOC_PAP_ctr != 0)
       fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PAP));
 
-  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
+  fprintf(tf,"\n%11ld (%5.1f%%) thread state objects",
        ALLOC_TSO_ctr,
        PC(INTAVG(ALLOC_TSO_ctr, tot_allocs)));
   if (ALLOC_TSO_ctr != 0)
@@ -208,16 +208,16 @@ PrintTickyInfo(void)
        tot_enters,
        jump_direct_enters,
        PC(INTAVG(jump_direct_enters,tot_enters)));
-  fprintf(tf,"%7ld (%5.1f%%) thunks\n",
+  fprintf(tf,"%11ld (%5.1f%%) thunks\n",
        tot_thk_enters,
        PC(INTAVG(tot_thk_enters,tot_enters)));
-  fprintf(tf,"%7ld (%5.1f%%) data values\n",
+  fprintf(tf,"%11ld (%5.1f%%) data values\n",
        tot_con_enters,
        PC(INTAVG(tot_con_enters,tot_enters)));
-  fprintf(tf,"%7ld (%5.1f%%) normal indirections\n",
+  fprintf(tf,"%11ld (%5.1f%%) normal indirections\n",
        tot_ind_enters,
        PC(INTAVG(tot_ind_enters,tot_enters)));
-  fprintf(tf,"%7" FMT_Int " (%5.1f%%) permanent indirections\n",
+  fprintf(tf,"%11" FMT_Int " (%5.1f%%) permanent indirections\n",
        ENT_PERM_IND_ctr,
        PC(INTAVG(ENT_PERM_IND_ctr,tot_enters)));
 
@@ -239,22 +239,22 @@ PrintTickyInfo(void)
   fprintf(tf, "\n");
 
   fprintf(tf,"\nRETURNS: %ld\n", tot_returns);
-  fprintf(tf,"%7ld (%5.1f%%) from entering a new constructor\n\t\t  [the rest from entering an existing constructor]\n",
+  fprintf(tf,"%11ld (%5.1f%%) from entering a new constructor\n\t\t  [the rest from entering an existing constructor]\n",
        tot_returns_of_new,
        PC(INTAVG(tot_returns_of_new,tot_returns)));
 
   /* krc: comment out some of this stuff temporarily */
 
   /*
-  fprintf(tf, "\nRET_NEW:         %7ld: ", RET_NEW_ctr);
+  fprintf(tf, "\nRET_NEW:         %11ld: ", RET_NEW_ctr);
   for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
                                PC(INTAVG(RET_NEW_hst[i],RET_NEW_ctr))); }
   fprintf(tf, "\n");
-  fprintf(tf, "RET_OLD:         %7ld: ", RET_OLD_ctr);
+  fprintf(tf, "RET_OLD:         %11ld: ", RET_OLD_ctr);
   for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
                                PC(INTAVG(RET_OLD_hst[i],RET_OLD_ctr))); }
   fprintf(tf, "\n");
-  fprintf(tf, "RET_UNBOXED_TUP: %7ld: ", RET_UNBOXED_TUP_ctr);
+  fprintf(tf, "RET_UNBOXED_TUP: %11ld: ", RET_UNBOXED_TUP_ctr);
   for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
                                    PC(INTAVG(RET_UNBOXED_TUP_hst[i],
                                              RET_UNBOXED_TUP_ctr))); }
@@ -268,33 +268,33 @@ PrintTickyInfo(void)
   fprintf(tf,"\nCATCH FRAMES:  %" FMT_Int "", CATCHF_PUSHED_ctr);
 
   if (UPDF_RCC_PUSHED_ctr != 0)
-     fprintf(tf,"%7" FMT_Int " restore cost centre frames (%" FMT_Int " omitted)\n",
+     fprintf(tf,"%11" FMT_Int " restore cost centre frames (%" FMT_Int " omitted)\n",
        UPDF_RCC_PUSHED_ctr,
        UPDF_RCC_OMITTED_ctr);
 
   fprintf(tf,"\nUPDATES: %ld\n", tot_updates);
-  fprintf(tf,"%7ld (%5.1f%%) data values\n\t\t  [%" FMT_Int " in place, %" FMT_Int " allocated new space]\n",
+  fprintf(tf,"%11ld (%5.1f%%) data values\n\t\t  [%" FMT_Int " in place, %" FMT_Int " allocated new space]\n",
        con_updates,
        PC(INTAVG(con_updates,tot_updates)),
        UPD_CON_IN_PLACE_ctr, UPD_CON_IN_NEW_ctr);
-  fprintf(tf,"%7ld (%5.1f%%) partial applications\n\t\t  [%" FMT_Int " in place, %" FMT_Int " allocated new space]\n",
+  fprintf(tf,"%11ld (%5.1f%%) partial applications\n\t\t  [%" FMT_Int " in place, %" FMT_Int " allocated new space]\n",
        pap_updates,
        PC(INTAVG(pap_updates,tot_updates)),
        UPD_PAP_IN_PLACE_ctr, UPD_PAP_IN_NEW_ctr);
-  fprintf(tf,"%7" FMT_Int " (%5.1f%%) updates by squeezing\n",
+  fprintf(tf,"%11" FMT_Int " (%5.1f%%) updates by squeezing\n",
        UPD_SQUEEZED_ctr,
        PC(INTAVG(UPD_SQUEEZED_ctr, tot_updates)));
 
   /* krc: also avoid dealing with this for now */
 #if FALSE
-  fprintf(tf, "\nUPD_CON_IN_NEW:   %7ld: ", UPD_CON_IN_NEW_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_CON_IN_NEW_hst[i]); }
+  fprintf(tf, "\nUPD_CON_IN_NEW:   %11ld: ", UPD_CON_IN_NEW_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%11ld", UPD_CON_IN_NEW_hst[i]); }
   fprintf(tf, "\n");
-  fprintf(tf, "UPD_CON_IN_PLACE: %7ld: ", UPD_CON_IN_PLACE_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_CON_IN_PLACE_hst[i]); }
+  fprintf(tf, "UPD_CON_IN_PLACE: %11ld: ", UPD_CON_IN_PLACE_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%11ld", UPD_CON_IN_PLACE_hst[i]); }
   fprintf(tf, "\n");
-  fprintf(tf, "UPD_PAP_IN_NEW:   %7ld: ", UPD_PAP_IN_NEW_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_PAP_IN_NEW_hst[i]); }
+  fprintf(tf, "UPD_PAP_IN_NEW:   %11ld: ", UPD_PAP_IN_NEW_ctr);
+  for (i = 0; i < 9; i++) { fprintf(tf, "%11ld", UPD_PAP_IN_NEW_hst[i]); }
   fprintf(tf, "\n");
 #endif
 
@@ -317,20 +317,39 @@ PrintTickyInfo(void)
   */
 
 #define PR_CTR(ctr) \
-  do { fprintf(tf,"%7" FMT_Int " " #ctr "\n", ctr); } while(0)
+  do { fprintf(tf,"%11" FMT_Int " " #ctr "\n", ctr); } while(0)
 /* COND_PR_CTR takes a boolean; if false then msg is the printname rather than ctr */
 #define COND_PR_CTR(ctr,b,msg) \
-    if (b) { fprintf(tf,"%7" FMT_Int " " #ctr "\n", ctr); } else { fprintf(tf,"%7" FMT_Int " " msg "\n", ctr); }
+    if (b) { fprintf(tf,"%11" FMT_Int " " #ctr "\n", ctr); } else { fprintf(tf,"%11" FMT_Int " " msg "\n", ctr); }
 #define PR_HST(hst,i) \
-  do { fprintf(tf,"%7ld " #hst "_" #i "\n", hst[i]); } while(0)
+  do { fprintf(tf,"%11ld " #hst "_" #i "\n", hst[i]); } while(0)
+
+  ALLOC_HEAP_ctr = (StgInt)ALLOC_HEAP_ctr + (StgInt)ALLOC_RTS_ctr;
+  ALLOC_HEAP_tot = (StgInt)ALLOC_HEAP_tot + (StgInt)ALLOC_RTS_tot;
 
   PR_CTR(ALLOC_HEAP_ctr);
   PR_CTR(ALLOC_HEAP_tot);
 
+  PR_CTR(ALLOC_RTS_ctr);
+  PR_CTR(ALLOC_RTS_tot);
+
   PR_CTR(ALLOC_FUN_ctr);
-  PR_CTR(ALLOC_FUN_adm);
   PR_CTR(ALLOC_FUN_gds);
-  PR_CTR(ALLOC_FUN_slp);
+
+  PR_CTR(ALLOC_PAP_ctr);
+  PR_CTR(ALLOC_PAP_adm);
+  PR_CTR(ALLOC_PAP_gds);
+
+  PR_CTR(ALLOC_UP_THK_ctr);
+  PR_CTR(ALLOC_SE_THK_ctr);
+  PR_CTR(ALLOC_THK_gds);
+
+  PR_CTR(ALLOC_CON_ctr);
+  PR_CTR(ALLOC_CON_gds);
+
+  PR_CTR(ALLOC_PRIM_ctr);
+  PR_CTR(ALLOC_PRIM_gds);
+  PR_CTR(ALLOC_PRIM_slp);
 
   /* krc: comment out some of this stuff temporarily
   PR_HST(ALLOC_FUN_hst,0);
@@ -384,9 +403,6 @@ PrintTickyInfo(void)
   PR_HST(ALLOC_PRIM_hst,2);
   PR_HST(ALLOC_PRIM_hst,3);
   PR_HST(ALLOC_PRIM_hst,4);
-  PR_CTR(ALLOC_PAP_ctr);
-  PR_CTR(ALLOC_PAP_adm);
-  PR_CTR(ALLOC_PAP_gds);
   PR_CTR(ALLOC_PAP_slp);
   PR_HST(ALLOC_PAP_hst,0);
   PR_HST(ALLOC_PAP_hst,1);
@@ -410,6 +426,7 @@ PrintTickyInfo(void)
   PR_CTR(ENT_DYN_CON_ctr);
   PR_CTR(ENT_STATIC_FUN_DIRECT_ctr);
   PR_CTR(ENT_DYN_FUN_DIRECT_ctr);
+  PR_CTR(ENT_LNE_ctr);
   PR_CTR(ENT_STATIC_IND_ctr);
   PR_CTR(ENT_DYN_IND_ctr);
 
@@ -435,21 +452,22 @@ PrintTickyInfo(void)
   PR_CTR(ENT_STATIC_THK_ctr);
   PR_CTR(ENT_DYN_THK_ctr);
 
-  PR_CTR(SLOW_CALL_v_ctr);
-  PR_CTR(SLOW_CALL_f_ctr);
-  PR_CTR(SLOW_CALL_d_ctr);
-  PR_CTR(SLOW_CALL_l_ctr);
-  PR_CTR(SLOW_CALL_n_ctr);
-  PR_CTR(SLOW_CALL_p_ctr);
-  PR_CTR(SLOW_CALL_pv_ctr);
-  PR_CTR(SLOW_CALL_pp_ctr);
-  PR_CTR(SLOW_CALL_ppv_ctr);
-  PR_CTR(SLOW_CALL_ppp_ctr);
-  PR_CTR(SLOW_CALL_pppv_ctr);
-  PR_CTR(SLOW_CALL_pppp_ctr);
-  PR_CTR(SLOW_CALL_ppppp_ctr);
-  PR_CTR(SLOW_CALL_pppppp_ctr);
-  PR_CTR(SLOW_CALL_OTHER_ctr);
+  PR_CTR(SLOW_CALL_fast_v16_ctr);
+  PR_CTR(SLOW_CALL_fast_v_ctr);
+  PR_CTR(SLOW_CALL_fast_f_ctr);
+  PR_CTR(SLOW_CALL_fast_d_ctr);
+  PR_CTR(SLOW_CALL_fast_l_ctr);
+  PR_CTR(SLOW_CALL_fast_n_ctr);
+  PR_CTR(SLOW_CALL_fast_p_ctr);
+  PR_CTR(SLOW_CALL_fast_pv_ctr);
+  PR_CTR(SLOW_CALL_fast_pp_ctr);
+  PR_CTR(SLOW_CALL_fast_ppv_ctr);
+  PR_CTR(SLOW_CALL_fast_ppp_ctr);
+  PR_CTR(SLOW_CALL_fast_pppv_ctr);
+  PR_CTR(SLOW_CALL_fast_pppp_ctr);
+  PR_CTR(SLOW_CALL_fast_ppppp_ctr);
+  PR_CTR(SLOW_CALL_fast_pppppp_ctr);
+  PR_CTR(VERY_SLOW_CALL_ctr);
 
   PR_CTR(UNKNOWN_CALL_ctr);
   PR_CTR(KNOWN_CALL_ctr);
@@ -574,19 +592,20 @@ printRegisteredCounterInfo (FILE *tf)
     StgEntCounter *p;
 
     if ( ticky_entry_ctrs != NULL ) {
+      fprintf(tf,"\nThe following table is explained by http://hackage.haskell.org/trac/ghc/wiki/Debugging/TickyTicky\nAll allocation numbers are in bytes.\n");
       fprintf(tf,"\n**************************************************\n\n");
     }
-    fprintf(tf, "%11s%11s %6s%6s    %-11s%-30s\n",
-           "Entries", "Allocs", "Arity", "Stack", "Kinds", "Function");
+    fprintf(tf, "%11s%11s%11s  %-23s %s\n",
+           "Entries", "Alloc", "Alloc'd", "Non-void Arguments", "STG Name");
     fprintf(tf, "--------------------------------------------------------------------------------\n");
     /* Function name at the end so it doesn't mess up the tabulation */
 
     for (p = ticky_entry_ctrs; p != NULL; p = p->link) {
-       fprintf(tf, "%11" FMT_Int "%11" FMT_Int " %6lu%6lu    %-11s%-30s",
+       fprintf(tf, "%11" FMT_Int "%11" FMT_Int "%11" FMT_Int " %3lu %-20.20s %s",
                p->entry_count,
                p->allocs,
+               p->allocd,
                (unsigned long)p->arity,
-               (unsigned long)p->stk_args,
                p->arg_kinds,
                p->str);
 
index f14b3b0..5c4e54f 100644 (file)
@@ -638,7 +638,7 @@ allocate (Capability *cap, W_ n)
     bdescr *bd;
     StgPtr p;
 
-    TICK_ALLOC_HEAP_NOCTR(n);
+    TICK_ALLOC_HEAP_NOCTR(WDS(n));
     CCS_ALLOC(cap->r.rCCCS,n);
     
     if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
@@ -753,7 +753,7 @@ allocatePinned (Capability *cap, W_ n)
         return p;
     }
 
-    TICK_ALLOC_HEAP_NOCTR(n);
+    TICK_ALLOC_HEAP_NOCTR(WDS(n));
     CCS_ALLOC(cap->r.rCCCS,n);
 
     bd = cap->pinned_object_block;
index 77daf5c..78233a5 100644 (file)
@@ -365,6 +365,7 @@ wanteds = concat
           ,closurePayload C "StgClosure" "payload"
 
           ,structFieldH Both "StgEntCounter" "allocs"
+          ,structFieldH Both "StgEntCounter" "allocd"
           ,structField  Both "StgEntCounter" "registeredp"
           ,structField  Both "StgEntCounter" "link"
           ,structField  Both "StgEntCounter" "entry_count"