Initial work on GHC 7.7 compatibility

diff --git a/cbits/HeapView.c b/cbits/HeapView.c
index f1bf5bf..24cfaa3 100644 (file)
--- a/cbits/HeapView.c
+++ b/cbits/HeapView.c
@@ -62,7 +62,10 @@ char *gtc_heap_view_closure_type_names[] = {
  [RET_BCO]               = "RET_BCO",
  [RET_SMALL]             = "RET_SMALL",
  [RET_BIG]               = "RET_BIG",
+#ifdef GHC_7_7
+#else
  [RET_DYN]               = "RET_DYN",
+#endif
  [RET_FUN]               = "RET_FUN",
  [UPDATE_FRAME]          = "UPDATE_FRAME",
  [CATCH_FRAME]           = "CATCH_FRAME",

diff --git a/cbits/HeapViewPrim.cmm b/cbits/HeapViewPrim.cmm
index 349e29e..1f684a5 100644 (file)
--- a/cbits/HeapViewPrim.cmm
+++ b/cbits/HeapViewPrim.cmm
@@ -1,5 +1,69 @@
 #include "Cmm.h"
 
+#if GHC_7_7
+
+aToWordzh (P_ clos)
+{
+       return (clos);
+}
+
+slurpClosurezh ( P_ closure )
+{
+    W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
+    info  = %GET_STD_INFO(UNTAG(closure));
+
+    ptrs  = TO_W_(%INFO_PTRS(info));
+    nptrs = TO_W_(%INFO_NPTRS(info));
+
+    W_ ptrs_arr_sz, ptrs_arr_cards, nptrs_arr_sz;
+    nptrs_arr_sz = SIZEOF_StgArrWords   + WDS(nptrs);
+    ptrs_arr_cards = mutArrPtrsCardWords(ptrs);
+    ptrs_arr_sz  = SIZEOF_StgMutArrPtrs + WDS(ptrs) + WDS(ptrs_arr_cards);
+
+    ALLOC_PRIM_P (ptrs_arr_sz + nptrs_arr_sz, stg_unpackClosurezh, closure);
+
+    W_ clos;
+    clos = UNTAG(closure);
+
+    ptrs_arr  = Hp - nptrs_arr_sz - ptrs_arr_sz + WDS(1);
+    nptrs_arr = Hp - nptrs_arr_sz + WDS(1);
+
+    SET_HDR(ptrs_arr, stg_MUT_ARR_PTRS_FROZEN_info, CCCS);
+    StgMutArrPtrs_ptrs(ptrs_arr) = ptrs;
+    StgMutArrPtrs_size(ptrs_arr) = ptrs + ptrs_arr_cards;
+
+    p = 0;
+for:
+    if(p < ptrs) {
+         W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(clos,p);
+         p = p + 1;
+         goto for;
+    }
+    /* We can leave the card table uninitialised, since the array is
+       allocated in the nursery.  The GC will fill it in if/when the array
+       is promoted. */
+
+    SET_HDR(nptrs_arr, stg_ARR_WORDS_info, CCCS);
+    StgArrWords_bytes(nptrs_arr) = WDS(nptrs);
+    p = 0;
+for2:
+    if(p < nptrs) {
+         W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(clos, p+ptrs);
+         p = p + 1;
+         goto for2;
+    }
+    return (info, ptrs_arr, nptrs_arr);
+}
+
+
+reallyUnsafePtrEqualityUpToTag (W_ clos1, W_  clos2)
+{
+    clos1 = UNTAG(clos1);
+    clos2 = UNTAG(clos2);
+    return (clos1 == clos2);
+}
+
+#else
 aToWordzh
 {
        W_ clos;
@@ -55,3 +119,4 @@ reallyUnsafePtrEqualityUpToTag
     clos2 = UNTAG(R2);
     RET_N(clos1 == clos2);
 }
+#endif

diff --git a/ghc-heap-view.cabal b/ghc-heap-view.cabal
index a73c097..cebb4d8 100644 (file)
--- a/ghc-heap-view.cabal
+++ b/ghc-heap-view.cabal
@@ -1,5 +1,5 @@
 Name:                ghc-heap-view
-Version:             0.5.1
+Version:             0.5.2
 Synopsis:            Extract the heap representation of Haskell values and thunks
 Description:
   This library provides functions to introspect the Haskell heap, for example
@@ -53,6 +53,8 @@ Flag prim-supports-any
     Description: The used GHC supports Any as an argument to foreign prim functions (GHC ticket #5931)
     Default: False
 
+Flag ghc_7_7
+
 Library
   Default-Language:    Haskell2010
   Exposed-modules:
@@ -61,13 +63,17 @@ Library
     GHC.Disassembler
     GHC.HeapView.Debug
   Build-depends:
-    base >= 4.5 && < 4.7,
+    base >= 4.5 && < 4.8,
     containers,
     transformers,
     template-haskell,
     bytestring >= 0.10,
-    binary,
-    ghc
+    binary
+  if flag(ghc_7_7)
+    build-depends: ghc >= 7.7
+    cc-options: -DGHC_7_7
+  else
+    build-depends: ghc < 7.7
   C-Sources: cbits/HeapView.c cbits/HeapViewPrim.cmm
   Hs-source-dirs: src/
   Ghc-options: -Wall

diff --git a/src/GHC/HeapView.hs b/src/GHC/HeapView.hs
index 975b828..d21260e 100644 (file)
--- a/src/GHC/HeapView.hs
+++ b/src/GHC/HeapView.hs
@@ -56,7 +56,6 @@ import GHC.Exts         ( Any,
 
 import GHC.Arr          (Array(..))
 
-import GHC.Constants    ( wORD_SIZE, tAG_MASK, wORD_SIZE_IN_BITS )
 
 import Foreign          hiding ( unsafePerformIO, void )
 import Numeric          ( showHex )
@@ -1008,3 +1007,11 @@ addBraces False t = t
 braceize :: [String] -> String
 braceize [] = ""
 braceize xs = "{" ++ intercalate "," xs ++ "}"
+
+-- This used to be available via GHC.Constants
+#include "MachDeps.h"
+wORD_SIZE, tAG_MASK, wORD_SIZE_IN_BITS :: Int
+wORD_SIZE = SIZEOF_HSWORD
+tAG_MASK = (1 `shift` TAG_BITS) - 1
+wORD_SIZE_IN_BITS = WORD_SIZE_IN_BITS
+