ticky enhancements

  * 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

1 files changed, 17 insertions, 26 deletions

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 136bb52b07..1e5d6b9f4f 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -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