From: Kirsten Chevalier Date: Wed, 7 Feb 2007 08:14:04 +0000 (+0000) Subject: Lightweight ticky-ticky profiling X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=5ddee764beb312933256096d03df7c3ec47ac452 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.*). --- diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 397a074..6dbf0f2 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 99290d2..8337f91 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 985ebb8..0be58dd 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 96b5313..88a1cca 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 a66a836..61b10bc 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 ab2c8e8..53957e7 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)) diff --git a/includes/Cmm.h b/includes/Cmm.h index 25ffb5d..4a4d0ea 100644 --- a/includes/Cmm.h +++ b/includes/Cmm.h @@ -463,18 +463,13 @@ #define TICK_SLOW_CALL_ppppp() TICK_BUMP(SLOW_CALL_ppppp_ctr) #define TICK_SLOW_CALL_pppppp() TICK_BUMP(SLOW_CALL_pppppp_ctr) -#ifdef TICKY_TICKY -#define TICK_HISTO_BY(histo,n,i) \ - W_ __idx; \ - __idx = (n); \ - if (__idx > 8) { \ - __idx = 8; \ - } \ - CLong[histo##_hst + _idx*SIZEOF_LONG] \ - = histo##_hst + __idx*SIZEOF_LONG] + i; -#else +/* NOTE: TICK_HISTO_BY and TICK_HISTO + currently have no effect. + The old code for it didn't typecheck and I + just commented it out to get ticky to work. + - krc 1/2007 */ + #define TICK_HISTO_BY(histo,n,i) /* nothing */ -#endif #define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1) diff --git a/includes/README b/includes/README index aae99bf..a63d027 100644 --- a/includes/README +++ b/includes/README @@ -86,7 +86,6 @@ Rts.h Parallel.h SMP.h Block.h - StgTicky.h Stable.h Hooks.h Signals.h diff --git a/includes/Rts.h b/includes/Rts.h index c2b25a8..59edc09 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -150,7 +150,9 @@ extern void _assertFail (const char *, unsigned int); /* Macros for STG/C code */ #include "Block.h" #include "ClosureMacros.h" -#include "StgTicky.h" + + /* Ticky-ticky counters */ +#include "TickyCounters.h" /* Runtime-system hooks */ #include "Hooks.h" @@ -257,4 +259,29 @@ extern void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__); } #endif + +/* krc: I put this here because I don't think + it needs to be visible externally. + It used to be in StgTicky.h, but I got rid + of that. */ + +/* ----------------------------------------------------------------------------- + The StgEntCounter type - needed regardless of TICKY_TICKY + -------------------------------------------------------------------------- */ + +typedef struct _StgEntCounter { + /* krc: StgWord32, not StgWord16, in order to match the code + generator, which doesn't generate anything of that type. */ + StgWord32 registeredp; /* 0 == no, 1 == yes */ + StgWord32 arity; /* arity (static info) */ + StgWord32 stk_args; /* # of args off stack */ + /* (rest of args are in registers) */ + char *str; /* name of the thing */ + char *arg_kinds; /* info about the args types */ + StgInt entry_count; /* Trips to fast entry code */ + StgInt allocs; /* number of allocations by this fun */ + struct _StgEntCounter *link;/* link to chain them all together */ +} StgEntCounter; + + #endif /* RTS_H */ diff --git a/includes/StgTicky.h b/includes/StgTicky.h deleted file mode 100644 index 27dd24e..0000000 --- a/includes/StgTicky.h +++ /dev/null @@ -1,771 +0,0 @@ -/* ---------------------------------------------------------------------------- - * - * (c) The AQUA project, Glasgow University, 1994-1997 - * (c) The GHC Team, 1998-1999 - * - * Ticky-ticky profiling macros. - * - * -------------------------------------------------------------------------- */ - -#ifndef TICKY_H -#define TICKY_H - -/* ----------------------------------------------------------------------------- - The StgEntCounter type - needed regardless of TICKY_TICKY - -------------------------------------------------------------------------- */ - -typedef struct _StgEntCounter { - StgWord16 registeredp; /* 0 == no, 1 == yes */ - StgWord16 arity; /* arity (static info) */ - StgWord16 stk_args; /* # of args off stack */ - /* (rest of args are in registers) */ - char *str; /* name of the thing */ - char *arg_kinds; /* info about the args types */ - StgInt entry_count; /* Trips to fast entry code */ - StgInt allocs; /* number of allocations by this fun */ - struct _StgEntCounter *link;/* link to chain them all together */ -} StgEntCounter; - - -#ifdef TICKY_TICKY - -/* ----------------------------------------------------------------------------- - Allocations - -------------------------------------------------------------------------- */ - -/* How many times we do a heap check and move Hp; comparing this with - * the allocations gives an indication of how many things we get per trip - * to the well: - */ -#define TICK_ALLOC_HEAP(n, f_ct) \ - { \ - f_ct.allocs += (n); \ - ALLOC_HEAP_ctr++; \ - ALLOC_HEAP_tot += (n); \ - } - -#define TICK_ALLOC_HEAP_NOCTR(n) \ - { \ - ALLOC_HEAP_ctr++; \ - ALLOC_HEAP_tot += (n); \ - } - -/* We count things every time we allocate something in the dynamic heap. - * For each, we count the number of words of (1) ``admin'' (header), - * (2) good stuff (useful pointers and data), and (3) ``slop'' (extra - * space, to leave room for an old generation indirection for example). - * - * The first five macros are inserted when the compiler generates code - * to allocate something; the categories correspond to the @ClosureClass@ - * datatype (manifest functions, thunks, constructors, big tuples, and - * partial applications). - */ - -#define _HS sizeofW(StgHeader) - -#define TICK_ALLOC_FUN(g,s) \ - ALLOC_FUN_ctr++; ALLOC_FUN_adm += _HS; \ - ALLOC_FUN_gds += (g); ALLOC_FUN_slp += (s); \ - TICK_ALLOC_HISTO(FUN,_HS,g,s) - -#define TICK_ALLOC_UP_THK(g,s) \ - ALLOC_UP_THK_ctr++; ALLOC_THK_adm += _HS; \ - ALLOC_THK_gds += (g); ALLOC_THK_slp += (s); \ - TICK_ALLOC_HISTO(THK,_HS,g,s) - -#define TICK_ALLOC_SE_THK(g,s) \ - ALLOC_SE_THK_ctr++; ALLOC_THK_adm += _HS; \ - ALLOC_THK_gds += (g); ALLOC_THK_slp += (s); \ - TICK_ALLOC_HISTO(THK,_HS,g,s) - -#define TICK_ALLOC_CON(g,s) \ - ALLOC_CON_ctr++; ALLOC_CON_adm += _HS; \ - ALLOC_CON_gds += (g); ALLOC_CON_slp += (s); \ - TICK_ALLOC_HISTO(CON,_HS,g,s) - -#define TICK_ALLOC_TUP(g,s) \ - ALLOC_TUP_ctr++; ALLOC_TUP_adm += _HS; \ - ALLOC_TUP_gds += (g); ALLOC_TUP_slp += (s); \ - TICK_ALLOC_HISTO(TUP,_HS,g,s) - -#define TICK_ALLOC_BH(g,s) \ - ALLOC_BH_ctr++; ALLOC_BH_adm += _HS; \ - ALLOC_BH_gds += (g); ALLOC_BH_slp += (s); \ - TICK_ALLOC_HISTO(BH,_HS,g,s) - -/* - * admin size doesn't take into account the FUN, that is accounted for - * in the "goods". - */ -#define TICK_ALLOC_PAP(g,s) \ - ALLOC_PAP_ctr++; ALLOC_PAP_adm += sizeofW(StgPAP)-1; \ - ALLOC_PAP_gds += (g); ALLOC_PAP_slp += (s); \ - TICK_ALLOC_HISTO(PAP,sizeofW(StgPAP)-1,g,s) - -#define TICK_ALLOC_TSO(g,s) \ - ALLOC_TSO_ctr++; ALLOC_TSO_adm += sizeofW(StgTSO); \ - ALLOC_TSO_gds += (g); ALLOC_TSO_slp += (s); \ - TICK_ALLOC_HISTO(TSO,sizeofW(StgTSO),g,s) - -#ifdef PAR -#define TICK_ALLOC_FMBQ(a,g,s) \ - ALLOC_FMBQ_ctr++; ALLOC_FMBQ_adm += (a); \ - ALLOC_FMBQ_gds += (g); ALLOC_FMBQ_slp += (s); \ - TICK_ALLOC_HISTO(FMBQ,a,g,s) - -#define TICK_ALLOC_FME(a,g,s) \ - ALLOC_FME_ctr++; ALLOC_FME_adm += (a); \ - ALLOC_FME_gds += (g); ALLOC_FME_slp += (s); \ - TICK_ALLOC_HISTO(FME,a,g,s) - -#define TICK_ALLOC_BF(a,g,s) \ - ALLOC_BF_ctr++; ALLOC_BF_adm += (a); \ - ALLOC_BF_gds += (g); ALLOC_BF_slp += (s); \ - TICK_ALLOC_HISTO(BF,a,g,s) -#endif - -/* The histogrammy bit is fairly straightforward; the -2 is: one for - * 0-origin C arrays; the other one because we do no one-word - * allocations, so we would never inc that histogram slot; so we shift - * everything over by one. - */ -#define TICK_ALLOC_HISTO(categ,a,g,s) \ - { I_ __idx; \ - __idx = (a) + (g) + (s) - 2; \ - ALLOC_##categ##_hst[((__idx > 4) ? 4 : __idx)] += 1;} - -/* Some hard-to-account-for words are allocated by/for primitives, - * includes Integer support. ALLOC_PRIM2 tells us about these. We - * count everything as ``goods'', which is not strictly correct. - * (ALLOC_PRIM is the same sort of stuff, but we know the - * admin/goods/slop breakdown.) - */ -#define TICK_ALLOC_PRIM(a,g,s) \ - ALLOC_PRIM_ctr++; ALLOC_PRIM_adm += (a); \ - ALLOC_PRIM_gds += (g); ALLOC_PRIM_slp += (s); \ - TICK_ALLOC_HISTO(PRIM,a,g,s) - -#define TICK_ALLOC_PRIM2(w) ALLOC_PRIM_ctr++; ALLOC_PRIM_gds +=(w); \ - TICK_ALLOC_HISTO(PRIM,0,w,0) - - -/* ----------------------------------------------------------------------------- - Enters - -------------------------------------------------------------------------- */ - -#define TICK_ENT_VIA_NODE() ENT_VIA_NODE_ctr++ - -#define TICK_ENT_STATIC_THK() ENT_STATIC_THK_ctr++ -#define TICK_ENT_DYN_THK() ENT_DYN_THK_ctr++ - -#define TICK_CTR(f_ct, str, arity, args, arg_kinds) \ - static StgEntCounter f_ct \ - = { 0, arity, args, \ - str, arg_kinds, \ - 0, 0, NULL }; - -#define TICK_ENT_FUN_DIRECT_BODY(f_ct) \ - { \ - if ( ! f_ct.registeredp ) { \ - /* hook this one onto the front of the list */ \ - f_ct.link = ticky_entry_ctrs; \ - ticky_entry_ctrs = & (f_ct); \ - /* mark it as "registered" */ \ - f_ct.registeredp = 1; \ - } \ - f_ct.entry_count += 1; \ - } - -#define TICK_ENT_STATIC_FUN_DIRECT(f_ct) \ - TICK_ENT_FUN_DIRECT_BODY(f_ct) \ - ENT_STATIC_FUN_DIRECT_ctr++ /* The static total one */ - -#define TICK_ENT_DYN_FUN_DIRECT(f_ct) \ - TICK_ENT_FUN_DIRECT_BODY(f_ct) \ - ENT_DYN_FUN_DIRECT_ctr++ /* The dynamic total one */ - -extern StgEntCounter top_ct; -extern StgEntCounter *ticky_entry_ctrs; - -#define TICK_ENT_STATIC_CON(n) ENT_STATIC_CON_ctr++ /* enter static constructor */ -#define TICK_ENT_DYN_CON(n) ENT_DYN_CON_ctr++ /* enter dynamic constructor */ -#define TICK_ENT_STATIC_IND(n) ENT_STATIC_IND_ctr++ /* enter static indirection */ -#define TICK_ENT_DYN_IND(n) ENT_DYN_IND_ctr++ /* enter dynamic indirection */ -#define TICK_ENT_PERM_IND(n) ENT_PERM_IND_ctr++ /* enter permanent indirection */ -#define TICK_ENT_PAP(n) ENT_PAP_ctr++ /* enter PAP */ -#define TICK_ENT_AP(n) ENT_AP_ctr++ /* enter AP_UPD */ -#define TICK_ENT_AP_STACK(n) ENT_AP_STACK_ctr++ /* enter AP_STACK_UPD */ -#define TICK_ENT_BH() ENT_BH_ctr++ /* enter BLACKHOLE */ - - -#define TICK_SLOW_HISTO(n) \ - { unsigned __idx; \ - __idx = (n); \ - SLOW_CALL_hst[((__idx > 8) ? 8 : __idx)] += 1; \ - } - -#define UNDO_TICK_SLOW_HISTO(n) \ - { unsigned __idx; \ - __idx = (n); \ - SLOW_CALL_hst[((__idx > 8) ? 8 : __idx)] -= 1; \ - } - -/* - * A slow call with n arguments. In the unevald case, this call has - * already been counted once, so don't count it again. - */ -#define TICK_SLOW_CALL(n) \ - SLOW_CALL_ctr++; \ - TICK_SLOW_HISTO(n) - -/* - * This slow call was found to be to an unevaluated function; undo the - * ticks we did in TICK_SLOW_CALL. - */ -#define TICK_SLOW_CALL_UNEVALD(n) \ - SLOW_CALL_UNEVALD_ctr++; \ - SLOW_CALL_ctr--; \ - UNDO_TICK_SLOW_HISTO(n) - -#define TICK_MULTI_CHUNK_SLOW_CALL(pattern, chunks) \ - fprintf(stderr, "Multi-chunk slow call: %s\n", pattern); \ - MULTI_CHUNK_SLOW_CALL_ctr++; \ - MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr += chunks; - -/* A completely unknown tail-call */ -#define TICK_UNKNOWN_CALL() UNKNOWN_CALL_ctr++ - -/* - * slow call patterns (includes "extra" args to known calls, - * so the total of these will be greater than UNKNOWN_CALL_ctr). - */ -#define TICK_SLOW_CALL_v() SLOW_CALL_v_ctr++ -#define TICK_SLOW_CALL_f() SLOW_CALL_f_ctr++ -#define TICK_SLOW_CALL_d() SLOW_CALL_d_ctr++ -#define TICK_SLOW_CALL_l() SLOW_CALL_l_ctr++ -#define TICK_SLOW_CALL_n() SLOW_CALL_n_ctr++ -#define TICK_SLOW_CALL_p() SLOW_CALL_p_ctr++ -#define TICK_SLOW_CALL_pv() SLOW_CALL_pv_ctr++ -#define TICK_SLOW_CALL_pp() SLOW_CALL_pp_ctr++ -#define TICK_SLOW_CALL_ppv() SLOW_CALL_ppv_ctr++ -#define TICK_SLOW_CALL_ppp() SLOW_CALL_ppp_ctr++ -#define TICK_SLOW_CALL_pppv() SLOW_CALL_pppv_ctr++ -#define TICK_SLOW_CALL_pppp() SLOW_CALL_pppp_ctr++ -#define TICK_SLOW_CALL_ppppp() SLOW_CALL_ppppp_ctr++ -#define TICK_SLOW_CALL_pppppp() SLOW_CALL_pppppp_ctr++ -#define TICK_SLOW_CALL_OTHER(pattern) \ - fprintf(stderr,"slow call: %s\n", pattern); \ - SLOW_CALL_OTHER_ctr++ - -#define TICK_KNOWN_CALL() KNOWN_CALL_ctr++ -#define TICK_KNOWN_CALL_TOO_FEW_ARGS() KNOWN_CALL_TOO_FEW_ARGS_ctr++ -#define TICK_KNOWN_CALL_EXTRA_ARGS() KNOWN_CALL_EXTRA_ARGS_ctr++ - -/* A slow call to a FUN found insufficient arguments, and built a PAP */ -#define TICK_SLOW_CALL_FUN_TOO_FEW() SLOW_CALL_FUN_TOO_FEW_ctr++ -#define TICK_SLOW_CALL_FUN_CORRECT() SLOW_CALL_FUN_CORRECT_ctr++ -#define TICK_SLOW_CALL_FUN_TOO_MANY() SLOW_CALL_FUN_TOO_MANY_ctr++ -#define TICK_SLOW_CALL_PAP_TOO_FEW() SLOW_CALL_PAP_TOO_FEW_ctr++ -#define TICK_SLOW_CALL_PAP_CORRECT() SLOW_CALL_PAP_CORRECT_ctr++ -#define TICK_SLOW_CALL_PAP_TOO_MANY() SLOW_CALL_PAP_TOO_MANY_ctr++ - -/* ----------------------------------------------------------------------------- - Returns - -------------------------------------------------------------------------- */ - -#define TICK_RET_HISTO(categ,n) \ - { I_ __idx; \ - __idx = (n); \ - RET_##categ##_hst[((__idx > 8) ? 8 : __idx)] += 1;} - -#define TICK_RET_NEW(n) RET_NEW_ctr++; \ - TICK_RET_HISTO(NEW,n) - -#define TICK_RET_OLD(n) RET_OLD_ctr++; \ - TICK_RET_HISTO(OLD,n) - -#define TICK_RET_UNBOXED_TUP(n) RET_UNBOXED_TUP_ctr++; \ - TICK_RET_HISTO(UNBOXED_TUP,n) - -#define TICK_VEC_RETURN(n) VEC_RETURN_ctr++; \ - TICK_RET_HISTO(VEC_RETURN,n) - -/* ----------------------------------------------------------------------------- - Stack Frames - - Macro Counts - ------------------ ------------------------------------------- - TICK_UPDF_PUSHED Update frame pushed - TICK_CATCHF_PUSHED Catch frame pushed - TICK_UPDF_OMITTED A thunk decided not to push an update frame - TICK_UPDF_RCC_PUSHED Cost Centre restore frame pushed - TICK_UPDF_RCC_OMITTED Cost Centres not required -- not pushed - - -------------------------------------------------------------------------- */ - -#define TICK_UPDF_OMITTED() UPDF_OMITTED_ctr++ -#define TICK_UPDF_PUSHED(tgt,inf) UPDF_PUSHED_ctr++ \ -/* ; fprintf(stderr,"UPDF_PUSHED:%p:%p\n",tgt,inf) */ -#define TICK_CATCHF_PUSHED() CATCHF_PUSHED_ctr++ -#define TICK_UPDF_RCC_PUSHED() UPDF_RCC_PUSHED_ctr++ -#define TICK_UPDF_RCC_OMITTED() UPDF_RCC_OMITTED_ctr++ - -/* ----------------------------------------------------------------------------- - Updates - - These macros record information when we do an update. We always - update either with a data constructor (CON) or a partial application - (PAP). - - - Macro Where - ----------------------- -------------------------------------------- - TICK_UPD_SQUEEZED Same as UPD_EXISTING but because - of stack-squeezing - - TICK_UPD_CON_IN_NEW Allocating a new CON - TICK_UPD_CON_IN_PLACE Updating with a PAP in place - TICK_UPD_PAP_IN_NEW Allocating a new PAP - TICK_UPD_PAP_IN_PLACE Updating with a PAP in place - - ToDo: the IN_PLACE versions are not relevant any more. - -------------------------------------------------------------------------- */ - -#define TICK_UPD_HISTO(categ,n) \ - { I_ __idx; \ - __idx = (n); \ - UPD_##categ##_hst[((__idx > 8) ? 8 : __idx)] += 1;} - -#define TICK_UPD_SQUEEZED() UPD_SQUEEZED_ctr++ - -#define TICK_UPD_CON_IN_NEW(n) UPD_CON_IN_NEW_ctr++ ; \ - TICK_UPD_HISTO(CON_IN_NEW,n) - -#define TICK_UPD_CON_IN_PLACE(n) UPD_CON_IN_PLACE_ctr++; \ - TICK_UPD_HISTO(CON_IN_PLACE,n) - -#define TICK_UPD_PAP_IN_NEW(n) UPD_PAP_IN_NEW_ctr++ ; \ - TICK_UPD_HISTO(PAP_IN_NEW,n) - -#define TICK_UPD_PAP_IN_PLACE() UPD_PAP_IN_PLACE_ctr++ - -/* For the generational collector: - */ -#define TICK_UPD_NEW_IND() UPD_NEW_IND_ctr++ -#define TICK_UPD_NEW_PERM_IND(tgt) UPD_NEW_PERM_IND_ctr++ \ -/* ; fprintf(stderr,"UPD_NEW_PERM:%p\n",tgt) */ -#define TICK_UPD_OLD_IND() UPD_OLD_IND_ctr++ -#define TICK_UPD_OLD_PERM_IND() UPD_OLD_PERM_IND_ctr++ - -/* Count blackholes: - */ -#define TICK_UPD_BH_UPDATABLE() UPD_BH_UPDATABLE_ctr++ -#define TICK_UPD_BH_SINGLE_ENTRY() UPD_BH_SINGLE_ENTRY_ctr++ -#define TICK_UPD_CAF_BH_UPDATABLE(s) \ - UPD_CAF_BH_UPDATABLE_ctr++ \ -/* ; fprintf(stderr,"TICK_UPD_CAF_BH_UPDATABLE(%s)\n",s) */ -#define TICK_UPD_CAF_BH_SINGLE_ENTRY(s) \ - UPD_CAF_BH_SINGLE_ENTRY_ctr++ \ -/* ; fprintf(stderr,"TICK_UPD_CAF_BH_SINGLE_ENTRY(%s)\n",s) */ - - -/* ----------------------------------------------------------------------------- - Garbage collection counters - -------------------------------------------------------------------------- */ - -/* Selectors: - * - * GC_SEL_ABANDONED: we could've done the selection, but we gave up - * (e.g., to avoid overflowing the C stack); GC_SEL_MINOR: did a - * selection in a minor GC; GC_SEL_MAJOR: ditto, but major GC. - */ -#define TICK_GC_SEL_ABANDONED() GC_SEL_ABANDONED_ctr++ -#define TICK_GC_SEL_MINOR() GC_SEL_MINOR_ctr++ -#define TICK_GC_SEL_MAJOR() GC_SEL_MAJOR_ctr++ - -/* Failed promotion: we wanted to promote an object early, but - * it had already been evacuated to (or resided in) a younger - * generation. - */ -#define TICK_GC_FAILED_PROMOTION() GC_FAILED_PROMOTION_ctr++ - -/* Bytes copied: this is a fairly good measure of GC cost and depends - * on all sorts of things like number of generations, aging, eager - * promotion, generation sizing policy etc. - */ -#define TICK_GC_WORDS_COPIED(n) GC_WORDS_COPIED_ctr+=(n) - -/* ----------------------------------------------------------------------------- - The accumulators (extern decls) - -------------------------------------------------------------------------- */ - -#ifdef TICKY_C -#define INIT(ializer) = ializer -#define EXTERN -#else -#define INIT(ializer) -#define EXTERN extern -#endif - -EXTERN unsigned long ALLOC_HEAP_ctr INIT(0); -EXTERN unsigned long ALLOC_HEAP_tot INIT(0); - -EXTERN unsigned long ALLOC_FUN_ctr INIT(0); -EXTERN unsigned long ALLOC_FUN_adm INIT(0); -EXTERN unsigned long ALLOC_FUN_gds INIT(0); -EXTERN unsigned long ALLOC_FUN_slp INIT(0); -EXTERN unsigned long ALLOC_FUN_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} /* urk, can't use INIT macro 'cause of the commas */ -#endif -; - -EXTERN unsigned long ALLOC_UP_THK_ctr INIT(0); -EXTERN unsigned long ALLOC_SE_THK_ctr INIT(0); -EXTERN unsigned long ALLOC_THK_adm INIT(0); -EXTERN unsigned long ALLOC_THK_gds INIT(0); -EXTERN unsigned long ALLOC_THK_slp INIT(0); -EXTERN unsigned long ALLOC_THK_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -EXTERN unsigned long ALLOC_CON_ctr INIT(0); -EXTERN unsigned long ALLOC_CON_adm INIT(0); -EXTERN unsigned long ALLOC_CON_gds INIT(0); -EXTERN unsigned long ALLOC_CON_slp INIT(0); -EXTERN unsigned long ALLOC_CON_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -EXTERN unsigned long ALLOC_TUP_ctr INIT(0); -EXTERN unsigned long ALLOC_TUP_adm INIT(0); -EXTERN unsigned long ALLOC_TUP_gds INIT(0); -EXTERN unsigned long ALLOC_TUP_slp INIT(0); -EXTERN unsigned long ALLOC_TUP_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -EXTERN unsigned long ALLOC_BH_ctr INIT(0); -EXTERN unsigned long ALLOC_BH_adm INIT(0); -EXTERN unsigned long ALLOC_BH_gds INIT(0); -EXTERN unsigned long ALLOC_BH_slp INIT(0); -EXTERN unsigned long ALLOC_BH_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -EXTERN unsigned long ALLOC_PRIM_ctr INIT(0); -EXTERN unsigned long ALLOC_PRIM_adm INIT(0); -EXTERN unsigned long ALLOC_PRIM_gds INIT(0); -EXTERN unsigned long ALLOC_PRIM_slp INIT(0); -EXTERN unsigned long ALLOC_PRIM_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -EXTERN unsigned long ALLOC_PAP_ctr INIT(0); -EXTERN unsigned long ALLOC_PAP_adm INIT(0); -EXTERN unsigned long ALLOC_PAP_gds INIT(0); -EXTERN unsigned long ALLOC_PAP_slp INIT(0); -EXTERN unsigned long ALLOC_PAP_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -EXTERN unsigned long ALLOC_TSO_ctr INIT(0); -EXTERN unsigned long ALLOC_TSO_adm INIT(0); -EXTERN unsigned long ALLOC_TSO_gds INIT(0); -EXTERN unsigned long ALLOC_TSO_slp INIT(0); -EXTERN unsigned long ALLOC_TSO_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -# ifdef PAR -EXTERN unsigned long ALLOC_FMBQ_ctr INIT(0); -EXTERN unsigned long ALLOC_FMBQ_adm INIT(0); -EXTERN unsigned long ALLOC_FMBQ_gds INIT(0); -EXTERN unsigned long ALLOC_FMBQ_slp INIT(0); -EXTERN unsigned long ALLOC_FMBQ_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -EXTERN unsigned long ALLOC_FME_ctr INIT(0); -EXTERN unsigned long ALLOC_FME_adm INIT(0); -EXTERN unsigned long ALLOC_FME_gds INIT(0); -EXTERN unsigned long ALLOC_FME_slp INIT(0); -EXTERN unsigned long ALLOC_FME_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; - -EXTERN unsigned long ALLOC_BF_ctr INIT(0); -EXTERN unsigned long ALLOC_BF_adm INIT(0); -EXTERN unsigned long ALLOC_BF_gds INIT(0); -EXTERN unsigned long ALLOC_BF_slp INIT(0); -EXTERN unsigned long ALLOC_BF_hst[5] -#ifdef TICKY_C - = {0,0,0,0,0} -#endif -; -#endif /* PAR */ - -EXTERN unsigned long ENT_VIA_NODE_ctr INIT(0); -EXTERN unsigned long ENT_STATIC_THK_ctr INIT(0); -EXTERN unsigned long ENT_DYN_THK_ctr INIT(0); -EXTERN unsigned long ENT_STATIC_FUN_DIRECT_ctr INIT(0); -EXTERN unsigned long ENT_DYN_FUN_DIRECT_ctr INIT(0); -EXTERN unsigned long ENT_STATIC_CON_ctr INIT(0); -EXTERN unsigned long ENT_DYN_CON_ctr INIT(0); -EXTERN unsigned long ENT_STATIC_IND_ctr INIT(0); -EXTERN unsigned long ENT_DYN_IND_ctr INIT(0); -EXTERN unsigned long ENT_PERM_IND_ctr INIT(0); -EXTERN unsigned long ENT_PAP_ctr INIT(0); -EXTERN unsigned long ENT_AP_ctr INIT(0); -EXTERN unsigned long ENT_AP_STACK_ctr INIT(0); -EXTERN unsigned long ENT_BH_ctr INIT(0); - -EXTERN unsigned long UNKNOWN_CALL_ctr INIT(0); - -EXTERN unsigned long SLOW_CALL_v_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_f_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_d_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_l_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_n_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_p_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_pv_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_pp_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_ppv_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_ppp_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_pppv_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_pppp_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_ppppp_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_pppppp_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_OTHER_ctr INIT(0); - -EXTERN unsigned long ticky_slow_call_unevald INIT(0); -EXTERN unsigned long SLOW_CALL_ctr INIT(0); -EXTERN unsigned long MULTI_CHUNK_SLOW_CALL_ctr INIT(0); -EXTERN unsigned long MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr INIT(0); -EXTERN unsigned long KNOWN_CALL_ctr INIT(0); -EXTERN unsigned long KNOWN_CALL_TOO_FEW_ARGS_ctr INIT(0); -EXTERN unsigned long KNOWN_CALL_EXTRA_ARGS_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_FUN_TOO_FEW_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_FUN_CORRECT_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_FUN_TOO_MANY_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_PAP_TOO_FEW_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_PAP_CORRECT_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_PAP_TOO_MANY_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_UNEVALD_ctr INIT(0); - -EXTERN unsigned long SLOW_CALL_hst[8] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0} -#endif -; - -EXTERN unsigned long RET_NEW_ctr INIT(0); -EXTERN unsigned long RET_OLD_ctr INIT(0); -EXTERN unsigned long RET_UNBOXED_TUP_ctr INIT(0); - -EXTERN unsigned long VEC_RETURN_ctr INIT(0); - -EXTERN unsigned long RET_NEW_hst[9] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0,0} -#endif -; -EXTERN unsigned long RET_OLD_hst[9] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0,0} -#endif -; -EXTERN unsigned long RET_UNBOXED_TUP_hst[9] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0,0} -#endif -; -EXTERN unsigned long RET_SEMI_IN_HEAP_hst[9] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0,0} -#endif -; -EXTERN unsigned long RET_VEC_RETURN_hst[9] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0,0} -#endif -; - -EXTERN unsigned long RET_SEMI_loads_avoided INIT(0); - -EXTERN unsigned long UPDF_OMITTED_ctr INIT(0); -EXTERN unsigned long UPDF_PUSHED_ctr INIT(0); -EXTERN unsigned long CATCHF_PUSHED_ctr INIT(0); -EXTERN unsigned long UPDF_RCC_PUSHED_ctr INIT(0); -EXTERN unsigned long UPDF_RCC_OMITTED_ctr INIT(0); - -EXTERN unsigned long UPD_SQUEEZED_ctr INIT(0); -EXTERN unsigned long UPD_CON_IN_NEW_ctr INIT(0); -EXTERN unsigned long UPD_CON_IN_PLACE_ctr INIT(0); -EXTERN unsigned long UPD_PAP_IN_NEW_ctr INIT(0); -EXTERN unsigned long UPD_PAP_IN_PLACE_ctr INIT(0); - -EXTERN unsigned long UPD_CON_IN_NEW_hst[9] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0,0} -#endif -; -EXTERN unsigned long UPD_CON_IN_PLACE_hst[9] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0,0} -#endif -; -EXTERN unsigned long UPD_PAP_IN_NEW_hst[9] -#ifdef TICKY_C - = {0,0,0,0,0,0,0,0,0} -#endif -; - -EXTERN unsigned long UPD_NEW_IND_ctr INIT(0); -EXTERN unsigned long UPD_NEW_PERM_IND_ctr INIT(0); -EXTERN unsigned long UPD_OLD_IND_ctr INIT(0); -EXTERN unsigned long UPD_OLD_PERM_IND_ctr INIT(0); - -EXTERN unsigned long UPD_BH_UPDATABLE_ctr INIT(0); -EXTERN unsigned long UPD_BH_SINGLE_ENTRY_ctr INIT(0); -EXTERN unsigned long UPD_CAF_BH_UPDATABLE_ctr INIT(0); -EXTERN unsigned long UPD_CAF_BH_SINGLE_ENTRY_ctr INIT(0); - -EXTERN unsigned long GC_SEL_ABANDONED_ctr INIT(0); -EXTERN unsigned long GC_SEL_MINOR_ctr INIT(0); -EXTERN unsigned long GC_SEL_MAJOR_ctr INIT(0); - -EXTERN unsigned long GC_FAILED_PROMOTION_ctr INIT(0); - -EXTERN unsigned long GC_WORDS_COPIED_ctr INIT(0); - -#undef INIT -#undef EXTERN - -/* ----------------------------------------------------------------------------- - Just stubs if no ticky-ticky profiling - -------------------------------------------------------------------------- */ - -#else /* !TICKY_TICKY */ - -#define TICK_ALLOC_HEAP(words, f_ct) -#define TICK_ALLOC_HEAP_NOCTR(words) - -#define TICK_ALLOC_FUN(g,s) -#define TICK_ALLOC_UP_THK(g,s) -#define TICK_ALLOC_SE_THK(g,s) -#define TICK_ALLOC_CON(g,s) -#define TICK_ALLOC_TUP(g,s) -#define TICK_ALLOC_BH(g,s) -#define TICK_ALLOC_PAP(g,s) -#define TICK_ALLOC_TSO(g,s) -#define TICK_ALLOC_FMBQ(a,g,s) -#define TICK_ALLOC_FME(a,g,s) -#define TICK_ALLOC_BF(a,g,s) -#define TICK_ALLOC_PRIM(a,g,s) -#define TICK_ALLOC_PRIM2(w) - -#define TICK_ENT_VIA_NODE() - -#define TICK_ENT_STATIC_THK() -#define TICK_ENT_DYN_THK() -#define TICK_ENT_STATIC_FUN_DIRECT(n) -#define TICK_ENT_DYN_FUN_DIRECT(n) -#define TICK_ENT_STATIC_CON(n) -#define TICK_ENT_DYN_CON(n) -#define TICK_ENT_STATIC_IND(n) -#define TICK_ENT_DYN_IND(n) -#define TICK_ENT_PERM_IND(n) -#define TICK_ENT_PAP(n) -#define TICK_ENT_AP(n) -#define TICK_ENT_AP_STACK(n) -#define TICK_ENT_BH() - -#define TICK_SLOW_CALL(n) -#define TICK_SLOW_CALL_UNEVALD(n) -#define TICK_SLOW_CALL_FUN_TOO_FEW() -#define TICK_SLOW_CALL_FUN_CORRECT() -#define TICK_SLOW_CALL_FUN_TOO_MANY() -#define TICK_SLOW_CALL_PAP_TOO_FEW() -#define TICK_SLOW_CALL_PAP_CORRECT() -#define TICK_SLOW_CALL_PAP_TOO_MANY() - -#define TICK_SLOW_CALL_v() -#define TICK_SLOW_CALL_f() -#define TICK_SLOW_CALL_d() -#define TICK_SLOW_CALL_l() -#define TICK_SLOW_CALL_n() -#define TICK_SLOW_CALL_p() -#define TICK_SLOW_CALL_pv() -#define TICK_SLOW_CALL_pp() -#define TICK_SLOW_CALL_ppv() -#define TICK_SLOW_CALL_ppp() -#define TICK_SLOW_CALL_pppv() -#define TICK_SLOW_CALL_pppp() -#define TICK_SLOW_CALL_ppppp() -#define TICK_SLOW_CALL_pppppp() -#define TICK_SLOW_CALL_OTHER(pattern) - -#define TICK_KNOWN_CALL() -#define TICK_KNOWN_CALL_TOO_FEW_ARGS() -#define TICK_KNOWN_CALL_EXTRA_ARGS() -#define TICK_UNKNOWN_CALL() - -#define TICK_RET_NEW(n) -#define TICK_RET_OLD(n) -#define TICK_RET_UNBOXED_TUP(n) -#define TICK_RET_SEMI(n) -#define TICK_RET_SEMI_BY_DEFAULT() -#define TICK_RET_SEMI_FAILED(tag) -#define TICK_VEC_RETURN(n) - -#define TICK_UPDF_OMITTED() -#define TICK_UPDF_PUSHED(tgt,inf) -#define TICK_CATCHF_PUSHED() -#define TICK_UPDF_RCC_PUSHED() -#define TICK_UPDF_RCC_OMITTED() - -#define TICK_UPD_SQUEEZED() -#define TICK_UPD_CON_IN_NEW(n) -#define TICK_UPD_CON_IN_PLACE(n) -#define TICK_UPD_PAP_IN_NEW(n) -#define TICK_UPD_PAP_IN_PLACE() - -#define TICK_UPD_NEW_IND() -#define TICK_UPD_NEW_PERM_IND(tgt) -#define TICK_UPD_OLD_IND() -#define TICK_UPD_OLD_PERM_IND() - -#define TICK_UPD_BH_UPDATABLE() -#define TICK_UPD_BH_SINGLE_ENTRY() -#define TICK_UPD_CAF_BH_UPDATABLE() -#define TICK_UPD_CAF_BH_SINGLE_ENTRY() - -#define TICK_GC_SEL_ABANDONED() -#define TICK_GC_SEL_MINOR() -#define TICK_GC_SEL_MAJOR() - -#define TICK_GC_FAILED_PROMOTION() -#define TICK_GC_WORDS_COPIED(n) - -#endif /* !TICKY_TICKY */ - -#endif /* TICKY_H */ diff --git a/includes/TickyCounters.h b/includes/TickyCounters.h new file mode 100644 index 0000000..e676a78 --- /dev/null +++ b/includes/TickyCounters.h @@ -0,0 +1,203 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2007 + * + * Declarations for counters used by ticky-ticky profiling. + *----------------------------------------------------------------------------- */ + + +#ifndef TICKYCOUNTERS_H +#define TICKYCOUNTERS_H + +/* These should probably be automatically generated in order to + keep them consistent with the macros that use them (which are + defined in Cmm.h. */ + +#ifdef TICKY_TICKY +/* same trick as in the former StgTicky.h: recycle the same declarations + for both extern decls (which are included everywhere) + and initializations (which only happen once) */ +#ifdef TICKY_C +#define INIT(ializer) = ializer +#define EXTERN +#else +#define INIT(ializer) +#define EXTERN extern +#endif + + +/* Here are all the counter declarations: */ + +EXTERN StgInt ENT_VIA_NODE_ctr INIT(0); +EXTERN StgInt ENT_STATIC_THK_ctr INIT(0); +EXTERN StgInt ENT_DYN_THK_ctr INIT(0); +EXTERN StgInt ENT_STATIC_FUN_DIRECT_ctr INIT(0); +EXTERN StgInt ENT_DYN_FUN_DIRECT_ctr INIT(0); +EXTERN StgInt ENT_STATIC_CON_ctr INIT(0); +EXTERN StgInt ENT_DYN_CON_ctr INIT(0); +EXTERN StgInt ENT_STATIC_IND_ctr INIT(0); +EXTERN StgInt ENT_DYN_IND_ctr INIT(0); +EXTERN StgInt ENT_PERM_IND_ctr INIT(0); +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 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 ticky_slow_call_unevald; +EXTERN StgInt SLOW_CALL_ctr INIT(0); +EXTERN StgInt MULTI_CHUNK_SLOW_CALL_ctr INIT(0); +EXTERN StgInt MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr INIT(0); +EXTERN StgInt KNOWN_CALL_ctr INIT(0); +EXTERN StgInt KNOWN_CALL_TOO_FEW_ARGS_ctr INIT(0); +EXTERN StgInt KNOWN_CALL_EXTRA_ARGS_ctr INIT(0); +EXTERN StgInt SLOW_CALL_FUN_TOO_FEW_ctr INIT(0); +EXTERN StgInt SLOW_CALL_FUN_CORRECT_ctr INIT(0); +EXTERN StgInt SLOW_CALL_FUN_TOO_MANY_ctr INIT(0); +EXTERN StgInt SLOW_CALL_PAP_TOO_FEW_ctr INIT(0); +EXTERN StgInt SLOW_CALL_PAP_CORRECT_ctr INIT(0); +EXTERN StgInt SLOW_CALL_PAP_TOO_MANY_ctr INIT(0); +EXTERN StgInt SLOW_CALL_UNEVALD_ctr INIT(0); + + +EXTERN StgInt UPDF_OMITTED_ctr INIT(0); +EXTERN StgInt UPDF_PUSHED_ctr INIT(0); +EXTERN StgInt CATCHF_PUSHED_ctr INIT(0); +EXTERN StgInt UPDF_RCC_PUSHED_ctr INIT(0); +EXTERN StgInt UPDF_RCC_OMITTED_ctr INIT(0); + +EXTERN StgInt UPD_SQUEEZED_ctr INIT(0); +EXTERN StgInt UPD_CON_IN_NEW_ctr INIT(0); +EXTERN StgInt UPD_CON_IN_PLACE_ctr INIT(0); +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_FUN_ctr INIT(0); +EXTERN StgInt ALLOC_FUN_adm; +EXTERN StgInt ALLOC_FUN_gds; +EXTERN StgInt ALLOC_FUN_slp; + +EXTERN StgInt UPD_NEW_IND_ctr INIT(0); +EXTERN StgInt UPD_NEW_PERM_IND_ctr INIT(0); +EXTERN StgInt UPD_OLD_IND_ctr INIT(0); +EXTERN StgInt UPD_OLD_PERM_IND_ctr INIT(0); + +EXTERN StgInt UPD_BH_UPDATABLE_ctr INIT(0); +EXTERN StgInt UPD_BH_SINGLE_ENTRY_ctr INIT(0); +EXTERN StgInt UPD_CAF_BH_UPDATABLE_ctr INIT(0); +EXTERN StgInt UPD_CAF_BH_SINGLE_ENTRY_ctr INIT(0); + +EXTERN StgInt GC_SEL_ABANDONED_ctr INIT(0); +EXTERN StgInt GC_SEL_MINOR_ctr INIT(0); +EXTERN StgInt GC_SEL_MAJOR_ctr INIT(0); + +EXTERN StgInt GC_FAILED_PROMOTION_ctr INIT(0); + +EXTERN StgInt GC_WORDS_COPIED_ctr INIT(0); + +EXTERN StgInt ALLOC_UP_THK_ctr INIT(0); +EXTERN StgInt ALLOC_SE_THK_ctr INIT(0); +EXTERN StgInt ALLOC_THK_adm INIT(0); +EXTERN StgInt ALLOC_THK_gds INIT(0); +EXTERN StgInt ALLOC_THK_slp INIT(0); + +EXTERN StgInt ALLOC_CON_ctr INIT(0); +EXTERN StgInt ALLOC_CON_adm INIT(0); +EXTERN StgInt ALLOC_CON_gds INIT(0); +EXTERN StgInt ALLOC_CON_slp INIT(0); + +EXTERN StgInt ALLOC_TUP_ctr INIT(0); +EXTERN StgInt ALLOC_TUP_adm INIT(0); +EXTERN StgInt ALLOC_TUP_gds INIT(0); +EXTERN StgInt ALLOC_TUP_slp INIT(0); + +EXTERN StgInt ALLOC_BH_ctr INIT(0); +EXTERN StgInt ALLOC_BH_adm INIT(0); +EXTERN StgInt ALLOC_BH_gds INIT(0); +EXTERN StgInt ALLOC_BH_slp INIT(0); + +EXTERN StgInt ALLOC_PRIM_ctr INIT(0); +EXTERN StgInt ALLOC_PRIM_adm INIT(0); +EXTERN StgInt ALLOC_PRIM_gds INIT(0); +EXTERN StgInt ALLOC_PRIM_slp INIT(0); + +EXTERN StgInt ALLOC_PAP_ctr INIT(0); +EXTERN StgInt ALLOC_PAP_adm INIT(0); +EXTERN StgInt ALLOC_PAP_gds INIT(0); +EXTERN StgInt ALLOC_PAP_slp INIT(0); + +EXTERN StgInt ALLOC_TSO_ctr INIT(0); +EXTERN StgInt ALLOC_TSO_adm INIT(0); +EXTERN StgInt ALLOC_TSO_gds INIT(0); +EXTERN StgInt ALLOC_TSO_slp INIT(0); + +EXTERN StgInt RET_NEW_ctr INIT(0); +EXTERN StgInt RET_OLD_ctr INIT(0); +EXTERN StgInt RET_UNBOXED_TUP_ctr INIT(0); + +EXTERN StgInt VEC_RETURN_ctr INIT(0); + +EXTERN StgInt RET_SEMI_loads_avoided INIT(0); + +/* End of counter declarations. */ + +/* Here are stubs for a bunch of macros that aren't + implemented yet. */ + +#define TICK_ALLOC_FUN(g,s) +#define TICK_ALLOC_CON(g,s) +#define TICK_ALLOC_TUP(g,s) +#define TICK_ALLOC_BH(g,s) +#define TICK_ALLOC_PAP(g,s) +#define TICK_ALLOC_FMBQ(a,g,s) +#define TICK_ALLOC_FME(a,g,s) +#define TICK_ALLOC_BF(a,g,s) +#define TICK_ALLOC_PRIM2(w) + +#endif /* TICKY_TICKY */ + +/* This is ugly, but the story is: + We got rid of StgTicky.h, which was previously + defining these macros for the benefit of C code + so, we define them here instead (to be no-ops). + (since those macros are only defined in Cmm.h) + + Note that these macros must be defined whether + TICKY_TICKY is defined or not. */ + +#ifndef CMINUSMINUS +#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_GC_WORDS_COPIED(x) +#define TICK_GC_FAILED_PROMOTION() +#define TICK_ALLOC_TSO(g,s) +#define TICK_ALLOC_UP_THK(g,s) +#define TICK_ALLOC_SE_THK(g,s) + +#endif + + +#endif /* TICKYCOUNTERS_H */ diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c index ec081fb..8e3ac2b 100644 --- a/includes/mkDerivedConstants.c +++ b/includes/mkDerivedConstants.c @@ -261,7 +261,8 @@ main(int argc, char *argv[]) struct_field(StgEntCounter, allocs); struct_field(StgEntCounter, registeredp); struct_field(StgEntCounter, link); - + struct_field(StgEntCounter, entry_count); + closure_size(StgUpdateFrame); closure_size(StgCatchFrame); closure_size(StgStopFrame); diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 7193876..deb38e0 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -397,7 +397,7 @@ hs_exit(void) /* stop the ticker */ stopTimer(); - + /* reset the standard file descriptors to blocking mode */ resetNonBlockingFd(0); resetNonBlockingFd(1); diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index 0323618..93de540 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -294,7 +294,7 @@ INFO_TABLE(stg_IND_OLDGEN_PERM,1,0,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN #if defined(TICKY_TICKY) && !defined(PROFILING) /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */ - TICK_ENT_PERM_IND(R1); /* tick */ + TICK_ENT_PERM_IND(); /* tick */ #endif LDV_ENTER(R1); diff --git a/rts/Ticky.c b/rts/Ticky.c index 294e12b..d6ac172 100644 --- a/rts/Ticky.c +++ b/rts/Ticky.c @@ -11,6 +11,7 @@ #define TICKY_C /* define those variables */ #include "PosixSource.h" #include "Rts.h" +#include "TickyCounters.h" #include "RtsFlags.h" #include "Ticky.h" @@ -30,6 +31,7 @@ void PrintTickyInfo(void) { unsigned long i; + unsigned long tot_allocs = /* total number of things allocated */ ALLOC_FUN_ctr + ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr + ALLOC_CON_ctr + ALLOC_TUP_ctr + + ALLOC_TSO_ctr + ALLOC_BH_ctr + ALLOC_PAP_ctr + ALLOC_PRIM_ctr @@ -67,6 +69,7 @@ PrintTickyInfo(void) unsigned long tot_thk_enters = ENT_STATIC_THK_ctr + ENT_DYN_THK_ctr; unsigned long tot_con_enters = ENT_STATIC_CON_ctr + ENT_DYN_CON_ctr; + unsigned long tot_fun_direct_enters = ENT_STATIC_FUN_DIRECT_ctr + ENT_DYN_FUN_DIRECT_ctr; unsigned long tot_ind_enters = ENT_STATIC_IND_ctr + ENT_DYN_IND_ctr; @@ -84,12 +87,13 @@ PrintTickyInfo(void) unsigned long tot_tail_calls = UNKNOWN_CALL_ctr + tot_known_calls; - unsigned long tot_enters = - tot_con_enters + tot_fun_direct_enters + + unsigned long tot_enters = + tot_con_enters + tot_fun_direct_enters + tot_ind_enters + ENT_PERM_IND_ctr + ENT_PAP_ctr + tot_thk_enters; unsigned long jump_direct_enters = tot_enters - ENT_VIA_NODE_ctr; + unsigned long tot_returns = RET_NEW_ctr + RET_OLD_ctr + RET_UNBOXED_TUP_ctr; @@ -106,6 +110,8 @@ PrintTickyInfo(void) FILE *tf = RtsFlags.TickyFlags.tickyFile; + /* krc: avoid dealing with this just now */ +#if FALSE fprintf(tf,"\n\nALLOCATIONS: %ld (%ld words total: %ld admin, %ld goods, %ld slop)\n", tot_allocs, tot_wds, tot_adm_wds, tot_gds_wds, tot_slp_wds); fprintf(tf,"\t\t\t\ttotal words:\t 2 3 4 5 6+\n"); @@ -122,6 +128,7 @@ PrintTickyInfo(void) 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", ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr, @@ -185,12 +192,16 @@ PrintTickyInfo(void) if (ALLOC_BF_ctr != 0) fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BF)); #endif + fprintf(tf,"\n"); fprintf(tf,"\nTotal storage-manager allocations: %ld (%ld words)\n\t[%ld words lost to speculative heap-checks]\n", ALLOC_HEAP_ctr, ALLOC_HEAP_tot, ALLOC_HEAP_tot - tot_wds); +#endif /* FALSE */ + fprintf(tf,"\nSTACK USAGE:\n"); /* NB: some bits are direction sensitive */ + fprintf(tf,"\nENTERS: %ld of which %ld (%.1f%%) direct to the entry code\n\t\t [the rest indirected via Node's info ptr]\n", tot_enters, jump_direct_enters, @@ -208,6 +219,7 @@ PrintTickyInfo(void) ENT_PERM_IND_ctr, PC(INTAVG(ENT_PERM_IND_ctr,tot_enters))); + fprintf(tf,"\nFUNCTION ENTRIES: %ld\n", tot_fun_direct_enters); fprintf(tf, "\nTAIL CALLS: %ld, of which %ld (%.lf%%) were to known functions\n", @@ -232,6 +244,9 @@ PrintTickyInfo(void) VEC_RETURN_ctr, PC(INTAVG(VEC_RETURN_ctr,tot_returns))); + /* krc: comment out some of this stuff temporarily */ + + /* fprintf(tf, "\nRET_NEW: %7ld: ", RET_NEW_ctr); for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%", PC(INTAVG(RET_NEW_hst[i],RET_NEW_ctr))); } @@ -249,6 +264,7 @@ PrintTickyInfo(void) for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%", PC(INTAVG(RET_VEC_RETURN_hst[i],VEC_RETURN_ctr))); } fprintf(tf, "\n"); + */ fprintf(tf,"\nUPDATE FRAMES: %ld (%ld omitted from thunks)", UPDF_PUSHED_ctr, @@ -274,6 +290,8 @@ PrintTickyInfo(void) 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, "\n"); @@ -283,6 +301,7 @@ PrintTickyInfo(void) 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, "\n"); +#endif if (tot_gengc_updates != 0) { fprintf(tf,"\nNEW GEN UPDATES: %9ld (%5.1f%%)\n", @@ -320,6 +339,8 @@ PrintTickyInfo(void) PR_CTR(ALLOC_FUN_adm); PR_CTR(ALLOC_FUN_gds); PR_CTR(ALLOC_FUN_slp); + + /* krc: comment out some of this stuff temporarily PR_HST(ALLOC_FUN_hst,0); PR_HST(ALLOC_FUN_hst,1); PR_HST(ALLOC_FUN_hst,2); @@ -420,6 +441,7 @@ PrintTickyInfo(void) PR_HST(ALLOC_BF_hst,3); PR_HST(ALLOC_BF_hst,4); #endif + */ PR_CTR(ENT_VIA_NODE_ctr); PR_CTR(ENT_STATIC_CON_ctr); @@ -481,6 +503,9 @@ PrintTickyInfo(void) PR_CTR(SLOW_CALL_PAP_CORRECT_ctr); PR_CTR(SLOW_CALL_PAP_TOO_MANY_ctr); PR_CTR(SLOW_CALL_UNEVALD_ctr); + + /* krc: put off till later... */ +#if FALSE PR_HST(SLOW_CALL_hst,0); PR_HST(SLOW_CALL_hst,1); PR_HST(SLOW_CALL_hst,2); @@ -489,12 +514,15 @@ PrintTickyInfo(void) PR_HST(SLOW_CALL_hst,5); PR_HST(SLOW_CALL_hst,6); PR_HST(SLOW_CALL_hst,7); +#endif PR_CTR(RET_NEW_ctr); PR_CTR(RET_OLD_ctr); PR_CTR(RET_UNBOXED_TUP_ctr); PR_CTR(VEC_RETURN_ctr); + /* krc: put off till later... */ +#if FALSE PR_HST(RET_NEW_hst,0); PR_HST(RET_NEW_hst,1); PR_HST(RET_NEW_hst,2); @@ -531,6 +559,7 @@ PrintTickyInfo(void) PR_HST(RET_VEC_RETURN_hst,6); PR_HST(RET_VEC_RETURN_hst,7); PR_HST(RET_VEC_RETURN_hst,8); +#endif /* FALSE */ PR_CTR(UPDF_OMITTED_ctr); PR_CTR(UPDF_PUSHED_ctr); @@ -550,6 +579,8 @@ PrintTickyInfo(void) PR_CTR(UPD_CAF_BH_UPDATABLE_ctr); PR_CTR(UPD_CAF_BH_SINGLE_ENTRY_ctr); + /* krc: put off till later...*/ +#if FALSE PR_HST(UPD_CON_IN_NEW_hst,0); PR_HST(UPD_CON_IN_NEW_hst,1); PR_HST(UPD_CON_IN_NEW_hst,2); @@ -568,6 +599,7 @@ PrintTickyInfo(void) PR_HST(UPD_PAP_IN_NEW_hst,6); PR_HST(UPD_PAP_IN_NEW_hst,7); PR_HST(UPD_PAP_IN_NEW_hst,8); +#endif /* FALSE */ PR_CTR(UPD_NEW_IND_ctr); /* see comment on ENT_PERM_IND_ctr */ diff --git a/rts/Updates.cmm b/rts/Updates.cmm index 1d2fc5f..6265f90 100644 --- a/rts/Updates.cmm +++ b/rts/Updates.cmm @@ -10,6 +10,7 @@ * * ---------------------------------------------------------------------------*/ + #include "Cmm.h" #include "Updates.h" #include "StgLdvProf.h" @@ -52,8 +53,8 @@ /* remove the update frame from the stack */ \ Sp = Sp + SIZEOF_StgUpdateFrame; \ \ - /* ToDo: it might be a PAP, so we should check... */ \ - TICK_UPD_CON_IN_NEW(sizeW_fromITBL(%GET_STD_INFO(updatee))); \ + /* ToDo: it might be a PAP, so we should check... */ \ + TICK_UPD_CON_IN_NEW(sizeW_fromITBL(%GET_STD_INFO(updatee))); \ \ UPD_SPEC_IND(updatee, ind_info, R1, jump (ret)); \ } diff --git a/rts/Updates.h b/rts/Updates.h index abca788..3461c91 100644 --- a/rts/Updates.h +++ b/rts/Updates.h @@ -23,21 +23,14 @@ -------------------------------------------------------------------------- */ -#ifdef TICKY_TICKY -# define UPD_IND(updclosure, heapptr) \ - UPD_PERM_IND(updclosure,heapptr) -# define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \ - UPD_PERM_IND(updclosure,heapptr); and_then -#else # define SEMI ; # define UPD_IND(updclosure, heapptr) \ UPD_REAL_IND(updclosure,INFO_PTR(stg_IND_info),heapptr,SEMI) # define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \ UPD_REAL_IND(updclosure,ind_info,heapptr,and_then) -#endif /* These macros have to work in both C and C--, so here's the - * impedence matching: + * impedance matching: */ #ifdef CMINUSMINUS #define BLOCK_BEGIN @@ -57,9 +50,10 @@ #define ARG_PTR /* nothing */ #endif -/* UPD_IND actually does a PERM_IND if TICKY_TICKY is on; - if you *really* need an IND use UPD_REAL_IND - */ +/* krc: there used to be an UPD_REAL_IND and an + UPD_PERM_IND, the latter of which was used for + ticky and cost-centre profiling. + for now, we just have UPD_REAL_IND. */ #define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then) \ BLOCK_BEGIN \ DECLARE_IPTR(info); \ @@ -70,34 +64,18 @@ and_then); \ BLOCK_END -#if defined(PROFILING) || defined(TICKY_TICKY) -#define UPD_PERM_IND(updclosure, heapptr) \ - BLOCK_BEGIN \ - updateWithPermIndirection(updclosure, \ - heapptr); \ - BLOCK_END -#endif - #if defined(RTS_SUPPORTS_THREADS) -# ifdef TICKY_TICKY -# define UPD_IND_NOLOCK(updclosure, heapptr) \ - BLOCK_BEGIN \ - updateWithPermIndirection(updclosure, \ - heapptr); \ - BLOCK_END -# else # define UPD_IND_NOLOCK(updclosure, heapptr) \ BLOCK_BEGIN \ updateWithIndirection(INFO_PTR(stg_IND_info), \ updclosure, \ heapptr,); \ BLOCK_END -# endif #else #define UPD_IND_NOLOCK(updclosure,heapptr) UPD_IND(updclosure,heapptr) -#endif +#endif /* RTS_SUPPORTS_THREADS */ /* ----------------------------------------------------------------------------- Awaken any threads waiting on a blocking queue (BLACKHOLE_BQ). @@ -321,49 +299,5 @@ no_slop: and_then; \ } \ } -#endif - -/* The permanent indirection version isn't performance critical. We - * therefore use an inline C function instead of the C-- macro. - */ -#ifndef CMINUSMINUS -INLINE_HEADER void -updateWithPermIndirection(StgClosure *p1, - StgClosure *p2) -{ - bdescr *bd; - - ASSERT( p1 != p2 && !closure_IND(p1) ); - - /* - * @LDV profiling - * Destroy the old closure. - * Nb: LDV_* stuff cannot mix with ticky-ticky - */ - LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); - - bd = Bdescr((P_)p1); - if (bd->gen_no != 0) { - recordMutableGenLock(p1, &generations[bd->gen_no]); - ((StgInd *)p1)->indirectee = p2; - SET_INFO(p1, &stg_IND_OLDGEN_PERM_info); - /* - * @LDV profiling - * We have just created a new closure. - */ - LDV_RECORD_CREATE(p1); - TICK_UPD_OLD_PERM_IND(); - } else { - ((StgInd *)p1)->indirectee = p2; - SET_INFO(p1, &stg_IND_PERM_info); - /* - * @LDV profiling - * We have just created a new closure. - */ - LDV_RECORD_CREATE(p1); - TICK_UPD_NEW_PERM_IND(p1); - } -} -#endif - +#endif /* CMINUSMINUS */ #endif /* UPDATES_H */ diff --git a/utils/genapply/GenApply.hs b/utils/genapply/GenApply.hs index 39d8506..e9f335d 100644 --- a/utils/genapply/GenApply.hs +++ b/utils/genapply/GenApply.hs @@ -202,7 +202,7 @@ genMkPAP regstatus macro jump ticker disamb smaller_arity arity = text "if (arity == " <> int arity <> text ") {" $$ nest 4 (vcat [ - text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();", + -- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();", -- load up regs for the call, if necessary load_regs, @@ -300,7 +300,7 @@ genMkPAP regstatus macro jump ticker disamb | otherwise = loadRegArgs regstatus stk_args_offset args in nest 4 (vcat [ - text "TICK_SLOW_CALL_" <> text ticker <> text "_CORRECT();", +-- text "TICK_SLOW_CALL_" <> text ticker <> text "_CORRECT();", reg_doc, text "Sp_adj(" <> int sp' <> text ");", if is_pap @@ -326,7 +326,7 @@ genMkPAP regstatus macro jump ticker disamb empty in nest 4 (vcat [ - text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_FEW();", +-- text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_FEW();", save_regs, text macro <> char '(' <> int n_args <> comma <> int all_args_size <> @@ -396,7 +396,7 @@ genApply regstatus args = -- text "IF_DEBUG(sanity,checkStackChunk(Sp+" <> int (1 + all_args_size) <> -- text ", CurrentTSO->stack + CurrentTSO->stack_size));", - text "TICK_SLOW_CALL(" <> int (length args) <> text ");", +-- text "TICK_SLOW_CALL(" <> int (length args) <> text ");", let do_assert [] _ = [] do_assert (arg:args) offset @@ -483,7 +483,7 @@ genApply regstatus args = text " THUNK_STATIC,", text " THUNK_SELECTOR: {", nest 4 (vcat [ - text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");", +-- text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");", text "Sp(0) = " <> fun_info_label <> text ";", -- CAREFUL! in SMP mode, the info table may already have been -- overwritten by an indirection, so we must enter the original