[project @ 2004-08-13 13:04:50 by simonmar]
[ghc-hetmet.git] / ghc / rts / GC.c
index 8cd4a2c..adb36cc 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.153 2003/04/01 15:05:13 sof Exp $
+ * $Id: GC.c,v 1.168 2004/08/13 13:09:49 simonmar Exp $
  *
  * (c) The GHC Team 1998-2003
  *
@@ -13,7 +13,8 @@
 #include "RtsUtils.h"
 #include "Apply.h"
 #include "Storage.h"
-#include "StoragePriv.h"
+#include "LdvProfile.h"
+#include "Updates.h"
 #include "Stats.h"
 #include "Schedule.h"
 #include "SchedAPI.h"          // for ReverCAFs prototype
@@ -23,7 +24,6 @@
 #include "ProfHeap.h"
 #include "SchedAPI.h"
 #include "Weak.h"
-#include "StablePriv.h"
 #include "Prelude.h"
 #include "ParTicky.h"          // ToDo: move into Rts.h
 #include "GCCompact.h"
@@ -44,7 +44,6 @@
 #endif
 
 #include "RetainerProfile.h"
-#include "LdvProfile.h"
 
 #include <string.h>
 
@@ -142,11 +141,13 @@ static void         mark_root               ( StgClosure **root );
 
 // Use a register argument for evacuate, if available.
 #if __GNUC__ >= 2
-static StgClosure * evacuate (StgClosure *q) __attribute__((regparm(1)));
+#define REGPARM1 __attribute__((regparm(1)))
 #else
-static StgClosure * evacuate (StgClosure *q);
+#define REGPARM1
 #endif
 
+REGPARM1 static StgClosure * evacuate (StgClosure *q);
+
 static void         zero_static_object_list ( StgClosure* first_static );
 static void         zero_mutable_list       ( StgMutClosure *first );
 
@@ -190,31 +191,31 @@ static rtsBool mark_stack_overflowed;
 static bdescr *oldgen_scan_bd;
 static StgPtr  oldgen_scan;
 
-static inline rtsBool
+STATIC_INLINE rtsBool
 mark_stack_empty(void)
 {
     return mark_sp == mark_stack;
 }
 
-static inline rtsBool
+STATIC_INLINE rtsBool
 mark_stack_full(void)
 {
     return mark_sp >= mark_splim;
 }
 
-static inline void
+STATIC_INLINE void
 reset_mark_stack(void)
 {
     mark_sp = mark_stack;
 }
 
-static inline void
+STATIC_INLINE void
 push_mark_stack(StgPtr p)
 {
     *mark_sp++ = p;
 }
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 pop_mark_stack(void)
 {
     return *--mark_sp;
@@ -378,6 +379,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   if (RtsFlags.GcFlags.generations == 1) {
     old_to_blocks = g0s0->to_blocks;
     g0s0->to_blocks = NULL;
+    g0s0->n_to_blocks = 0;
   }
 
   /* Keep a count of how many new blocks we allocated during this GC
@@ -421,7 +423,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
 
       // mark the large objects as not evacuated yet 
       for (bd = stp->large_objects; bd; bd = bd->link) {
-       bd->flags = BF_LARGE;
+       bd->flags &= ~BF_EVACUATED;
       }
 
       // for a compacted step, we need to allocate the bitmap
@@ -444,11 +446,18 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
              // don't forget to fill it with zeros!
              memset(bitmap, 0, bitmap_size);
              
-             // for each block in this step, point to its bitmap from the
+             // For each block in this step, point to its bitmap from the
              // block descriptor.
              for (bd=stp->blocks; bd != NULL; bd = bd->link) {
                  bd->u.bitmap = bitmap;
                  bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE);
+
+                 // Also at this point we set the BF_COMPACTED flag
+                 // for this block.  The invariant is that
+                 // BF_COMPACTED is always unset, except during GC
+                 // when it is set on those blocks which will be
+                 // compacted.
+                 bd->flags |= BF_COMPACTED;
              }
          }
       }
@@ -575,17 +584,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
    */
   markStablePtrTable(mark_root);
 
-#ifdef INTERPRETER
-  { 
-      /* ToDo: To fix the caf leak, we need to make the commented out
-       * parts of this code do something sensible - as described in 
-       * the CAF document.
-       */
-      extern void markHugsObjects(void);
-      markHugsObjects();
-  }
-#endif
-
   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
    * more scavenging to be done.
@@ -750,7 +748,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
                // for a compacted step, just shift the new to-space
                // onto the front of the now-compacted existing blocks.
                for (bd = stp->to_blocks; bd != NULL; bd = bd->link) {
-                   bd->flags &= ~BF_EVACUATED; // now from-space 
+                   bd->flags &= ~BF_EVACUATED;  // now from-space 
                }
                // tack the new blocks on the end of the existing blocks
                if (stp->blocks == NULL) {
@@ -761,6 +759,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
                        if (next == NULL) {
                            bd->link = stp->to_blocks;
                        }
+                       // NB. this step might not be compacted next
+                       // time, so reset the BF_COMPACTED flags.
+                       // They are set before GC if we're going to
+                       // compact.  (search for BF_COMPACTED above).
+                       bd->flags &= ~BF_COMPACTED;
                    }
                }
                // add the new blocks to the block tally
@@ -770,7 +773,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
                stp->blocks = stp->to_blocks;
                stp->n_blocks = stp->n_to_blocks;
                for (bd = stp->blocks; bd != NULL; bd = bd->link) {
-                   bd->flags &= ~BF_EVACUATED; // now from-space 
+                   bd->flags &= ~BF_EVACUATED;  // now from-space 
                }
            }
            stp->to_blocks = NULL;
@@ -1293,6 +1296,7 @@ traverse_weak_ptr_list(void)
 
   default:
       barf("traverse_weak_ptr_list");
+      return rtsTrue;
   }
 
 }
@@ -1373,7 +1377,7 @@ isAlive(StgClosure *p)
     }
 
     // check the mark bit for compacted steps
-    if (bd->step->is_compacted && is_marked((P_)p,bd)) {
+    if ((bd->flags & BF_COMPACTED) && is_marked((P_)p,bd)) {
        return p;
     }
 
@@ -1412,19 +1416,19 @@ mark_root(StgClosure **root)
   *root = evacuate(*root);
 }
 
-static __inline__ void 
+STATIC_INLINE void 
 upd_evacuee(StgClosure *p, StgClosure *dest)
 {
     // Source object must be in from-space:
     ASSERT((Bdescr((P_)p)->flags & BF_EVACUATED) == 0);
     // not true: (ToDo: perhaps it should be)
     // ASSERT(Bdescr((P_)dest)->flags & BF_EVACUATED);
-    p->header.info = &stg_EVACUATED_info;
+    SET_INFO(p, &stg_EVACUATED_info);
     ((StgEvacuated *)p)->evacuee = dest;
 }
 
 
-static __inline__ StgClosure *
+STATIC_INLINE StgClosure *
 copy(StgClosure *src, nat size, step *stp)
 {
   P_ to, from, dest;
@@ -1530,7 +1534,7 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
    -------------------------------------------------------------------------- */
 
 
-static inline void
+STATIC_INLINE void
 evacuate_large(StgPtr p)
 {
   bdescr *bd = Bdescr(p);
@@ -1637,9 +1641,26 @@ mkMutCons(StgClosure *ptr, generation *gen)
    if  M <  evac_gen     set failed_to_evac flag to indicate that we
                          didn't manage to evacuate this object into evac_gen.
 
+
+   OPTIMISATION NOTES:
+
+   evacuate() is the single most important function performance-wise
+   in the GC.  Various things have been tried to speed it up, but as
+   far as I can tell the code generated by gcc 3.2 with -O2 is about
+   as good as it's going to get.  We pass the argument to evacuate()
+   in a register using the 'regparm' attribute (see the prototype for
+   evacuate() near the top of this file).
+
+   Changing evacuate() to take an (StgClosure **) rather than
+   returning the new pointer seems attractive, because we can avoid
+   writing back the pointer when it hasn't changed (eg. for a static
+   object, or an object in a generation > N).  However, I tried it and
+   it doesn't help.  One reason is that the (StgClosure **) pointer
+   gets spilled to the stack inside evacuate(), resulting in far more
+   extra reads/writes than we save.
    -------------------------------------------------------------------------- */
 
-static StgClosure *
+REGPARM1 static StgClosure *
 evacuate(StgClosure *q)
 {
   StgClosure *to;
@@ -1681,7 +1702,7 @@ loop:
     /* If the object is in a step that we're compacting, then we
      * need to use an alternative evacuate procedure.
      */
-    if (bd->step->is_compacted) {
+    if (bd->flags & BF_COMPACTED) {
        if (!is_marked((P_)q,bd)) {
            mark((P_)q,bd);
            if (mark_stack_full()) {
@@ -1810,7 +1831,7 @@ loop:
     goto loop;
 
   case THUNK_STATIC:
-    if (info->srt_len > 0 && major_gc && 
+    if (info->srt_bitmap != 0 && major_gc && 
        THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
       THUNK_STATIC_LINK((StgClosure *)q) = static_objects;
       static_objects = (StgClosure *)q;
@@ -1818,7 +1839,7 @@ loop:
     return q;
 
   case FUN_STATIC:
-    if (info->srt_len > 0 && major_gc && 
+    if (info->srt_bitmap != 0 && major_gc && 
        FUN_STATIC_LINK((StgClosure *)q) == NULL) {
       FUN_STATIC_LINK((StgClosure *)q) = static_objects;
       static_objects = (StgClosure *)q;
@@ -1913,8 +1934,18 @@ loop:
        * list it contains.  
        */
       {
-         StgTSO *new_tso = (StgTSO *)copy((StgClosure *)tso,tso_sizeW(tso),stp);
+         StgTSO *new_tso;
+         StgPtr p, q;
+
+         new_tso = (StgTSO *)copyPart((StgClosure *)tso,
+                                      tso_sizeW(tso),
+                                      sizeofW(StgTSO), stp);
          move_TSO(tso, new_tso);
+         for (p = tso->sp, q = new_tso->sp;
+              p < tso->stack+tso->stack_size;) {
+             *q++ = *p++;
+         }
+         
          return (StgClosure *)new_tso;
       }
     }
@@ -1982,6 +2013,22 @@ loop:
    thunk is unchanged.
    -------------------------------------------------------------------------- */
 
+static inline rtsBool
+is_to_space ( StgClosure *p )
+{
+    bdescr *bd;
+
+    bd = Bdescr((StgPtr)p);
+    if (HEAP_ALLOCED(p) &&
+       ((bd->flags & BF_EVACUATED) 
+        || ((bd->flags & BF_COMPACTED) &&
+            is_marked((P_)p,bd)))) {
+       return rtsTrue;
+    } else {
+       return rtsFalse;
+    }
+}    
+
 static StgClosure *
 eval_thunk_selector( nat field, StgSelector * p )
 {
@@ -2014,17 +2061,30 @@ selector_loop:
     // eval_thunk_selector().  There are various ways this could
     // happen:
     //
-    // - following an IND_STATIC
+    // 1. following an IND_STATIC
     //
-    // - when the old generation is compacted, the mark phase updates
-    //   from-space pointers to be to-space pointers, and we can't
-    //   reliably tell which we're following (eg. from an IND_STATIC).
+    // 2. when the old generation is compacted, the mark phase updates
+    //    from-space pointers to be to-space pointers, and we can't
+    //    reliably tell which we're following (eg. from an IND_STATIC).
     // 
-    // So we use the block-descriptor test to find out if we're in
-    // to-space.
+    // 3. compacting GC again: if we're looking at a constructor in
+    //    the compacted generation, it might point directly to objects
+    //    in to-space.  We must bale out here, otherwise doing the selection
+    //    will result in a to-space pointer being returned.
+    //
+    //  (1) is dealt with using a BF_EVACUATED test on the
+    //  selectee. (2) and (3): we can tell if we're looking at an
+    //  object in the compacted generation that might point to
+    //  to-space objects by testing that (a) it is BF_COMPACTED, (b)
+    //  the compacted generation is being collected, and (c) the
+    //  object is marked.  Only a marked object may have pointers that
+    //  point to to-space objects, because that happens when
+    //  scavenging.
+    //
+    //  The to-space test is now embodied in the in_to_space() inline
+    //  function, as it is re-used below.
     //
-    if (HEAP_ALLOCED(selectee) &&
-       Bdescr((StgPtr)selectee)->flags & BF_EVACUATED) {
+    if (is_to_space(selectee)) {
        goto bale_out;
     }
 
@@ -2042,9 +2102,21 @@ selector_loop:
          ASSERT(field <  (StgWord32)(info->layout.payload.ptrs + 
                                      info->layout.payload.nptrs));
          
-         // ToDo: shouldn't we test whether this pointer is in
-         // to-space?
-         return selectee->payload[field];
+         // Select the right field from the constructor, and check
+         // that the result isn't in to-space.  It might be in
+         // to-space if, for example, this constructor contains
+         // pointers to younger-gen objects (and is on the mut-once
+         // list).
+         //
+         { 
+             StgClosure *q;
+             q = selectee->payload[field];
+             if (is_to_space(q)) {
+                 goto bale_out;
+             } else {
+                 return q;
+             }
+         }
 
       case IND:
       case IND_PERM:
@@ -2088,21 +2160,22 @@ selector_loop:
              // For the purposes of LDV profiling, we have destroyed
              // the original selector thunk.
              SET_INFO(p, info_ptr);
-             LDV_recordDead_FILL_SLOP_DYNAMIC(selectee);
+             LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(selectee);
 #endif
              ((StgInd *)selectee)->indirectee = val;
              SET_INFO(selectee,&stg_IND_info);
-#ifdef PROFILING
+
              // For the purposes of LDV profiling, we have created an
              // indirection.
-             LDV_recordCreate(selectee);
-#endif
+             LDV_RECORD_CREATE(selectee);
+
              selectee = val;
              goto selector_loop;
          }
       }
 
       case AP:
+      case AP_STACK:
       case THUNK:
       case THUNK_1_0:
       case THUNK_0_1:
@@ -2148,70 +2221,109 @@ move_TSO (StgTSO *src, StgTSO *dest)
 {
     ptrdiff_t diff;
 
-    // relocate the stack pointers... 
+    // relocate the stack pointer... 
     diff = (StgPtr)dest - (StgPtr)src; // In *words* 
     dest->sp = (StgPtr)dest->sp + diff;
 }
 
-/* evacuate the SRT.  If srt_len is zero, then there isn't an
+/* Similar to scavenge_large_bitmap(), but we don't write back the
+ * pointers we get back from evacuate().
+ */
+static void
+scavenge_large_srt_bitmap( StgLargeSRT *large_srt )
+{
+    nat i, b, size;
+    StgWord bitmap;
+    StgClosure **p;
+    
+    b = 0;
+    bitmap = large_srt->l.bitmap[b];
+    size   = (nat)large_srt->l.size;
+    p      = (StgClosure **)large_srt->srt;
+    for (i = 0; i < size; ) {
+       if ((bitmap & 1) != 0) {
+           evacuate(*p);
+       }
+       i++;
+       p++;
+       if (i % BITS_IN(W_) == 0) {
+           b++;
+           bitmap = large_srt->l.bitmap[b];
+       } else {
+           bitmap = bitmap >> 1;
+       }
+    }
+}
+
+/* evacuate the SRT.  If srt_bitmap is zero, then there isn't an
  * srt field in the info table.  That's ok, because we'll
  * never dereference it.
  */
-static inline void
-scavenge_srt (StgClosure **srt, nat srt_len)
+STATIC_INLINE void
+scavenge_srt (StgClosure **srt, nat srt_bitmap)
 {
-  StgClosure **srt_end;
+  nat bitmap;
+  StgClosure **p;
 
-  srt_end = srt + srt_len;
+  bitmap = srt_bitmap;
+  p = srt;
 
-  for (; srt < srt_end; srt++) {
-    /* Special-case to handle references to closures hiding out in DLLs, since
-       double indirections required to get at those. The code generator knows
-       which is which when generating the SRT, so it stores the (indirect)
-       reference to the DLL closure in the table by first adding one to it.
-       We check for this here, and undo the addition before evacuating it.
+  if (bitmap == (StgHalfWord)(-1)) {  
+      scavenge_large_srt_bitmap( (StgLargeSRT *)srt );
+      return;
+  }
 
-       If the SRT entry hasn't got bit 0 set, the SRT entry points to a
-       closure that's fixed at link-time, and no extra magic is required.
-    */
+  while (bitmap != 0) {
+      if ((bitmap & 1) != 0) {
 #ifdef ENABLE_WIN32_DLL_SUPPORT
-    if ( (unsigned long)(*srt) & 0x1 ) {
-       evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
-    } else {
-       evacuate(*srt);
-    }
+         // Special-case to handle references to closures hiding out in DLLs, since
+         // double indirections required to get at those. The code generator knows
+         // which is which when generating the SRT, so it stores the (indirect)
+         // reference to the DLL closure in the table by first adding one to it.
+         // We check for this here, and undo the addition before evacuating it.
+         // 
+         // If the SRT entry hasn't got bit 0 set, the SRT entry points to a
+         // closure that's fixed at link-time, and no extra magic is required.
+         if ( (unsigned long)(*srt) & 0x1 ) {
+             evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
+         } else {
+             evacuate(*p);
+         }
 #else
-       evacuate(*srt);
+         evacuate(*p);
 #endif
+      }
+      p++;
+      bitmap = bitmap >> 1;
   }
 }
 
 
-static inline void
+STATIC_INLINE void
 scavenge_thunk_srt(const StgInfoTable *info)
 {
     StgThunkInfoTable *thunk_info;
 
     thunk_info = itbl_to_thunk_itbl(info);
-    scavenge_srt((StgClosure **)thunk_info->srt, thunk_info->i.srt_len);
+    scavenge_srt((StgClosure **)thunk_info->srt, thunk_info->i.srt_bitmap);
 }
 
-static inline void
+STATIC_INLINE void
 scavenge_fun_srt(const StgInfoTable *info)
 {
     StgFunInfoTable *fun_info;
 
     fun_info = itbl_to_fun_itbl(info);
-    scavenge_srt((StgClosure **)fun_info->srt, fun_info->i.srt_len);
+    scavenge_srt((StgClosure **)fun_info->f.srt, fun_info->i.srt_bitmap);
 }
 
-static inline void
+STATIC_INLINE void
 scavenge_ret_srt(const StgInfoTable *info)
 {
     StgRetInfoTable *ret_info;
 
     ret_info = itbl_to_ret_itbl(info);
-    scavenge_srt((StgClosure **)ret_info->srt, ret_info->i.srt_len);
+    scavenge_srt((StgClosure **)ret_info->srt, ret_info->i.srt_bitmap);
 }
 
 /* -----------------------------------------------------------------------------
@@ -2247,7 +2359,7 @@ scavengeTSO (StgTSO *tso)
    in PAPs.
    -------------------------------------------------------------------------- */
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 {
     StgPtr p;
@@ -2255,19 +2367,19 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     nat size;
 
     p = (StgPtr)args;
-    switch (fun_info->fun_type) {
+    switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->bitmap);
-       size = BITMAP_SIZE(fun_info->bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.bitmap);
+       size = BITMAP_SIZE(fun_info->f.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
-       size = ((StgLargeBitmap *)fun_info->bitmap)->size;
-       scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
+       size = ((StgLargeBitmap *)fun_info->f.bitmap)->size;
+       scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size);
        p += size;
        break;
     default:
-       bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
-       size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]);
+       bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
+       size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
     small_bitmap:
        while (size > 0) {
            if ((bitmap & 1) == 0) {
@@ -2282,7 +2394,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     return p;
 }
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 scavenge_PAP (StgPAP *pap)
 {
     StgPtr p;
@@ -2296,12 +2408,12 @@ scavenge_PAP (StgPAP *pap)
     p = (StgPtr)pap->payload;
     size = pap->n_args;
 
-    switch (fun_info->fun_type) {
+    switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
-       scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
+       scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size);
        p += size;
        break;
     case ARG_BCO:
@@ -2309,7 +2421,7 @@ scavenge_PAP (StgPAP *pap)
        p += size;
        break;
     default:
-       bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
+       bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
     small_bitmap:
        size = pap->n_args;
        while (size > 0) {
@@ -2371,7 +2483,7 @@ scavenge(step *stp)
 
     q = p;
     switch (info->type) {
-       
+
     case MVAR:
        /* treat MVars specially, because we don't want to evacuate the
         * mut_link field in the middle of the closure.
@@ -2495,14 +2607,12 @@ scavenge(step *stp)
         LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
 #endif        
         // 
-        // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+        // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
         //
        SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
-#ifdef PROFILING
-        // @LDV profiling
+
         // We pretend that p has just been created.
-        LDV_recordCreate((StgClosure *)p);
-#endif
+        LDV_RECORD_CREATE((StgClosure *)p);
       }
        // fall through 
     case IND_OLDGEN_PERM:
@@ -2598,6 +2708,11 @@ scavenge(step *stp)
     {
        StgPtr next;
 
+       // Set the mut_link field to NULL, so that we will put this
+       // array back on the mutable list if it is subsequently thawed
+       // by unsafeThaw#.
+       ((StgMutArrPtrs*)p)->mut_link = NULL;
+
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
            (StgClosure *)*p = evacuate((StgClosure *)*p);
@@ -2908,6 +3023,11 @@ linear_scan:
        {
            StgPtr next;
            
+           // Set the mut_link field to NULL, so that we will put this
+           // array on the mutable list if it is subsequently thawed
+           // by unsafeThaw#.
+           ((StgMutArrPtrs*)p)->mut_link = NULL;
+
            next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
            for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
                (StgClosure *)*p = evacuate((StgClosure *)*p);
@@ -3130,6 +3250,11 @@ scavenge_one(StgPtr p)
        // follow everything 
        StgPtr next;
       
+       // Set the mut_link field to NULL, so that we will put this
+       // array on the mutable list if it is subsequently thawed
+       // by unsafeThaw#.
+       ((StgMutArrPtrs*)p)->mut_link = NULL;
+
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
            (StgClosure *)*p = evacuate((StgClosure *)*p);
@@ -3338,6 +3463,9 @@ scavenge_mutable_list(generation *gen)
          (StgClosure *)*q = evacuate((StgClosure *)*q);
        }
        evac_gen = 0;
+       // Set the mut_link field to NULL, so that we will put this
+       // array back on the mutable list if it is subsequently thawed
+       // by unsafeThaw#.
        p->mut_link = NULL;
        if (failed_to_evac) {
            failed_to_evac = rtsFalse;
@@ -3587,7 +3715,7 @@ scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
     }
 }
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
 {
     while (size > 0) {
@@ -3646,7 +3774,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
        p = scavenge_small_bitmap(p, size, bitmap);
 
     follow_srt:
-       scavenge_srt((StgClosure **)info->srt, info->i.srt_len);
+       scavenge_srt((StgClosure **)info->srt, info->i.srt_bitmap);
        continue;
 
     case RET_BCO: {
@@ -3687,16 +3815,16 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
        dyn = ((StgRetDyn *)p)->liveness;
 
        // traverse the bitmap first
-       bitmap = GET_LIVENESS(dyn);
+       bitmap = RET_DYN_LIVENESS(dyn);
        p      = (P_)&((StgRetDyn *)p)->payload[0];
-       size   = RET_DYN_SIZE;
+       size   = RET_DYN_BITMAP_SIZE;
        p = scavenge_small_bitmap(p, size, bitmap);
 
        // skip over the non-ptr words
-       p += GET_NONPTRS(dyn);
+       p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
        
        // follow the ptr words
-       for (size = GET_PTRS(dyn); size > 0; size--) {
+       for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
            (StgClosure *)*p = evacuate((StgClosure *)*p);
            p++;
        }
@@ -3807,7 +3935,7 @@ revertCAFs( void )
     for (c = (StgIndStatic *)caf_list; c != NULL; 
         c = (StgIndStatic *)c->static_link) 
     {
-       c->header.info = c->saved_info;
+       SET_INFO(c, c->saved_info);
        c->saved_info = NULL;
        // could, but not necessary: c->static_link = NULL; 
     }
@@ -3928,11 +4056,9 @@ threadLazyBlackHole(StgTSO *tso)
                LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
 #endif
                SET_INFO(bh,&stg_BLACKHOLE_info);
-#ifdef PROFILING
-               // @LDV profiling
+
                // We pretend that bh has just been created.
-               LDV_recordCreate(bh);
-#endif
+               LDV_RECORD_CREATE(bh);
            }
            
            frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
@@ -4075,12 +4201,11 @@ threadSqueezeStack(StgTSO *tso)
                    // We pretend that bh is now dead.
                    LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
 #endif
-                   // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+                   // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
                    SET_INFO(bh,&stg_BLACKHOLE_info);
-#ifdef PROFILING
+
                    // We pretend that bh has just been created.
-                   LDV_recordCreate(bh);
-#endif
+                   LDV_RECORD_CREATE(bh);
                }
 
                prev_was_update_frame = rtsTrue;
@@ -4135,20 +4260,20 @@ done_traversing:
        void *gap_start, *next_gap_start, *gap_end;
        nat chunk_size;
 
-       next_gap_start = (void *)gap + sizeof(StgUpdateFrame);
+       next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame));
        sp = next_gap_start;
 
        while ((StgPtr)gap > tso->sp) {
 
            // we're working in *bytes* now...
            gap_start = next_gap_start;
-           gap_end = gap_start - gap->gap_size * sizeof(W_);
+           gap_end = (void*) ((unsigned char*)gap_start - gap->gap_size * sizeof(W_));
 
            gap = gap->next_gap;
-           next_gap_start = (void *)gap + sizeof(StgUpdateFrame);
+           next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame));
 
-           chunk_size = gap_end - next_gap_start;
-           sp -= chunk_size;
+           chunk_size = (unsigned char*)gap_end - (unsigned char*)next_gap_start;
+           (unsigned char*)sp -= chunk_size;
            memmove(sp, next_gap_start, chunk_size);
        }
 
@@ -4209,7 +4334,7 @@ printMutableList(generation *gen)
   fputc('\n', stderr);
 }
 
-static inline rtsBool
+STATIC_INLINE rtsBool
 maybeLarge(StgClosure *closure)
 {
   StgInfoTable *info = get_itbl(closure);