Commit f8f4cb3f authored by Simon Marlow's avatar Simon Marlow

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).
parent 0ee0be10
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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); \
} \
}
......
......@@ -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. */
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment