[project @ 2005-10-21 14:02:17 by simonmar]
[ghc-hetmet.git] / ghc / includes / Updates.h
index 37b8ecc..4bc6199 100644 (file)
@@ -64,8 +64,7 @@
         BLOCK_BEGIN                                            \
        DECLARE_IPTR(info);                                     \
        info = GET_INFO(updclosure);                            \
-        AWAKEN_BQ(info,updclosure);                            \
-       updateWithIndirection(GET_INFO(updclosure), ind_info,   \
+       updateWithIndirection(ind_info,                         \
                              updclosure,                       \
                              heapptr,                          \
                              and_then);                        \
 #if defined(PROFILING) || defined(TICKY_TICKY)
 #define UPD_PERM_IND(updclosure, heapptr)      \
         BLOCK_BEGIN                            \
-       DECLARE_IPTR(info);                     \
-       info = GET_INFO(updclosure);            \
-        AWAKEN_BQ(info,updclosure);            \
-       updateWithPermIndirection(info,         \
-                                 updclosure,   \
+       updateWithPermIndirection(updclosure,   \
                                  heapptr);     \
        BLOCK_END
 #endif
 # ifdef TICKY_TICKY
 #  define UPD_IND_NOLOCK(updclosure, heapptr)  \
         BLOCK_BEGIN                            \
-       DECLARE_IPTR(info);                     \
-       info = GET_INFO(updclosure);            \
-        AWAKEN_BQ_NOLOCK(info,updclosure);     \
-       updateWithPermIndirection(info,         \
-                                 updclosure,   \
+       updateWithPermIndirection(updclosure,   \
                                  heapptr);     \
        BLOCK_END
 # else
 #  define UPD_IND_NOLOCK(updclosure, heapptr)                  \
         BLOCK_BEGIN                                            \
-       DECLARE_IPTR(info);                                     \
-       info = GET_INFO(updclosure);                            \
-        AWAKEN_BQ_NOLOCK(info,updclosure);                     \
-       updateWithIndirection(info, INFO_PTR(stg_IND_info),     \
+       updateWithIndirection(INFO_PTR(stg_IND_info),           \
                              updclosure,                       \
                              heapptr,);                        \
        BLOCK_END
@@ -167,33 +155,9 @@ extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
                DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure);                           \
        }
 
-
-#else /* !GRAN && !PAR */
-
-#define DO_AWAKEN_BQ(closure)          \
-        FCALL awakenBlockedQueue(StgBlockingQueue_blocking_queue(closure) ARG_PTR);
-
-#define AWAKEN_BQ(info,closure)                                                \
-       if (info == INFO_PTR(stg_BLACKHOLE_BQ_info)) {                  \
-          DO_AWAKEN_BQ(closure);                                        \
-       }
-
-#define AWAKEN_STATIC_BQ(info,closure)                                 \
-       if (info == INFO_PTR(stg_BLACKHOLE_BQ_STATIC_info)) {           \
-          DO_AWAKEN_BQ(closure);                                        \
-       }
-
-#ifdef RTS_SUPPORTS_THREADS
-#define DO_AWAKEN_BQ_NOLOCK(closure) \
-        FCALL awakenBlockedQueueNoLock(StgBlockingQueue_blocking_queue(closure) ARG_PTR);
-
-#define AWAKEN_BQ_NOLOCK(info,closure)                                 \
-       if (info == INFO_PTR(stg_BLACKHOLE_BQ_info)) {                  \
-          DO_AWAKEN_BQ_NOLOCK(closure);                                 \
-       }
-#endif
 #endif /* GRAN || PAR */
 
+
 /* -----------------------------------------------------------------------------
    Updates: lower-level macros which update a closure with an
    indirection to another closure.
@@ -221,8 +185,13 @@ extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
  * to point to itself, and the closure being updated should not
  * already have been updated (the mutable list will get messed up
  * otherwise).
+ *
+ * NB. We do *not* do this in SMP mode, because when we have the
+ * possibility of multiple threads entering the same closure, zeroing
+ * the slop in one of the threads would have a disastrous effect on
+ * the other (seen in the wild!).
  */
-#if !defined(DEBUG)
+#if !defined(DEBUG) || defined(SMP)
 
 #define DEBUG_FILL_SLOP(p) /* nothing */
 
@@ -230,24 +199,28 @@ extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
 
 #ifdef CMINUSMINUS
 
-#define DEBUG_FILL_SLOP(p)                     \
-  W_ inf;                                      \
-  W_ np;                                       \
-  W_ nw;                                       \
-  W_ i;                                                \
-  inf = %GET_STD_INFO(p);                      \
-  np = TO_W_(%INFO_PTRS(inf));                 \
-  nw = TO_W_(%INFO_NPTRS(inf));                        \
-  if (%INFO_TYPE(inf) != HALF_W_(THUNK_SELECTOR)) {    \
-    i = 0;                                     \
-    for:                                       \
-      if (i < np + nw) {                       \
-        StgClosure_payload(p,i) = 0;           \
-        i = i + 1;                             \
-        goto for;                              \
-      }                                                \
-  }
-
+#define DEBUG_FILL_SLOP(p)                                             \
+  W_ inf;                                                              \
+  W_ sz;                                                               \
+  W_ i;                                                                        \
+  inf = %GET_STD_INFO(p);                                              \
+  if (%INFO_TYPE(inf) == HALF_W_(THUNK_SELECTOR)) {                    \
+       StgThunk_payload(p,0) = 0;                                      \
+  } else {                                                             \
+    if (%INFO_TYPE(inf) != HALF_W_(BLACKHOLE)) {                       \
+      if (%INFO_TYPE(inf) == HALF_W_(AP_STACK)) {                      \
+          sz = StgAP_STACK_size(p) + BYTES_TO_WDS(SIZEOF_StgAP_STACK_NoHdr); \
+      } else {                                                         \
+          sz = TO_W_(%INFO_PTRS(inf)) + TO_W_(%INFO_NPTRS(inf));       \
+      }                                                                        \
+      i = 0;                                                           \
+      for:                                                             \
+        if (i < sz) {                                                  \
+          StgThunk_payload(p,i) = 0;                                   \
+          i = i + 1;                                                   \
+          goto for;                                                    \
+        }                                                              \
+  } }
 
 #else /* !CMINUSMINUS */
 
@@ -255,12 +228,25 @@ INLINE_HEADER void
 DEBUG_FILL_SLOP(StgClosure *p)
 {                                              
     StgInfoTable *inf = get_itbl(p);           
-    nat np = inf->layout.payload.ptrs,         
-       nw = inf->layout.payload.nptrs, i;
-    if (inf->type != THUNK_SELECTOR) {
-       for (i = 0; i < np + nw; i++) {
-           ((StgClosure *)p)->payload[i] = 0;
-       }
+    nat i, sz;
+
+    switch (inf->type) {
+    case BLACKHOLE:
+       return;
+    case AP_STACK:
+       sz = ((StgAP_STACK *)p)->size + sizeofW(StgAP_STACK) - sizeofW(StgHeader);
+       break;
+    case THUNK_SELECTOR:
+#ifdef SMP
+       ((StgSelector *)p)->selectee = 0;
+#endif
+       return;
+    default:
+       sz = inf->layout.payload.ptrs + inf->layout.payload.nptrs;
+        break;
+    }
+    for (i = 0; i < sz; i++) {
+       ((StgThunk *)p)->payload[i] = 0;
     }
 }
 
@@ -279,12 +265,13 @@ DEBUG_FILL_SLOP(StgClosure *p)
  */
 #ifdef CMINUSMINUS
 #define generation(n) (W_[generations] + n*SIZEOF_generation)
-#define updateWithIndirection(info, ind_info, p1, p2, and_then)        \
+#define updateWithIndirection(ind_info, p1, p2, and_then)      \
     W_ bd;                                                     \
                                                                \
 /*    ASSERT( p1 != p2 && !closure_IND(p1) );                  \
  */ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);                     \
-    bd = Bdescr(p1);                                           \
+/*  foreign "C" cas(p1 "ptr", 0, stg_WHITEHOLE_info);          \
+ */ bd = Bdescr(p1);                                           \
     if (bdescr_gen_no(bd) == 0 :: CInt) {                      \
       StgInd_indirectee(p1) = p2;                              \
       SET_INFO(p1, ind_info);                                  \
@@ -292,14 +279,9 @@ DEBUG_FILL_SLOP(StgClosure *p)
       TICK_UPD_NEW_IND();                                      \
       and_then;                                                        \
     } else {                                                   \
-      if (info != stg_BLACKHOLE_BQ_info) {                     \
-        DEBUG_FILL_SLOP(p1);                                   \
-        W_ __mut_once_list;                                    \
-        __mut_once_list = generation(TO_W_(bdescr_gen_no(bd))) +       \
-                             OFFSET_generation_mut_once_list;  \
-        StgMutClosure_mut_link(p1) = W_[__mut_once_list];      \
-        W_[__mut_once_list] = p1;                              \
-      }                                                                \
+      DEBUG_FILL_SLOP(p1);                                     \
+      foreign "C" recordMutableGenLock(p1 "ptr",               \
+                generation(TO_W_(bdescr_gen_no(bd))) "ptr");   \
       StgInd_indirectee(p1) = p2;                              \
       SET_INFO(p1, stg_IND_OLDGEN_info);                       \
       LDV_RECORD_CREATE(p1);                                   \
@@ -307,10 +289,11 @@ DEBUG_FILL_SLOP(StgClosure *p)
       and_then;                                                        \
   }
 #else
-#define updateWithIndirection(_info, ind_info, p1, p2, and_then)       \
+#define updateWithIndirection(ind_info, p1, p2, and_then)              \
   {                                                                    \
     bdescr *bd;                                                                \
                                                                        \
+    /* cas(p1, 0, &stg_WHITEHOLE_info); */                             \
     ASSERT( (P_)p1 != (P_)p2 && !closure_IND(p1) );                    \
     LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);                             \
     bd = Bdescr((P_)p1);                                               \
@@ -321,12 +304,9 @@ DEBUG_FILL_SLOP(StgClosure *p)
       TICK_UPD_NEW_IND();                                              \
       and_then;                                                                \
     } else {                                                           \
-      if (_info != &stg_BLACKHOLE_BQ_info) {                           \
-        DEBUG_FILL_SLOP(p1);                                           \
-        ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list;        \
-        generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;    \
-      }                                                                        \
-      ((StgIndOldGen *)p1)->indirectee = p2;                           \
+      DEBUG_FILL_SLOP(p1);                                             \
+      recordMutableGenLock(p1, &generations[bd->gen_no]);              \
+      ((StgInd *)p1)->indirectee = p2;                                 \
       SET_INFO(p1, &stg_IND_OLDGEN_info);                              \
       TICK_UPD_OLD_IND();                                              \
       and_then;                                                                \
@@ -339,36 +319,38 @@ DEBUG_FILL_SLOP(StgClosure *p)
  */
 #ifndef CMINUSMINUS
 INLINE_HEADER void
-updateWithPermIndirection(const StgInfoTable *info, 
-                         StgClosure *p1,
+updateWithPermIndirection(StgClosure *p1,
                          StgClosure *p2) 
 {
   bdescr *bd;
 
   ASSERT( p1 != p2 && !closure_IND(p1) );
 
-  // @LDV profiling
-  // Destroy the old closure.
-  // Nb: LDV_* stuff cannot mix with ticky-ticky
+  /*
+   * @LDV profiling
+   * Destroy the old closure.
+   * Nb: LDV_* stuff cannot mix with ticky-ticky
+   */
   LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);
 
   bd = Bdescr((P_)p1);
   if (bd->gen_no == 0) {
     ((StgInd *)p1)->indirectee = p2;
     SET_INFO(p1, &stg_IND_PERM_info);
-    // @LDV profiling
-    // We have just created a new closure.
+    /*
+     * @LDV profiling
+     * We have just created a new closure.
+     */
     LDV_RECORD_CREATE(p1);
     TICK_UPD_NEW_PERM_IND(p1);
   } else {
-    if (info != &stg_BLACKHOLE_BQ_info) {
-      ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list;
-      generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;
-    }
-    ((StgIndOldGen *)p1)->indirectee = p2;
+    recordMutableGenLock(p1, &generations[bd->gen_no]);
+    ((StgInd *)p1)->indirectee = p2;
     SET_INFO(p1, &stg_IND_OLDGEN_PERM_info);
-    // @LDV profiling
-    // We have just created a new closure.
+    /*
+     * @LDV profiling
+     * We have just created a new closure.
+     */
     LDV_RECORD_CREATE(p1);
     TICK_UPD_OLD_PERM_IND();
   }