Lightweight ticky-ticky profiling

The following changes restore ticky-ticky profiling to functionality
from its formerly bit-rotted state. Sort of. (It got bit-rotted as part
of the switch to the C-- back-end.)

The way that ticky-ticky is supposed to work is documented in Section 5.7
of the GHC manual (though the manual doesn't mention that it hasn't worked
since sometime around 6.0, alas). Changes from this are as follows (which
I'll document on the wiki):

* In the past, you had to build all of the libraries with way=t in order to
use ticky-ticky, because it entailed a different closure layout. No longer.
You still need to do make way=t in rts/ in order to build the ticky RTS,
but you should now be able to mix ticky and non-ticky modules.

* Some of the counters that worked in the past aren't implemented yet.
I was originally just trying to get entry counts to work, so those should
be correct. The list of counters was never documented in the first place,
so I hope it's not too much of a disaster that some don't appear anymore.
Someday, someone (perhaps me) should document all the counters and what 
they do. For now, all of the counters are either accurate (or at least as
accurate as they always were), zero, or missing from the ticky profiling
report altogether.

This hasn't been particularly well-tested, but these changes shouldn't
affect anything except when compiling with -fticky-ticky (famous last
words...)

Implementation details:

I got rid of StgTicky.h, which in the past had the macros and declarations 
for all of the ticky counters. Now, those macros are defined in Cmm.h.
StgTicky.h was still there for inclusion in C code. Now, any remaining C
code simply cannot call the ticky macros -- or rather, they do call those
macros, but from the perspective of C code, they're defined as no-ops. 
(This shouldn't be too big a problem.)

I added a new file TickyCounter.h that has all the declarations for ticky
counters, as well as dummy macros for use in C code. Someday, these 
declarations should really be automatically generated, since they need
to be kept consistent with the macros defined in Cmm.h.

Other changes include getting rid of the header that was getting added to
closures before, and getting rid of various code having to do with eager
blackholing and permanent indirections (the changes under compiler/ 
and rts/Updates.*).

6 files changed, 71 insertions, 51 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 397a074ad3..6dbf0f2923 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -568,6 +568,8 @@ idInfoLabelType info =
     ConInfoTable  -> DataLabel
     StaticInfoTable -> DataLabel
     ClosureTable  -> DataLabel
+-- krc: aie! a ticky counter label is data
+    RednCounts    -> DataLabel
     _	          -> CodeLabel
 
 
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index 99290d2142..8337f916fe 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -447,12 +447,12 @@ emitBlackHoleCode is_single_entry
 	-- Profiling needs slop filling (to support LDV profiling), so
 	-- currently eager blackholing doesn't work with profiling.
 	--
-	-- TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of
-	-- single-entry thunks.
-    eager_blackholing 
-	| opt_DoTickyProfiling = True
-	| otherwise            = False
+        -- Previously, eager blackholing was enabled when ticky-ticky
+        -- was on. But it didn't work, and it wasn't strictly necessary 
+        -- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING 
+        -- is unconditionally disabled. -- krc 1/2007
 
+    eager_blackholing = False 
 \end{code}
 
 \begin{code}
@@ -475,17 +475,9 @@ setupUpdate closure_info code
 	; if closureUpdReqd closure_info
 	  then do	-- Blackhole the (updatable) CAF:
 		{ upd_closure <- link_caf closure_info True
-	 	; pushUpdateFrame upd_closure code }
+		; pushUpdateFrame upd_closure code }
 	  else do
-		{ 	-- No update reqd, you'd think we don't need to 
-			-- black-hole it. But when ticky-ticky is on, we 
-			-- black-hole it regardless, to catch errors in which
-			-- an allegedly single-entry closure is entered twice
-			--
-			-- We discard the pointer returned by link_caf, because
-			-- we don't push an update frame
-		  whenC opt_DoTickyProfiling -- Blackhole even a SE CAF
-			(link_caf closure_info False >> nopC)
+		{ -- krc: removed some ticky-related code here.
 		; tickyUpdateFrameOmitted
 		; code }
     }
diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs
index 985ebb8626..0be58dd39c 100644
--- a/compiler/codeGen/CgTicky.hs
+++ b/compiler/codeGen/CgTicky.hs
@@ -33,7 +33,7 @@ module CgTicky (
 	tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs,
 	tickyUnknownCall, tickySlowCallPat,
 
-	staticTickyHdr,
+       staticTickyHdr,
   ) where
 
 #include "HsVersions.h"
@@ -72,11 +72,12 @@ import Data.Maybe
 -----------------------------------------------------------------------------
 
 staticTickyHdr :: [CmmLit]
--- The ticky header words in a static closure
--- Was SET_STATIC_TICKY_HDR
-staticTickyHdr 
-  | not opt_DoTickyProfiling = []
-  | otherwise		     = [zeroCLit]
+-- 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] -> Int -> Code
 emitTickyCounter cl_info args on_stk
@@ -85,10 +86,12 @@ emitTickyCounter cl_info args on_stk
 	; fun_descr_lit <- mkStringCLit (fun_descr mod_name)
 	; arg_descr_lit <- mkStringCLit arg_descr
 	; emitDataLits ticky_ctr_label 	-- Must match layout of StgEntCounter
-	    [ CmmInt 0 I16,
-	      CmmInt (fromIntegral (length args)) I16, 	-- Arity
-	      CmmInt (fromIntegral on_stk) I16,		-- Words passed on stack
-	      CmmInt 0 I16,				-- 2-byte gap
+-- 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.
+	    [ CmmInt 0 I32,
+	      CmmInt (fromIntegral (length args)) I32, 	-- Arity
+	      CmmInt (fromIntegral on_stk) I32,		-- Words passed on stack
 	      fun_descr_lit,
 	      arg_descr_lit,
 	      zeroCLit, 		-- Entry count
@@ -147,10 +150,11 @@ tickyEnterFun cl_info
     do 	{ bumpTickyCounter ctr
 	; fun_ctr_lbl <- getTickyCtrLabel
 	; registerTickyCtr fun_ctr_lbl
-	; bumpTickyCounter' fun_ctr_lbl }
+	; bumpTickyCounter' (cmmLabelOffB fun_ctr_lbl oFFSET_StgEntCounter_entry_count)
+        }
   where
-    ctr | isStaticClosure cl_info = SLIT("TICK_ENT_STATIC_FUN_DIRECT")
-	| otherwise		  = SLIT("TICK_ENT_DYN_FUN_DIRECT")
+    ctr | isStaticClosure cl_info = SLIT("ENT_STATIC_FUN_DIRECT_ctr")
+	| otherwise		  = SLIT("ENT_DYN_FUN_DIRECT_ctr")
 
 registerTickyCtr :: CLabel -> Code
 -- Register a ticky counter
@@ -161,9 +165,11 @@ registerTickyCtr :: CLabel -> Code
 registerTickyCtr ctr_lbl
   = emitIf test (stmtsC register_stmts)
   where
-    test = CmmMachOp (MO_Not I16) 
-	    [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl 
-				oFFSET_StgEntCounter_registeredp)) I16]
+    -- krc: code generator doesn't handle Not, so we test for Eq 0 instead
+    test = CmmMachOp (MO_Eq I32)
+              [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl 
+				oFFSET_StgEntCounter_registeredp)) I32,
+               CmmLit (mkIntCLit 0)]
     register_stmts
       =	[ CmmStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_link))
 		   (CmmLoad ticky_entry_ctrs wordRep)
@@ -199,7 +205,7 @@ tickyVectoredReturn family_size
 -- Ticks at a *call site*:
 tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_TOO_FEW_ARGS_ctr")
 tickyKnownCallExact = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_ctr")
-tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_EXTRA_ctr")
+tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_EXTRA_ARGS_ctr")
 tickyUnknownCall = ifTicky $ bumpTickyCounter SLIT("UNKNOWN_CALL_ctr")
 
 -- Tick for the call pattern at slow call site (i.e. in addition to
@@ -234,11 +240,13 @@ tickyDynAlloc :: ClosureInfo -> Code
 tickyDynAlloc cl_info
   = ifTicky $
     case smRepClosureType (closureSMRep cl_info) of
-	Constr        -> tick_alloc_con
-	ConstrNoCaf   -> tick_alloc_con
-	Fun	      -> tick_alloc_fun
-	Thunk 	      -> tick_alloc_thk
-	ThunkSelector -> tick_alloc_thk
+	Just Constr           -> tick_alloc_con
+	Just ConstrNoCaf      -> tick_alloc_con
+	Just Fun	      -> tick_alloc_fun
+	Just Thunk 	      -> tick_alloc_thk
+	Just ThunkSelector    -> tick_alloc_thk
+        -- black hole
+        Nothing               -> return ()
   where
 	-- will be needed when we fill in stubs
     cl_size   =	closureSize cl_info
@@ -248,10 +256,13 @@ tickyDynAlloc cl_info
 	| closureUpdReqd cl_info = tick_alloc_up_thk
 	| otherwise	         = tick_alloc_se_thk
 
-    tick_alloc_con = panic "ToDo: tick_alloc"
-    tick_alloc_fun = panic "ToDo: tick_alloc"
-    tick_alloc_up_thk = panic "ToDo: tick_alloc"
-    tick_alloc_se_thk = panic "ToDo: tick_alloc"
+    -- 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 ()
+
 
 tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 tickyAllocPrim hdr goods slop = ifTicky $ panic "ToDo: tickyAllocPrim"
@@ -292,10 +303,11 @@ addToMemLbl rep lbl n = addToMem rep (CmmLit (CmmLabel lbl)) n
 
 -- All the ticky-ticky counters are declared "unsigned long" in C
 bumpTickyCounter :: LitString -> Code
-bumpTickyCounter lbl = bumpTickyCounter' (mkRtsDataLabel lbl)
+bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkRtsDataLabel lbl) 0)
 
-bumpTickyCounter' :: CLabel -> Code
-bumpTickyCounter' lbl = stmtC (addToMemLbl cLongRep lbl 1)
+bumpTickyCounter' :: CmmLit -> Code
+-- krc: note that we're incrementing the _entry_count_ field of the ticky counter
+bumpTickyCounter' lhs = stmtC (addToMem cLongRep (CmmLit lhs) 1)
 
 addToMemLong = addToMem cLongRep
 
diff --git a/compiler/codeGen/SMRep.lhs b/compiler/codeGen/SMRep.lhs
index 96b53135cd..88a1cca731 100644
--- a/compiler/codeGen/SMRep.lhs
+++ b/compiler/codeGen/SMRep.lhs
@@ -303,10 +303,11 @@ isStaticRep BlackHoleRep	         = False
 #include "../includes/ClosureTypes.h"
 -- Defines CONSTR, CONSTR_1_0 etc
 
-
-smRepClosureType :: SMRep -> ClosureType
-smRepClosureType (GenericRep _ _ _ ty) = ty
-smRepClosureType BlackHoleRep	       = panic "smRepClosureType: black hole"
+-- krc: only called by tickyDynAlloc in CgTicky; return
+-- Nothing for a black hole so we can at least make something work.
+smRepClosureType :: SMRep -> Maybe ClosureType
+smRepClosureType (GenericRep _ _ _ ty) = Just ty
+smRepClosureType BlackHoleRep	       = Nothing
 
 smRepClosureTypeInt :: SMRep -> Int
 smRepClosureTypeInt (GenericRep False 1 0 Constr) = CONSTR_1_0
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index a66a836c67..61b10bcc38 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -29,6 +29,9 @@ import FastString	( unpackFS )
 import Cmm		( Cmm )
 import HscTypes
 import DynFlags
+
+import StaticFlags      ( opt_DoTickyProfiling )
+
 import ErrUtils		( dumpIfSet_dyn, showPass, ghcExit )
 import Outputable
 import Pretty		( Mode(..), printDoc )
@@ -131,7 +134,7 @@ outputC dflags filenm mod location flat_absC
            all_headers =  c_includes
 		       ++ reverse cmdline_includes
 		       ++ ffi_decl_headers
-
+                       
        let cc_injects = unlines (map mk_include all_headers)
        	   mk_include h_file = 
        	    case h_file of 
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index ab2c8e8ccf..53957e7744 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -97,7 +97,7 @@ parseStaticFlags args = do
   when (not (null errs)) $ throwDyn (UsageError (unlines errs))
 
     -- deal with the way flags: the way (eg. prof) gives rise to
-    -- futher flags, some of which might be static.
+    -- further flags, some of which might be static.
   way_flags <- findBuildTag
 
     -- if we're unregisterised, add some more flags
@@ -489,7 +489,8 @@ findBuildTag :: IO [String]  -- new options
 findBuildTag = do
   way_names <- readIORef v_Ways
   let ws = sort (nub way_names)
-  if not (allowed_combination ws)
+  res <-
+    if not (allowed_combination ws)
       then throwDyn (CmdLineError $
       		    "combination not supported: "  ++
       		    foldr1 (\a b -> a ++ '/':b) 
@@ -503,6 +504,15 @@ findBuildTag = do
       	   writeIORef v_RTS_Build_tag rts_tag
       	   return (concat flags)
 
+  -- krc: horrible, I know.
+  (if opt_DoTickyProfiling then do
+                  writeIORef v_RTS_Build_tag (mkBuildTag [(lkupWay WayTicky)])
+                  return (res ++ (wayOpts (lkupWay WayTicky)))
+   else
+                  return res)
+
+
+
 mkBuildTag :: [Way] -> String
 mkBuildTag ways = concat (intersperse "_" (map wayTag ways))