[project @ 2006-01-17 16:03:47 by simonmar]

Improve the GC behaviour of IOArrays/STArrays

See Ticket #650

This is a small change to the way mutable arrays interact with the GC,
that can have a dramatic effect on performance, and make tricks with
unsafeThaw/unsafeFreeze redundant.  Data.HashTable should be faster
now (I haven't measured it yet).

We now have two mutable array closure types, MUT_ARR_PTRS_CLEAN and
MUT_ARR_PTRS_DIRTY.  Both are on the mutable list if the array is in
an old generation.  writeArray# sets the type to MUT_ARR_PTRS_DIRTY.
The garbage collector can set the type to MUT_ARR_PTRS_CLEAN if it
finds that no element of the array points into a younger generation
(discovering this required a small addition to evacuate(), but rough
tests indicate that it doesn't measurably affect performance).

NOTE: none of this affects unboxed arrays (IOUArray/STUArray), only
boxed arrays (IOArray/STArray).

We could go further and extend the DIRTY bit to be per-block rather
than for the whole array, but for now this is an easy improvement.

diff --git a/ghc/compiler/cmm/CLabel.hs b/ghc/compiler/cmm/CLabel.hs
index fb13589..ca818cb 100644 (file)
--- a/ghc/compiler/cmm/CLabel.hs
+++ b/ghc/compiler/cmm/CLabel.hs
@@ -51,6 +51,7 @@ module CLabel (
        mkIndStaticInfoLabel,
         mkMainCapabilityLabel,
        mkMAP_FROZEN_infoLabel,
+       mkMAP_DIRTY_infoLabel,
         mkEMPTY_MVAR_infoLabel,
 
        mkTopTickyCtrLabel,
@@ -347,6 +348,7 @@ mkSeqInfoLabel                      = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
 mkIndStaticInfoLabel           = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
 mkMainCapabilityLabel          = RtsLabel (RtsData SLIT("MainCapability"))
 mkMAP_FROZEN_infoLabel         = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0"))
+mkMAP_DIRTY_infoLabel          = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_DIRTY"))
 mkEMPTY_MVAR_infoLabel         = RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR"))
 
 mkTopTickyCtrLabel             = RtsLabel (RtsData SLIT("top_ct"))

diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs
index 610f4d5..7784efb 100644 (file)
--- a/ghc/compiler/codeGen/CgPrimOp.hs
+++ b/ghc/compiler/codeGen/CgPrimOp.hs
@@ -16,7 +16,7 @@ import CgMonad
 import CgInfoTbls      ( getConstrTag )
 import CgUtils         ( cmmOffsetW, cmmOffsetB, cmmLoadIndexW )
 import Cmm
-import CLabel          ( mkMAP_FROZEN_infoLabel )
+import CLabel          ( mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel )
 import CmmUtils
 import MachOp
 import SMRep
@@ -525,7 +525,8 @@ doWriteByteArrayOp _ _ _ _
    = panic "CgPrimOp: doWriteByteArrayOp"
 
 doWritePtrArrayOp addr idx val
-   = mkBasicIndexedWrite arrPtrsHdrSize Nothing wordRep addr idx val
+   = do stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
+        mkBasicIndexedWrite arrPtrsHdrSize Nothing wordRep addr idx val
 
 
 mkBasicIndexedRead off Nothing read_rep res base idx

diff --git a/ghc/includes/ClosureTypes.h b/ghc/includes/ClosureTypes.h
index 1ae6072..18e9448 100644 (file)
--- a/ghc/includes/ClosureTypes.h
+++ b/ghc/includes/ClosureTypes.h
@@ -72,26 +72,27 @@
 #define SE_CAF_BLACKHOLE       48
 #define MVAR                   49
 #define ARR_WORDS              50
-#define MUT_ARR_PTRS           51
-#define MUT_ARR_PTRS_FROZEN0    52
-#define MUT_ARR_PTRS_FROZEN     53
-#define MUT_VAR                        54
-#define WEAK                   55
-#define STABLE_NAME            56
-#define TSO                    57
-#define BLOCKED_FETCH          58
-#define FETCH_ME                59
-#define FETCH_ME_BQ             60
-#define RBH                     61
-#define EVACUATED               62
-#define REMOTE_REF              63
-#define TVAR_WAIT_QUEUE         64
-#define TVAR                    65
-#define TREC_CHUNK              66
-#define TREC_HEADER             67
-#define ATOMICALLY_FRAME        68
-#define CATCH_RETRY_FRAME       69
-#define CATCH_STM_FRAME         70
-#define N_CLOSURE_TYPES         71
+#define MUT_ARR_PTRS_CLEAN      51
+#define MUT_ARR_PTRS_DIRTY      52
+#define MUT_ARR_PTRS_FROZEN0    53
+#define MUT_ARR_PTRS_FROZEN     54
+#define MUT_VAR                        55
+#define WEAK                   56
+#define STABLE_NAME            57
+#define TSO                    58
+#define BLOCKED_FETCH          59
+#define FETCH_ME                60
+#define FETCH_ME_BQ             61
+#define RBH                     62
+#define EVACUATED               63
+#define REMOTE_REF              64
+#define TVAR_WAIT_QUEUE         65
+#define TVAR                    66
+#define TREC_CHUNK              67
+#define TREC_HEADER             68
+#define ATOMICALLY_FRAME        69
+#define CATCH_RETRY_FRAME       70
+#define CATCH_STM_FRAME         71
+#define N_CLOSURE_TYPES         72
 
 #endif /* CLOSURETYPES_H */

diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index cc75d5b..f55c059 100644 (file)
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -122,7 +122,8 @@ RTS_INFO(stg_EMPTY_MVAR_info);
 RTS_INFO(stg_TSO_info);
 RTS_INFO(stg_ARR_WORDS_info);
 RTS_INFO(stg_MUT_ARR_WORDS_info);
-RTS_INFO(stg_MUT_ARR_PTRS_info);
+RTS_INFO(stg_MUT_ARR_PTRS_CLEAN_info);
+RTS_INFO(stg_MUT_ARR_PTRS_DIRTY_info);
 RTS_INFO(stg_MUT_ARR_PTRS_FROZEN_info);
 RTS_INFO(stg_MUT_ARR_PTRS_FROZEN0_info);
 RTS_INFO(stg_MUT_VAR_info);
@@ -181,7 +182,8 @@ RTS_ENTRY(stg_EMPTY_MVAR_entry);
 RTS_ENTRY(stg_TSO_entry);
 RTS_ENTRY(stg_ARR_WORDS_entry);
 RTS_ENTRY(stg_MUT_ARR_WORDS_entry);
-RTS_ENTRY(stg_MUT_ARR_PTRS_entry);
+RTS_ENTRY(stg_MUT_ARR_PTRS_CLEAN_entry);
+RTS_ENTRY(stg_MUT_ARR_PTRS_DIRTY_entry);
 RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN_entry);
 RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN0_entry);
 RTS_ENTRY(stg_MUT_VAR_entry);

diff --git a/ghc/rts/ClosureFlags.c b/ghc/rts/ClosureFlags.c
index df9ef7b..a3f2d5f 100644 (file)
--- a/ghc/rts/ClosureFlags.c
+++ b/ghc/rts/ClosureFlags.c
@@ -77,7 +77,8 @@ StgWord16 closure_flags[] = {
 /* SE_CAF_BLACKHOLE    = */ (          _NS|              _UPT           ),
 /* MVAR                        = */ (_HNF|     _NS|         _MUT|_UPT           ),
 /* ARR_WORDS           = */ (_HNF|     _NS|              _UPT           ),
-/* MUT_ARR_PTRS                = */ (_HNF|     _NS|         _MUT|_UPT           ),
+/* MUT_ARR_PTRS_CLEAN          = */ (_HNF|     _NS|         _MUT|_UPT           ),
+/* MUT_ARR_PTRS_DIRTY          = */ (_HNF|     _NS|         _MUT|_UPT           ),
 /* MUT_ARR_PTRS_FROZEN0        = */ (_HNF|     _NS|         _MUT|_UPT           ),
 /* MUT_ARR_PTRS_FROZEN         = */ (_HNF|     _NS|              _UPT           ),
 /* MUT_VAR             = */ (_HNF|     _NS|         _MUT|_UPT           ),
@@ -99,7 +100,7 @@ StgWord16 closure_flags[] = {
 /* CATCH_STM_FRAME      = */ (     _BTM                                  )
 };
 
-#if N_CLOSURE_TYPES != 71
+#if N_CLOSURE_TYPES != 72
 #error Closure types changed: update ClosureFlags.c!
 #endif
 

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index f2d9437..566ccef 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -104,6 +104,10 @@ static rtsBool major_gc;
  */
 static nat evac_gen;
 
+/* Whether to do eager promotion or not.
+ */
+static rtsBool eager_promotion;
+
 /* Weak pointers
  */
 StgWeak *old_weak_ptr_list; // also pending finaliser list
@@ -585,6 +589,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       mark_stack_bdescr = NULL;
   }
 
+  eager_promotion = rtsTrue; // for now
+
   /* -----------------------------------------------------------------------
    * follow all the roots that we know about:
    *   - mutable lists from each generation > N
@@ -1567,11 +1573,11 @@ copy(StgClosure *src, nat size, step *stp)
    * by evacuate()).
    */
   if (stp->gen_no < evac_gen) {
-#ifdef NO_EAGER_PROMOTION    
-    failed_to_evac = rtsTrue;
-#else
-    stp = &generations[evac_gen].steps[0];
-#endif
+      if (eager_promotion) {
+         stp = &generations[evac_gen].steps[0];
+      } else {
+         failed_to_evac = rtsTrue;
+      }
   }
 
   /* chain a new block onto the to-space for the destination step if
@@ -1617,11 +1623,11 @@ copy_noscav(StgClosure *src, nat size, step *stp)
    * by evacuate()).
    */
   if (stp->gen_no < evac_gen) {
-#ifdef NO_EAGER_PROMOTION    
-    failed_to_evac = rtsTrue;
-#else
-    stp = &generations[evac_gen].steps[0];
-#endif
+      if (eager_promotion) {
+         stp = &generations[evac_gen].steps[0];
+      } else {
+         failed_to_evac = rtsTrue;
+      }
   }
 
   /* chain a new block onto the to-space for the destination step if
@@ -1664,11 +1670,11 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
 
   TICK_GC_WORDS_COPIED(size_to_copy);
   if (stp->gen_no < evac_gen) {
-#ifdef NO_EAGER_PROMOTION    
-    failed_to_evac = rtsTrue;
-#else
-    stp = &generations[evac_gen].steps[0];
-#endif
+      if (eager_promotion) {
+         stp = &generations[evac_gen].steps[0];
+      } else {
+         failed_to_evac = rtsTrue;
+      }
   }
 
   if (stp->hp + size_to_reserve >= stp->hpLim) {
@@ -1745,11 +1751,11 @@ evacuate_large(StgPtr p)
    */
   stp = bd->step->to;
   if (stp->gen_no < evac_gen) {
-#ifdef NO_EAGER_PROMOTION    
-    failed_to_evac = rtsTrue;
-#else
-    stp = &generations[evac_gen].steps[0];
-#endif
+      if (eager_promotion) {
+         stp = &generations[evac_gen].steps[0];
+      } else {
+         failed_to_evac = rtsTrue;
+      }
   }
 
   bd->step = stp;
@@ -2105,7 +2111,8 @@ loop:
       // just copy the block 
       return copy_noscav(q,arr_words_sizeW((StgArrWords *)q),stp);
 
-  case MUT_ARR_PTRS:
+  case MUT_ARR_PTRS_CLEAN:
+  case MUT_ARR_PTRS_DIRTY:
   case MUT_ARR_PTRS_FROZEN:
   case MUT_ARR_PTRS_FROZEN0:
       // just copy the block 
@@ -2934,18 +2941,32 @@ scavenge(step *stp)
        p += arr_words_sizeW((StgArrWords *)p);
        break;
 
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
        // follow everything 
     {
        StgPtr next;
-
-       evac_gen = 0;           // repeatedly mutable 
+       rtsBool saved_eager;
+
+       // We don't eagerly promote objects pointed to by a mutable
+       // array, but if we find the array only points to objects in
+       // the same or an older generation, we mark it "clean" and
+       // avoid traversing it during minor GCs.
+       saved_eager = eager_promotion;
+       eager_promotion = rtsFalse;
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
            *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
-       evac_gen = saved_evac_gen;
-       failed_to_evac = rtsTrue; // mutable anyhow.
+       eager_promotion = saved_eager;
+
+       if (failed_to_evac) {
+           ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
+       } else {
+           ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
+       }
+
+       failed_to_evac = rtsTrue; // always put it on the mutable list.
        break;
     }
 
@@ -3295,17 +3316,31 @@ linear_scan:
            scavenge_AP((StgAP *)p);
            break;
       
-       case MUT_ARR_PTRS:
+       case MUT_ARR_PTRS_CLEAN:
+       case MUT_ARR_PTRS_DIRTY:
            // follow everything 
        {
            StgPtr next;
-           
-           evac_gen = 0;               // repeatedly mutable 
+           rtsBool saved_eager;
+
+           // We don't eagerly promote objects pointed to by a mutable
+           // array, but if we find the array only points to objects in
+           // the same or an older generation, we mark it "clean" and
+           // avoid traversing it during minor GCs.
+           saved_eager = eager_promotion;
+           eager_promotion = rtsFalse;
            next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
            for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
                *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
            }
-           evac_gen = saved_evac_gen;
+           eager_promotion = saved_eager;
+
+           if (failed_to_evac) {
+               ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
+           } else {
+               ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
+           }
+
            failed_to_evac = rtsTrue; // mutable anyhow.
            break;
        }
@@ -3614,17 +3649,31 @@ scavenge_one(StgPtr p)
        // nothing to follow 
        break;
 
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     {
-       // follow everything 
-       StgPtr next;
-      
-       evac_gen = 0;           // repeatedly mutable 
+       StgPtr next, q;
+       rtsBool saved_eager;
+
+       // We don't eagerly promote objects pointed to by a mutable
+       // array, but if we find the array only points to objects in
+       // the same or an older generation, we mark it "clean" and
+       // avoid traversing it during minor GCs.
+       saved_eager = eager_promotion;
+       eager_promotion = rtsFalse;
+       q = p;
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
            *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
        }
-       evac_gen = saved_evac_gen;
+       eager_promotion = saved_eager;
+
+       if (failed_to_evac) {
+           ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
+       } else {
+           ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
+       }
+
        failed_to_evac = rtsTrue;
        break;
     }
@@ -3845,7 +3894,8 @@ scavenge_mutable_list(generation *gen)
            switch (get_itbl((StgClosure *)p)->type) {
            case MUT_VAR:
                mutlist_MUTVARS++; break;
-           case MUT_ARR_PTRS:
+           case MUT_ARR_PTRS_CLEAN:
+           case MUT_ARR_PTRS_DIRTY:
            case MUT_ARR_PTRS_FROZEN:
            case MUT_ARR_PTRS_FROZEN0:
                mutlist_MUTARRS++; break;
@@ -3854,6 +3904,13 @@ scavenge_mutable_list(generation *gen)
            }
 #endif
 
+           // We don't need to scavenge clean arrays.  This is the
+           // Whole Point of MUT_ARR_PTRS_CLEAN.
+           if (get_itbl((StgClosure *)p)->type == MUT_ARR_PTRS_CLEAN) {
+               recordMutableGen((StgClosure *)p,gen);
+               continue;
+           }
+
            if (scavenge_one(p)) {
                /* didn't manage to promote everything, so put the
                 * object back on the list.

diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c
index 58753fe..9d05f5d 100644 (file)
--- a/ghc/rts/GCCompact.c
+++ b/ghc/rts/GCCompact.c
@@ -138,7 +138,8 @@ obj_sizeW( StgClosure *p, StgInfoTable *info )
        return pap_sizeW((StgPAP *)p);
     case ARR_WORDS:
        return arr_words_sizeW((StgArrWords *)p);
-    case MUT_ARR_PTRS:
+    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);
@@ -478,7 +479,8 @@ update_fwd_large( bdescr *bd )
       // nothing to follow 
       continue;
 
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
       // follow everything 
@@ -657,7 +659,8 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case ARR_WORDS:
        return p + arr_words_sizeW((StgArrWords *)p);
        
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
        // follow everything 

diff --git a/ghc/rts/LdvProfile.c b/ghc/rts/LdvProfile.c
index c98a47e..cd3c2d1 100644 (file)
--- a/ghc/rts/LdvProfile.c
+++ b/ghc/rts/LdvProfile.c
@@ -126,7 +126,8 @@ processHeapClosureForDead( StgClosure *c )
        size = sizeofW(StgMVar);
        return size;
 
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
        size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);

diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm
index a3f5144..01b4138 100644 (file)
--- a/ghc/rts/PrimOps.cmm
+++ b/ghc/rts/PrimOps.cmm
@@ -100,7 +100,7 @@ newArrayzh_fast
     "ptr" arr = foreign "C" allocateLocal(MyCapability() "ptr",words) [];
     TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0);
 
-    SET_HDR(arr, stg_MUT_ARR_PTRS_info, W_[CCCS]);
+    SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
     StgMutArrPtrs_ptrs(arr) = n;
 
     // Initialise all elements of the the array with the value in R2
@@ -137,12 +137,12 @@ unsafeThawArrayzh_fast
   // multiple times during GC, which would be unnecessarily slow.
   //
   if (StgHeader_info(R1) != stg_MUT_ARR_PTRS_FROZEN0_info) {
-       SET_INFO(R1,stg_MUT_ARR_PTRS_info);
+       SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info);
        foreign "C" recordMutableLock(R1 "ptr") [R1];
        // must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
        RET_P(R1);
   } else {
-       SET_INFO(R1,stg_MUT_ARR_PTRS_info);
+       SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info);
        RET_P(R1);
   }
 }

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index ca9b008..356bb38 100644 (file)
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -332,8 +332,12 @@ printClosure( StgClosure *obj )
             break;
         }
 
-    case MUT_ARR_PTRS:
-       debugBelch("MUT_ARR_PTRS(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
+    case MUT_ARR_PTRS_CLEAN:
+       debugBelch("MUT_ARR_PTRS_CLEAN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
+       break;
+
+    case MUT_ARR_PTRS_DIRTY:
+       debugBelch("MUT_ARR_PTRS_DIRTY(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
        break;
 
     case MUT_ARR_PTRS_FROZEN:

diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index 59447e4..85ae9fd 100644 (file)
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -153,7 +153,8 @@ static char *type_names[] = {
 
     , "ARR_WORDS"
 
-    , "MUT_ARR_PTRS"
+    , "MUT_ARR_PTRS_CLEAN"
+    , "MUT_ARR_PTRS_DIRTY"
     , "MUT_ARR_PTRS_FROZEN"
     , "MUT_VAR"
 
@@ -946,7 +947,8 @@ heapCensusChain( Census *census, bdescr *bd )
                size = arr_words_sizeW(stgCast(StgArrWords*,p));
                break;
                
-           case MUT_ARR_PTRS:
+           case MUT_ARR_PTRS_CLEAN:
+           case MUT_ARR_PTRS_DIRTY:
            case MUT_ARR_PTRS_FROZEN:
            case MUT_ARR_PTRS_FROZEN0:
                prim = rtsTrue;

diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c
index 074c256..8217f26 100644 (file)
--- a/ghc/rts/RetainerProfile.c
+++ b/ghc/rts/RetainerProfile.c
@@ -521,7 +521,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
        break;
 
        // StgMutArrPtr.ptrs, no SRT
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
        init_ptrs(&se.info, ((StgMutArrPtrs *)c)->ptrs,
@@ -820,7 +821,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
        case BCO:
        case CONSTR_STATIC:
            // StgMutArrPtr.ptrs, no SRT
-       case MUT_ARR_PTRS:
+       case MUT_ARR_PTRS_CLEAN:
+       case MUT_ARR_PTRS_DIRTY:
        case MUT_ARR_PTRS_FROZEN:
        case MUT_ARR_PTRS_FROZEN0:
            *c = find_ptrs(&se->info);
@@ -990,7 +992,8 @@ isRetainer( StgClosure *c )
        // mutable objects
     case MVAR:
     case MUT_VAR:
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
 
@@ -2072,7 +2075,8 @@ sanityCheckHeapClosure( StgClosure *c )
     case MVAR:
        return sizeofW(StgMVar);
 
-    case MUT_ARR_PTRS:
+    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 *)c);

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index 43200d2..f6947c9 100644 (file)
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -400,7 +400,8 @@ checkClosure( StgClosure* p )
     case ARR_WORDS:
            return arr_words_sizeW((StgArrWords *)p);
 
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
        {

diff --git a/ghc/rts/StgMiscClosures.cmm b/ghc/rts/StgMiscClosures.cmm
index 628e0f1..9e71f85 100644 (file)
--- a/ghc/rts/StgMiscClosures.cmm
+++ b/ghc/rts/StgMiscClosures.cmm
@@ -582,8 +582,11 @@ INFO_TABLE(stg_EXCEPTION_CONS,1,1,CONSTR,"EXCEPTION_CONS","EXCEPTION_CONS")
 INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
 { foreign "C" barf("ARR_WORDS object entered!"); }
 
-INFO_TABLE(stg_MUT_ARR_PTRS, 0, 0, MUT_ARR_PTRS, "MUT_ARR_PTRS", "MUT_ARR_PTRS")
-{ foreign "C" barf("MUT_ARR_PTRS object entered!"); }
+INFO_TABLE(stg_MUT_ARR_PTRS_CLEAN, 0, 0, MUT_ARR_PTRS_CLEAN, "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_CLEAN")
+{ foreign "C" barf("MUT_ARR_PTRS_CLEAN object entered!"); }
+
+INFO_TABLE(stg_MUT_ARR_PTRS_DIRTY, 0, 0, MUT_ARR_PTRS_DIRTY, "MUT_ARR_PTRS_DIRTY", "MUT_ARR_PTRS_DIRTY")
+{ foreign "C" barf("MUT_ARR_PTRS_DIRTY object entered!"); }
 
 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FROZEN", "MUT_ARR_PTRS_FROZEN")
 { foreign "C" barf("MUT_ARR_PTRS_FROZEN object entered!"); }