From f8f4cb3f3a46e0495917a927cefe906531b7b38e Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Tue, 17 Mar 2009 14:49:39 +0000 Subject: [PATCH] FIX biographical profiling (#3039, probably #2297) Since we introduced pointer tagging, we no longer always enter a closure to evaluate it. However, the biographical profiler relies on closures being entered in order to mark them as "used", so we were getting spurious amounts of data attributed to VOID. It turns out there are various places that need to be fixed, and I think at least one of them was also wrong before pointer tagging (CgCon.cgReturnDataCon). --- compiler/codeGen/CgCon.lhs | 15 ++++++++++++--- compiler/codeGen/CgTailCall.lhs | 6 +++++- compiler/codeGen/ClosureInfo.lhs | 4 ++++ includes/Cmm.h | 30 ++++++++++++++++++++++++++---- rts/StgStdThunks.cmm | 22 +++++++++++++++++----- 5 files changed, 64 insertions(+), 13 deletions(-) diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs index a700ccd..0fb90b0 100644 --- a/compiler/codeGen/CgCon.lhs +++ b/compiler/codeGen/CgCon.lhs @@ -47,6 +47,9 @@ import Outputable import ListSetOps import Util import FastString +import StaticFlags + +import Control.Monad \end{code} @@ -296,6 +299,11 @@ sure the @amodes@ passed don't conflict with each other. cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code cgReturnDataCon con amodes + | isUnboxedTupleCon con = returnUnboxedTuple amodes + -- when profiling we can't shortcut here, we have to enter the closure + -- for it to be marked as "used" for LDV profiling. + | opt_SccProfilingOn = build_it_then enter_it + | otherwise = ASSERT( amodes `lengthIs` dataConRepArity con ) do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ; case sequel of @@ -319,11 +327,12 @@ cgReturnDataCon con amodes | isDeadBinder bndr -> performReturn (jump_to deflt_lbl) | otherwise -> build_it_then (jump_to deflt_lbl) } - _ -- The usual case - | isUnboxedTupleCon con -> returnUnboxedTuple amodes - | otherwise -> build_it_then emitReturnInstr + _otherwise -- The usual case + -> build_it_then emitReturnInstr } where + enter_it = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)), + CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg))) [] ] jump_to lbl = stmtC (CmmJump (CmmLit lbl) []) build_it_then return_code = do { -- BUILD THE OBJECT IN THE HEAP diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs index e4f79a7..60a8561 100644 --- a/compiler/codeGen/CgTailCall.lhs +++ b/compiler/codeGen/CgTailCall.lhs @@ -35,6 +35,7 @@ import Id import StgSyn import PrimOp import Outputable +import StaticFlags import Control.Monad @@ -183,7 +184,10 @@ performTailCall fun_info arg_amodes pending_assts untag_node = CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)) -- Test if closure is a constructor maybeSwitchOnCons enterClosure eob - | EndOfBlockInfo _ (CaseAlts lbl _ _) <- eob + | EndOfBlockInfo _ (CaseAlts lbl _ _) <- eob, + not opt_SccProfilingOn + -- we can't shortcut when profiling is on, because we have + -- to enter a closure to mark it as "used" for LDV profiling = do { is_constr <- newLabelC -- Is the pointer tagged? -- Yes, jump to switch statement diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index 9598233..8c36ab2 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -598,6 +598,10 @@ getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args | otherwise = DirectEntry (enterIdLabel name caf) arity getCallMethod _ _ _ (LFCon con) n_args + | opt_SccProfilingOn -- when profiling, we must always enter + = EnterIt -- a closure when we use it, so that the closure + -- can be recorded as used for LDV profiling. + | otherwise = ASSERT( n_args == 0 ) ReturnCon con diff --git a/includes/Cmm.h b/includes/Cmm.h index 06a66a7..da0a2ac 100644 --- a/includes/Cmm.h +++ b/includes/Cmm.h @@ -252,13 +252,34 @@ Indirections can contain tagged pointers, so their tag is checked. -------------------------------------------------------------------------- */ +#ifdef PROFILING + +// When profiling, we cannot shortcut ENTER() by checking the tag, +// because LDV profiling relies on entering closures to mark them as +// "used". + +#define LOAD_INFO \ + info = %INFO_PTR(UNTAG(P1)); + +#define UNTAG_R1 \ + P1 = UNTAG(P1); + +#else + +#define LOAD_INFO \ + if (GETTAG(P1) != 0) { \ + jump %ENTRY_CODE(Sp(0)); \ + } \ + info = %INFO_PTR(P1); + +#define UNTAG_R1 /* nothing */ + +#endif + #define ENTER() \ again: \ W_ info; \ - if (GETTAG(P1) != 0) { \ - jump %ENTRY_CODE(Sp(0)); \ - } \ - info = %INFO_PTR(P1); \ + LOAD_INFO \ switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \ (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \ case \ @@ -285,6 +306,7 @@ } \ default: \ { \ + UNTAG_R1 \ jump %ENTRY_CODE(info); \ } \ } diff --git a/rts/StgStdThunks.cmm b/rts/StgStdThunks.cmm index fecbb4c..be85999 100644 --- a/rts/StgStdThunks.cmm +++ b/rts/StgStdThunks.cmm @@ -52,7 +52,22 @@ * so we untag it before accessing the field. * */ -#define SELECTOR_CODE_UPD(offset) \ +#ifdef PROFILING +// When profiling, we cannot shortcut by checking the tag, +// because LDV profiling relies on entering closures to mark them as +// "used". +#define SEL_ENTER(offset) \ + R1 = UNTAG(R1); \ + jump %GET_ENTRY(R1); +#else +#define SEL_ENTER(offset) \ + if (GETTAG(R1) != 0) { \ + jump RET_LBL(stg_sel_ret_##offset##_upd); \ + } \ + jump %GET_ENTRY(R1); +#endif + +#define SELECTOR_CODE_UPD(offset) \ INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_SMALL, RET_PARAMS) \ { \ R1 = StgClosure_payload(UNTAG(R1),offset); \ @@ -73,10 +88,7 @@ W_[Sp-WITHUPD_FRAME_SIZE] = stg_sel_ret_##offset##_upd_info; \ Sp = Sp - WITHUPD_FRAME_SIZE; \ R1 = StgThunk_payload(R1,0); \ - if (GETTAG(R1) != 0) { \ - jump RET_LBL(stg_sel_ret_##offset##_upd); \ - } \ - jump %GET_ENTRY(R1); \ + SEL_ENTER(offset); \ } /* NOTE: no need to ENTER() here, we know the closure cannot evaluate to a function, because we're going to do a field selection on the result. */ -- 1.7.10.4