Try to support ghc-8.2 and drop support for ghc <8
authorJoachim Breitner <mail@joachim-breitner.de>
Fri, 1 Sep 2017 12:14:49 +0000 (13:14 +0100)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 1 Sep 2017 12:28:11 +0000 (13:28 +0100)
.travis.yml
cbits/HeapView.c
cbits/HeapViewPrim.cmm
ghc-heap-view.cabal
src/GHC/Disassembler.hs
src/GHC/HeapView.hs

index fdf0f0f..5dc69e0 100644 (file)
@@ -4,10 +4,8 @@
 # test only against the last release in a major GHC version. Feel free to omit
 # lines listings versions you don't need/want testing for.
 env:
- - CABALVER=1.18 GHCVER=7.6.3
- - CABALVER=1.18 GHCVER=7.8.4
- - CABALVER=1.22 GHCVER=7.10.3
- - CABALVER=1.24 GHCVER=8.0.1
+ - CABALVER=1.24 GHCVER=8.0.2
+ - CABALVER=2.0 GHCVER=8.2.1
  - CABALVER=head GHCVER=head   # see section about GHC HEAD snapshots
 
 matrix:
index d4c3faa..38f7922 100644 (file)
@@ -6,9 +6,9 @@ StgWord gtc_heap_view_closureSize(StgClosure *closure) {
 }
 
 static void
-gtc_heap_view_closure_ptrs_in_large_bitmap(StgClosure *ptrs[], StgWord *nptrs, StgClosure **p, StgLargeBitmap *large_bitmap, nat size )
+gtc_heap_view_closure_ptrs_in_large_bitmap(StgClosure *ptrs[], StgWord *nptrs, StgClosure **p, StgLargeBitmap *large_bitmap, uint32_t size )
 {
-    nat i, j, b;
+    uint32_t i, j, b;
     StgWord bitmap;
 
     b = 0;
@@ -35,8 +35,12 @@ char *gtc_heap_view_closure_type_names[] = {
  [CONSTR_2_0]            = "CONSTR_2_0",
  [CONSTR_1_1]            = "CONSTR_1_1",
  [CONSTR_0_2]            = "CONSTR_0_2",
+#if defined(GHC_8_0)
  [CONSTR_STATIC]         = "CONSTR_STATIC",
  [CONSTR_NOCAF_STATIC]   = "CONSTR_NOCAF_STATIC",
+#else
+ [CONSTR_NOCAF]          = "CONSTR_NOCAF",
+#endif
  [FUN]                   = "FUN",
  [FUN_1_0]               = "FUN_1_0",
  [FUN_0_1]               = "FUN_0_1",
@@ -57,18 +61,13 @@ char *gtc_heap_view_closure_type_names[] = {
  [PAP]                   = "PAP",
  [AP_STACK]              = "AP_STACK",
  [IND]                   = "IND",
-#ifdef MIN_VERSION_GLASGOW_HASKELL
-#if !MIN_VERSION_GLASGOW_HASKELL(8,1,0,0)
+#if defined(GHC_8_0)
  [IND_PERM]              = "IND_PERM",
-#endif
 #endif
  [IND_STATIC]            = "IND_STATIC",
  [RET_BCO]               = "RET_BCO",
  [RET_SMALL]             = "RET_SMALL",
  [RET_BIG]               = "RET_BIG",
-#if !defined(GHC_7_7) && !defined(GHC_8_0)
- [RET_DYN]               = "RET_DYN",
-#endif
  [RET_FUN]               = "RET_FUN",
  [UPDATE_FRAME]          = "UPDATE_FRAME",
  [CATCH_FRAME]           = "CATCH_FRAME",
@@ -78,9 +77,6 @@ char *gtc_heap_view_closure_type_names[] = {
  [BLOCKING_QUEUE]        = "BLOCKING_QUEUE",
  [MVAR_CLEAN]            = "MVAR_CLEAN",
  [MVAR_DIRTY]            = "MVAR_DIRTY",
-#if defined(GHC_7_7) || defined(GHC_8_0)
- [TVAR]                  = "TVAR",
-#endif
  [ARR_WORDS]             = "ARR_WORDS",
  [MUT_ARR_PTRS_CLEAN]    = "MUT_ARR_PTRS_CLEAN",
  [MUT_ARR_PTRS_DIRTY]    = "MUT_ARR_PTRS_DIRTY",
@@ -97,13 +93,20 @@ char *gtc_heap_view_closure_type_names[] = {
  [ATOMICALLY_FRAME]      = "ATOMICALLY_FRAME",
  [CATCH_RETRY_FRAME]     = "CATCH_RETRY_FRAME",
  [CATCH_STM_FRAME]       = "CATCH_STM_FRAME",
- [WHITEHOLE]             = "WHITEHOLE"
+ [WHITEHOLE]             = "WHITEHOLE",
+ [SMALL_MUT_ARR_PTRS_CLEAN]   = "SMALL_MUT_ARR_PTRS_CLEAN",
+ [SMALL_MUT_ARR_PTRS_DIRTY]   = "SMALL_MUT_ARR_PTRS_DIRTY",
+ [SMALL_MUT_ARR_PTRS_FROZEN0] = "SMALL_MUT_ARR_PTRS_FROZEN0",
+ [SMALL_MUT_ARR_PTRS_FROZEN]  = "SMALL_MUT_ARR_PTRS_FROZEN",
+#if defined(GHC_8_2)
+ [COMPACT_NFDATA]  = "COMPACT_NFDATA",
+#endif
 };
 
 
 void gtc_heap_view_closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs, StgClosure *fun, StgClosure **payload, StgWord size) {
     StgWord bitmap;
-    StgFunInfoTable *fun_info;
+    const StgFunInfoTable *fun_info;
 
     fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
     // ASSERT(fun_info->i.type != PAP);
@@ -150,7 +153,7 @@ StgMutArrPtrs *gtc_heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
     StgClosure **end;
     StgClosure **ptr;
 
-    StgInfoTable *info = get_itbl(closure);
+    const StgInfoTable *info = get_itbl(closure);
     StgThunkInfoTable *thunk_info;
     StgFunInfoTable *fun_info;
 
@@ -170,8 +173,12 @@ StgMutArrPtrs *gtc_heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
         case CONSTR_1_1:
         case CONSTR_0_2:
         case CONSTR:
+#if defined(GHC_8_0)
         case CONSTR_STATIC:
         case CONSTR_NOCAF_STATIC:
+#else
+        case CONSTR_NOCAF:
+#endif
         case PRIM:
 
         case FUN:
@@ -234,10 +241,8 @@ StgMutArrPtrs *gtc_heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
             break;
             
         case IND:
-#ifdef MIN_VERSION_GLASGOW_HASKELL
-#if !MIN_VERSION_GLASGOW_HASKELL(8,1,0,0)
+#if defined(GHC_8_0)
         case IND_PERM:
-#endif
 #endif
         case IND_STATIC:
         case BLACKHOLE:
index f17f44a..645dad3 100644 (file)
@@ -1,7 +1,5 @@
 #include "Cmm.h"
 
-#if GHC_8_0
-
 aToWordzh (P_ clos)
 {
        return (clos);
@@ -53,115 +51,3 @@ reallyUnsafePtrEqualityUpToTag (W_ clos1, W_  clos2)
     clos2 = UNTAG(clos2);
     return (clos1 == clos2);
 }
-
-#elif GHC_7_7
-
-aToWordzh (P_ clos)
-{
-       return (clos);
-}
-
-slurpClosurezh ( P_ closure )
-{
-    W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr;
-    info  = %GET_STD_INFO(UNTAG(closure));
-
-    ptrs  = TO_W_(%INFO_PTRS(info));
-    nptrs = TO_W_(%INFO_NPTRS(info));
-
-    W_ clos;
-    clos = UNTAG(closure);
-
-    W_ len;
-    (len) = foreign "C" gtc_heap_view_closureSize(clos "ptr");
-
-    W_ ptrs_arr_sz, ptrs_arr_cards, dat_arr_sz;
-    dat_arr_sz = SIZEOF_StgArrWords + WDS(len);
-
-    ALLOC_PRIM_P (dat_arr_sz, slurpClosurezh, closure);
-
-    dat_arr = Hp - dat_arr_sz + WDS(1);
-
-
-    SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS);
-    StgArrWords_bytes(dat_arr) = WDS(len);
-    p = 0;
-for:
-    if(p < len) {
-         W_[BYTE_ARR_CTS(dat_arr) + WDS(p)] = W_[clos + WDS(p)];
-         p = p + 1;
-         goto for;
-    }
-
-    W_ ptrArray;
-
-    ("ptr" ptrArray) = foreign "C" gtc_heap_view_closurePtrs(MyCapability() "ptr", clos "ptr");
-
-    return (info, dat_arr, ptrArray);
-}
-
-
-reallyUnsafePtrEqualityUpToTag (W_ clos1, W_  clos2)
-{
-    clos1 = UNTAG(clos1);
-    clos2 = UNTAG(clos2);
-    return (clos1 == clos2);
-}
-
-#else
-aToWordzh
-{
-       W_ clos;
-       clos = R1;
-       RET_N(clos);
-}
-
-// Taken from stg_unpackClosurezh in rts/PrimOps.cmm
-slurpClosurezh
-{
-/* args: R1 = closure to analyze */
-
-    W_ clos, len;
-    clos = UNTAG(R1);
-
-    W_ info;
-    info = %GET_STD_INFO(clos);
-
-    (len) = foreign "C" gtc_heap_view_closureSize(clos "ptr") [R1];
-
-    W_ data_arr_sz;
-    data_arr_sz = SIZEOF_StgArrWords  + WDS(len);
-
-    ALLOC_PRIM (data_arr_sz, R1_PTR, slurpClosurezh);
-
-    W_ data_arr;
-    data_arr = Hp - data_arr_sz + WDS(1);
-
-    SET_HDR(data_arr, stg_ARR_WORDS_info, CCCS);
-    StgArrWords_bytes(data_arr) = WDS(len);
-    W_ p;
-    p = 0;
-for:
-    if(p < len) {
-        // W_[BYTE_ARR_CTS(data_arr) + WDS(p)] = StgClosure_payload(clos, p);
-        W_[BYTE_ARR_CTS(data_arr) + WDS(p)] = W_[clos + WDS(p)];
-        p = p + 1;
-        goto for;
-    }
-
-    W_ ptrArray;
-
-    ("ptr" ptrArray) = foreign "C" gtc_heap_view_closurePtrs(MyCapability() "ptr", clos "ptr") [];
-
-    RET_NPP(info, data_arr, ptrArray);
-}
-
-reallyUnsafePtrEqualityUpToTag
-{
-    W_ clos1;
-    W_ clos2;
-    clos1 = UNTAG(R1);
-    clos2 = UNTAG(R2);
-    RET_N(clos1 == clos2);
-}
-#endif
index 67ae75d..27ecdc0 100644 (file)
@@ -1,5 +1,5 @@
 Name:                ghc-heap-view
-Version:             0.5.9
+Version:             0.5.10
 Synopsis:            Extract the heap representation of Haskell values and thunks
 Description:
   This library provides functions to introspect the Haskell heap, for example
@@ -56,10 +56,10 @@ 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
-
 Flag ghc_8_0
 
+Flag ghc_8_2
+
 Library
   Default-Language:    Haskell2010
   Exposed-modules:
@@ -68,24 +68,25 @@ Library
     GHC.Disassembler
     GHC.HeapView.Debug
   Build-depends:
-    base >= 4.5 && < 4.10,
+    base >= 4.5 && < 4.11,
     containers,
     transformers,
     template-haskell,
     bytestring >= 0.10,
     binary
 
-  if flag(ghc_7_7)
-    build-depends: ghc >= 7.7 && < 8
-    cc-options: -DGHC_7_7
-    cpp-options: -DGHC_7_7
+  if flag(ghc_8_0)
+    build-depends: ghc >= 8.0 && < 8.2
+    cc-options: -DGHC_8_0
+    cpp-options: -DGHC_8_0
   else
-    if flag(ghc_8_0)
-      build-depends: ghc >= 8
-      cc-options: -DGHC_8_0
-      cpp-options: -DGHC_8_0
+    if flag(ghc_8_2)
+      build-depends: ghc >= 8.2 && < 8.4
+      cc-options: -DGHC_8_2
+      cpp-options: -DGHC_8_2
     else
-      build-depends: ghc < 7.7
+      build-depends: ghc == 0.0
+
 
   C-Sources: cbits/HeapView.c cbits/HeapViewPrim.cmm
   Hs-source-dirs: src/
index c188f59..58d7ad2 100644 (file)
@@ -16,7 +16,6 @@ import Data.Bits
 import Data.Foldable    ( Foldable )
 import Data.Traversable ( Traversable )
 import Control.Applicative ((<$>))
-import Data.Monoid
 
 #include "ghcautoconf.h"
 #include "rts/Bytecodes.h"
index c717f85..2eda349 100644 (file)
@@ -214,8 +214,12 @@ data ClosureType =
         | CONSTR_2_0
         | CONSTR_1_1
         | CONSTR_0_2
+#if defined(GHC_8_0)
         | CONSTR_STATIC
         | CONSTR_NOCAF_STATIC
+#else
+        | CONSTR_NOCAF
+#endif
         | FUN
         | FUN_1_0
         | FUN_0_1
@@ -236,14 +240,13 @@ data ClosureType =
         | PAP
         | AP_STACK
         | IND
+#if defined(GHC_8_0)
         | IND_PERM
+#endif
         | IND_STATIC
         | RET_BCO
         | RET_SMALL
         | RET_BIG
-#if !defined(GHC_7_7) && !defined(GHC_8_0)
-        | RET_DYN
-#endif
         | RET_FUN
         | UPDATE_FRAME
         | CATCH_FRAME
@@ -253,9 +256,7 @@ data ClosureType =
         | BLACKHOLE
         | MVAR_CLEAN
         | MVAR_DIRTY
-#if defined(GHC_7_7) || defined(GHC_8_0)
         | TVAR
-#endif
         | ARR_WORDS
         | MUT_ARR_PTRS_CLEAN
         | MUT_ARR_PTRS_DIRTY
@@ -273,11 +274,12 @@ data ClosureType =
         | CATCH_RETRY_FRAME
         | CATCH_STM_FRAME
         | WHITEHOLE
-#if defined(GHC_8_0)
         | SMALL_MUT_ARR_PTRS_CLEAN
         | SMALL_MUT_ARR_PTRS_DIRTY
         | SMALL_MUT_ARR_PTRS_FROZEN0
         | SMALL_MUT_ARR_PTRS_FROZEN
+#if defined(GHC_8_2)
+        | COMPACT_NFDATA
 #endif
  deriving (Show, Eq, Enum, Bounded, Ord)
 
@@ -551,7 +553,13 @@ getClosureData x = do
     (iptr, wds, ptrs) <- getClosureRaw x
     itbl <- peek iptr
     case tipe itbl of
-        t | t >= CONSTR && t <= CONSTR_NOCAF_STATIC -> do
+        t | t >= CONSTR
+#if defined(GHC_8_0)
+          , t <= CONSTR_NOCAF_STATIC
+#else
+          , t <= CONSTR_NOCAF
+#endif
+          -> do
             (pkg, modl, name) <- dataConInfoPtrToNames iptr
             if modl == "ByteCodeInstr" && name == "BreakInfo"
               then return $ UnsupportedClosure itbl