Fix crashes by evaluating rawWords deeply enough
authorJoachim Breitner <mail@joachim-breitner.de>
Fri, 22 Mar 2013 15:55:36 +0000 (15:55 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 22 Mar 2013 15:55:36 +0000 (15:55 +0000)
cbits/HeapViewPrim.cmm
src/GHC/HeapView.hs

index c8a0a61..349e29e 100644 (file)
@@ -7,10 +7,10 @@ aToWordzh
        RET_N(clos);
 }
 
+// Taken from stg_unpackClosurezh in rts/PrimOps.cmm
 slurpClosurezh
 {
 /* args: R1 = closure to analyze */
-// TODO: Consider the absence of ptrs or nonptrs as a special case ?
 
     W_ clos, len;
     clos = UNTAG(R1);
@@ -18,7 +18,7 @@ slurpClosurezh
     W_ info;
     info = %GET_STD_INFO(clos);
 
-    (len) = foreign "C" gtc_heap_view_closureSize(clos "ptr") [];
+    (len) = foreign "C" gtc_heap_view_closureSize(clos "ptr") [R1];
 
     W_ data_arr_sz;
     data_arr_sz = SIZEOF_StgArrWords  + WDS(len);
index e966af3..69f89d2 100644 (file)
@@ -76,6 +76,7 @@ import Control.Monad.Trans.State
 import Control.Monad.Trans.Class
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Writer.Strict
+import Control.Exception.Base (evaluate)
 
 import GHC.Disassembler
 
@@ -446,7 +447,11 @@ getClosureRaw x =
                 rawWords = [W# (indexWordArray# dat i) | I# i <- [0.. fromIntegral nelems -1] ]
                 pelems = I# (sizeofArray# ptrs) 
                 ptrList = amap' Box $ Array 0 (pelems - 1) pelems ptrs
-            ptrList `seq` rawWords `seq` return (Ptr iptr, rawWords, ptrList)
+            -- This is just for good measure, and seems to be not important.
+            mapM_ evaluate ptrList
+            -- The following deep evaluation is crucial to avoid crashes (but why)?
+            mapM_ evaluate rawWords
+            return (Ptr iptr, rawWords, ptrList)
 
 -- From compiler/ghci/RtClosureInspect.hs
 amap' :: (t -> b) -> Array Int t -> [b]