X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=includes%2FCmm.h;h=e3f46e143be84fc627179bde90d5a7965b4d489c;hb=a4005d2d0c18ffa72ba7bd0fa052666e70e8c16e;hp=06a66a79ef724925a117fa5f8dd43af638409472;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69;p=ghc-hetmet.git diff --git a/includes/Cmm.h b/includes/Cmm.h index 06a66a7..e3f46e1 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 \ @@ -277,6 +298,7 @@ FUN_0_1, \ FUN_2_0, \ FUN_1_1, \ + FUN_0_2, \ FUN_STATIC, \ BCO, \ PAP: \ @@ -285,6 +307,7 @@ } \ default: \ { \ + UNTAG_R1 \ jump %ENTRY_CODE(info); \ } \ }