From a20fa5174654eff73fd5164a9135646cc76108de Mon Sep 17 00:00:00 2001
From: Peter Wang <novalazy@gmail.com>
Date: Mon, 16 Jun 2014 21:05:05 +1000
Subject: [PATCH] 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.
---
 alloc.c                   |  7 +++++++
 include/gc.h              |  3 +++
 include/private/gc_priv.h |  2 ++
 reclaim.c                 | 36 ++++++++++++++++++++++++++++++++++++
 4 files changed, 48 insertions(+)

diff --git a/alloc.c b/alloc.c
index 9eb1c06e..0a77fe53 100644
--- 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 d1423818..e98431ca 100644
--- 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 f3f0718e..e369a7cc 100644
--- 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 a332ef67..0685f937 100644
--- 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);
+}
-- 
2.40.0