From 419e9e117fa110de24b87ace73984f133887078c Mon Sep 17 00:00:00 2001
From: Marius Vollmer <mvo@zagadka.de>
Date: Mon, 16 Jun 1997 19:09:11 +0000
Subject: [PATCH] * dynl.c (scm_dynamic_call, scm_dynamic_args_call): Wrap
 dynamic function call in SCM_DEFER_INTS/SCM_ALLOW_INTS. (scm_dynamic_link,
 scm_dynamic_unlink, scm_dynamic_func): Always call the sysdep functions with
 deferred ints. * dynl.c, dynl-dl.c, dynl-dld.c, dynl-shl.c (sysdep_dynl_link,
 sysdep_dynl_unlink, sysdep_dynl_func): Expect to be called with deferred
 interrupts and insert SCM_ALLOW_INTS before throwing an error.

* dynl.c (scm_dynamic_unlink, scm_dynamic_call): Return
SCM_UNSPECIFIED.
---
 libguile/dynl-dl.c  | 19 ++++++++++---------
 libguile/dynl-dld.c | 11 +++++++----
 libguile/dynl-shl.c | 21 ++++++++++++---------
 libguile/dynl.c     | 26 ++++++++++++++++++++------
 4 files changed, 49 insertions(+), 28 deletions(-)

diff --git a/libguile/dynl-dl.c b/libguile/dynl-dl.c
index 9655b7fa5..d8fb0c49d 100644
--- a/libguile/dynl-dl.c
+++ b/libguile/dynl-dl.c
@@ -60,7 +60,10 @@ sysdep_dynl_link (fname, subr)
 {
     void *handle = dlopen (fname, DLOPEN_MODE);
     if (NULL == handle)
+      {
+	SCM_ALLOW_INTS;
 	scm_misc_error (subr, (char *)dlerror (), SCM_EOL);
+      }
     return handle;
 }
 
@@ -69,13 +72,11 @@ sysdep_dynl_unlink (handle, subr)
      void *handle;
      char *subr;
 {
-    int status;
-
-    SCM_DEFER_INTS;
-    status = dlclose (handle);
-    SCM_ALLOW_INTS;
-    if(status)
+    if (dlclose (handle))
+      {
+	SCM_ALLOW_INTS;
 	scm_misc_error (subr, (char *)dlerror (), SCM_EOL);
+      }
 }
    
 static void *
@@ -87,13 +88,13 @@ sysdep_dynl_func (symb, handle, subr)
     void *fptr;
     char *err;
 
-    SCM_DEFER_INTS;
     fptr = dlsym (handle, symb);
     err = (char *)dlerror ();
-    SCM_ALLOW_INTS;
-
     if (!fptr)
+      {
+	SCM_ALLOW_INTS;
 	scm_misc_error (subr, err? err : "symbol has NULL address", SCM_EOL);
+      }
     return fptr;
 }
 
diff --git a/libguile/dynl-dld.c b/libguile/dynl-dld.c
index f9cec2778..17d975c83 100644
--- a/libguile/dynl-dld.c
+++ b/libguile/dynl-dld.c
@@ -72,7 +72,10 @@ sysdep_dynl_link (fname, subr)
 
     status = dld_link (fname);
     if (status)
+      {
+	SCM_ALLOW_INTS;
 	scm_misc_error (subr, dld_strerror (status), SCM_EOL);
+      }
     return fname;
 }
 
@@ -83,11 +86,12 @@ sysdep_dynl_unlink (handle, subr)
 {
     int status;
 
-    SCM_DEFER_INTS;
     status = dld_unlink_by_file ((char *)fname, 1);
-    SCM_ALLOW_INTS;
     if (status)
+      {
+	SCM_ALLOW_INTS;
 	scm_misc_error (s_dynamic_unlink, dld_strerror (status), SCM_EOL);
+      }
 }
 
 static void *
@@ -98,15 +102,14 @@ sysdep_dynl_func (symb, handle, subr)
 {
     void *func;
 
-    SCM_DEFER_INTS;
     func = (void *) dld_get_func (func);
     if (func == 0)
 	scm_misc_error (subr, dld_strerror (dld_errno), SCM_EOL);
     if (!dld_function_executable_p (func)) {
 	listundefs ();
+	SCM_ALLOW_INTS;
 	scm_misc_error (subr, "unresolved symbols remain", SCM_EOL);
     }
-    SCM_ALLOW_INTS;
     return func;
 }
 
diff --git a/libguile/dynl-shl.c b/libguile/dynl-shl.c
index 9d0ee613b..c6c4f97fe 100644
--- a/libguile/dynl-shl.c
+++ b/libguile/dynl-shl.c
@@ -61,7 +61,10 @@ sysdep_dynl_link (fname, subr)
                     BIND_TOGETHER ||
                     BIND_VERBOSE || DYNAMIC_PATH, 0L);
     if (NULL==shl)
+      {
+	SCM_ALLOW_INTS;
 	scm_misc_error (subr, "dynamic linking failed", SCM_EOL);
+      }
     return shl;
 }
 
@@ -70,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 *
@@ -87,13 +88,15 @@ sysdep_dynl_func (symb, handle, subr)
 {
     int status, i;
     struct shl_symbol *sym;
-    SCM_DEFER_INTS;
+
     status = shl_getsymbols((shl_t) handle, TYPE_PROCEDURE,
              EXPORT_SYMBOLS, malloc, &sym);
-    SCM_ALLOW_INTS;
+
     for (i=0; i<status; ++i) {
       if (strcmp(symb, sym[i].name) == 0) return sym[i].value;
     }
+
+    SCM_ALLOW_INTS;
     scm_misc_error (subr, "undefined function",
 		    scm_cons (scm_makfrom0str (symb), SCM_EOL));
 }
diff --git a/libguile/dynl.c b/libguile/dynl.c
index b480e2281..6458e6c38 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -219,7 +219,12 @@ scm_clear_registered_modules ()
 
 /* Dispatch to the system dependent files
  *
- * They define these static functions:
+ * 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).
  */
 
 static void sysdep_dynl_init SCM_P ((void));
@@ -248,7 +253,8 @@ static void
 no_dynl_error (subr)
      char *subr;
 {
-    scm_misc_error (subr, "dynamic linking not available", SCM_EOL);
+  SCM_ALLOW_INTS;
+  scm_misc_error (subr, "dynamic linking not available", SCM_EOL);
 }
     
 static void *
@@ -376,9 +382,11 @@ scm_dynamic_unlink (dobj)
      SCM dobj;
 {
     struct dynl_obj *d = get_dynl_obj (dobj, s_dynamic_unlink, SCM_ARG1);
+    SCM_DEFER_INTS;
     sysdep_dynl_unlink (d->handle, s_dynamic_unlink);
     d->handle = NULL;
-    return SCM_BOOL_T;
+    SCM_ALLOW_INTS;
+    return SCM_UNSPECIFIED;
 }
 
 SCM_PROC (s_dynamic_func, "dynamic-func", 2, 0, 0, scm_dynamic_func);
@@ -392,7 +400,10 @@ scm_dynamic_func (SCM symb, SCM dobj)
     symb = scm_coerce_rostring (symb, s_dynamic_func, SCM_ARG1);
     d = get_dynl_obj (dobj, s_dynamic_func, SCM_ARG2);
 
+    SCM_DEFER_INTS;
     func = sysdep_dynl_func (SCM_CHARS (symb), d->handle, s_dynamic_func);
+    SCM_ALLOW_INTS;
+
     return scm_ulong2num ((unsigned long)func);
 }
 
@@ -406,8 +417,10 @@ scm_dynamic_call (SCM func, SCM dobj)
     if (SCM_NIMP (func) && SCM_ROSTRINGP (func))
 	func = scm_dynamic_func (func, dobj);
     fptr = (void (*)()) scm_num2ulong (func, (char *)SCM_ARG1, s_dynamic_call);
+    SCM_DEFER_INTS;
     fptr ();
-    return SCM_BOOL_T;
+    SCM_ALLOW_INTS;
+    return SCM_UNSPECIFIED;
 }
 
 SCM_PROC (s_dynamic_args_call, "dynamic-args-call", 3, 0, 0, scm_dynamic_args_call);
@@ -425,12 +438,13 @@ scm_dynamic_args_call (func, dobj, args)
 
     fptr = (int (*)(int, char **)) scm_num2ulong (func, (char *)SCM_ARG1,
 						   s_dynamic_args_call);
+    SCM_DEFER_INTS;
     argv = scm_make_argv_from_stringlist (args, &argc, s_dynamic_args_call,
 					  SCM_ARG3);
-
     result = (*fptr) (argc, argv);
-
     scm_must_free_argv (argv);
+    SCM_ALLOW_INTS;
+
     return SCM_MAKINUM(0L+result);
 }