Initial work on GHC 7.7 compatibility

[ghc-heap-view.git] / cbits / HeapViewPrim.cmm

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