Re: using GSL with cblas via FFI

[cong gu <gucong43216@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 358 bytes --]

I found libtool offers a way to make a shared library globally
available.  So I wrote a patch that provides `dynamic-link-global'.
A call like `(dynamic-link-global "libgslcblas")' should make things work.

I don't know whether it is portable, though.  Documentation of libtool
mentioned that not all loaders are able to act upon this `advice'.

-- 
Cong Gu

[-- Attachment #2: guile-2.0.5-dl-global.patch --]
[-- Type: application/octet-stream, Size: 3160 bytes --]

diff -ru guile-2.0.5-orig/libguile/dynl.c guile-2.0.5/libguile/dynl.c
--- guile-2.0.5-orig/libguile/dynl.c	2011-07-06 17:49:59.000000000 -0500
+++ guile-2.0.5/libguile/dynl.c	2012-06-03 15:38:22.867277245 -0500
@@ -99,6 +99,34 @@
   return (void *) handle;
 }
 
+static void *
+sysdep_dynl_link_global (const char *fname, const char *subr)
+{
+  lt_dlhandle handle;
+  lt_dladvise advise;
+
+  if (fname != NULL && !lt_dladvise_init (&advise) &&
+      !lt_dladvise_ext (&advise) && !lt_dladvise_global (&advise))
+    handle = lt_dlopenadvise (fname, advise);
+  else 
+    /* Return a handle for the program as a whole.  */
+    handle = lt_dlopen (NULL);
+
+  lt_dladvise_destroy (&advise);
+
+  if (NULL == handle || 0 == (lt_dlgetinfo(handle)->is_symglobal))
+    {
+      SCM fn;
+      SCM msg;
+
+      fn = fname != NULL ? scm_from_locale_string (fname) : SCM_BOOL_F;
+      msg = scm_from_locale_string (lt_dlerror ());
+      scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
+    }
+
+  return (void *) handle;
+}
+
 static void
 sysdep_dynl_unlink (void *handle, const char *subr)
 {
@@ -234,6 +262,45 @@
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_dynamic_link_global, "dynamic-link-global", 0, 1, 0,
+            (SCM filename),
+	    "Find the shared object (shared library) denoted by\n"
+	    "@var{filename} and link it into the running Guile\n"
+	    "application.  The returned\n"
+	    "scheme object is a ``handle'' for the library which can\n"
+	    "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n"
+	    "Searching for object files is system dependent.  Normally,\n"
+	    "if @var{filename} does have an explicit directory it will\n"
+	    "be searched for in locations\n"
+	    "such as @file{/usr/lib} and @file{/usr/local/lib}.\n\n"
+	    "When @var{filename} is omitted, a @dfn{global symbol handle} is\n"
+	    "returned.  This handle provides access to the symbols\n"
+	    "available to the program at run-time, including those exported\n"
+	    "by the program itself and the shared libraries already loaded.\n")
+#define FUNC_NAME s_scm_dynamic_link_global
+{
+  void *handle;
+  char *file;
+
+  scm_dynwind_begin (0);
+
+  if (SCM_UNBNDP (filename))
+    file = NULL;
+  else
+    {
+      file = scm_to_locale_string (filename);
+      scm_dynwind_free (file);
+    }
+
+  handle = sysdep_dynl_link_global (file, FUNC_NAME);
+  scm_dynwind_end ();
+
+  SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj,
+		       SCM_UNBNDP (filename)
+		       ? SCM_UNPACK (SCM_BOOL_F) : SCM_UNPACK (filename),
+		       handle);
+}
+#undef FUNC_NAME
 
 SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0, 
             (SCM obj),
diff -ru guile-2.0.5-orig/libguile/dynl.h guile-2.0.5/libguile/dynl.h
--- guile-2.0.5-orig/libguile/dynl.h	2010-12-14 12:15:17.000000000 -0600
+++ guile-2.0.5/libguile/dynl.h	2012-06-03 15:38:42.974081191 -0500
@@ -28,6 +28,7 @@
 \f
 
 SCM_API SCM scm_dynamic_link (SCM fname);
+SCM_API SCM scm_dynamic_link_global (SCM fname);
 SCM_API SCM scm_dynamic_unlink (SCM dobj);
 SCM_API SCM scm_dynamic_object_p (SCM obj);
 SCM_API SCM scm_dynamic_pointer (SCM name, SCM dobj);