/[guile]/guile/guile-core/libguile/dynl.c
ViewVC logotype

Diff of /guile/guile-core/libguile/dynl.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.70 by ghouston, Sun Jun 30 19:27:18 2002 UTC revision 1.71 by ghouston, Sun Jun 30 20:34:38 2002 UTC
# Line 75  maybe_drag_in_eprintf () Line 75  maybe_drag_in_eprintf ()
75  #include "libguile/lang.h"  #include "libguile/lang.h"
76  #include "libguile/validate.h"  #include "libguile/validate.h"
77    
 /* 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).  
  */  
   
78  #ifdef DYNAMIC_LINKING  #ifdef DYNAMIC_LINKING
79    
80  #include "libltdl/ltdl.h"  #include "libltdl/ltdl.h"
81    
82    /* From the libtool manual: "Note that libltdl is not threadsafe,
83       i.e. a multithreaded application has to use a mutex for libltdl.".
84    
85       Guile does not currently support pre-emptive threads, so there is
86       no mutex.  Previously SCM_DEFER_INTS and SCM_ALLOW_INTS were used:
87       they are mentioned here in case somebody is grepping for thread
88       problems ;)
89    */
90    
91  static void *  static void *
92  sysdep_dynl_link (const char *fname, const char *subr)  sysdep_dynl_link (const char *fname, const char *subr)
93  {  {
# Line 99  sysdep_dynl_link (const char *fname, con Line 98  sysdep_dynl_link (const char *fname, con
98        SCM fn;        SCM fn;
99        SCM msg;        SCM msg;
100    
       SCM_ALLOW_INTS;  
101        fn = scm_makfrom0str (fname);        fn = scm_makfrom0str (fname);
102        msg = scm_makfrom0str (lt_dlerror ());        msg = scm_makfrom0str (lt_dlerror ());
103        scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));        scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
# Line 112  sysdep_dynl_unlink (void *handle, const Line 110  sysdep_dynl_unlink (void *handle, const
110  {  {
111    if (lt_dlclose ((lt_dlhandle) handle))    if (lt_dlclose ((lt_dlhandle) handle))
112      {      {
       SCM_ALLOW_INTS;  
113        scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);        scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
114      }      }
115  }  }
# Line 125  sysdep_dynl_func (const char *symb, void Line 122  sysdep_dynl_func (const char *symb, void
122    fptr = lt_dlsym ((lt_dlhandle) handle, symb);    fptr = lt_dlsym ((lt_dlhandle) handle, symb);
123    if (!fptr)    if (!fptr)
124      {      {
       SCM_ALLOW_INTS;  
125        scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);        scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
126      }      }
127    return fptr;    return fptr;
# Line 149  sysdep_dynl_init (void) Line 145  sysdep_dynl_init (void)
145  static void  static void
146  no_dynl_error (const char *subr)  no_dynl_error (const char *subr)
147  {  {
   SCM_ALLOW_INTS;  
148    scm_misc_error (subr, "dynamic linking not available", SCM_EOL);    scm_misc_error (subr, "dynamic linking not available", SCM_EOL);
149  }  }
150            
# Line 245  SCM_DEFINE (scm_dynamic_unlink, "dynamic Line 240  SCM_DEFINE (scm_dynamic_unlink, "dynamic
240    if (DYNL_HANDLE (dobj) == NULL) {    if (DYNL_HANDLE (dobj) == NULL) {
241      SCM_MISC_ERROR ("Already unlinked: ~S", dobj);      SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
242    } else {    } else {
     SCM_DEFER_INTS;  
243      sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME);      sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME);
244      SET_DYNL_HANDLE (dobj, NULL);      SET_DYNL_HANDLE (dobj, NULL);
     SCM_ALLOW_INTS;  
245      return SCM_UNSPECIFIED;      return SCM_UNSPECIFIED;
246    }    }
247  }  }
# Line 281  SCM_DEFINE (scm_dynamic_func, "dynamic-f Line 274  SCM_DEFINE (scm_dynamic_func, "dynamic-f
274    } else {    } else {
275      char *chars;      char *chars;
276    
     SCM_DEFER_INTS;  
277      chars = SCM_STRING_CHARS (name);      chars = SCM_STRING_CHARS (name);
278      func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME);      func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME);
     SCM_ALLOW_INTS;  
279      return scm_ulong2num ((unsigned long) func);      return scm_ulong2num ((unsigned long) func);
280    }    }
281  }  }
# Line 301  SCM_DEFINE (scm_dynamic_call, "dynamic-c Line 292  SCM_DEFINE (scm_dynamic_call, "dynamic-c
292              "is equivalent to\n"              "is equivalent to\n"
293              "@smallexample\n"              "@smallexample\n"
294              "(dynamic-call (dynamic-func @var{func} @var{dobj} #f))\n"              "(dynamic-call (dynamic-func @var{func} @var{dobj} #f))\n"
295              "@end smallexample\n\n"              "@end smallexample\n\n")
             "Interrupts are deferred while the C function is executing (with\n"  
             "@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}).")  
296  #define FUNC_NAME s_scm_dynamic_call  #define FUNC_NAME s_scm_dynamic_call
297  {  {
298    void (*fptr) ();    void (*fptr) ();
# Line 311  SCM_DEFINE (scm_dynamic_call, "dynamic-c Line 300  SCM_DEFINE (scm_dynamic_call, "dynamic-c
300    if (SCM_STRINGP (func))    if (SCM_STRINGP (func))
301      func = scm_dynamic_func (func, dobj);      func = scm_dynamic_func (func, dobj);
302    fptr = (void (*) ()) SCM_NUM2ULONG (1, func);    fptr = (void (*) ()) SCM_NUM2ULONG (1, func);
   SCM_DEFER_INTS;  
303    fptr ();    fptr ();
   SCM_ALLOW_INTS;  
304    return SCM_UNSPECIFIED;    return SCM_UNSPECIFIED;
305  }  }
306  #undef FUNC_NAME  #undef FUNC_NAME
# Line 371  SCM_DEFINE (scm_dynamic_args_call, "dyna Line 358  SCM_DEFINE (scm_dynamic_args_call, "dyna
358      func = scm_dynamic_func (func, dobj);      func = scm_dynamic_func (func, dobj);
359    
360    fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func);    fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func);
   SCM_DEFER_INTS;  
361    argv = allocate_string_pointers (args, &argc);    argv = allocate_string_pointers (args, &argc);
362    /* if the procedure mutates its arguments, the original strings will be    /* if the procedure mutates its arguments, the original strings will be
363       changed -- in Guile 1.6 and earlier, this wasn't the case since a       changed -- in Guile 1.6 and earlier, this wasn't the case since a
364       new copy of each string was allocated.  */       new copy of each string was allocated.  */
365    result = (*fptr) (argc, argv);    result = (*fptr) (argc, argv);
366    free (argv);    free (argv);
   SCM_ALLOW_INTS;  
367    
368    return SCM_MAKINUM (0L + result);    return SCM_MAKINUM (0L + result);
369  }  }

Legend:
Removed from v.1.70  
changed lines
  Added in v.1.71

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26