* root.h: Added "fluids" member to scm_root_state.

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

diff --git a/libguile/dynl.c b/libguile/dynl.c
index b480e22..b486436 100644 (file)
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -59,7 +59,6 @@ maybe_drag_in_eprintf ()
 }
 
 #include <stdio.h>
-
 #include "_scm.h"
 #include "dynl.h"
 #include "genio.h"
@@ -219,7 +218,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 +252,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 *
@@ -299,6 +304,15 @@ mark_dynl_obj (ptr)
     return d->filename;
 }
 
+static scm_sizet free_dynl_obj SCM_P ((SCM ptr));
+static scm_sizet
+free_dynl_obj (ptr)
+     SCM ptr;
+{
+  scm_must_free ((char *)SCM_CDR (ptr));
+  return sizeof (struct dynl_obj);
+}
+
 static int print_dynl_obj SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
 static int
 print_dynl_obj (exp, port, pstate)
@@ -317,7 +331,7 @@ print_dynl_obj (exp, port, pstate)
 
 static scm_smobfuns dynl_obj_smob = {
     mark_dynl_obj,
-    scm_free0,
+    free_dynl_obj,
     print_dynl_obj
 };
   
@@ -328,15 +342,19 @@ scm_dynamic_link (fname)
      SCM fname;
 {
     SCM z;
+    void *handle;
     struct dynl_obj *d;
 
     fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
+
+    SCM_DEFER_INTS;
+    handle = sysdep_dynl_link (SCM_CHARS (fname), s_dynamic_link);
+
     d = (struct dynl_obj *)scm_must_malloc (sizeof (struct dynl_obj),
                                            s_dynamic_link);
     d->filename = fname;
+    d->handle = handle;
 
-    SCM_DEFER_INTS;
-    d->handle = sysdep_dynl_link (SCM_CHARS (fname), s_dynamic_link);
     SCM_NEWCELL (z);
     SCM_SETCHARS (z, d);
     SCM_SETCAR (z, scm_tc16_dynamic_obj);
@@ -376,9 +394,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 +412,11 @@ 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);
 
-    func = sysdep_dynl_func (SCM_CHARS (symb), d->handle, s_dynamic_func);
+    SCM_DEFER_INTS;
+    func = (void (*) ()) sysdep_dynl_func (SCM_CHARS (symb), d->handle,
+                                          s_dynamic_func);
+    SCM_ALLOW_INTS;
+
     return scm_ulong2num ((unsigned long)func);
 }
 
@@ -406,8 +430,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 +451,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);
 }