Add more sanity checking
[ghc-heap-view.git] / cbits / HeapView.c
index f70ce47..ccfb122 100644 (file)
@@ -1,12 +1,12 @@
 #include "Rts.h"
 
-StgWord closureSize(StgClosure *closure) {
+StgWord gtc_heap_view_closureSize(StgClosure *closure) {
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
     return closure_sizeW(closure);
 }
 
 static void
-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, nat size )
 {
     nat i, j, b;
     StgWord bitmap;
@@ -27,7 +27,7 @@ closure_ptrs_in_large_bitmap(StgClosure *ptrs[], StgWord *nptrs, StgClosure **p,
 }
 
 // from rts/Printer.c
-char *closure_type_names[] = {
+char *gtc_heap_view_closure_type_names[] = {
  [INVALID_OBJECT]        = "INVALID_OBJECT",
  [CONSTR]                = "CONSTR",
  [CONSTR_1_0]            = "CONSTR_1_0",
@@ -62,7 +62,9 @@ char *closure_type_names[] = {
  [RET_BCO]               = "RET_BCO",
  [RET_SMALL]             = "RET_SMALL",
  [RET_BIG]               = "RET_BIG",
+#ifndef GHC_7_7
  [RET_DYN]               = "RET_DYN",
+#endif
  [RET_FUN]               = "RET_FUN",
  [UPDATE_FRAME]          = "UPDATE_FRAME",
  [CATCH_FRAME]           = "CATCH_FRAME",
@@ -72,6 +74,9 @@ char *closure_type_names[] = {
  [BLOCKING_QUEUE]        = "BLOCKING_QUEUE",
  [MVAR_CLEAN]            = "MVAR_CLEAN",
  [MVAR_DIRTY]            = "MVAR_DIRTY",
+#ifdef GHC_7_7
+ [TVAR]                  = "TVAR",
+#endif
  [ARR_WORDS]             = "ARR_WORDS",
  [MUT_ARR_PTRS_CLEAN]    = "MUT_ARR_PTRS_CLEAN",
  [MUT_ARR_PTRS_DIRTY]    = "MUT_ARR_PTRS_DIRTY",
@@ -92,12 +97,12 @@ char *closure_type_names[] = {
 };
 
 
-void closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs, StgClosure *fun, StgClosure **payload, StgWord size) {
+void gtc_heap_view_closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs, StgClosure *fun, StgClosure **payload, StgWord size) {
     StgWord bitmap;
     StgFunInfoTable *fun_info;
-    
+
     fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
-    ASSERT(fun_info->i.type != PAP);
+    // ASSERT(fun_info->i.type != PAP);
     StgClosure **p = payload;
 
     switch (fun_info->f.fun_type) {
@@ -105,10 +110,10 @@ void closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs, StgClosure
         bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
         goto small_bitmap;
     case ARG_GEN_BIG:
-        closure_ptrs_in_large_bitmap(ptrs, nptrs, payload, GET_FUN_LARGE_BITMAP(fun_info), size);
+        gtc_heap_view_closure_ptrs_in_large_bitmap(ptrs, nptrs, payload, GET_FUN_LARGE_BITMAP(fun_info), size);
         break;
     case ARG_BCO:
-        closure_ptrs_in_large_bitmap(ptrs, nptrs, payload, BCO_BITMAP(fun), size);
+        gtc_heap_view_closure_ptrs_in_large_bitmap(ptrs, nptrs, payload, BCO_BITMAP(fun), size);
         break;
     default:
         bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
@@ -125,10 +130,10 @@ void closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs, StgClosure
     }
 }
 
-StgMutArrPtrs *closurePtrs(Capability *cap, StgClosure *closure) {
+StgMutArrPtrs *gtc_heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
 
-    StgWord size = closureSize(closure);
+    StgWord size = gtc_heap_view_closureSize(closure);
     StgWord nptrs = 0;
     StgWord i;
 
@@ -197,7 +202,7 @@ StgMutArrPtrs *closurePtrs(Capability *cap, StgClosure *closure) {
             
         case AP:
             ptrs[nptrs++] = ((StgAP *)closure)->fun;
-            closure_ptrs_in_pap_payload(ptrs, &nptrs,
+            gtc_heap_view_closure_ptrs_in_pap_payload(ptrs, &nptrs,
                 ((StgAP *)closure)->fun,
                 ((StgAP *)closure)->payload,
                 ((StgAP *)closure)->n_args);
@@ -205,7 +210,7 @@ StgMutArrPtrs *closurePtrs(Capability *cap, StgClosure *closure) {
             
         case PAP:
             ptrs[nptrs++] = ((StgPAP *)closure)->fun;
-            closure_ptrs_in_pap_payload(ptrs, &nptrs,
+            gtc_heap_view_closure_ptrs_in_pap_payload(ptrs, &nptrs,
                 ((StgPAP *)closure)->fun,
                 ((StgPAP *)closure)->payload,
                 ((StgPAP *)closure)->n_args);
@@ -249,7 +254,7 @@ StgMutArrPtrs *closurePtrs(Capability *cap, StgClosure *closure) {
             break;
 
         default:
-            fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", closure_type_names[info->type]);
+            //fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", gtc_heap_view_closure_type_names[info->type]);
             break;
     }