4 files changed, 141 insertions, 2 deletions
diff --git a/configure b/configure
index 0147bd9d..648c8d4c 100755
--- a/configure
+++ b/configure
@@ -2746,6 +2746,42 @@ else
   printf "no\n"
 fi
 
+printf "Checking for dlopen ... "
+
+cat > conftest.c <<!
+#include <dlfcn.h>
+
+int main(void)
+{
+  void *lib = dlopen("foo.so", 0);
+  void *sym = dlsym(lib, "bar");
+#if TEST_DLVSYM
+  void *vsym = dlsvym(lib, "bar", "1");
+#endif
+  dlclose(lib);
+  return 0;
+}
+!
+
+if conftest ; then
+  printf "yes\n"
+  printf "#define HAVE_DLOPEN 1\n" >> config.h
+elif conftest EXTRA_LDFLAGS=-ldl ; then
+  printf "yes\n"
+  printf "#define HAVE_DLOPEN 1\n" >> config.h
+  conf_ldflags="${conf_ldflags:+"$conf_ldflags "}-ldl"
+else
+  printf "no\n"
+fi
+
+printf "Checking for dlsvsym ... "
+if conftest CONF_LDFLAGS="$conf_ldflags" EXTRA_CFLAGS=-DTEST_DLVSYM=1 ; then
+  printf "yes\n"
+  printf "#define HAVE_DLVSYM 1\n" >> config.h
+else
+  printf "no\n"
+fi
+
 printf "Checking for libffi ... "
 
 cat > conftest.c <<!
diff --git a/lib.c b/lib.c
index 9e2decdd..8eaa81bf 100644
--- a/lib.c
+++ b/lib.c
@@ -7338,13 +7338,13 @@ void cobj_print_op(val obj, val out, val pretty, struct strm_ctx *ctx)
   format(out, lit(": ~p>"), coerce(val, obj->co.handle), nao);
 }
 
-static val cptr_equal_op(val left, val right)
+val cobj_equal_handle_op(val left, val right)
 {
   return (left->co.handle == right->co.handle) ? t : nil;
 }
 
 static struct cobj_ops cptr_ops = {
-  cptr_equal_op,
+  cobj_equal_handle_op,
   cobj_print_op,
   cobj_destroy_stub_op,
   cobj_mark_op,
diff --git a/lib.h b/lib.h
index e78e8789..943fd3ac 100644
--- a/lib.h
+++ b/lib.h
@@ -253,6 +253,7 @@ struct cobj_ops {
  */
 
 void cobj_print_op(val, val, val, struct strm_ctx *);
+val cobj_equal_handle_op(val left, val right);
 void cobj_destroy_stub_op(val);
 void cobj_destroy_free_op(val);
 void cobj_mark_op(val);
diff --git a/sysif.c b/sysif.c
index 0e104851..9106a88b 100644
--- a/sysif.c
+++ b/sysif.c
@@ -71,6 +71,9 @@
 #if HAVE_UNAME
 #include <sys/utsname.h>
 #endif
+#if HAVE_DLOPEN
+#include <dlfcn.h>
+#endif
 #include ALLOCA_H
 #include "lib.h"
 #include "stream.h"
@@ -1452,6 +1455,79 @@ static val uname_wrap(void)
 }
 #endif
 
+#if HAVE_DLOPEN
+
+static void cptr_dl_destroy_op(val obj)
+{
+  if (obj->co.handle != 0) {
+    (void) dlclose(obj->co.handle);
+    obj->co.handle = 0;
+  }
+}
+
+static struct cobj_ops cptr_dl_ops = {
+  cobj_equal_handle_op,
+  cobj_print_op,
+  cptr_dl_destroy_op,
+  cobj_mark_op,
+  cobj_hash_op
+};
+
+static val dlopen_wrap(val name, val flags)
+{
+  const wchar_t *name_ws = c_str(name);
+  char *name_u8 = utf8_dup_to(name_ws);
+  cnum f = c_num(flags);
+  mem_t *ptr = coerce(mem_t *, dlopen(name_u8, f));
+  free(name_u8);
+  return cobj(ptr, cptr_s, &cptr_dl_ops);
+}
+
+static val dlclose_wrap(val cptr)
+{
+  mem_t *ptr = cptr_get(cptr);
+  if (cptr->co.ops != &cptr_dl_ops)
+    uw_throwf(error_s, lit("dlclose: object ~s isn't a handle from dlopen"),
+              cptr, nao);
+  if (ptr != 0) {
+    int res = dlclose(ptr);
+    cptr->co.handle = 0;
+    return tnil(res == 0);
+  }
+  return nil;
+}
+
+static val dlsym_wrap(val dlptr, val name)
+{
+  const wchar_t *name_ws = c_str(name);
+  char *name_u8 = utf8_dup_to(name_ws);
+  mem_t *dl = cptr_get(dlptr);
+  mem_t *sym = coerce(mem_t *, dlsym(dl, name_u8));
+  free(name_u8);
+  return cptr(sym);
+}
+
+#if HAVE_DLVSYM
+static val dlvsym_wrap(val dlptr, val name, val ver)
+{
+  if (null_or_missing_p(ver)) {
+    return dlsym_wrap(dlptr, name);
+  } else {
+    const wchar_t *name_ws = c_str(name);
+    const wchar_t *ver_ws = c_str(ver);
+    char *name_u8 = utf8_dup_to(name_ws);
+    char *ver_u8 = utf8_dup_to(ver_ws);
+    mem_t *dl = cptr_get(dlptr);
+    mem_t *sym = coerce(mem_t *, dlvsym(dl, name_u8, ver_u8));
+    free(name_u8);
+    free(ver_u8);
+    return cptr(sym);
+  }
+}
+#endif
+
+#endif
+
 void sysif_init(void)
 {
   prot1(&at_exit_list);
@@ -1793,4 +1869,30 @@ void sysif_init(void)
 #if HAVE_UNAME
   reg_fun(intern(lit("uname"), user_package), func_n0(uname_wrap));
 #endif
+
+#if HAVE_DLOPEN
+  reg_fun(intern(lit("dlopen"), user_package), func_n2(dlopen_wrap));
+  reg_fun(intern(lit("dlclose"), user_package), func_n1(dlclose_wrap));
+  reg_fun(intern(lit("dlsym"), user_package), func_n2(dlsym_wrap));
+#if HAVE_DLVSYM
+  reg_fun(intern(lit("dlvsym"), user_package), func_n3o(dlvsym_wrap, 2));
+#endif
+  reg_varl(intern(lit("rtld-lazy"), user_package), num_fast(RTLD_LAZY));
+  reg_varl(intern(lit("rtld-now"), user_package), num_fast(RTLD_NOW));
+#ifdef RTLD_GLOBAL
+  reg_varl(intern(lit("rtld-global"), user_package), num_fast(RTLD_GLOBAL));
+#endif
+#ifdef RTLD_LOCAL
+  reg_varl(intern(lit("rtld-local"), user_package), num_fast(RTLD_LOCAL));
+#endif
+#ifdef RTLD_NODELETE
+  reg_varl(intern(lit("rtld-nodelete"), user_package), num_fast(RTLD_NODELETE));
+#endif
+#ifdef RTLD_NOLOAD
+  reg_varl(intern(lit("rtld-noload"), user_package), num_fast(RTLD_NOLOAD));
+#endif
+#ifdef RTLD_DEEPBIND
+  reg_varl(intern(lit("rtld-deepbind"), user_package), num_fast(RTLD_DEEPBIND));
+#endif
+#endif
 }