[project @ 2002-02-12 15:17:13 by simonmar]
[ghc-hetmet.git] / ghc / rts / StgMiscClosures.hc
index 51b57c3..266b6fd 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.57 2001/01/10 17:21:18 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.73 2002/02/12 15:17:22 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -7,11 +7,11 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#include "Stg.h"
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
 #include "StgMiscClosures.h"
-#include "HeapStackCheck.h"   /* for stg_gen_yield */
 #include "Storage.h"
 #include "StoragePriv.h"
 #include "Profiling.h"
@@ -51,14 +51,12 @@ STGFUN(stg_##type##_entry)                                                  \
    Support for the bytecode interpreter.
    -------------------------------------------------------------------------- */
 
-#ifdef GHCI
-
 /* 9 bits of return code for constructors created by the interpreter. */
 FN_(stg_interp_constr_entry) 
 { 
   /* R1 points at the constructor */
   FB_ 
-    STGCALL2(fprintf,stderr,"stg_interp_constr_entry (direct return)!\n");
+    /* STGCALL2(fprintf,stderr,"stg_interp_constr_entry (direct return)!\n"); */
     /* Pointless, since SET_TAG doesn't do anything */
     SET_TAG( GET_TAG(GET_INFO(R1.cl))); 
     JMP_(ENTRY_CODE((P_)(*Sp))); 
@@ -77,7 +75,7 @@ FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
 /* Some info tables to be used when compiled code returns a value to
    the interpreter, i.e. the interpreter pushes one of these onto the
    stack before entering a value.  What the code does is to
-   impedance-match the compiled return convention (in R1/F1/D1 etc) to
+   impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to
    the interpreter's convention (returned value is on top of stack),
    and then cause the scheduler to enter the interpreter.
 
@@ -87,7 +85,7 @@ FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
       ptr to one of these info tables.
  
    The info table code, both direct and vectored, must:
-      * push R1/F1/D1 on the stack
+      * push R1/F1/D1 on the stack, and its tag if necessary
       * push the BCO (so it's now on the stack twice)
       * Yield, ie, go to the scheduler.
 
@@ -108,8 +106,9 @@ FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
    haven't got a good story about that yet.
 */
 
-/* When the returned value is in R1 ... */
-#define STG_CtoI_RET_R1_Template(label)        \
+/* When the returned value is in R1 and it is a pointer, so doesn't
+   need tagging ... */
+#define STG_CtoI_RET_R1p_Template(label)       \
    IFN_(label)                         \
    {                                    \
       StgPtr bco;                       \
@@ -123,17 +122,50 @@ FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
       FE_                               \
    }
 
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_0_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_1_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_2_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_3_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_4_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_5_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_6_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_7_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_0_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_1_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_2_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_3_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_4_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_5_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1p,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+
+
+/* When the returned value is in R1 and it isn't a pointer. */
+#define STG_CtoI_RET_R1n_Template(label)       \
+   IFN_(label)                         \
+   {                                    \
+      StgPtr bco;                       \
+      FB_                              \
+      bco = ((StgPtr*)Sp)[1];           \
+      Sp -= 1;                         \
+      ((StgPtr*)Sp)[0] = (StgPtr)R1.i; \
+      Sp -= 1;                          \
+      ((StgPtr*)Sp)[0] = (StgPtr)1; /* tag */   \
+      Sp -= 1;                         \
+      ((StgPtr*)Sp)[0] = bco;          \
+      JMP_(stg_yield_to_interpreter);   \
+      FE_                               \
+   }
+
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_0_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_1_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_2_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_3_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_4_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_5_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_6_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1n,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
 
-VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
 
 /* When the returned value is in F1 ... */
 #define STG_CtoI_RET_F1_Template(label)        \
@@ -144,6 +176,8 @@ VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/,
       bco = ((StgPtr*)Sp)[1];           \
       Sp -= sizeofW(StgFloat);         \
       ASSIGN_FLT((W_*)Sp, F1);          \
+      Sp -= 1;                          \
+      ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgFloat); \
       Sp -= 1;                         \
       ((StgPtr*)Sp)[0] = bco;          \
       JMP_(stg_yield_to_interpreter);   \
@@ -172,6 +206,8 @@ VEC_POLY_INFO_TABLE(stg_ctoi_ret_F1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/,
       bco = ((StgPtr*)Sp)[1];           \
       Sp -= sizeofW(StgDouble);                \
       ASSIGN_DBL((W_*)Sp, D1);          \
+      Sp -= 1;                          \
+      ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgDouble); \
       Sp -= 1;                         \
       ((StgPtr*)Sp)[0] = bco;          \
       JMP_(stg_yield_to_interpreter);   \
@@ -191,6 +227,34 @@ STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_7_entry);
 VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
 
 
+/* When the returned value a VoidRep ... */
+#define STG_CtoI_RET_V_Template(label)         \
+   IFN_(label)                         \
+   {                                    \
+      StgPtr bco;                       \
+      FB_                              \
+      bco = ((StgPtr*)Sp)[1];           \
+      Sp -= 1;                          \
+      ((StgPtr*)Sp)[0] = 0; /* VoidRep tag */ \
+      Sp -= 1;                         \
+      ((StgPtr*)Sp)[0] = bco;          \
+      JMP_(stg_yield_to_interpreter);   \
+      FE_                               \
+   }
+
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_0_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_1_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_2_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_3_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_4_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_5_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_6_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_V,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+
 /* The other way round: when the interpreter returns a value to
    compiled code.  The stack looks like this:
 
@@ -219,33 +283,30 @@ STGFUN(stg_BCO_entry) {
   FE_
 }
 
-#endif /* GHCI */
-
 
 /* -----------------------------------------------------------------------------
    Entry code for an indirection.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,0,0);
+INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,"IND","IND");
 STGFUN(stg_IND_entry)
 {
     FB_
     TICK_ENT_IND(Node);        /* tick */
-
     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
     TICK_ENT_VIA_NODE();
-    JMP_(ENTRY_CODE(*R1.p));
+    JMP_(GET_ENTRY(R1.cl));
     FE_
 }
 
-INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
+INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,"IND_STATIC","IND_STATIC");
 STGFUN(stg_IND_STATIC_entry)
 {
     FB_
     TICK_ENT_IND(Node);        /* tick */
     R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
     TICK_ENT_VIA_NODE();
-    JMP_(ENTRY_CODE(*R1.p));
+    JMP_(GET_ENTRY(R1.cl));
     FE_
 }
 
@@ -261,6 +322,8 @@ STGFUN(stg_IND_PERM_entry)
     TICK_ENT_PERM_IND(R1.p); /* tick */
 #endif
 
+    LDV_ENTER((StgInd *)R1.p);
+
     /* Enter PAP cost centre -- lexical scoping only */
     ENTER_CCS_PAP_CL(R1.cl);
 
@@ -276,7 +339,7 @@ STGFUN(stg_IND_PERM_entry)
 #  ifdef PROFILING
 #    error Profiling and ticky-ticky do not mix at present!
 #  endif  /* PROFILING */
-    SET_INFO((StgInd*)R1.p,&IND_info);
+    SET_INFO((StgInd*)R1.p,&stg_IND_info);
 #endif /* TICKY_TICKY */
 
     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
@@ -287,23 +350,22 @@ STGFUN(stg_IND_PERM_entry)
     TICK_ENT_VIA_NODE();
 #endif
 
-    JMP_(ENTRY_CODE(*R1.p));
+    JMP_(GET_ENTRY(R1.cl));
     FE_
 }  
 
-INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
+INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,"IND_OLDGEN","IND_OLDGEN");
 STGFUN(stg_IND_OLDGEN_entry)
 {
     FB_
     TICK_ENT_IND(Node);        /* tick */
-  
     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
     TICK_ENT_VIA_NODE();
-    JMP_(ENTRY_CODE(*R1.p));
+    JMP_(GET_ENTRY(R1.cl));
     FE_
 }
 
-INFO_TABLE(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
+INFO_TABLE(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,"IND_OLDGEN_PERM","IND_OLDGEN_PERM");
 STGFUN(stg_IND_OLDGEN_PERM_entry)
 {
     FB_
@@ -313,7 +375,9 @@ STGFUN(stg_IND_OLDGEN_PERM_entry)
     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra  */
     TICK_ENT_PERM_IND(R1.p); /* tick */
 #endif
-  
+
+    LDV_ENTER((StgInd *)R1.p);
+
     /* Enter PAP cost centre -- lexical scoping only */
     ENTER_CCS_PAP_CL(R1.cl);
 
@@ -322,39 +386,11 @@ STGFUN(stg_IND_OLDGEN_PERM_entry)
 #  ifdef PROFILING
 #    error Profiling and ticky-ticky do not mix at present!
 #  endif  /* PROFILING */
-    SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
+    SET_INFO((StgInd*)R1.p,&stg_IND_OLDGEN_info);
 #endif /* TICKY_TICKY */
 
     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
     TICK_ENT_VIA_NODE();
-    JMP_(ENTRY_CODE(*R1.p));
-    FE_
-}
-
-/* -----------------------------------------------------------------------------
-   Entry code for CAFs
-
-   This code assumes R1 is in a register for now.
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_CAF_UNENTERED_info,stg_CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
-STGFUN(stg_CAF_UNENTERED_entry)
-{
-    FB_
-    /* ToDo: implement directly in GHC */
-    Sp -= 1;
-    Sp[0] = R1.w;
-    JMP_(stg_yield_to_interpreter);
-    FE_
-}
-
-/* 0,4 is entirely bogus; _do not_ rely on this info */
-INFO_TABLE(stg_CAF_ENTERED_info,stg_CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
-STGFUN(stg_CAF_ENTERED_entry)
-{
-    FB_
-    R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
-    TICK_ENT_VIA_NODE();
     JMP_(GET_ENTRY(R1.cl));
     FE_
 }
@@ -387,9 +423,9 @@ STGFUN(stg_BLACKHOLE_entry)
 #ifdef SMP
     {
       bdescr *bd = Bdescr(R1.p);
-      if (bd->back != (bdescr *)BaseReg) {
-       if (bd->gen->no >= 1 || bd->step->no >= 1) {
-         CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
+      if (bd->u.back != (bdescr *)BaseReg) {
+       if (bd->gen_no >= 1 || bd->step->no >= 1) {
+         CMPXCHG(R1.cl->header.info, &stg_BLACKHOLE_info, &stg_WHITEHOLE_info);
        } else {
          EXTFUN_RTS(stg_gc_enter_1_hponly);
          JMP_(stg_gc_enter_1_hponly);
@@ -399,28 +435,43 @@ STGFUN(stg_BLACKHOLE_entry)
 #endif
     TICK_ENT_BH();
 
+    // Actually this is not necessary because R1.p is about to be destroyed.
+    LDV_ENTER((StgClosure *)R1.p);
+
     /* Put ourselves on the blocking queue for this black hole */
 #if defined(GRAN) || defined(PAR)
-    /* in fact, only difference is the type of the end-of-queue marker! */
+    // in fact, only difference is the type of the end-of-queue marker!
     CurrentTSO->link = END_BQ_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
 #else
     CurrentTSO->link = END_TSO_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 #endif
-    /* jot down why and on what closure we are blocked */
+    // jot down why and on what closure we are blocked
     CurrentTSO->why_blocked = BlockedOnBlackHole;
     CurrentTSO->block_info.closure = R1.cl;
-    /* closure is mutable since something has just been added to its BQ */
-    recordMutable((StgMutClosure *)R1.cl);
+
     /* Change the BLACKHOLE into a BLACKHOLE_BQ */
+#ifdef PROFILING
+
+    // The size remains the same, so we call LDV_recordDead() - no need to fill slop.
+    LDV_recordDead((StgClosure *)R1.p, BLACKHOLE_sizeW());
+#endif
+    // 
+    // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+    // 
     ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
+#ifdef PROFILING
+    LDV_recordCreate((StgClosure *)R1.p);
+#endif
 
-    /* PAR: dumping of event now done in blockThread -- HWL */
+    // closure is mutable since something has just been added to its BQ
+    recordMutable((StgMutClosure *)R1.cl);
 
-    /* stg_gen_block is too heavyweight, use a specialised one */
-    BLOCK_NP(1);
+    // PAR: dumping of event now done in blockThread -- HWL
 
+    // stg_gen_block is too heavyweight, use a specialised one
+    BLOCK_NP(1);
   FE_
 }
 
@@ -436,9 +487,9 @@ STGFUN(stg_BLACKHOLE_BQ_entry)
 #ifdef SMP
     {
       bdescr *bd = Bdescr(R1.p);
-      if (bd->back != (bdescr *)BaseReg) {
-       if (bd->gen->no >= 1 || bd->step->no >= 1) {
-         CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
+      if (bd->u.back != (bdescr *)BaseReg) {
+       if (bd->gen_no >= 1 || bd->step->no >= 1) {
+         CMPXCHG(R1.cl->header.info, &stg_BLACKHOLE_info, &stg_WHITEHOLE_info);
        } else {
          EXTFUN_RTS(stg_gc_enter_1_hponly);
          JMP_(stg_gc_enter_1_hponly);
@@ -448,6 +499,7 @@ STGFUN(stg_BLACKHOLE_BQ_entry)
 #endif
 
     TICK_ENT_BH();
+    LDV_ENTER((StgClosure *)R1.p);
 
     /* Put ourselves on the blocking queue for this black hole */
     CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
@@ -480,7 +532,7 @@ STGFUN(stg_BLACKHOLE_BQ_entry)
 
 #if defined(PAR) || defined(GRAN)
 
-INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,0,0);
+INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,"RBH","RBH");
 STGFUN(stg_RBH_entry)
 {
   FB_
@@ -504,13 +556,13 @@ STGFUN(stg_RBH_entry)
   FE_
 }
 
-INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
+INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,EF_,"RBH_Save_0","RBH_Save_0");
 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
 
-INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
+INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,EF_,"RBH_Save_1","RBH_Save_1");
 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
 
-INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
+INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,EF_,"RBH_Save_2","RBH_Save_2");
 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
 #endif /* defined(PAR) || defined(GRAN) */
 
@@ -527,9 +579,9 @@ STGFUN(stg_CAF_BLACKHOLE_entry)
 #ifdef SMP
     {
       bdescr *bd = Bdescr(R1.p);
-      if (bd->back != (bdescr *)BaseReg) {
-       if (bd->gen->no >= 1 || bd->step->no >= 1) {
-         CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
+      if (bd->u.back != (bdescr *)BaseReg) {
+       if (bd->gen_no >= 1 || bd->step->no >= 1) {
+         CMPXCHG(R1.cl->header.info, &stg_CAF_BLACKHOLE_info, &stg_WHITEHOLE_info);
        } else {
          EXTFUN_RTS(stg_gc_enter_1_hponly);
          JMP_(stg_gc_enter_1_hponly);
@@ -539,33 +591,36 @@ STGFUN(stg_CAF_BLACKHOLE_entry)
 #endif
 
     TICK_ENT_BH();
+    LDV_ENTER((StgClosure *)R1.p);
 
-    /* Put ourselves on the blocking queue for this black hole */
+    // Put ourselves on the blocking queue for this black hole
 #if defined(GRAN) || defined(PAR)
-    /* in fact, only difference is the type of the end-of-queue marker! */
+    // in fact, only difference is the type of the end-of-queue marker!
     CurrentTSO->link = END_BQ_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
 #else
     CurrentTSO->link = END_TSO_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 #endif
-    /* jot down why and on what closure we are blocked */
+    // jot down why and on what closure we are blocked
     CurrentTSO->why_blocked = BlockedOnBlackHole;
     CurrentTSO->block_info.closure = R1.cl;
-    /* closure is mutable since something has just been added to its BQ */
-    recordMutable((StgMutClosure *)R1.cl);
-    /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
+
+    // Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC
     ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
 
-    /* PAR: dumping of event now done in blockThread -- HWL */
+    // closure is mutable since something has just been added to its BQ
+    recordMutable((StgMutClosure *)R1.cl);
 
-    /* stg_gen_block is too heavyweight, use a specialised one */
+    // PAR: dumping of event now done in blockThread -- HWL
+
+    // stg_gen_block is too heavyweight, use a specialised one
     BLOCK_NP(1);
   FE_
 }
 
 #ifdef TICKY_TICKY
-INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
+INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,"SE_BLACKHOLE","SE_BLACKHOLE");
 STGFUN(stg_SE_BLACKHOLE_entry)
 {
   FB_
@@ -574,7 +629,7 @@ STGFUN(stg_SE_BLACKHOLE_entry)
   FE_
 }
 
-INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
+INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
 STGFUN(stg_SE_CAF_BLACKHOLE_entry)
 {
   FB_
@@ -585,7 +640,7 @@ STGFUN(stg_SE_CAF_BLACKHOLE_entry)
 #endif
 
 #ifdef SMP
-INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,"WHITEHOLE","WHITEHOLE");
 STGFUN(stg_WHITEHOLE_entry)
 {
   FB_
@@ -608,7 +663,7 @@ NON_ENTERABLE_ENTRY_CODE(TSO);
    one is a real bug.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
+INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,EF_,"EVACUATED","EVACUATED");
 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
 
 /* -----------------------------------------------------------------------------
@@ -622,7 +677,19 @@ NON_ENTERABLE_ENTRY_CODE(EVACUATED);
 INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
 NON_ENTERABLE_ENTRY_CODE(WEAK);
 
-INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
+// XXX! The garbage collector replaces a WEAK with a DEAD_WEAK
+// in-place, which causes problems if the heap is scanned linearly
+// after GC (certain kinds of profiling do this).  So when profiling,
+// we set the size of a DEAD_WEAK to 4 non-pointers, rather than its
+// usual 1.
+
+#ifdef PROFILING
+#define DEAD_WEAK_PAYLOAD_WORDS 4
+#else
+#define DEAD_WEAK_PAYLOAD_WORDS 1
+#endif
+
+INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,DEAD_WEAK_PAYLOAD_WORDS,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
 
 /* -----------------------------------------------------------------------------
@@ -632,7 +699,7 @@ NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
    finalizer in a weak pointer object.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"NO_FINALIZER","NO_FINALIZER");
 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
 
 SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,EI_)
@@ -672,7 +739,7 @@ NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
    end of a linked TSO queue.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_TSO_QUEUE","END_TSO_QUEUE");
 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
 
 SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,EI_)
@@ -686,26 +753,26 @@ SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,EI_)
    an END_MUT_LIST closure.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_MUT_LIST","END_MUT_LIST");
 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
 
 SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,EI_)
 , /*payload*/{} };
 
-INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
+INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_CONS, , EF_, "MUT_CONS", "MUT_CONS");
 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
 
 /* -----------------------------------------------------------------------------
    Exception lists
    -------------------------------------------------------------------------- */
 
-INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_EXCEPTION_LIST","END_EXCEPTION_LIST");
 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
 
 SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
 , /*payload*/{} };
 
-INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
+INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, "EXCEPTION_CONS", "EXCEPTION_CONS");
 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
 
 /* -----------------------------------------------------------------------------
@@ -767,7 +834,7 @@ STGFUN(stg_error_entry)                                                     \
    just enter the top stack word to start the thread.  (see deleteThread)
  * -------------------------------------------------------------------------- */
 
-INFO_TABLE(stg_dummy_ret_info, stg_dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
+INFO_TABLE(stg_dummy_ret_info, stg_dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, "DUMMY_RET", "DUMMY_RET");
 STGFUN(stg_dummy_ret_entry)
 {
   W_ ret_addr;
@@ -805,7 +872,7 @@ STGFUN(stg_forceIO_ret_entry)
 }
 #else
 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
-STGFUN(forceIO_ret_entry)
+STGFUN(stg_forceIO_ret_entry)
 {
   StgClosure *rval;
   FB_
@@ -818,7 +885,7 @@ STGFUN(forceIO_ret_entry)
 }
 #endif
 
-INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
+INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,"FORCE_IO","FORCE_IO");
 FN_(stg_forceIO_entry)
 {
   FB_
@@ -856,8 +923,8 @@ static INFO_TBL_CONST StgInfoTable izh_static_info;
 #define Char_hash_static_info czh_static_info
 #define Int_hash_static_info izh_static_info
 #else
-#define Char_hash_static_info PrelBase_Czh_static_info
-#define Int_hash_static_info PrelBase_Izh_static_info
+#define Char_hash_static_info GHCziBase_Czh_static_info
+#define Int_hash_static_info GHCziBase_Izh_static_info
 #endif
 
 #define CHARLIKE_HDR(n)                                                \