diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2013-10-11 10:35:14 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2013-10-11 10:37:02 +0100 |
| commit | 83be3d7b8881eca63adf834e425e6799e572bd1f (patch) | |
| tree | c810919459e70599b51e094be3d7e8024c4f1307 | |
| parent | 8ea8c371f345e3a265d425b37e793d8b553a1588 (diff) | |
| download | haskell-83be3d7b8881eca63adf834e425e6799e572bd1f.tar.gz | |
Fix a bug in the canned selector code when profiling.
| -rw-r--r-- | compiler/codeGen/StgCmm.hs | 7 | ||||
| -rw-r--r-- | rts/StgStdThunks.cmm | 22 |
2 files changed, 21 insertions, 8 deletions
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index bf950c4158..a92f80439b 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -233,7 +233,12 @@ cgDataCon data_con $ mk_code ticky_code mk_code ticky_code - = -- NB: We don't set CC when entering data (WDP 94/06) + = -- NB: the closure pointer is assumed *untagged* on + -- entry to a constructor. If the pointer is tagged, + -- then we should not be entering it. This assumption + -- is used in ldvEnter and when tagging the pointer to + -- return it. + -- NB 2: We don't set CC when entering data (WDP 94/06) do { _ <- ticky_code ; ldvEnter (CmmReg nodeReg) ; tickyReturnOldCon (length arg_things) diff --git a/rts/StgStdThunks.cmm b/rts/StgStdThunks.cmm index 979f7498ca..ba15d3c1fc 100644 --- a/rts/StgStdThunks.cmm +++ b/rts/StgStdThunks.cmm @@ -49,9 +49,15 @@ * */ #ifdef PROFILING -// When profiling, we cannot shortcut by checking the tag, -// because LDV profiling relies on entering closures to mark them as -// "used". +/* When profiling, we cannot shortcut by checking the tag, + * because LDV profiling relies on entering closures to mark them as + * "used". + * + * Note [untag for prof]: when we enter a closure, the convention is + * that the closure pointer passed in the first argument is + * *untagged*. Without profiling we don't have to worry about this, + * because we never enter a tagged pointer. + */ #define NEED_EVAL(__x__) 1 #else #define NEED_EVAL(__x__) GETTAG(__x__) == 0 @@ -61,7 +67,7 @@ INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \ (P_ node) \ { \ - P_ selectee, field; \ + P_ selectee, field, dest; \ TICK_ENT_DYN_THK(); \ STK_CHK_NP(node); \ UPD_BH_UPDATABLE(node); \ @@ -71,7 +77,8 @@ ENTER_CCS_THUNK(node); \ if (NEED_EVAL(selectee)) { \ SAVE_CCS; \ - (P_ constr) = call %GET_ENTRY(UNTAG_IF_PROF(selectee)) (selectee); \ + dest = UNTAG_IF_PROF(selectee); /* Note [untag for prof] */ \ + (P_ constr) = call %GET_ENTRY(dest) (dest); \ RESTORE_CCS; \ selectee = constr; \ } \ @@ -105,7 +112,7 @@ SELECTOR_CODE_UPD(15) INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd") \ (P_ node) \ { \ - P_ selectee, field; \ + P_ selectee, field, dest; \ TICK_ENT_DYN_THK(); \ STK_CHK_NP(node); \ UPD_BH_UPDATABLE(node); \ @@ -114,7 +121,8 @@ SELECTOR_CODE_UPD(15) ENTER_CCS_THUNK(node); \ if (NEED_EVAL(selectee)) { \ SAVE_CCS; \ - (P_ constr) = call %GET_ENTRY(UNTAG_IF_PROF(selectee)) (selectee); \ + dest = UNTAG_IF_PROF(selectee); /* Note [untag for prof] */ \ + (P_ constr) = call %GET_ENTRY(dest) (dest); \ RESTORE_CCS; \ selectee = constr; \ } \ |