Adding TcGadt.lhs

[ghc-hetmet.git] / rts / Updates.h

diff --git a/rts/Updates.h b/rts/Updates.h
index 5872157..abca788 100644 (file)
--- a/rts/Updates.h
+++ b/rts/Updates.h
@@ -198,17 +198,20 @@ extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
   W_ sz;                                                               \
   W_ i;                                                                        \
   inf = %GET_STD_INFO(p);                                              \
-  if (%INFO_TYPE(inf) != HALF_W_(THUNK_SELECTOR)                       \
-       && %INFO_TYPE(inf) != HALF_W_(BLACKHOLE)                        \
+  if (%INFO_TYPE(inf) != HALF_W_(BLACKHOLE)                            \
        && %INFO_TYPE(inf) != HALF_W_(CAF_BLACKHOLE)) {                 \
-      if (%INFO_TYPE(inf) == HALF_W_(AP_STACK)) {                      \
-          sz = StgAP_STACK_size(p) + BYTES_TO_WDS(SIZEOF_StgAP_STACK_NoThunkHdr); \
-      } else {                                                         \
-          if (%INFO_TYPE(inf) == HALF_W_(AP)) {                                \
-             sz = TO_W_(StgAP_n_args(p)) +  BYTES_TO_WDS(SIZEOF_StgAP_NoThunkHdr);     \
+      if (%INFO_TYPE(inf) == HALF_W_(THUNK_SELECTOR)) {                        \
+         sz = BYTES_TO_WDS(SIZEOF_StgSelector_NoThunkHdr);             \
+     } else {                                                          \
+          if (%INFO_TYPE(inf) == HALF_W_(AP_STACK)) {                  \
+              sz = StgAP_STACK_size(p) + BYTES_TO_WDS(SIZEOF_StgAP_STACK_NoThunkHdr); \
           } else {                                                     \
-              sz = TO_W_(%INFO_PTRS(inf)) + TO_W_(%INFO_NPTRS(inf));   \
-         }                                                             \
+              if (%INFO_TYPE(inf) == HALF_W_(AP)) {                    \
+                 sz = TO_W_(StgAP_n_args(p)) +  BYTES_TO_WDS(SIZEOF_StgAP_NoThunkHdr); \
+              } else {                                                 \
+                  sz = TO_W_(%INFO_PTRS(inf)) + TO_W_(%INFO_NPTRS(inf)); \
+             }                                                         \
+          }                                                            \
       }                                                                        \
       i = 0;                                                           \
       for:                                                             \
@@ -230,8 +233,13 @@ FILL_SLOP(StgClosure *p)
     switch (inf->type) {
     case BLACKHOLE:
     case CAF_BLACKHOLE:
+       goto no_slop;
+       // we already filled in the slop when we overwrote the thunk
+       // with BLACKHOLE, and also an evacuated BLACKHOLE is only the
+       // size of an IND.
     case THUNK_SELECTOR:
-       return;
+       sz = sizeofW(StgSelector) - sizeofW(StgThunkHeader);
+       break;
     case AP:
        sz = ((StgAP *)p)->n_args + sizeofW(StgAP) - sizeofW(StgThunkHeader);
        break;
@@ -245,6 +253,8 @@ FILL_SLOP(StgClosure *p)
     for (i = 0; i < sz; i++) {
        ((StgThunk *)p)->payload[i] = 0;
     }
+no_slop:
+    ;
 }
 
 #endif /* CMINUSMINUS */
@@ -273,12 +283,10 @@ FILL_SLOP(StgClosure *p)
     DEBUG_FILL_SLOP(p1);                                       \
     LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);                     \
     StgInd_indirectee(p1) = p2;                                        \
-    foreign "C" wb() [];                                       \
+    prim %write_barrier() [];                                  \
     bd = Bdescr(p1);                                           \
     if (bdescr_gen_no(bd) != 0 :: CInt) {                      \
-      foreign "C" recordMutableCap(p1 "ptr",                   \
-                                  MyCapability() "ptr",        \
-                                  bdescr_gen_no(bd)) [R1];     \
+      recordMutableCap(p1, TO_W_(bdescr_gen_no(bd)), R1);      \
       SET_INFO(p1, stg_IND_OLDGEN_info);                       \
       LDV_RECORD_CREATE(p1);                                   \
       TICK_UPD_OLD_IND();                                      \
@@ -290,28 +298,28 @@ FILL_SLOP(StgClosure *p)
       and_then;                                                        \
   }
 #else
-#define updateWithIndirection(ind_info, p1, p2, and_then)              \
-  {                                                                    \
-    bdescr *bd;                                                                \
-                                                                       \
-    /* cas(p1, 0, &stg_WHITEHOLE_info); */                             \
-    ASSERT( (P_)p1 != (P_)p2 && !closure_IND(p1) );                    \
-    DEBUG_FILL_SLOP(p1);                                               \
-    LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);                             \
-    ((StgInd *)p1)->indirectee = p2;                                   \
-    wb();                                                              \
-    bd = Bdescr((P_)p1);                                               \
-    if (bd->gen_no != 0) {                                             \
-      recordMutableGenLock(p1, &generations[bd->gen_no]);              \
-      SET_INFO(p1, &stg_IND_OLDGEN_info);                              \
-      TICK_UPD_OLD_IND();                                              \
-      and_then;                                                                \
-    } else {                                                           \
-      SET_INFO(p1, ind_info);                                          \
-      LDV_RECORD_CREATE(p1);                                           \
-      TICK_UPD_NEW_IND();                                              \
-      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) );            \
+    DEBUG_FILL_SLOP(p1);                                       \
+    LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);                     \
+    ((StgInd *)p1)->indirectee = p2;                           \
+    write_barrier();                                           \
+    bd = Bdescr((P_)p1);                                       \
+    if (bd->gen_no != 0) {                                     \
+      recordMutableGenLock(p1, &generations[bd->gen_no]);      \
+      SET_INFO(p1, &stg_IND_OLDGEN_info);                      \
+      TICK_UPD_OLD_IND();                                      \
+      and_then;                                                        \
+    } else {                                                   \
+      SET_INFO(p1, ind_info);                                  \
+      LDV_RECORD_CREATE(p1);                                   \
+      TICK_UPD_NEW_IND();                                      \
+      and_then;                                                        \
+    }                                                          \
   }
 #endif