diff options
author | Simon Marlow <marlowsd@gmail.com> | 2009-03-17 14:49:39 +0000 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2009-03-17 14:49:39 +0000 |
commit | f8f4cb3f3a46e0495917a927cefe906531b7b38e (patch) | |
tree | d73d7f883bda109e68dca56cc9ab6e5258aa8e6d /includes/Cmm.h | |
parent | 0ee0be109fd00ec629f7a2ad6a597885a0c9d5b4 (diff) | |
download | haskell-f8f4cb3f3a46e0495917a927cefe906531b7b38e.tar.gz |
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).
Diffstat (limited to 'includes/Cmm.h')
-rw-r--r-- | includes/Cmm.h | 30 |
1 files changed, 26 insertions, 4 deletions
diff --git a/includes/Cmm.h b/includes/Cmm.h index 06a66a79ef..da0a2ac6bd 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); \ } \ } |