[project @ 2005-01-23 06:10:15 by wolfgang]
[ghc-hetmet.git] / ghc / rts / GC.c
index 25f794f..06f46f7 100644 (file)
@@ -26,6 +26,7 @@
 #include "ParTicky.h"          // ToDo: move into Rts.h
 #include "GCCompact.h"
 #include "Signals.h"
+#include "STM.h"
 #if defined(GRAN) || defined(PAR)
 # include "GranSimRts.h"
 # include "ParallelRts.h"
@@ -314,6 +315,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   blockUserSignals();
 #endif
 
+  // tell the STM to discard any cached closures its hoping to re-use
+  stmPreGCHook();
+
   // tell the stats department that we've started a GC 
   stat_startGC();
 
@@ -1236,7 +1240,7 @@ traverse_weak_ptr_list(void)
          prev = &old_all_threads;
          for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
              
-             (StgClosure *)tmp = isAlive((StgClosure *)t);
+             tmp = (StgTSO *)isAlive((StgClosure *)t);
              
              if (tmp != NULL) {
                  t = tmp;
@@ -1283,7 +1287,7 @@ traverse_weak_ptr_list(void)
          StgTSO *t, *tmp, *next;
          for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
              next = t->global_link;
-             (StgClosure *)tmp = evacuate((StgClosure *)t);
+             tmp = (StgTSO *)evacuate((StgClosure *)t);
              tmp->global_link = resurrected_threads;
              resurrected_threads = tmp;
          }
@@ -1322,7 +1326,7 @@ mark_weak_ptr_list ( StgWeak **list )
       // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here
       ASSERT(w->header.info == &stg_DEAD_WEAK_info 
             || get_itbl(w)->type == WEAK || get_itbl(w)->type == EVACUATED);
-      (StgClosure *)w = evacuate((StgClosure *)w);
+      w = (StgWeak *)evacuate((StgClosure *)w);
       *last_w = w;
       last_w = &(w->link);
   }
@@ -1881,6 +1885,9 @@ loop:
   case UPDATE_FRAME:
   case STOP_FRAME:
   case CATCH_FRAME:
+  case CATCH_STM_FRAME:
+  case CATCH_RETRY_FRAME:
+  case ATOMICALLY_FRAME:
     // shouldn't see these 
     barf("evacuate: stack frame at %p\n", q);
 
@@ -1989,6 +1996,18 @@ loop:
     return to;
 #endif
 
+  case TREC_HEADER: 
+    return copy(q,sizeofW(StgTRecHeader),stp);
+
+  case TVAR_WAIT_QUEUE:
+    return copy(q,sizeofW(StgTVarWaitQueue),stp);
+
+  case TVAR:
+    return copy(q,sizeofW(StgTVar),stp);
+    
+  case TREC_CHUNK:
+    return copy(q,sizeofW(StgTRecChunk),stp);
+
   default:
     barf("evacuate: strange closure type %d", (int)(info->type));
   }
@@ -2332,7 +2351,7 @@ static void
 scavengeTSO (StgTSO *tso)
 {
     // chase the link field for any TSOs on the same queue 
-    (StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
+    tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
     if (   tso->why_blocked == BlockedOnMVar
        || tso->why_blocked == BlockedOnBlackHole
        || tso->why_blocked == BlockedOnException
@@ -2348,6 +2367,9 @@ scavengeTSO (StgTSO *tso)
            (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
     }
     
+    // scavange current transaction record
+    tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec);
+    
     // scavenge this thread's stack 
     scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
 }
@@ -2381,7 +2403,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     small_bitmap:
        while (size > 0) {
            if ((bitmap & 1) == 0) {
-               (StgClosure *)*p = evacuate((StgClosure *)*p);
+               *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
            }
            p++;
            bitmap = bitmap >> 1;
@@ -2424,7 +2446,7 @@ scavenge_PAP (StgPAP *pap)
        size = pap->n_args;
        while (size > 0) {
            if ((bitmap & 1) == 0) {
-               (StgClosure *)*p = evacuate((StgClosure *)*p);
+               *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
            }
            p++;
            bitmap = bitmap >> 1;
@@ -2489,9 +2511,9 @@ scavenge(step *stp)
     { 
        StgMVar *mvar = ((StgMVar *)p);
        evac_gen = 0;
-       (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
-       (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
-       (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
+       mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+       mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+       mvar->value = evacuate((StgClosure *)mvar->value);
        evac_gen = saved_evac_gen;
        recordMutable((StgMutClosure *)mvar);
        failed_to_evac = rtsFalse; // mutable.
@@ -2580,7 +2602,7 @@ scavenge(step *stp)
 
        end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
        for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-           (StgClosure *)*p = evacuate((StgClosure *)*p);
+           *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
        p += info->layout.payload.nptrs;
        break;
@@ -2588,10 +2610,10 @@ scavenge(step *stp)
 
     case BCO: {
        StgBCO *bco = (StgBCO *)p;
-       (StgClosure *)bco->instrs = evacuate((StgClosure *)bco->instrs);
-       (StgClosure *)bco->literals = evacuate((StgClosure *)bco->literals);
-       (StgClosure *)bco->ptrs = evacuate((StgClosure *)bco->ptrs);
-       (StgClosure *)bco->itbls = evacuate((StgClosure *)bco->itbls);
+       bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
+       bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
+       bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
+       bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
        p += bco_sizeW(bco);
        break;
     }
@@ -2648,8 +2670,8 @@ scavenge(step *stp)
     case BLACKHOLE_BQ:
     { 
        StgBlockingQueue *bh = (StgBlockingQueue *)p;
-       (StgClosure *)bh->blocking_queue = 
-           evacuate((StgClosure *)bh->blocking_queue);
+       bh->blocking_queue = 
+           (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
        recordMutable((StgMutClosure *)bh);
        failed_to_evac = rtsFalse;
        p += BLACKHOLE_sizeW();
@@ -2693,7 +2715,7 @@ scavenge(step *stp)
        evac_gen = 0;           // repeatedly mutable 
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-           (StgClosure *)*p = evacuate((StgClosure *)*p);
+           *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
        evac_gen = saved_evac_gen;
        recordMutable((StgMutClosure *)q);
@@ -2713,7 +2735,7 @@ scavenge(step *stp)
 
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-           (StgClosure *)*p = evacuate((StgClosure *)*p);
+           *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
        // it's tempting to recordMutable() if failed_to_evac is
        // false, but that breaks some assumptions (eg. every
@@ -2800,6 +2822,65 @@ scavenge(step *stp)
     }
 #endif
 
+    case TVAR_WAIT_QUEUE:
+      {
+       StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+       evac_gen = 0;
+       wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
+       wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+       wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+       evac_gen = saved_evac_gen;
+       recordMutable((StgMutClosure *)wq);
+       failed_to_evac = rtsFalse; // mutable
+       p += sizeofW(StgTVarWaitQueue);
+       break;
+      }
+
+    case TVAR:
+      {
+       StgTVar *tvar = ((StgTVar *) p);
+       evac_gen = 0;
+       tvar->current_value = evacuate((StgClosure*)tvar->current_value);
+       tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+       evac_gen = saved_evac_gen;
+       recordMutable((StgMutClosure *)tvar);
+       failed_to_evac = rtsFalse; // mutable
+       p += sizeofW(StgTVar);
+       break;
+      }
+
+    case TREC_HEADER:
+      {
+        StgTRecHeader *trec = ((StgTRecHeader *) p);
+        evac_gen = 0;
+       trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
+       trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+       evac_gen = saved_evac_gen;
+       recordMutable((StgMutClosure *)trec);
+       failed_to_evac = rtsFalse; // mutable
+       p += sizeofW(StgTRecHeader);
+        break;
+      }
+
+    case TREC_CHUNK:
+      {
+       StgWord i;
+       StgTRecChunk *tc = ((StgTRecChunk *) p);
+       TRecEntry *e = &(tc -> entries[0]);
+       evac_gen = 0;
+       tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+       for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
+         e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
+         e->expected_value = evacuate((StgClosure*)e->expected_value);
+         e->new_value = evacuate((StgClosure*)e->new_value);
+       }
+       evac_gen = saved_evac_gen;
+       recordMutable((StgMutClosure *)tc);
+       failed_to_evac = rtsFalse; // mutable
+       p += sizeofW(StgTRecChunk);
+       break;
+      }
+
     default:
        barf("scavenge: unimplemented/strange closure type %d @ %p", 
             info->type, p);
@@ -2854,9 +2935,9 @@ linear_scan:
        {
            StgMVar *mvar = ((StgMVar *)p);
            evac_gen = 0;
-           (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
-           (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
-           (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
+           mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+           mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+           mvar->value = evacuate((StgClosure *)mvar->value);
            evac_gen = saved_evac_gen;
            failed_to_evac = rtsFalse; // mutable.
            break;
@@ -2921,17 +3002,17 @@ linear_scan:
            
            end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
            for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-               (StgClosure *)*p = evacuate((StgClosure *)*p);
+               *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
            }
            break;
        }
 
        case BCO: {
            StgBCO *bco = (StgBCO *)p;
-           (StgClosure *)bco->instrs = evacuate((StgClosure *)bco->instrs);
-           (StgClosure *)bco->literals = evacuate((StgClosure *)bco->literals);
-           (StgClosure *)bco->ptrs = evacuate((StgClosure *)bco->ptrs);
-           (StgClosure *)bco->itbls = evacuate((StgClosure *)bco->itbls);
+           bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
+           bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
+           bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
+           bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
            break;
        }
 
@@ -2973,8 +3054,8 @@ linear_scan:
        case BLACKHOLE_BQ:
        { 
            StgBlockingQueue *bh = (StgBlockingQueue *)p;
-           (StgClosure *)bh->blocking_queue = 
-               evacuate((StgClosure *)bh->blocking_queue);
+           bh->blocking_queue = 
+               (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
            failed_to_evac = rtsFalse;
            break;
        }
@@ -3009,7 +3090,7 @@ linear_scan:
            evac_gen = 0;               // repeatedly mutable 
            next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
            for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-               (StgClosure *)*p = evacuate((StgClosure *)*p);
+               *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
            }
            evac_gen = saved_evac_gen;
            failed_to_evac = rtsFalse; // mutable anyhow.
@@ -3028,7 +3109,7 @@ linear_scan:
 
            next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
            for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-               (StgClosure *)*p = evacuate((StgClosure *)*p);
+               *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
            }
            break;
        }
@@ -3052,8 +3133,8 @@ linear_scan:
            StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
 #endif
            StgRBH *rbh = (StgRBH *)p;
-           (StgClosure *)rbh->blocking_queue = 
-               evacuate((StgClosure *)rbh->blocking_queue);
+           bh->blocking_queue = 
+               (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
            recordMutable((StgMutClosure *)rbh);
            failed_to_evac = rtsFalse;  // mutable anyhow.
            IF_DEBUG(gc,
@@ -3104,6 +3185,61 @@ linear_scan:
        }
 #endif // PAR
 
+       case TVAR_WAIT_QUEUE:
+         {
+           StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+           evac_gen = 0;
+           wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
+           wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+           wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+           evac_gen = saved_evac_gen;
+           recordMutable((StgMutClosure *)wq);
+           failed_to_evac = rtsFalse; // mutable
+           break;
+         }
+         
+       case TVAR:
+         {
+           StgTVar *tvar = ((StgTVar *) p);
+           evac_gen = 0;
+           tvar->current_value = evacuate((StgClosure*)tvar->current_value);
+           tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+           evac_gen = saved_evac_gen;
+           recordMutable((StgMutClosure *)tvar);
+           failed_to_evac = rtsFalse; // mutable
+           break;
+         }
+         
+       case TREC_CHUNK:
+         {
+           StgWord i;
+           StgTRecChunk *tc = ((StgTRecChunk *) p);
+           TRecEntry *e = &(tc -> entries[0]);
+           evac_gen = 0;
+           tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+           for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
+             e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
+             e->expected_value = evacuate((StgClosure*)e->expected_value);
+             e->new_value = evacuate((StgClosure*)e->new_value);
+           }
+           evac_gen = saved_evac_gen;
+           recordMutable((StgMutClosure *)tc);
+           failed_to_evac = rtsFalse; // mutable
+           break;
+         }
+
+       case TREC_HEADER:
+         {
+           StgTRecHeader *trec = ((StgTRecHeader *) p);
+           evac_gen = 0;
+           trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
+           trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+           evac_gen = saved_evac_gen;
+           recordMutable((StgMutClosure *)trec);
+           failed_to_evac = rtsFalse; // mutable
+           break;
+         }
+
        default:
            barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p", 
                 info->type, p);
@@ -3205,7 +3341,7 @@ scavenge_one(StgPtr p)
        
        end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
        for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) {
-           (StgClosure *)*q = evacuate((StgClosure *)*q);
+           *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
        }
        break;
     }
@@ -3236,7 +3372,7 @@ scavenge_one(StgPtr p)
        recordMutable((StgMutClosure *)p);
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-           (StgClosure *)*p = evacuate((StgClosure *)*p);
+           *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
        evac_gen = saved_evac_gen;
        failed_to_evac = rtsFalse;
@@ -3255,7 +3391,7 @@ scavenge_one(StgPtr p)
 
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-           (StgClosure *)*p = evacuate((StgClosure *)*p);
+           *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
        break;
     }
@@ -3445,7 +3581,7 @@ scavenge_mutable_list(generation *gen)
        
        end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
-         (StgClosure *)*q = evacuate((StgClosure *)*q);
+           *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
        }
        continue;
       }
@@ -3458,7 +3594,7 @@ scavenge_mutable_list(generation *gen)
        evac_gen = gen->no;
        end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
-         (StgClosure *)*q = evacuate((StgClosure *)*q);
+           *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
        }
        evac_gen = 0;
        // Set the mut_link field to NULL, so that we will put this
@@ -3481,9 +3617,9 @@ scavenge_mutable_list(generation *gen)
     case MVAR:
       {
        StgMVar *mvar = (StgMVar *)p;
-       (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
-       (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
-       (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
+       mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+       mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+       mvar->value = evacuate((StgClosure *)mvar->value);
        p->mut_link = gen->mut_list;
        gen->mut_list = p;
        continue;
@@ -3507,8 +3643,8 @@ scavenge_mutable_list(generation *gen)
     case BLACKHOLE_BQ:
       { 
        StgBlockingQueue *bh = (StgBlockingQueue *)p;
-       (StgClosure *)bh->blocking_queue = 
-         evacuate((StgClosure *)bh->blocking_queue);
+       bh->blocking_queue = 
+           (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
        p->mut_link = gen->mut_list;
        gen->mut_list = p;
        continue;
@@ -3594,6 +3730,53 @@ scavenge_mutable_list(generation *gen)
       }
 #endif
 
+    case TVAR_WAIT_QUEUE:
+      {
+       StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+       wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
+       wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+       wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+       p->mut_link = gen->mut_list;
+       gen->mut_list = p;
+       continue;
+      }
+
+    case TVAR:
+      {
+       StgTVar *tvar = ((StgTVar *) p);
+       tvar->current_value = evacuate((StgClosure*)tvar->current_value);
+       tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+       p->mut_link = gen->mut_list;
+       gen->mut_list = p;
+       continue;
+      }
+
+    case TREC_CHUNK:
+      {
+       StgWord i;
+       StgTRecChunk *tc = ((StgTRecChunk *) p);
+       TRecEntry *e = &(tc -> entries[0]);
+       tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+       for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
+           e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
+           e->expected_value = evacuate((StgClosure*)e->expected_value);
+           e->new_value = evacuate((StgClosure*)e->new_value);
+       }
+       p->mut_link = gen->mut_list;
+       gen->mut_list = p;
+       continue;
+      }
+
+    case TREC_HEADER:
+      {
+       StgTRecHeader *trec = ((StgTRecHeader *) p);
+       trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
+       trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+       p->mut_link = gen->mut_list;
+       gen->mut_list = p;
+       continue;
+      }
+
     default:
       // shouldn't have anything else on the mutables list 
       barf("scavenge_mutable_list: strange object? %d", (int)(info->type));
@@ -3667,7 +3850,7 @@ scavenge_static(void)
        next = (P_)p->payload + info->layout.payload.ptrs;
        // evacuate the pointers 
        for (q = (P_)p->payload; q < next; q++) {
-         (StgClosure *)*q = evacuate((StgClosure *)*q);
+           *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
        }
        break;
       }
@@ -3700,7 +3883,7 @@ scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
     bitmap = large_bitmap->bitmap[b];
     for (i = 0; i < size; ) {
        if ((bitmap & 1) == 0) {
-           (StgClosure *)*p = evacuate((StgClosure *)*p);
+           *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
        i++;
        p++;
@@ -3718,7 +3901,7 @@ scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
 {
     while (size > 0) {
        if ((bitmap & 1) == 0) {
-           (StgClosure *)*p = evacuate((StgClosure *)*p);
+           *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
        p++;
        bitmap = bitmap >> 1;
@@ -3760,6 +3943,9 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
        continue;
 
       // small bitmap (< 32 entries, or 64 on a 64-bit machine) 
+    case CATCH_STM_FRAME:
+    case CATCH_RETRY_FRAME:
+    case ATOMICALLY_FRAME:
     case STOP_FRAME:
     case CATCH_FRAME:
     case RET_SMALL:
@@ -3780,7 +3966,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
        nat size;
 
        p++;
-       (StgClosure *)*p = evacuate((StgClosure *)*p);
+       *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        bco = (StgBCO *)*p;
        p++;
        size = BCO_BITMAP_SIZE(bco);
@@ -3823,7 +4009,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
        
        // follow the ptr words
        for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-           (StgClosure *)*p = evacuate((StgClosure *)*p);
+           *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
            p++;
        }
        continue;
@@ -4067,7 +4253,7 @@ threadLazyBlackHole(StgTSO *tso)
            
            // normal stack frames; do nothing except advance the pointer
        default:
-           (StgPtr)frame += stack_frame_sizeW(frame);
+           frame = (StgClosure *)((StgPtr)frame + stack_frame_sizeW(frame));
        }
     }
 }
@@ -4271,7 +4457,7 @@ done_traversing:
            next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame));
 
            chunk_size = (unsigned char*)gap_end - (unsigned char*)next_gap_start;
-           (unsigned char*)sp -= chunk_size;
+           sp -= chunk_size;
            memmove(sp, next_gap_start, chunk_size);
        }