X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGCCompact.c;h=0e2129fa95c5cd82c92b503077b4e6ddef6e8cdd;hb=94e06463420582cc2d336b39a297e82af39e4cc4;hp=16b8fb180be454339b1702fb2acb79bb42f27373;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git

diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c
index 16b8fb1..0e2129f 100644
--- a/ghc/rts/GCCompact.c
+++ b/ghc/rts/GCCompact.c
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: GCCompact.c,v 1.13 2002/12/11 15:36:42 simonmar Exp $
  *
  * (c) The GHC Team 2001
  *
@@ -16,9 +15,14 @@
 #include "MBlock.h"
 #include "GCCompact.h"
 #include "Schedule.h"
-#include "StablePriv.h"
 #include "Apply.h"
 
+// Turn off inlining when debugging - it obfuscates things
+#ifdef DEBUG
+# undef  STATIC_INLINE
+# define STATIC_INLINE static
+#endif
+
 /* -----------------------------------------------------------------------------
    Threading / unthreading pointers.
 
@@ -41,7 +45,7 @@
    except for the info pointer.
    -------------------------------------------------------------------------- */
 
-static inline void
+STATIC_INLINE void
 thread( StgPtr p )
 {
     StgPtr q = (StgPtr)*p;
@@ -64,21 +68,21 @@ thread( StgPtr p )
     }
 }
 
-static inline void
+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 *
+STATIC_INLINE StgInfoTable *
 get_threaded_info( StgPtr p )
 {
     StgPtr q = (P_)GET_INFO((StgClosure *)p);
@@ -93,7 +97,7 @@ get_threaded_info( StgPtr p )
 
 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
 // Remember, the two regions *might* overlap, but: to <= from.
-static inline void
+STATIC_INLINE void
 move(StgPtr to, StgPtr from, nat size)
 {
     for(; size > 0; --size) {
@@ -101,7 +105,7 @@ move(StgPtr to, StgPtr from, nat size)
     }
 }
 
-static inline nat
+STATIC_INLINE nat
 obj_sizeW( StgClosure *p, StgInfoTable *info )
 {
     switch (info->type) {
@@ -136,6 +140,8 @@ obj_sizeW( StgClosure *p, StgInfoTable *info )
 	return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
     case TSO:
 	return tso_sizeW((StgTSO *)p);
+    case BCO:
+	return bco_sizeW((StgBCO *)p);
     default:
 	return sizeW_fromITBL(info);
     }
@@ -175,7 +181,7 @@ thread_static( StgClosure* p )
   }
 }
 
-static inline void
+STATIC_INLINE void
 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
 {
     nat i, b;
@@ -198,7 +204,7 @@ thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
     }
 }
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 {
     StgPtr p;
@@ -206,19 +212,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 = ((StgLargeBitmap *)fun_info->f.bitmap)->size;
+	thread_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) {
@@ -259,9 +265,9 @@ 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_SIZE;
+	    size   = RET_DYN_BITMAP_SIZE;
 	    while (size > 0) {
 		if ((bitmap & 1) == 0) {
 		    thread(p);
@@ -272,10 +278,10 @@ thread_stack(StgPtr p, StgPtr stack_end)
 	    }
 	    
 	    // 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--) {
 		thread(p);
 		p++;
 	    }
@@ -308,8 +314,8 @@ thread_stack(StgPtr p, StgPtr stack_end)
 	    nat size;
 	    
 	    p++;
-	    thread(p);
 	    bco = (StgBCO *)*p;
+	    thread(p);
 	    p++;
 	    size = BCO_BITMAP_SIZE(bco);
 	    thread_large_bitmap(p, BCO_BITMAP(bco), size);
@@ -331,7 +337,9 @@ thread_stack(StgPtr p, StgPtr stack_end)
 	    StgRetFun *ret_fun = (StgRetFun *)p;
 	    StgFunInfoTable *fun_info;
 	    
-	    fun_info = get_fun_itbl(ret_fun->fun); // *before* threading it!
+	    fun_info = itbl_to_fun_itbl(
+		get_threaded_info((StgPtr)ret_fun->fun));
+	         // *before* threading it!
 	    thread((StgPtr)&ret_fun->fun);
 	    p = thread_arg_block(fun_info, ret_fun->payload);
 	    continue;
@@ -344,26 +352,25 @@ thread_stack(StgPtr p, StgPtr stack_end)
     }
 }
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 thread_PAP (StgPAP *pap)
 {
     StgPtr p;
     StgWord bitmap, size;
     StgFunInfoTable *fun_info;
     
-    thread((StgPtr)&pap->fun);
-    fun_info = get_fun_itbl(pap->fun);
+    fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
     ASSERT(fun_info->i.type != 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, (StgLargeBitmap *)fun_info->f.bitmap, size);
 	p += size;
 	break;
     case ARG_BCO:
@@ -371,7 +378,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) {
@@ -384,10 +391,12 @@ thread_PAP (StgPAP *pap)
 	}
 	break;
     }
+
+    thread((StgPtr)&pap->fun);
     return p;
 }
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 thread_AP_STACK (StgAP_STACK *ap)
 {
     thread((StgPtr)&ap->fun);
@@ -468,7 +477,7 @@ update_fwd_large( bdescr *bd )
   }
 }
 
-static inline StgPtr
+STATIC_INLINE StgPtr
 thread_obj (StgInfoTable *info, StgPtr p)
 {
     switch (info->type) {
@@ -504,12 +513,20 @@ thread_obj (StgInfoTable *info, StgPtr p)
 	thread((StgPtr)&((StgClosure *)p)->payload[1]);
 	return p + sizeofW(StgHeader) + 2;
 	
+    case BCO: {
+	StgBCO *bco = (StgBCO *)p;
+	thread((StgPtr)&bco->instrs);
+	thread((StgPtr)&bco->literals);
+	thread((StgPtr)&bco->ptrs);
+	thread((StgPtr)&bco->itbls);
+	return p + bco_sizeW(bco);
+    }
+
     case FUN:
     case THUNK:
     case CONSTR:
     case FOREIGN:
     case STABLE_NAME:
-    case BCO:
     case IND_PERM:
     case MUT_VAR:
     case MUT_CONS:
@@ -590,6 +607,7 @@ thread_obj (StgInfoTable *info, StgPtr p)
     
     default:
 	barf("update_fwd: unknown/strange object  %d", (int)(info->type));
+	return NULL;
     }
 }
 
@@ -861,12 +879,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);
 	    }
 	}
@@ -876,7 +894,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;