* dynl.c (scm_dynamic_call, scm_dynamic_args_call): Wrap dynamic

[bpt/guile.git] / libguile / dynl-shl.c

diff --git a/libguile/dynl-shl.c b/libguile/dynl-shl.c
index 4612fa9..c6c4f97 100644 (file)
--- a/libguile/dynl-shl.c
+++ b/libguile/dynl-shl.c
@@ -1,6 +1,6 @@
 /* dynl-shl.c - dynamic linking with shl_load (HP-UX)
  *
- * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * Copyright (C) 1990-1997 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
@@ -14,7 +14,8 @@
  * 
  * 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * 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.
@@ -38,14 +39,15 @@
  *
  * 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.  
- */
+ * If you do not wish that, delete this exception notice.  */
 
 /* "dynl.c" dynamically link&load object files.
    Author: Aubrey Jaffer
    Modified for libguile by Marius Vollmer */
 
 #include "dl.h"
+#include <stdio.h>
+#include <string.h>
 
 static void *
 sysdep_dynl_link (fname, subr)
@@ -54,9 +56,15 @@ sysdep_dynl_link (fname, subr)
 {
     shl_t shl;
     
-    shl = shl_load (fname, BIND_DEFERRED , 0L);
+    /* Probably too much BIND_* flags */
+    shl = shl_load (fname, BIND_IMMEDIATE || BIND_FIRST ||
+                    BIND_TOGETHER ||
+                    BIND_VERBOSE || DYNAMIC_PATH, 0L);
     if (NULL==shl)
+      {
+       SCM_ALLOW_INTS;
        scm_misc_error (subr, "dynamic linking failed", SCM_EOL);
+      }
     return shl;
 }
 
@@ -65,13 +73,11 @@ sysdep_dynl_unlink (handle, subr)
      void *handle;
      char *subr;
 {
-    int status;
-
-    SCM_DEFER_INTS;
-    status = shl_unload ((shl_t) handle);
-    SCM_ALLOW_INTS;
-    if (status)
-       scm_misc_error (subr, "dynamic unlinking failed", SCM_EOL);
+  if (shl_unload ((shl_t) handle))
+    {
+      SCM_ALLOW_INTS;
+      scm_misc_error (subr, "dynamic unlinking failed", SCM_EOL);
+    }
 }
 
 static void *
@@ -80,16 +86,19 @@ sysdep_dynl_func (symb, handle, subr)
      void *handle;
      char *subr;
 {
-    void (*func)() = NULL;
-    int status;
+    int status, i;
+    struct shl_symbol *sym;
+
+    status = shl_getsymbols((shl_t) handle, TYPE_PROCEDURE,
+             EXPORT_SYMBOLS, malloc, &sym);
+
+    for (i=0; i<status; ++i) {
+      if (strcmp(symb, sym[i].name) == 0) return sym[i].value;
+    }
 
-    SCM_DEFER_INTS;
-    status = shl_findsym ((shl_t) handle, symb, TYPE_PROCEDURE, &func);
     SCM_ALLOW_INTS;
-    if (status)
-       scm_misc_error (s_dynamic_call, "undefined function",
-                       scm_cons (scm_makfrom0str (symb), SCM_EOL));
-    return func;
+    scm_misc_error (subr, "undefined function",
+                   scm_cons (scm_makfrom0str (symb), SCM_EOL));
 }
 
 static void