Add closures I stumbled upon

diff --git a/cbits/HeapView.c b/cbits/HeapView.c
index 6d2598b..f70ce47 100644 (file)
--- a/cbits/HeapView.c
+++ b/cbits/HeapView.c
@@ -234,10 +234,19 @@ StgMutArrPtrs *closurePtrs(Capability *cap, StgClosure *closure) {
         case MUT_ARR_PTRS_CLEAN:
         case MUT_ARR_PTRS_DIRTY:
         case MUT_ARR_PTRS_FROZEN:
+        case MUT_ARR_PTRS_FROZEN0:
             for (i = 0; i < ((StgMutArrPtrs *)closure)->ptrs; ++i) {
                 ptrs[nptrs++] = ((StgMutArrPtrs *)closure)->payload[i];
             }
             break;
+        case MUT_VAR_CLEAN:
+            ptrs[nptrs++] = ((StgMutVar *)closure)->var;
+            break;
+        case MVAR_CLEAN:
+            ptrs[nptrs++] = (StgClosure *)((StgMVar *)closure)->head;
+            ptrs[nptrs++] = (StgClosure *)((StgMVar *)closure)->tail;
+            ptrs[nptrs++] = ((StgMVar *)closure)->value;
+            break;
 
         default:
             fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", closure_type_names[info->type]);

diff --git a/src/GHC/HeapView.hs b/src/GHC/HeapView.hs
index a60899d..cc20f8f 100644 (file)
--- a/src/GHC/HeapView.hs
+++ b/src/GHC/HeapView.hs
@@ -24,6 +24,7 @@ module GHC.HeapView (
     -- * Boxes
     Box(..),
     asBox,
+    aToWord#
     )
     where
 
@@ -289,6 +290,16 @@ data Closure =
         , mccPayload :: [Box]
         -- Card table ignored
     } |
+    MutVarClosure {
+        info         :: StgInfoTable 
+        , var        :: Box
+    } |
+    MVarClosure {
+        info         :: StgInfoTable 
+        , queueHead  :: Box
+        , queueTail  :: Box
+        , value      :: Box
+    } |
     FunClosure {
         info         :: StgInfoTable 
         , ptrArgs    :: [Box]
@@ -319,6 +330,8 @@ allPtrs (PAPClosure {..}) = fun:payload
 allPtrs (BCOClosure {..}) = [instrs,literals,bcoptrs]
 allPtrs (ArrWordsClosure {..}) = []
 allPtrs (MutArrClosure {..}) = mccPayload
+allPtrs (MutVarClosure {..}) = [var]
+allPtrs (MVarClosure {..}) = [queueHead,queueTail,value]
 allPtrs (FunClosure {..}) = ptrArgs
 allPtrs (BlockingQueueClosure {..}) = [link, blackHole, owner, queue]
 allPtrs (OtherClosure {..}) = hvalues
@@ -460,7 +473,7 @@ getClosureData x = do
         ARR_WORDS ->
             return $ ArrWordsClosure itbl (wds !! 1) (drop 2 wds)
         MUT_ARR_PTRS_FROZEN ->
-            return $ MutArrClosure itbl (wds !! 2) (wds !! 3) ptrs
+            return $ MutArrClosure itbl (words !! 2) (words !! 3) ptrs
 
         BLOCKING_QUEUE ->
           return $ OtherClosure itbl ptrs wds