X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStorage.h;h=46081ad69bf984f952c47a1fdde1a1025a422498;hb=0372ac231bd18e993a2533f784805046876d5527;hp=e37c50d054af8265873fbb763de73882a04ae39d;hpb=c5cd2343c5a86c8cb5349823a9699b30a269f3e8;p=ghc-hetmet.git

diff --git a/ghc/includes/Storage.h b/ghc/includes/Storage.h
index e37c50d..46081ad 100644
--- a/ghc/includes/Storage.h
+++ b/ghc/includes/Storage.h
@@ -140,7 +140,7 @@ extern void exitStorage(void);
                                 via allocate() since the last GC.
 				Used in the reporting of statistics.
 
-   SMP: allocate and doYouWantToGC can be used from STG code, they are
+   THREADED_RTS: allocate and doYouWantToGC can be used from STG code, they are
    surrounded by a mutex.
    -------------------------------------------------------------------------- */
 
@@ -198,11 +198,12 @@ extern void GarbageCollect(void (*get_roots)(evac_fn),rtsBool force_major_gc);
 /*
  * Storage manager mutex
  */
-#if defined(SMP)
+#if defined(THREADED_RTS)
 extern Mutex sm_mutex;
+extern Mutex atomic_modify_mutvar_mutex;
 #endif
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
 #define ACQUIRE_SM_LOCK   ACQUIRE_LOCK(&sm_mutex);
 #define RELEASE_SM_LOCK   RELEASE_LOCK(&sm_mutex);
 #define ASSERT_SM_LOCK()  ASSERT_LOCK_HELD(&sm_mutex);
@@ -263,6 +264,15 @@ recordMutableLock(StgClosure *p)
 extern rtsBool keepCAFs;
 
 /* -----------------------------------------------------------------------------
+   This is the write barrier for MUT_VARs, a.k.a. IORefs.  A
+   MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
+   is.  When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
+   and is put on the mutable list.
+   -------------------------------------------------------------------------- */
+
+void dirty_MUT_VAR(StgRegTable *reg, StgClosure *p);
+
+/* -----------------------------------------------------------------------------
    DEBUGGING predicates for pointers
 
    LOOKS_LIKE_INFO_PTR(p)    returns False if p is definitely not an info ptr
@@ -303,10 +313,10 @@ INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np )
 { return sizeofW(StgHeader) + p + np; }
 
 INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void )
-{ return stg_max(sizeofW(StgHeader)+MIN_UPD_SIZE, sizeofW(StgSelector)); }
+{ return sizeofW(StgSelector); }
 
 INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void )
-{ return sizeofW(StgHeader)+MIN_UPD_SIZE; }
+{ return sizeofW(StgHeader)+MIN_PAYLOAD_SIZE; }
 
 /* --------------------------------------------------------------------------
    Sizes of closures
@@ -343,6 +353,74 @@ INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso )
 INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco )
 { return bco->size; }
 
+STATIC_INLINE nat
+closure_sizeW_ (StgClosure *p, StgInfoTable *info)
+{
+    switch (info->type) {
+    case THUNK_0_1:
+    case THUNK_1_0:
+	return sizeofW(StgThunk) + 1;
+    case FUN_0_1:
+    case CONSTR_0_1:
+    case FUN_1_0:
+    case CONSTR_1_0:
+	return sizeofW(StgHeader) + 1;
+    case THUNK_0_2:
+    case THUNK_1_1:
+    case THUNK_2_0:
+	return sizeofW(StgThunk) + 2;
+    case FUN_0_2:
+    case CONSTR_0_2:
+    case FUN_1_1:
+    case CONSTR_1_1:
+    case FUN_2_0:
+    case CONSTR_2_0:
+	return sizeofW(StgHeader) + 2;
+    case THUNK:
+	return thunk_sizeW_fromITBL(info);
+    case THUNK_SELECTOR:
+	return THUNK_SELECTOR_sizeW();
+    case AP_STACK:
+	return ap_stack_sizeW((StgAP_STACK *)p);
+    case AP:
+    case PAP:
+	return pap_sizeW((StgPAP *)p);
+    case IND:
+    case IND_PERM:
+    case IND_OLDGEN:
+    case IND_OLDGEN_PERM:
+	return sizeofW(StgInd);
+    case ARR_WORDS:
+	return arr_words_sizeW((StgArrWords *)p);
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
+    case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
+	return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+    case TSO:
+	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);
+    }
+}
+
+// The definitive way to find the size, in words, of a heap-allocated closure
+STATIC_INLINE nat
+closure_sizeW (StgClosure *p)
+{
+    return closure_sizeW_(p, get_itbl(p));
+}
+
 /* -----------------------------------------------------------------------------
    Sizes of stack frames
    -------------------------------------------------------------------------- */