Revert "Various ticky-related work"
authorBen Gamari <ben@smart-cactus.org>
Thu, 24 Mar 2016 10:23:31 +0000 (11:23 +0100)
committerBen Gamari <ben@smart-cactus.org>
Thu, 24 Mar 2016 10:23:52 +0000 (11:23 +0100)
This reverts commit 6c2c853b11fe25c106469da7b105e2be596c17de which was
supposed to be merged as individual commits.

compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmProf.hs
compiler/codeGen/StgCmmTicky.hs
rts/sm/Scav.c

index eae599c..f34186a 100644 (file)
@@ -206,7 +206,7 @@ cgRhs :: Id
                )
 
 cgRhs id (StgRhsCon cc con args)
-  = withNewTickyCounterCon (idName id) $
+  = withNewTickyCounterThunk False (idName id) $ -- False for "not static"
     buildDynCon id True cc con args
 
 {- See Note [GC recovery] in compiler/codeGen/StgCmmClosure.hs -}
@@ -386,7 +386,7 @@ cgRhsStdThunk bndr lf_info payload
        }
  where
  gen_code reg  -- AHA!  A STANDARD-FORM THUNK
-  = withNewTickyCounterStdThunk (lfUpdatable lf_info) (idName bndr) $
+  = withNewTickyCounterStdThunk False (idName bndr) $ -- False for "not static"
     do
   {     -- LAY OUT THE OBJECT
     mod_name <- getModuleName
@@ -402,6 +402,7 @@ cgRhsStdThunk bndr lf_info payload
 --  ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body
   ; let use_cc = curCCS; blame_cc = curCCS
 
+  ; tickyEnterStdThunk closure_info
 
         -- BUILD THE OBJECT
   ; let info_tbl = mkCmmInfo closure_info
@@ -452,10 +453,7 @@ 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
-  = withNewTickyCounterThunk
-        (isStaticClosure cl_info)
-        (closureUpdReqd cl_info)
-        (closureName cl_info) $
+  = withNewTickyCounterThunk (isStaticClosure cl_info) (closureName cl_info) $
     emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl [] $
       \(_, node, _) -> thunkCode cl_info fv_details cc node arity body
    where
@@ -578,7 +576,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 434d7b5..c1b149d 100644 (file)
@@ -328,7 +328,8 @@ ldvRecordCreate closure = do
 --
 -- | Called when a closure is entered, marks the closure as having
 -- been "used".  The closure is not an "inherently used" one.  The
--- closure is not @IND@ because that is not considered for LDV profiling.
+-- closure is not @IND@ or @IND_OLDGEN@ because neither is considered
+-- for LDV profiling.
 --
 ldvEnterClosure :: ClosureInfo -> CmmReg -> FCode ()
 ldvEnterClosure closure_info node_reg = do
index 0ffe6a3..95dfa99 100644 (file)
@@ -70,7 +70,6 @@ module StgCmmTicky (
   withNewTickyCounterLNE,
   withNewTickyCounterThunk,
   withNewTickyCounterStdThunk,
-  withNewTickyCounterCon,
 
   tickyDynAlloc,
   tickyAllocHeap,
@@ -144,13 +143,7 @@ import Control.Monad ( unless, when )
 --
 -----------------------------------------------------------------------------
 
-data TickyClosureType
-    = TickyFun
-    | TickyCon
-    | TickyThunk
-        Bool -- True <-> updateable
-        Bool -- True <-> standard thunk (AP or selector), has no entry counter
-    | TickyLNE
+data TickyClosureType = TickyFun | TickyThunk | TickyLNE
 
 withNewTickyCounterFun, withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode a -> FCode a
 withNewTickyCounterFun = withNewTickyCounter TickyFun
@@ -159,38 +152,15 @@ withNewTickyCounterLNE nm args code = do
   b <- tickyLNEIsOn
   if not b then code else withNewTickyCounter TickyLNE nm args code
 
-withNewTickyCounterThunk
-  :: Bool -- ^ static
-  -> Bool -- ^ updateable
-  -> Name
-  -> FCode a
-  -> FCode a
-withNewTickyCounterThunk isStatic isUpdatable name code = do
+withNewTickyCounterThunk,withNewTickyCounterStdThunk ::
+  Bool -> Name -> FCode a -> FCode a
+withNewTickyCounterThunk isStatic name code = do
     b <- tickyDynThunkIsOn
     if isStatic || not b -- ignore static thunks
       then code
-      else withNewTickyCounter (TickyThunk isUpdatable False) name [] code
-
-withNewTickyCounterStdThunk
-  :: Bool -- ^ updateable
-  -> Name
-  -> FCode a
-  -> FCode a
-withNewTickyCounterStdThunk isUpdatable name code = do
-    b <- tickyDynThunkIsOn
-    if not b
-      then code
-      else withNewTickyCounter (TickyThunk isUpdatable True) name [] code
+      else withNewTickyCounter TickyThunk name [] code
 
-withNewTickyCounterCon
-  :: Name
-  -> FCode a
-  -> FCode a
-withNewTickyCounterCon name code = do
-    b <- tickyDynThunkIsOn
-    if not b
-      then code
-      else withNewTickyCounter TickyCon name [] code
+withNewTickyCounterStdThunk = withNewTickyCounterThunk
 
 -- args does not include the void arguments
 withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode a -> FCode a
@@ -214,21 +184,21 @@ emitTickyCounter cloType name args
         ; let ppr_for_ticky_name :: SDoc
               ppr_for_ticky_name =
                 let n = ppr name
-                    ext = case cloType of
-                              TickyFun -> empty
-                              TickyCon -> parens (text "con")
-                              TickyThunk upd std -> parens $ hcat $ punctuate comma $
-                                  [text "thk"] ++ [text "se"|not upd] ++ [text "std"|std]
-                              TickyLNE | isInternalName name -> parens (text "LNE")
-                                       | otherwise -> panic "emitTickyCounter: how is this an external LNE?"
                     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 if isInternalName name
-                   then n <+> parens (ppr mod_name) <+> ext <+> p
-                   else n <+> ext <+> p
+                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
index abb7726..953f055 100644 (file)
@@ -1533,7 +1533,7 @@ scavenge_one(StgPtr p)
         } else {
           size = gen->scan - start;
         }
-        debugBelch("evac IND: %ld bytes", size * sizeof(W_));
+        debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
       }
 #endif
       break;