using GSL with cblas via FFI

using GSL with cblas via FFI

[Johan Hidding]

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

Hi,
I'm trying to use GSL through the FFI, but the program is not linked
to libgslcblas, so it cannot find some functions. Attached a minimal
example.
Cheers, Johan

[-- Attachment #2: minex.scm --]
[-- Type: text/x-scheme, Size: 4945 bytes --]


(use-modules (system foreign) 
	     (rnrs bytevectors))

(define libgsl (dynamic-link "libgsl"))
(define libgslcblas (dynamic-link "libgslcblas"))

;=== Misc. utility functions ========================================
; (make-guard) creates a guard closure that collects objects
; that have memory stored outside the garbage collector with their
; destructors. if the guard is called without arguments, all
; objects in this guard are destroyed.

(define (apply-list l)
  (if (null? l)
    '()
    (begin (apply (caar l) (cdar l))
	   (apply-list (cdr l)))))

(define (make-guard)
  (let ((collection '()))
    (case-lambda 
      (() (apply-list collection))
      ((destructor obj) (set! collection 
			  (cons (list destructor obj) collection))))))
;====================================================================

;=== matrices =======================================================
(define gsl-matrix-alloc
  (pointer->procedure '*
		      (dynamic-func "gsl_matrix_alloc" libgsl)
		      (list size_t size_t)))

(define gsl-matrix-free
  (pointer->procedure void
		      (dynamic-func "gsl_matrix_free" libgsl)
		      (list '*)))

(define (make-gsl-matrix n m guard)
  (let ((m (gsl-matrix-alloc n m)))
    (guard gsl-matrix-free m)
    m))

(define (gsl-matrix->array M)
  (let* ((raw (parse-c-struct M (list size_t size_t size_t '* '* int)))
	 (n   (car raw))
	 (m   (cadr raw))
	 (tda (caddr raw))
	 (ptr (cadddr raw)))
    (make-shared-array
      (pointer->bytevector ptr (* tda n) 0 'f64)
      (lambda x (list (+ (* tda (car x)) (cadr x))))
      n m)))
;====================================================================

;=== vectors ========================================================
(define gsl-vector-alloc
  (pointer->procedure '*
		      (dynamic-func "gsl_vector_alloc" libgsl)
		      (list size_t)))

(define gsl-vector-free
  (pointer->procedure void
		      (dynamic-func "gsl_vector_free" libgsl)
		      (list '*)))

(define (gsl-vector->array v)
  (let* ((raw    (parse-c-struct v (list size_t size_t '* '* int)))
	 (size   (car raw))
	 (stride (cadr raw))
	 (ptr    (caddr raw)))
    (pointer->bytevector ptr size 0 'f64)))

(define (make-gsl-vector n guard)
  (let ((v (gsl-vector-alloc n)))
    (guard gsl-vector-free v)
    v))
;====================================================================

;=== permutations ===================================================
(define permutation-alloc
  (pointer->procedure '*
		      (dynamic-func "gsl_permutation_alloc" libgsl)
		      (list size_t)))

(define permutation-free
  (pointer->procedure void
		      (dynamic-func "gsl_permutation_free" libgsl)
		      (list '*)))

(define (make-permutation n guard)
  (let ((p (permutation-alloc n)))
    (guard permutation-free p)
    p))
;====================================================================

;=== linear algebra =================================================

;=== this could be easier, need a c-pointer to a single int ===
(define (dynamic-int) 
  (make-bytevector (sizeof int)))
(define (dynamic-int->pointer di) 
  (bytevector->pointer di))
(define (dynamic-int->int di) 
  (bytevector-sint-ref di 0 (native-endianness) (sizeof int)))
;======

(define linalg-LU-decomp
  (pointer->procedure int
		      (dynamic-func "gsl_linalg_LU_decomp" libgsl)
		      (list '* '* '*)))

(define linalg-LU-solve
  (pointer->procedure int
		      (dynamic-func "gsl_linalg_LU_solve" libgsl)
		      (list '* '* '* '*)))

(define linalg-LU-det
  (pointer->procedure double
		      (dynamic-func "gsl_linalg_LU_det" libgsl)
		      (list '* int)))

(define (make-linalg-det n guard)
  (let ((perm (make-permutation n guard))
	(sgn (dynamic-int)))
    (lambda (m)
      (linalg-LU-decomp m perm (dynamic-int->pointer sgn))
      (linalg-LU-det m (dynamic-int->int sgn)))))

(define (make-linalg-solve n guard)
  (let ((perm (make-permutation n guard))
	(sgn (dynamic-int)))
    (lambda (A b x)
      (linalg-LU-decomp A perm (dynamic-int->pointer sgn))
      (linalg-LU-solve A perm b x))))

;====================================================================
(define (randomize-timer)
  (let ((time (gettimeofday)))
    (set! *random-state*
      (seed->random-state (+ (car time)	
			     (cdr time))))))
(let* ((guard (make-guard))
       (b (make-gsl-vector 5 guard))
       (b-vec (gsl-vector->array b))
       (x (make-gsl-vector 5 guard))
       (x-vec (gsl-vector->array b))
       (A (make-gsl-matrix 5 5 guard))
       (A-vec (gsl-matrix->array A))
       (det (make-linalg-det 5 guard))
       (solve (make-linalg-solve 5 guard)))

  (randomize-timer)
  (array-index-map! (array-contents A-vec) (lambda X (random:normal)))
  (array-index-map! (array-contents b-vec) (lambda X (random:normal)))

  (display A-vec) (newline)
  (display b-vec) (newline)
  (display "=================") (newline)
  (display (det A)) (newline)

  (solve A b x)
  (display x-vec) (newline)

  (guard))

Re: using GSL with cblas via FFI

[Ludovic Courtès]

Hi Johan,

Johan Hidding <johannes.hidding@gmail.com> writes:

> I'm trying to use GSL through the FFI, but the program is not linked
> to libgslcblas, so it cannot find some functions. Attached a minimal

Can you please post your Guile session including the error message that
you get?

Thanks,
Ludo’.

Re: using GSL with cblas via FFI

[Johan Hidding]

Hello Ludo',
I had a chat with Mark Weaver on IRC; he could reproduce the error.
The output shows basic GSL working, but GSL+CBLAS failing. I found a
way to -combine the static versions into a single shared library using
a trick I found on StackOverflow:

> gcc -shared -o c.so -Wl,--whole-archive libgsl.a libgslcblas.a -Wl,--no-whole-archive

Then the code works fine. A C program using GSL is normally compiled
using -lgsl -lgslcblas, as the CBLAS functionality is optional.
Cheers, Johan

===
> guile ./minex.scm
#2f64((-0.234971334260896 -0.594500912896459 -1.11255443967142
0.801480195855566 -0.316194645848403) (1.24290785268759
-2.08593556136405 -1.22752508394053 0.277045912580934
-0.516092994917882) (0.459567260627738 1.15395341561812
-0.835952522855203 0.0988356041772604 -0.635311924759972)
(-0.244100471165847 1.15963505516295 0.0613902743778219
0.259165537608565 0.0346540015684283) (0.296738078387975
2.71061022226222 0.0472142970448045 -0.602746825007033
1.07870413974582))
#f64(0.967207588370043 -1.05773505748483 0.554728493261389
-0.996518864916059 0.577347100608013)
=================
-1.74071198327312
guile: symbol lookup error: /usr/lib/libgsl.so: undefined symbol: cblas_dtrsv
===

2011/3/25 Ludovic Courtès <ludo@gnu.org>:
> Hi Johan,
>
> Johan Hidding <johannes.hidding@gmail.com> writes:
>
>> I'm trying to use GSL through the FFI, but the program is not linked
>> to libgslcblas, so it cannot find some functions. Attached a minimal
>
> Can you please post your Guile session including the error message that
> you get?
>
> Thanks,
> Ludo’.
>

Re: using GSL with cblas via FFI

[Andy Wingo]

On Sat 26 Mar 2011 10:53, Johan Hidding <johannes.hidding@gmail.com> writes:

> Hello Ludo',
> I had a chat with Mark Weaver on IRC; he could reproduce the error.
> The output shows basic GSL working, but GSL+CBLAS failing. I found a
> way to -combine the static versions into a single shared library using
> a trick I found on StackOverflow:
>
>> gcc -shared -o c.so -Wl,--whole-archive libgsl.a libgslcblas.a -Wl,--no-whole-archive
>
> Then the code works fine. A C program using GSL is normally compiled
> using -lgsl -lgslcblas, as the CBLAS functionality is optional.

Does that mean that gslcblas should be opened with RTDL_GLOBAL or
something?

Andy
-- 
http://wingolog.org/

Re: using GSL with cblas via FFI

[cong gu]

[-- 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);

Re: using GSL with cblas via FFI

[Thien-Thi Nguyen]

() cong gu <gucong43216@gmail.com>
() Sun, 3 Jun 2012 17:04:29 -0500

   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'.

Aside from portability, there is also coherence in design to consider.
In (info "(libtool) Libltdl interface") i see seven funcs that take
‘lt_dladvise *ADVISE’:

 lt_dladvise_init
 lt_dladvise_destroy
 lt_dladvise_ext
 lt_dladvise_global
 lt_dladvise_local
 lt_dladvise_resident
 lt_dladvise_preload

The first two manage the object; the last five mutate its internals.

Your proposal sequences ‘lt_dladvise_ext’ and ‘lt_dladvise_global’
with ‘lt_dlopenadvise’, essentially.  This is fine for your needs
today, no doubt.  How about further on, when you need _resident
or _preload, or _FOO (in some future libtool release), or when you
want _global but not _ext?

With five bits, you have 32 combinations (actually less, as not all
combinations are meaningful, e.g., _global and _local together).  It
would be awkward to eventually find all these combinations wrapped
individually, in C and exposed to Scheme.  What is a better way?

Re: using GSL with cblas via FFI

[Thien-Thi Nguyen]

BTW, i made a similar design decision in Guile 1.4.x (see below),
which now i regret, so that's why i comment: to selfishly keep you
away from my regrets so that you can find your own.  :-D

[cc trimmed]

________________________________________________________
SCM_DEFINE
(scm_dynamic_link, "dynamic-link", 1, 0, 0,
 (SCM name),
 doc: /***********
Open the dynamic library file @var{name} and return
its @dfn{library handle}, suitable for passing to the
following functions.
As a special case, if @var{name} is @code{#f},
the returned handle is for the Guile executable itself.  */)
{
#define FUNC_NAME s_scm_dynamic_link
  const char *fname = NULL;
  lt_dladvise advise;
  lt_dlhandle handle;

  if (SCM_NFALSEP (name))
    {
      SCM_COERCE_SUBSTR (name);
      SCM_VALIDATE_ROSTRING_COPY (1, name, fname);
    }

  NOINTS ();

  ZHOPEFULLY (lt_dladvise_init (&advise));
  ZHOPEFULLY (lt_dladvise_global (&advise));

  if (!fname || '/' != fname[0])
    ZHOPEFULLY (lt_dladvise_ext (&advise));

  handle = lt_dlopenadvise (fname, advise);
  lt_dladvise_destroy (&advise);

  HOPEFULLY (handle);

  INTSOK ();
  SCM_RETURN_NEWSMOB2 (tc, SCM_UNPACK (name), handle);
#undef FUNC_NAME
}

Re: using GSL with cblas via FFI

[cong gu]

On Sun, Jun 3, 2012 at 11:15 PM, Thien-Thi Nguyen <ttn@gnuvola.org> wrote:
> () cong gu <gucong43216@gmail.com>
> () Sun, 3 Jun 2012 17:04:29 -0500
>
>   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'.
>
> Aside from portability, there is also coherence in design to consider.
> In (info "(libtool) Libltdl interface") i see seven funcs that take
> ‘lt_dladvise *ADVISE’:
>
>  lt_dladvise_init
>  lt_dladvise_destroy
>  lt_dladvise_ext
>  lt_dladvise_global
>  lt_dladvise_local
>  lt_dladvise_resident
>  lt_dladvise_preload
>
> The first two manage the object; the last five mutate its internals.
>
> Your proposal sequences ‘lt_dladvise_ext’ and ‘lt_dladvise_global’
> with ‘lt_dlopenadvise’, essentially.  This is fine for your needs
> today, no doubt.  How about further on, when you need _resident
> or _preload, or _FOO (in some future libtool release), or when you
> want _global but not _ext?
>
> With five bits, you have 32 combinations (actually less, as not all
> combinations are meaningful, e.g., _global and _local together).  It
> would be awkward to eventually find all these combinations wrapped
> individually, in C and exposed to Scheme.  What is a better way?

Yes, I addmit this is a quick hack to the problem at hand.  And your
consideration is absolutely right.

Firstly, I think this feature is essential to a more useful dynamic
FFI.  A shared library may require another shared library to actually
run some function, for example in the case of libgsl and libgslcblas.
It is annoying to link them into one object before I can use the
library.  This patch is just a proof of idea or a working hack.  I
really hope this can serve as an inspriation to someone more familiar
with guile's design, and this functionality will someday be
incorprated in guile in a better way.  At the moment, I can write and
live with a extension module doing the job.

Back to the design, the original `dynamic-link' is just equivalent to
calling only `lt_dladvise_ext' and leave other "advise" unspecified or
platform dependent. Maybe we can add some optional argument to specify
those "advise".  Some test maybe needed to see whether the loader act
upon these "advise", either during configuration or dynamically. .

-- 
Cong Gu