summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
0ee0be1)
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).
import ListSetOps
import Util
import FastString
import ListSetOps
import Util
import FastString
+import StaticFlags
+
+import Control.Monad
cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
cgReturnDataCon con amodes
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
= ASSERT( amodes `lengthIs` dataConRepArity con )
do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
; case sequel of
| isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
| otherwise -> build_it_then (jump_to deflt_lbl) }
| 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
+ 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
jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
build_it_then return_code
= do { -- BUILD THE OBJECT IN THE HEAP
import StgSyn
import PrimOp
import Outputable
import StgSyn
import PrimOp
import Outputable
untag_node = CmmAssign nodeReg (cmmUntag (CmmReg nodeReg))
-- Test if closure is a constructor
maybeSwitchOnCons enterClosure eob
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
= do { is_constr <- newLabelC
-- Is the pointer tagged?
-- Yes, jump to switch statement
| otherwise = DirectEntry (enterIdLabel name caf) arity
getCallMethod _ _ _ (LFCon con) 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
= ASSERT( n_args == 0 )
ReturnCon con
Indirections can contain tagged pointers, so their tag is checked.
-------------------------------------------------------------------------- */
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; \
#define ENTER() \
again: \
W_ info; \
- if (GETTAG(P1) != 0) { \
- jump %ENTRY_CODE(Sp(0)); \
- } \
- info = %INFO_PTR(P1); \
switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \
(TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \
case \
switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \
(TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \
case \
jump %ENTRY_CODE(info); \
} \
}
jump %ENTRY_CODE(info); \
} \
}
* so we untag it before accessing the field.
*
*/
* 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); \
INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_SMALL, RET_PARAMS) \
{ \
R1 = StgClosure_payload(UNTAG(R1),offset); \
W_[Sp-WITHUPD_FRAME_SIZE] = stg_sel_ret_##offset##_upd_info; \
Sp = Sp - WITHUPD_FRAME_SIZE; \
R1 = StgThunk_payload(R1,0); \
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); \
}
/* 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. */
}
/* 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. */