*** empty log message ***
[bpt/guile.git] / libguile / dynl.c
index 2f8eac1..443102a 100644 (file)
@@ -1,45 +1,21 @@
 /* dynl.c - dynamic linking
  *
- * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
+ * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 Free Software Foundation, Inc.
  * 
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- * 
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
  *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way.  To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
 
 
 
@@ -75,33 +51,30 @@ maybe_drag_in_eprintf ()
 #include "libguile/lang.h"
 #include "libguile/validate.h"
 
-/* Dispatch to the system dependent files
- *
- * They define some static functions.  These functions are called with
- * deferred interrupts.  When they want to throw errors, they are
- * expected to insert a SCM_ALLOW_INTS before doing the throw.  It
- * might work to throw an error while interrupts are deferred (because
- * they will be unconditionally allowed the next time a SCM_ALLOW_INTS
- * is executed, SCM_DEFER_INTS and SCM_ALLOW_INTS do not nest).
- */
+#include "guile-ltdl.h"
 
-#ifdef DYNAMIC_LINKING
+/*
+  From the libtool manual: "Note that libltdl is not threadsafe,
+  i.e. a multithreaded application has to use a mutex for libltdl.".
 
-#include "libltdl/ltdl.h"
+  Guile does not currently support pre-emptive threads, so there is
+  no mutex.  Previously SCM_DEFER_INTS and SCM_ALLOW_INTS were used:
+  they are mentioned here in case somebody is grepping for thread
+  problems ;)
+*/
 
 static void *
 sysdep_dynl_link (const char *fname, const char *subr)
 {
-  lt_dlhandle handle;
-  handle = lt_dlopenext (fname);
+  scm_lt_dlhandle handle;
+  handle = scm_lt_dlopenext (fname);
   if (NULL == handle)
     {
       SCM fn;
       SCM msg;
 
-      SCM_ALLOW_INTS;
       fn = scm_makfrom0str (fname);
-      msg = scm_makfrom0str (lt_dlerror ());
+      msg = scm_makfrom0str (scm_lt_dlerror ());
       scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
     }
   return (void *) handle;
@@ -110,10 +83,9 @@ sysdep_dynl_link (const char *fname, const char *subr)
 static void
 sysdep_dynl_unlink (void *handle, const char *subr)
 {
-  if (lt_dlclose ((lt_dlhandle) handle))
+  if (scm_lt_dlclose ((scm_lt_dlhandle) handle))
     {
-      SCM_ALLOW_INTS;
-      scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
+      scm_misc_error (subr, (char *) scm_lt_dlerror (), SCM_EOL);
     }
 }
    
@@ -122,11 +94,10 @@ sysdep_dynl_func (const char *symb, void *handle, const char *subr)
 {
   void *fptr;
 
-  fptr = lt_dlsym ((lt_dlhandle) handle, symb);
+  fptr = scm_lt_dlsym ((scm_lt_dlhandle) handle, symb);
   if (!fptr)
     {
-      SCM_ALLOW_INTS;
-      scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
+      scm_misc_error (subr, (char *) scm_lt_dlerror (), SCM_EOL);
     }
   return fptr;
 }
@@ -134,50 +105,9 @@ sysdep_dynl_func (const char *symb, void *handle, const char *subr)
 static void
 sysdep_dynl_init ()
 {
-  lt_dlinit ();
-}
-
-#else
-
-/* no dynamic linking available, throw errors. */
-
-static void
-sysdep_dynl_init (void)
-{
+  scm_lt_dlinit ();
 }
 
-static void
-no_dynl_error (const char *subr)
-{
-  SCM_ALLOW_INTS;
-  scm_misc_error (subr, "dynamic linking not available", SCM_EOL);
-}
-    
-static void *
-sysdep_dynl_link (const char *filename, const char *subr)
-{
-  no_dynl_error (subr);
-  return NULL;
-}
-
-static void 
-sysdep_dynl_unlink (void *handle, 
-                   const char *subr)
-{
-  no_dynl_error (subr);
-}
-
-static void *
-sysdep_dynl_func (const char *symbol, 
-                 void *handle,
-                 const char *subr)
-{
-  no_dynl_error (subr);
-  return NULL;
-}
-
-#endif
-
 scm_t_bits scm_tc16_dynamic_obj;
 
 #define DYNL_FILENAME(x)        (SCM_CELL_OBJECT_1 (x))
@@ -206,10 +136,15 @@ dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate)
 
 SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0, 
             (SCM filename),
-           "Open the dynamic library called @var{filename}.  A library\n"
-           "handle representing the opened library is returned; this handle\n"
-           "should be used as the @var{dobj} argument to the following\n"
-           "functions.")
+           "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}.")
 #define FUNC_NAME s_scm_dynamic_link
 {
   void *handle;
@@ -223,8 +158,8 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0,
 
 SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0, 
             (SCM obj),
-           "Return @code{#t} if @var{obj} is a dynamic library handle, or @code{#f}\n"
-           "otherwise.")
+           "Return @code{#t} if @var{obj} is a dynamic object handle,\n"
+           "or @code{#f} otherwise.")
 #define FUNC_NAME s_scm_dynamic_object_p
 {
   return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj));
@@ -234,10 +169,11 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
 
 SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0, 
             (SCM dobj),
-           "Unlink the indicated object file from the application.  The\n"
-           "argument @var{dobj} must have been obtained by a call to\n"
-           "@code{dynamic-link}.  After @code{dynamic-unlink} has been\n"
-           "called on @var{dobj}, its content is no longer accessible.")
+           "Unlink a dynamic object from the application, if possible.  The\n"
+           "object must have been linked by @code{dynamic-link}, with \n"
+           "@var{dobj} the corresponding handle.  After this procedure\n"
+           "is called, the handle can no longer be used to access the\n"
+           "object.")
 #define FUNC_NAME s_scm_dynamic_unlink
 {
   /*fixme* GC-problem */
@@ -245,10 +181,8 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
   if (DYNL_HANDLE (dobj) == NULL) {
     SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
   } else {
-    SCM_DEFER_INTS;
     sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME);
     SET_DYNL_HANDLE (dobj, NULL);
-    SCM_ALLOW_INTS;
     return SCM_UNSPECIFIED;
   }
 }
@@ -257,14 +191,14 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
 
 SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, 
             (SCM name, SCM dobj),
-           "Search the dynamic object @var{dobj} for the C function\n"
-           "indicated by the string @var{name} and return some Scheme\n"
-           "handle that can later be used with @code{dynamic-call} to\n"
-           "actually call the function.\n\n"
-           "Regardless whether your C compiler prepends an underscore @samp{_} to\n"
-           "the global names in a program, you should @strong{not} include this\n"
-           "underscore in @var{function}.  Guile knows whether the underscore is\n"
-           "needed or not and will add it when necessary.")
+           "Return a ``handle'' for the function @var{name} in the\n"
+           "shared object referred to by @var{dobj}.  The handle\n"
+           "can be passed to @code{dynamic-call} to actually\n"
+           "call the function.\n\n"
+           "Regardless whether your C compiler prepends an underscore\n"
+           "@samp{_} to the global names in a program, you should\n"
+           "@strong{not} include this underscore in @var{name}\n"
+           "since it will be added automatically when necessary.")
 #define FUNC_NAME s_scm_dynamic_func
 {
   /* The returned handle is formed by casting the address of the function to a
@@ -281,10 +215,8 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
   } else {
     char *chars;
 
-    SCM_DEFER_INTS;
     chars = SCM_STRING_CHARS (name);
     func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME);
-    SCM_ALLOW_INTS;
     return scm_ulong2num ((unsigned long) func);
   }
 }
@@ -293,17 +225,22 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
 
 SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, 
             (SCM func, SCM dobj),
-           "Call the C function indicated by @var{func} and @var{dobj}.\n"
-           "The function is passed no arguments and its return value is\n"
-           "ignored.  When @var{function} is something returned by\n"
-           "@code{dynamic-func}, call that function and ignore @var{dobj}.\n"
-           "When @var{func} is a string , look it up in @var{dynobj}; this\n"
-           "is equivalent to\n"
-           "@smallexample\n"
-           "(dynamic-call (dynamic-func @var{func} @var{dobj} #f))\n"
-           "@end smallexample\n\n"
-           "Interrupts are deferred while the C function is executing (with\n"
-           "@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}).")
+           "Call a C function in a dynamic object.  Two styles of\n"
+           "invocation are supported:\n\n"
+           "@itemize @bullet\n"
+           "@item @var{func} can be a function handle returned by\n"
+           "@code{dynamic-func}.  In this case @var{dobj} is\n"
+           "ignored\n"
+           "@item @var{func} can be a string with the name of the\n"
+           "function to call, with @var{dobj} the handle of the\n"
+           "dynamic object in which to find the function.\n"
+           "This is equivalent to\n"
+           "@smallexample\n\n"
+           "(dynamic-call (dynamic-func @var{func} @var{dobj}) #f)\n"
+           "@end smallexample\n"
+           "@end itemize\n\n"
+           "In either case, the function is passed no arguments\n"
+           "and its return value is ignored.")
 #define FUNC_NAME s_scm_dynamic_call
 {
   void (*fptr) ();
@@ -311,9 +248,7 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
   if (SCM_STRINGP (func))
     func = scm_dynamic_func (func, dobj);
   fptr = (void (*) ()) SCM_NUM2ULONG (1, func);
-  SCM_DEFER_INTS;
   fptr ();
-  SCM_ALLOW_INTS;
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -371,14 +306,12 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
     func = scm_dynamic_func (func, dobj);
 
   fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func);
-  SCM_DEFER_INTS;
   argv = allocate_string_pointers (args, &argc);
   /* if the procedure mutates its arguments, the original strings will be
      changed -- in Guile 1.6 and earlier, this wasn't the case since a
      new copy of each string was allocated.  */
   result = (*fptr) (argc, argv);
   free (argv);
-  SCM_ALLOW_INTS;
 
   return SCM_MAKINUM (0L + result);
 }