X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=includes%2FCmm.h;h=e3f46e143be84fc627179bde90d5a7965b4d489c;hb=da6785e5a241f65fdc8b3d393c576865e059acd4;hp=99158304516ce1f11b9038e0ab19f005484aca93;hpb=8f52645bd99ee3e636a34826c0cbfc5939920da1;p=ghc-hetmet.git diff --git a/includes/Cmm.h b/includes/Cmm.h index 9915830..e3f46e1 100644 --- a/includes/Cmm.h +++ b/includes/Cmm.h @@ -88,6 +88,7 @@ #define I16 bits16 #define I32 bits32 #define I64 bits64 +#define P_ gcptr #if SIZEOF_VOID_P == 4 #define W_ bits32 @@ -251,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(R1) != 0) { \ - jump %ENTRY_CODE(Sp(0)); \ - } \ - info = %INFO_PTR(R1); \ + LOAD_INFO \ switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \ (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \ case \ @@ -267,7 +289,7 @@ IND_OLDGEN_PERM, \ IND_STATIC: \ { \ - R1 = StgInd_indirectee(R1); \ + P1 = StgInd_indirectee(P1); \ goto again; \ } \ case \ @@ -276,6 +298,7 @@ FUN_0_1, \ FUN_2_0, \ FUN_1_1, \ + FUN_0_2, \ FUN_STATIC, \ BCO, \ PAP: \ @@ -284,6 +307,7 @@ } \ default: \ { \ + UNTAG_R1 \ jump %ENTRY_CODE(info); \ } \ } @@ -301,7 +325,7 @@ #include "ClosureTypes.h" #include "StgFun.h" #include "OSThreads.h" -#include "SMP.h" +#include "SMPClosureOps.h" /* * Need MachRegs, because some of the RTS code is conditionally @@ -562,7 +586,7 @@ bdescr_free(__bd) = free + WDS(1); #define recordMutable(p, regs) \ - W_ __p; \ + P_ __p; \ W_ __bd; \ W_ __gen; \ __p = p; \