[project @ 2004-11-19 17:24:48 by tharris]

[ghc-hetmet.git] / ghc / rts / GCCompact.c

diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c
index 860c531..2f124d5 100644 (file)
--- a/ghc/rts/GCCompact.c
+++ b/ghc/rts/GCCompact.c
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: GCCompact.c,v 1.18 2003/11/12 17:49:07 sof Exp $
  *
  * (c) The GHC Team 2001
  *
@@ -16,7 +15,6 @@
 #include "MBlock.h"
 #include "GCCompact.h"
 #include "Schedule.h"
-#include "StablePriv.h"
 #include "Apply.h"
 
 // Turn off inlining when debugging - it obfuscates things
@@ -73,15 +71,15 @@ thread( StgPtr p )
 STATIC_INLINE void
 unthread( StgPtr p, StgPtr free )
 {
-    StgPtr q = (StgPtr)*p, r;
+    StgWord q = *p, r;
     
-    while (((StgWord)q & 1) != 0) {
-       (StgWord)q -= 1;        // unset the low bit again
-       r = (StgPtr)*q;
-       *q = (StgWord)free;
+    while ((q & 1) != 0) {
+       q -= 1; // unset the low bit again
+       r = *((StgPtr)q);
+       *((StgPtr)q) = (StgWord)free;
        q = r;
     }
-    *p = (StgWord)q;
+    *p = q;
 }
 
 STATIC_INLINE StgInfoTable *
@@ -144,6 +142,14 @@ obj_sizeW( StgClosure *p, StgInfoTable *info )
        return tso_sizeW((StgTSO *)p);
     case BCO:
        return bco_sizeW((StgBCO *)p);
+    case TVAR_WAIT_QUEUE:
+        return sizeofW(StgTVarWaitQueue);
+    case TVAR:
+        return sizeofW(StgTVar);
+    case TREC_CHUNK:
+        return sizeofW(StgTRecChunk);
+    case TREC_HEADER:
+        return sizeofW(StgTRecHeader);
     default:
        return sizeW_fromITBL(info);
     }
@@ -214,19 +220,19 @@ thread_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;
-       thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
+       size = GET_FUN_LARGE_BITMAP(fun_info)->size;
+       thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), 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) {
@@ -267,7 +273,7 @@ thread_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_BITMAP_SIZE;
            while (size > 0) {
@@ -280,10 +286,10 @@ thread_stack(StgPtr p, StgPtr stack_end)
            }
            
            // skip over the non-ptr words
-           p += GET_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
+           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--) {
                thread(p);
                p++;
            }
@@ -291,6 +297,9 @@ thread_stack(StgPtr p, StgPtr stack_end)
        }
            
            // small bitmap (<= 32 entries, or 64 on a 64-bit machine) 
+        case CATCH_RETRY_FRAME:
+        case CATCH_STM_FRAME:
+        case ATOMICALLY_FRAME:
        case UPDATE_FRAME:
        case STOP_FRAME:
        case CATCH_FRAME:
@@ -329,8 +338,8 @@ thread_stack(StgPtr p, StgPtr stack_end)
        case RET_BIG:
        case RET_VEC_BIG:
            p++;
-           size = info->i.layout.large_bitmap->size;
-           thread_large_bitmap(p, info->i.layout.large_bitmap, size);
+           size = GET_LARGE_BITMAP(&info->i)->size;
+           thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
            p += size;
            continue;
 
@@ -367,12 +376,12 @@ thread_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:
-       thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
+       thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
        p += size;
        break;
     case ARG_BCO:
@@ -380,7 +389,7 @@ thread_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) {
@@ -426,6 +435,8 @@ thread_TSO (StgTSO *tso)
        thread((StgPtr)&tso->blocked_exceptions);
     }
     
+    thread((StgPtr)&tso->trec);
+
     thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
     return (StgPtr)tso + tso_sizeW(tso);
 }
@@ -607,6 +618,45 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case TSO:
        return thread_TSO((StgTSO *)p);
     
+    case TVAR_WAIT_QUEUE:
+    {
+        StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
+       thread((StgPtr)&wq->waiting_tso);
+       thread((StgPtr)&wq->next_queue_entry);
+       thread((StgPtr)&wq->prev_queue_entry);
+       return p + sizeofW(StgTVarWaitQueue);
+    }
+    
+    case TVAR:
+    {
+        StgTVar *tvar = (StgTVar *)p;
+       thread((StgPtr)&tvar->current_value);
+       thread((StgPtr)&tvar->first_wait_queue_entry);
+       return p + sizeofW(StgTVar);
+    }
+    
+    case TREC_HEADER:
+    {
+        StgTRecHeader *trec = (StgTRecHeader *)p;
+       thread((StgPtr)&trec->enclosing_trec);
+       thread((StgPtr)&trec->current_chunk);
+       return p + sizeofW(StgTRecHeader);
+    }
+
+    case TREC_CHUNK:
+    {
+        StgWord i;
+        StgTRecChunk *tc = (StgTRecChunk *)p;
+       TRecEntry *e = &(tc -> entries[0]);
+       thread((StgPtr)&tc->prev_chunk);
+       for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
+         thread((StgPtr)&e->tvar);
+         thread((StgPtr)&e->expected_value);
+         thread((StgPtr)&e->new_value);
+       }
+       return p + sizeofW(StgTRecChunk);
+    }
+
     default:
        barf("update_fwd: unknown/strange object  %d", (int)(info->type));
        return NULL;
@@ -881,12 +931,12 @@ compact( void (*get_roots)(evac_fn) )
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
        for (s = 0; s < generations[g].n_steps; s++) {
            stp = &generations[g].steps[s];
-           IF_DEBUG(gc, fprintf(stderr,"update_fwd:  %d.%d\n", stp->gen->no, stp->no););
+           IF_DEBUG(gc, debugBelch("update_fwd:  %d.%d\n", stp->gen->no, stp->no););
 
            update_fwd(stp->to_blocks);
            update_fwd_large(stp->scavenged_large_objects);
            if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
-               IF_DEBUG(gc, fprintf(stderr,"update_fwd:  %d.%d (compact)\n", stp->gen->no, stp->no););
+               IF_DEBUG(gc, debugBelch("update_fwd:  %d.%d (compact)\n", stp->gen->no, stp->no););
                update_fwd_compact(stp->blocks);
            }
        }
@@ -896,7 +946,7 @@ compact( void (*get_roots)(evac_fn) )
     stp = &oldest_gen->steps[0];
     if (stp->blocks != NULL) {
        blocks = update_bkwd_compact(stp);
-       IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", 
+       IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", 
                             stp->gen->no, stp->no,
                             stp->n_blocks, blocks););
        stp->n_blocks = blocks;