Add support for enumerating the reachable objects in the heap

(Apply part of commit dbf2db8 from 'paulbone/mercury7_4_pbone' branch.)

This can be used to do heap profiling, helping the developer work out which
objects are live or what kinds of objects account for a lot of their heap
space.

* alloc.c:
* include/gc.h:
* include/private/gc_priv.h:
* reclaim.c:
    As above.

diff --git a/alloc.c b/alloc.c
index 9eb1c06e51641f3e341dcab8bd4bcdf3cbd4269b..0a77fe5365f5e9ea773f524d6d5382a65336604c 100644 (file)
--- a/alloc.c
+++ b/alloc.c
@@ -63,6 +63,10 @@ word GC_non_gc_bytes = 0;  /* Number of bytes not intended to be collected */
 
 word GC_gc_no = 0;
 
+void (*GC_mercury_callback_reachable_object)(GC_word *, size_t) = NULL;
+                           /* Callbacks for mercury to notify   */
+                           /* the runtime of certain events     */
+
 #ifndef GC_DISABLE_INCREMENTAL
   GC_INNER int GC_incremental = 0;      /* By default, stop the world.  */
 #endif
@@ -930,6 +934,9 @@ STATIC void GC_finish_collection(void)
         }
 #   endif
     COND_DUMP;
+    if (GC_mercury_callback_reachable_object) {
+       GC_mercury_enumerate_reachable_objects();
+    }
     if (GC_find_leak) {
       /* Mark all objects on the free list.  All objects should be      */
       /* marked when we're done.                                        */

diff --git a/include/gc.h b/include/gc.h
index d1423818664cf726829847922dc1a0b094095ab3..e98431ca86721364817069819c2aef9198bd5bfb 100644 (file)
--- a/include/gc.h
+++ b/include/gc.h
@@ -392,6 +392,9 @@ GC_API GC_ATTR_DEPRECATED unsigned long GC_time_limit;
 GC_API void GC_CALL GC_set_time_limit(unsigned long);
 GC_API unsigned long GC_CALL GC_get_time_limit(void);
 
+GC_API void (*GC_mercury_callback_reachable_object)(GC_word *, size_t);
+                /* This object on the heap is reachable. */
+
 /* Public procedures */
 
 /* Set whether the GC will allocate executable memory pages or not.     */

diff --git a/include/private/gc_priv.h b/include/private/gc_priv.h
index f3f0718ee72d3d7fba34c6be6ec52ae482d2b0c3..e369a7cc2b97a793394907fdd2cb7cad153684aa 100644 (file)
--- a/include/private/gc_priv.h
+++ b/include/private/gc_priv.h
@@ -2082,6 +2082,8 @@ void GC_print_static_roots(void);
 
 extern word GC_fo_entries; /* should be visible in extra/MacOS.c */
 
+GC_INNER void GC_mercury_enumerate_reachable_objects(void);
+
 #ifdef KEEP_BACK_PTRS
    GC_INNER void GC_store_back_pointer(ptr_t source, ptr_t dest);
    GC_INNER void GC_marked_for_finalization(ptr_t dest);

diff --git a/reclaim.c b/reclaim.c
index a332ef67bcde1fc2a5786d74fb28c00861ce2e3d..0685f937cdd5671bce35ea70924806299d52f544 100644 (file)
--- a/reclaim.c
+++ b/reclaim.c
@@ -772,3 +772,39 @@ GC_INNER GC_bool GC_reclaim_all(GC_stop_func stop_func, GC_bool ignore_old)
     }
   }
 #endif /* !EAGER_SWEEP && ENABLE_DISCLAIM */
+
+STATIC void GC_mercury_do_enumerate_reachable_objects(struct hblk *hbp,
+    word dummy)
+{
+    struct hblkhdr * hhdr = HDR(hbp);
+    size_t sz = hhdr -> hb_sz;
+    size_t bit_no;
+    char *p, *plim;
+
+    if (GC_block_empty(hhdr)) {
+        return;
+    }
+
+    p = hbp->hb_body;
+    bit_no = 0;
+    if (sz > MAXOBJBYTES) { /* one big object */
+        plim = p;
+    } else {
+        plim = hbp->hb_body + HBLKSIZE - sz;
+    }
+    /* Go through all words in block. */
+    while (p <= plim) {
+        if (mark_bit_from_hdr(hhdr, bit_no)) {
+            GC_mercury_callback_reachable_object((GC_word *)p,
+               BYTES_TO_WORDS(sz));
+        }
+        bit_no += MARK_BIT_OFFSET(sz);
+        p += sz;
+    }
+}
+
+GC_INNER void GC_mercury_enumerate_reachable_objects(void)
+{
+    GC_ASSERT(GC_mercury_callback_reachable_object);
+    GC_apply_to_all_blocks(GC_mercury_do_enumerate_reachable_objects, (word)0);
+}