add (mapped-elf-images) procedure to (system vm objcode) module

* libguile/objcodes.c (register_elf, scm_mapped_elf_images): New
  interfaces that keep a list of all ELF mappings.  Exported to (but not
  from) the (system vm objcode) module.

1 files changed, 31 insertions, 0 deletions

diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 127655b0f..45518877b 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -88,6 +88,8 @@
 #define ELFDATA ELFDATA2LSB
 #endif
 
+static void register_elf (char *data, size_t len);
+
 enum bytecode_kind
   {
     BYTECODE_KIND_NONE,
@@ -456,6 +458,8 @@ load_thunk_from_memory (char *data, size_t len, int is_read_only)
   if (scm_is_true (init))
     scm_call_0 (init);
 
+  register_elf (data, len);
+
   /* Finally!  Return the thunk.  */
   return entry;
 
@@ -634,6 +638,30 @@ scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr)
 }
 #undef FUNC_NAME
 
+static SCM mapped_elf_images = SCM_EOL;
+
+static void
+register_elf (char *data, size_t len)
+{
+  SCM bv = scm_c_take_gc_bytevector ((signed char *) data, len, SCM_BOOL_F);
+
+  scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
+  mapped_elf_images = scm_cons (bv, mapped_elf_images);
+  scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+}
+
+static SCM
+scm_mapped_elf_images (void)
+{
+  SCM ret;
+
+  scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
+  ret = mapped_elf_images;
+  scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+
+  return ret;
+}
+
 
 /*
  * Scheme interface
@@ -772,6 +800,9 @@ scm_init_objcodes (void)
 #include "libguile/objcodes.x"
 #endif
 
+  scm_c_define_gsubr ("mapped-elf-images", 0, 0, 0,
+                      (scm_t_subr) scm_mapped_elf_images);
+
   scm_c_define ("word-size", scm_from_size_t (sizeof(SCM)));
   scm_c_define ("byte-order", scm_from_uint16 (SCM_BYTE_ORDER));
 }