X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FLdvProfile.c;h=355d09d0287ee7e2f9c7e6fb97bdcc41c0bb1d98;hb=beb5737b7ee42c4e9373a505e7d957206d69a30e;hp=efced2862b576065c39316350d5c14fb799ce211;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git

diff --git a/ghc/rts/LdvProfile.c b/ghc/rts/LdvProfile.c
index efced28..355d09d 100644
--- a/ghc/rts/LdvProfile.c
+++ b/ghc/rts/LdvProfile.c
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: LdvProfile.c,v 1.3 2002/12/11 15:36:42 simonmar Exp $
  *
  * (c) The GHC Team, 2001
  * Author: Sungwoo Park
@@ -10,12 +9,9 @@
 
 #ifdef PROFILING
 
-#include "Stg.h"
 #include "Rts.h"
 #include "LdvProfile.h"
 #include "RtsFlags.h"
-#include "Itimer.h"
-#include "Proftimer.h"
 #include "Profiling.h"
 #include "Stats.h"
 #include "Storage.h"
@@ -41,44 +37,22 @@ void
 LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
 {
     StgInfoTable *info;
-    nat nw, i;
+    nat size, i;
+
+#if defined(__GNUC__) && __GNUC__ < 3 && defined(DEBUG)
+#error Please use gcc 3.0+ to compile this file with DEBUG; gcc < 3.0 miscompiles it
+#endif
 
     if (era > 0) {
-	info = get_itbl((p));
-	switch (info->type) {
-	case THUNK_1_0:
-	case THUNK_0_1:
-	case THUNK_2_0:
-	case THUNK_1_1:
-	case THUNK_0_2:
-	case THUNK_SELECTOR:
-	    nw = MIN_UPD_SIZE;
-	    break;
-	case THUNK:
-	    nw = info->layout.payload.ptrs + info->layout.payload.nptrs;
-	    if (nw < MIN_UPD_SIZE)
-		nw = MIN_UPD_SIZE;
-	    break;
-	case AP:
-	    nw = sizeofW(StgPAP) - sizeofW(StgHeader) + ((StgPAP *)p)->n_args;
-	    break;
-	case AP_STACK:
-	    nw = sizeofW(StgAP_STACK) - sizeofW(StgHeader)
-		+ ((StgAP_STACK *)p)->size;
-	    break;
-	case CAF_BLACKHOLE:
-	case BLACKHOLE:
-	case SE_BLACKHOLE:
-	case SE_CAF_BLACKHOLE:
-	    nw = info->layout.payload.ptrs + info->layout.payload.nptrs;
-	    break;
-	default:
-	    barf("Unexpected closure type %u in LDV_recordDead_FILL_SLOP_DYNAMIC()", info->type);
-	    break;
-	}
-	LDV_recordDead((StgClosure *)(p), nw + sizeofW(StgHeader));
-	for (i = 0; i < nw; i++) {
-	    ((StgClosure *)(p))->payload[i] = 0;
+	// very like FILL_SLOP(), except that we call LDV_recordDead().
+	size = closure_sizeW(p);
+
+	LDV_recordDead((StgClosure *)(p), size);
+
+	if (size > sizeofW(StgThunkHeader)) {
+	    for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
+		((StgThunk *)(p))->payload[i] = 0;
+	    }
 	}
     }
 }
@@ -92,7 +66,7 @@ LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
  * closure.  Returns the size of the closure, including the profiling
  * header portion, so that the caller can find the next closure.
  * ----------------------------------------------------------------------- */
-static inline nat
+STATIC_INLINE nat
 processHeapClosureForDead( StgClosure *c )
 {
     nat size;
@@ -110,93 +84,64 @@ processHeapClosureForDead( StgClosure *c )
 		   ));
     }
 
+    if (info->type == EVACUATED) {
+	// The size of the evacuated closure is currently stored in
+	// the LDV field.  See SET_EVACUAEE_FOR_LDV() in
+	// includes/StgLdvProf.h.
+	return LDVW(c);
+    }
+
+    size = closure_sizeW(c);
+
     switch (info->type) {
 	/*
 	  'inherently used' cases: do nothing.
 	*/
-
     case TSO:
-	size = tso_sizeW((StgTSO *)c);
-	return size;
-
     case MVAR:
-	size = sizeofW(StgMVar);
-	return size;
-
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
-	size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
-	return size;
-
+    case MUT_ARR_PTRS_FROZEN0:
     case ARR_WORDS:
-	size = arr_words_sizeW((StgArrWords *)c);
-	return size;
-
     case WEAK:
-    case MUT_VAR:
-    case MUT_CONS:
-    case FOREIGN:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
     case BCO:
     case STABLE_NAME:
-	size = sizeW_fromITBL(info);
 	return size;
 
 	/*
 	  ordinary cases: call LDV_recordDead().
 	*/
-
     case THUNK:
-	size = stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
-	break;
-
     case THUNK_1_0:
     case THUNK_0_1:
+    case THUNK_SELECTOR:
     case THUNK_2_0:
     case THUNK_1_1:
     case THUNK_0_2:
-    case THUNK_SELECTOR:
-	size = sizeofW(StgHeader) + MIN_UPD_SIZE;
-	break;
-
     case AP:
     case PAP:
-	size = pap_sizeW((StgPAP *)c);
-	break;
-
     case AP_STACK:
-	size = ap_stack_sizeW((StgAP_STACK *)c);
-	break;
-
     case CONSTR:
     case CONSTR_1_0:
     case CONSTR_0_1:
     case CONSTR_2_0:
     case CONSTR_1_1:
     case CONSTR_0_2:
-
     case FUN:
     case FUN_1_0:
     case FUN_0_1:
     case FUN_2_0:
     case FUN_1_1:
     case FUN_0_2:
-
-    case BLACKHOLE_BQ:
     case BLACKHOLE:
     case SE_BLACKHOLE:
     case CAF_BLACKHOLE:
     case SE_CAF_BLACKHOLE:
-	size = sizeW_fromITBL(info);
-	break;
-
     case IND_PERM:
-	size = sizeofW(StgInd);
-	break;
-
     case IND_OLDGEN_PERM:
-	size = sizeofW(StgIndOldGen);
-	break;
-
 	/*
 	  'Ingore' cases
 	*/
@@ -207,19 +152,11 @@ processHeapClosureForDead( StgClosure *c )
 	// because they will perish before the next census at any
 	// rate.
     case IND:
-	size = sizeofW(StgInd);
-	return size;
-
     case IND_OLDGEN:
-	size = sizeofW(StgIndOldGen);
+	// Found a dead closure: record its size
+	LDV_recordDead(c, size);
 	return size;
 
-    case EVACUATED:
-	// The size of the evacuated closure is currently stored in
-	// the LDV field.  See SET_EVACUAEE_FOR_LDV() in
-	// includes/StgLdvProf.h.
-	return LDVW(c);
-
 	/*
 	  Error case
 	*/
@@ -252,10 +189,6 @@ processHeapClosureForDead( StgClosure *c )
 	barf("Invalid object in processHeapClosureForDead(): %d", info->type);
 	return 0;
     }
-
-    // Found a dead closure: record its size
-    LDV_recordDead(c, size);
-    return size;
 }
 
 /* --------------------------------------------------------------------------
@@ -288,7 +221,7 @@ processNurseryForDead( void )
     StgPtr p, bdLimit;
     bdescr *bd;
 
-    bd = MainCapability.r.rNursery;
+    bd = MainCapability.r.rNursery->blocks;
     while (bd->start < bd->free) {
 	p = bd->start;
 	bdLimit = bd->start + BLOCK_SIZE_W;