X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=includes%2FCmm.h;fp=includes%2FCmm.h;h=da0a2ac6bdc77af09952ba33d29cd73d77b65565;hb=f8f4cb3f3a46e0495917a927cefe906531b7b38e;hp=06a66a79ef724925a117fa5f8dd43af638409472;hpb=0ee0be109fd00ec629f7a2ad6a597885a0c9d5b4;p=ghc-hetmet.git 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); \ } \ }