Changeset 15907 in project for chicken


Ignore:
Timestamp:
09/15/09 20:17:43 (10 years ago)
Author:
kon
Message:

Made dynld routines handle string allocation. Use of common code for dynamic-library-procedure/variable. Made dynld sym routine a noret.

Location:
chicken/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/chicken.h

    r15869 r15907  
    15221522
    15231523C_fctexport void C_ccall C_dynamic_library_load(C_word c, C_word closure, C_word k, C_word name) C_noret;
     1524C_fctexport void C_ccall C_dynamic_library_symbol(C_word c, C_word closure, C_word k, C_word mname, C_word sname, C_word isprcsym) C_noret;
    15241525C_fctexport void C_ccall C_dynamic_library_unload(C_word c, C_word closure, C_word k, C_word name) C_noret;
    15251526
     
    16771678C_fctexport int C_fcall C_dynamic_library_close(void *handle) C_regparm;
    16781679
    1679 C_fctexport void * C_fcall C_dynamic_library_symbol(C_word mname, C_word sname, C_word isprcsym) C_regparm;
    1680 
    16811680C_fctexport C_char * C_lookup_procedure_id(void *ptr);
    16821681C_fctexport void * C_lookup_procedure_ptr(C_char *id);
  • chicken/trunk/eval.scm

    r15869 r15907  
    10831083(define load-library ##sys#load-library)
    10841084
    1085 (define (dynamic-library-load name)
    1086   (##sys#check-string name 'dynamic-library-load)
    1087   (or (##sys#dynamic-library-load name)
    1088       (##sys#error 'dynamic-library-load "cannot load dynamic library" name _dlerror) ) )
    1089 
    10901085(define (loaded-libraries)
    10911086  ; Ignore the names of explicitly loaded library units
     
    10961091          (loop (cdr ils) (if (member nam (dynamic-load-libraries)) ols (cons nam ols))) ) ) ) )
    10971092
    1098 ;; (##sys#dynamic-library-procedure mname sname) => mname+sname-ptr
    1099 ;; (##sys#dynamic-library-variable mname sname) => mname+sname-ptr
     1093(define (dynamic-library-load name)
     1094  (##sys#check-string name 'dynamic-library-load)
     1095  (or (##sys#dynamic-library-load name)
     1096      (##sys#error 'dynamic-library-load "cannot load dynamic library" name _dlerror) ) )
     1097
     1098;; (dynamic-library-procedure mname sname handler) => procedure/n
     1099;; (dynamic-library-variable mname sname handler) => procedure/n
     1100;;
     1101;; The 'procedure/n' invokes the handler on (mname sname mname+sname-ptr n-args).
     1102;; A symbol 'sname' is converted to a string.
    11001103;;
    11011104;; Will attempt to load (global lazy) the library should the attempt to
     
    11031106;; resolved, or an error will be signaled.
    11041107
    1105 (define ##sys#dynamic-library-procedure)
    1106 (define ##sys#dynamic-library-variable)
     1108(define dynamic-library-procedure)
     1109(define dynamic-library-variable)
    11071110(let ()
    11081111
     
    11131116        (##sys#error loc "cannot resolve dynamic library symbol" mname sname _dlerror) ) )
    11141117
    1115   (set! ##sys#dynamic-library-procedure
    1116     (lambda (mname sname)
    1117       (checked-pointer 'dynamic-library-procedure
    1118                        ##sys#dynamic-library-procedure-pointer mname sname) ) )
    1119 
    1120   (set! ##sys#dynamic-library-variable
    1121     (lambda (mname sname)
    1122       (checked-pointer 'dynamic-library-variable
    1123                         ##sys#dynamic-library-variable-pointer mname sname) ) ) )
    1124 
    1125 ;; (dynamic-library-procedure mname sname handler) => procedure/n
    1126 ;; (dynamic-library-variable mname sname handler) => procedure/n
    1127 ;;
    1128 ;; The 'procedure/n' invokes the handler on (mname sname mname+sname-ptr n-args).
    1129 ;;
    1130 ;; Will attempt to load (global lazy) the library should the attempt to
    1131 ;; resolve the symbol fail. Either this succeeds and the symbol is then
    1132 ;; resolved, or an error will be signaled.
    1133 
    1134 (define (dynamic-library-procedure mname sname handler)
    1135   (##sys#check-string mname 'dynamic-library-procedure)
    1136   (##sys#check-closure handler 'dynamic-library-procedure)
    1137   (let ((prcnam (if (symbol? sname) (symbol->string sname) sname)))
    1138     (##sys#check-string prcnam 'dynamic-library-procedure)
    1139     (let ((ptr (##sys#dynamic-library-procedure mname sname handler)))
    1140       (lambda args (handler mname sname ptr args)) ) ) )
    1141 
    1142 (define (dynamic-library-variable mname sname handler)
    1143   (##sys#check-string mname 'dynamic-library-variable)
    1144   (##sys#check-closure handler 'dynamic-library-variable)
    1145   (let ((varnam (if (symbol? sname) (symbol->string sname) sname)))
    1146     (##sys#check-string varnam 'dynamic-library-variable)
    1147     (let ((ptr (##sys#dynamic-library-variable mname sname handler)))
    1148       (lambda args (handler mname sname ptr args)) ) ) )
     1118  (define (dynlibsym loc ptrfnc mname sname handler)
     1119    (##sys#check-string mname loc)
     1120    (##sys#check-closure handler loc)
     1121    (let ((sname (if (symbol? sname) (symbol->string sname) sname)))
     1122      (##sys#check-string sname loc)
     1123      (let ((ptr (checked-pointer loc ptrfnc mname sname)))
     1124        (lambda args (handler mname sname ptr args)) ) ) )
     1125
     1126  (set! dynamic-library-procedure
     1127    (lambda (mname sname handler)
     1128      (dynlibsym 'dynamic-library-procedure
     1129                 ##sys#dynamic-library-procedure-pointer mname sname handler) ) )
     1130
     1131  (set! dynamic-library-variable
     1132    (lambda (mname sname handler)
     1133      (dynlibsym 'dynamic-library-variable
     1134                 ##sys#dynamic-library-variable-pointer mname sname handler) ) ) )
     1135
    11491136
    11501137;;; Extensions:
  • chicken/trunk/library.scm

    r15869 r15907  
    365365;;; Dynamic Load
    366366
     367;; Library load mode (only active when HAVE_DLFCN_H at the momemnt)
     368
    367369(define ##sys#dlopen-flags (##core#primitive "C_dlopen_flags"))
    368370(define ##sys#set-dlopen-flags! (##core#primitive "C_set_dlopen_flags"))
    369 
    370 ;; Arbitrary library load
    371 
    372 (define ##sys#dynamic-library-load (##core#primitive "C_dynamic_library_load"))
    373 
    374 ; Dynamic Unload not available on all platforms and to be used with caution!
    375 (define ##sys#dynamic-library-unload (##core#primitive "C_dynamic_library_unload"))
    376371
    377372;; Chicken library load
     
    385380    #t ) )
    386381
     382;; Non-Chicken library load
     383
     384(define ##sys#dynamic-library-load (##core#primitive "C_dynamic_library_load"))
     385
     386; Dynamic Unload not available on all platforms and to be used with caution!
     387(define ##sys#dynamic-library-unload (##core#primitive "C_dynamic_library_unload"))
     388
    387389;; Introspection of loaded libraries
    388390
     
    390392; (##sys#dynamic-library-variable-pointer mname sname) => mname+sname-ptr or #f
    391393
    392 (define ##sys#dynamic-library-procedure-pointer)
    393 (define ##sys#dynamic-library-variable-pointer)
    394 (let ((dynlibsymptr (foreign-lambda c-pointer "C_dynamic_library_symbol"
    395                                               scheme-object scheme-object scheme-object)))
    396   (set! ##sys#dynamic-library-procedure-pointer
    397     (lambda (mname sname) (dynlibsymptr mname sname #t) ) )
    398   (set! ##sys#dynamic-library-variable-pointer
    399     (lambda (mname sname) (dynlibsymptr mname sname #f) ) ) )
    400 
    401 ; (##sys#dynamic-library-names)
    402 ; => (<pathname>...)
    403 ; Does not return the "name" of the running program (i.e. #f)
     394(define (##sys#dynamic-library-procedure-pointer mname sname)
     395  ((##core#primitive "C_dynamic_library_symbol") mname sname #t) )
     396
     397(define (##sys#dynamic-library-variable-pointer mname sname)
     398  ((##core#primitive "C_dynamic_library_symbol") mname sname #f) )
     399
     400; (##sys#dynamic-library-names) => (<pathname>...)
     401; Does not return the "name" of the running program (i.e. #f) but
     402; does return any default libraries.
    404403
    405404(define ##sys#dynamic-library-names (##core#primitive "C_dynamic_library_names"))
     
    413412(define ##sys#dynamic-library-data (##core#primitive "C_dynamic_library_data"))
    414413
    415 ; (##sys#chicken-library-literal-frame name handle count)
    416 ; => (<lf[0]>...)
     414; (##sys#chicken-library-literal-frame name handle count) => (<lf[0]>...)
    417415
    418416(define ##sys#chicken-library-literal-frame (##core#primitive "C_chicken_library_literal_frame"))
  • chicken/trunk/runtime.c

    r15902 r15907  
    499499static C_word get_unbound_variable_value(C_word sym);
    500500static LF_LIST *find_lf_list_node(C_char *name);
    501 static void checked_library_name_argument(char *loc, C_word libnam, char **name);
     501static C_char *checked_string_argument(char *loc, C_word hstr);
     502static C_char *checked_string_or_null_argument(char *loc, C_word hstr);
    502503static void checked_library_query_arguments(char *loc,
    503504                                            C_word libnam, C_word libhdl, C_word lfcnt,
     
    506507static void link_lf_list_node(LF_LIST *node);
    507508static void unlink_lf_list_node(LF_LIST *node);
    508 static void unmake_lf_list_node(LF_LIST *node);
     509static void destroy_lf_list_node(LF_LIST *node);
     510static C_char *make_underscore_symstr(C_char *sym);
    509511
    510512static C_ccall void call_cc_wrapper(C_word c, C_word closure, C_word k, C_word result) C_noret;
     
    731733static C_PTABLE_ENTRY *create_initial_ptable()
    732734{
    733   C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 73);
     735  C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 74);
    734736  int i = 0;
    735737
     
    764766  C_pte(C_chicken_library_ptable);
    765767  C_pte(C_dynamic_library_load);
     768  C_pte(C_dynamic_library_symbol);
    766769  C_pte(C_dynamic_library_unload);
    767770  C_pte(C_become);
     
    18991902
    19001903static void
    1901 unmake_lf_list_node(LF_LIST *node)
     1904destroy_lf_list_node(LF_LIST *node)
    19021905{
    19031906  unlink_lf_list_node(node);
     
    19651968void C_unregister_lf(void *handle)
    19661969{
    1967   unmake_lf_list_node((LF_LIST *)handle);
     1970  destroy_lf_list_node((LF_LIST *)handle);
    19681971}
    19691972
     
    19881991
    19891992
    1990 static void
    1991 checked_library_name_argument(char *loc, C_word libnam, char **name)
    1992 {
    1993   if(C_immediatep(libnam) && C_SCHEME_FALSE == libnam)
    1994     *name = NULL;
    1995   else if (!C_immediatep(libnam) && C_STRING_TYPE == C_header_bits(libnam)) {
    1996     /* Make copy of module name string so cannot be corrupted */
    1997     int len = C_header_size(libnam);
    1998     if(STRING_BUFFER_SIZE <= len) {
    1999       if(NULL == (*name = (char *)C_malloc(len + 1)))
    2000          barf(C_OUT_OF_MEMORY_ERROR, loc);
    2001     } else
    2002       *name = buffer;
    2003     C_memcpy(*name, C_c_string(libnam), len); (*name)[ len ] = '\0';
     1993static C_char *
     1994checked_string_argument(char *loc, C_word hstr)
     1995{
     1996 int len;
     1997  C_char *cstr;
     1998
     1999  if (!C_immediatep(hstr) && C_STRING_TYPE == C_header_bits(hstr)) {
     2000    /* make copy of heap string so movement unnoticeable */
     2001    len = C_header_size(hstr);
     2002    if(NULL == (cstr = (char *)C_malloc(len + 1)))
     2003      barf(C_OUT_OF_MEMORY_ERROR, loc);
     2004    C_memcpy(cstr, C_c_string(hstr), len); (cstr)[ len ] = '\0';
    20042005  } else
    2005     barf(C_BAD_ARGUMENT_TYPE_ERROR, loc, libnam);
     2006    barf(C_BAD_ARGUMENT_TYPE_ERROR, loc, hstr);
     2007
     2008  return cstr;
     2009}
     2010
     2011
     2012static C_char *
     2013checked_string_or_null_argument(char *loc, C_word hstr)
     2014{
     2015  C_char *cstr = NULL;
     2016
     2017  if(!C_immediatep(hstr) || C_SCHEME_FALSE != hstr)
     2018    cstr = checked_string_argument(loc, hstr);
     2019
     2020  return cstr;
    20062021}
    20072022
     
    20162031  if(c != 3) C_bad_argc(c, 3);
    20172032
    2018   checked_library_name_argument("##sys#dynamic-library-data", libnam, &name);
     2033  name = checked_string_or_null_argument("##sys#dynamic-library-data", libnam);
    20192034
    20202035  for(np = lf_list; np; np = np->next) {
     
    20272042  }
    20282043
    2029   if(name && name != buffer) C_free(name);
     2044  if(name) C_free(name);
    20302045
    20312046  C_kontinue(k, olst);
     
    20532068    barf(C_BAD_ARGUMENT_TYPE_ERROR, loc, lfcnt);
    20542069
    2055   /*assert(*handle && *count);*/
    2056 
    2057   checked_library_name_argument(loc, libnam, name);
     2070  *name = checked_string_or_null_argument(loc, libnam);
    20582071}
    20592072
     
    20882101  }
    20892102 
    2090   if(name && name != buffer) C_free(name);
     2103  if(name) C_free(name);
    20912104
    20922105  C_kontinue(k, olst);
     
    21282141  }
    21292142 
    2130   if(name && name != buffer) C_free(name);
     2143  if(name) C_free(name);
    21312144
    21322145  C_kontinue(k, olst);
     
    87068719
    87078720
     8721/* Dynamic Library Access from C */
     8722
    87088723C_regparm void * C_fcall
    87098724C_dynamic_library_open(C_char *name)
     
    87158730  shl_t handle = shl_load(name, BIND_IMMEDIATE | DYNAMIC_PATH, 0L);
    87168731  if(NULL != handle) return (void *)handle;
    8717   C_dlerror = (char *) C_strerror(errno);
     8732  C_dlerror = (char *)C_strerror(errno);
    87188733
    87198734# elif defined(HAVE_DLFCN_H)
     
    87258740# elif defined(HAVE_LOADLIBRARY)
    87268741
     8742  HMODULE handle;
     8743
    87278744  /* cannot use LoadLibrary on non-DLLs, so we use extension checking */
    87288745  int len = strlen(name);
    8729   if (len >= 5) {
    8730     if (C_strncasecmp(".dll", name+len-5, 4) &&
    8731         C_strncasecmp(".so", name+len-4, 3))
    8732       return NULL;
    8733   } else {
    8734     HMODULE handle = LoadLibrary(name);
    8735     if(NULL != handle) return (void *)handle;
    8736     C_dlerror = (char *) C_strerror(errno);
    8737   }
     8746  if (   (len >= 5 && C_strncasecmp(".dll", name+len-5, 4))
     8747      || (len >= 4 && C_strncasecmp(".so", name+len-4, 3))) {
     8748    /* FIXME - really should have an error for this */
     8749    C_dlerror = NULL;
     8750    return NULL;
     8751  }
     8752
     8753  handle = LoadLibrary(name);
     8754  if(NULL != handle) return (void *)handle;
     8755  C_dlerror = (char *)C_strerror(errno);
    87388756
    87398757# endif
     
    87428760
    87438761  return NULL;
     8762}
     8763
     8764
     8765static C_char *
     8766make_underscore_symstr(C_char *sym)
     8767{
     8768  /* if we're out-of-memory don't report it here */
     8769  char *usym = (C_char *)C_malloc(C_strlen(sym) + 2);
     8770  if(NULL != usym) {
     8771    C_strcpy(usym, C_text("_"));
     8772    C_strcat(usym, sym);
     8773  }
     8774  return usym;
    87448775}
    87458776
     
    87488779C_dynamic_library_procedure(void *handle, C_char *name)
    87498780{
    8750   void *p = C_dynamic_library_procedure_exact(handle, name);
     8781  void *ptr = C_dynamic_library_procedure_exact(handle, name);
    87518782
    87528783#ifndef C_MICROSOFT_WINDOWS
    8753   if(NULL == p) {
    8754     char *tmp = (C_char *)C_malloc(C_strlen(name) + 2);
    8755     if(NULL == tmp)
    8756       panic(C_text("out of memory - cannot allocate toplevel name string"));
    8757     C_strcpy(tmp, C_text("_"));
    8758     C_strcat(tmp, name);
    8759     p = C_dynamic_library_procedure_exact(handle, tmp);
    8760     C_free(tmp);
    8761   }
    8762 #endif
    8763 
    8764   return p;
    8765 }
    8766 
    8767 
    8768 /* Dynamic Library Access from C */
     8784  if(NULL == ptr) {
     8785    char *tmp = make_underscore_symstr(name);
     8786    if(NULL != tmp) {
     8787      ptr = C_dynamic_library_procedure_exact(handle, tmp);
     8788      C_free(tmp);
     8789    }
     8790  }
     8791#endif
     8792
     8793  return ptr;
     8794}
     8795
    87698796
    87708797C_regparm void * C_fcall
     
    87768803
    87778804  shl_t shl_handle = (shl_t)handle;
     8805  void *ptr;
     8806  if(0 == shl_findsym(&shl_handle, name, TYPE_PROCEDURE, &ptr)) return ptr;
     8807  C_dlerror = (char *)C_strerror(errno);
     8808
     8809# elif defined(HAVE_DLFCN_H)
     8810
     8811  void *ptr = C_dlsym(handle, name);
     8812  if(NULL != ptr) return ptr;
     8813  C_dlerror = (char *)dlerror();
     8814
     8815# elif defined(HAVE_GETPROCADDRESS)
     8816
     8817  FARPROC ptr = GetProcAddress((HMODULE)handle, name);
     8818  if(NULL != ptr) return (void *)ptr;
     8819  C_dlerror = (char *)C_strerror(errno);
     8820
     8821# endif
     8822
     8823#endif
     8824
     8825  return NULL;
     8826}
     8827
     8828
     8829C_regparm void * C_fcall
     8830C_dynamic_library_variable(void *handle, C_char *name)
     8831{
     8832  void *ptr = C_dynamic_library_variable_exact(handle, name);
     8833
     8834#ifndef C_MICROSOFT_WINDOWS
     8835  if(NULL == ptr) {
     8836    char *tmp = make_underscore_symstr(name);
     8837    if(NULL != tmp) {
     8838      ptr = C_dynamic_library_variable_exact(handle, tmp);
     8839      C_free(tmp);
     8840    }
     8841  }
     8842#endif
     8843
     8844  return ptr;
     8845}
     8846
     8847
     8848C_regparm void * C_fcall
     8849C_dynamic_library_variable_exact(void *handle, C_char *name)
     8850{
     8851#ifndef NO_DLOAD2
     8852
     8853# if defined(__hpux__) && defined(HAVE_DL_H)
     8854
     8855  shl_t shl_handle = (shl_t)handle;
    87788856  void *p;
    8779   if(0 == shl_findsym(&shl_handle, name, TYPE_PROCEDURE, &p)) return p;
    8780   C_dlerror = (char *) C_strerror(errno);
     8857  if(0 == shl_findsym(&shl_handle, name, TYPE_DATA, &p)) return p;
     8858  C_dlerror = (char *)C_strerror(errno);
    87818859
    87828860# elif defined(HAVE_DLFCN_H)
     
    87888866# elif defined(HAVE_GETPROCADDRESS)
    87898867
    8790   FARPROC p = GetProcAddress((HMODULE)handle, name);
    8791   if(NULL != p) return (void *)p;
    8792   C_dlerror = (char *) C_strerror(errno);
    8793 
    8794 # endif
    8795 
    8796 #endif
    8797 
    8798   return NULL;
    8799 }
    8800 
    8801 
    8802 C_regparm void * C_fcall
    8803 C_dynamic_library_variable(void *handle, C_char *name)
    8804 {
    8805   void *p = C_dynamic_library_variable_exact(handle, name);
    8806 
    8807 #ifndef C_MICROSOFT_WINDOWS
    8808   if(NULL == p) {
    8809     char *tmp = (C_char *)C_malloc(C_strlen(name) + 2);
    8810     if(NULL == tmp)
    8811       panic(C_text("out of memory - cannot allocate toplevel name string"));
    8812     C_strcpy(tmp, C_text("_"));
    8813     C_strcat(tmp, name);
    8814     p = C_dynamic_library_variable_exact(handle, tmp);
    8815     C_free(tmp);
    8816   }
    8817 #endif
    8818 
    8819   return p;
    8820 }
    8821 
    8822 
    8823 C_regparm void * C_fcall
    8824 C_dynamic_library_variable_exact(void *handle, C_char *name)
    8825 {
    8826 #ifndef NO_DLOAD2
    8827 
    8828 # if defined(__hpux__) && defined(HAVE_DL_H)
    8829 
    8830   shl_t shl_handle = (shl_t)handle;
    8831   void *p;
    8832   if(0 == shl_findsym(&shl_handle, name, TYPE_DATA, &p)) return p;
    8833   C_dlerror = (char *) C_strerror(errno);
    8834 
    8835 # elif defined(HAVE_DLFCN_H)
    8836 
    8837   void *p = C_dlsym(handle, name);
    8838   if(NULL != p) return p;
    8839   C_dlerror = (char *)dlerror();
    8840 
    8841 # elif defined(HAVE_GETPROCADDRESS)
    8842 
    88438868  /* Not Supported */
    88448869
     
    88598884
    88608885  if(0 != shl_unload((shl_t)handle)) return -1;
     8886  C_dlerror = (char *)C_strerror(errno);
    88618887
    88628888# elif defined(HAVE_DLFCN_H)
    88638889
    88648890  if(0 != C_dlclose(handle)) return -1;
     8891  C_dlerror = (char *)dlerror();
    88658892
    88668893# elif defined(HAVE_LOADLIBRARY)
    88678894
    88688895  if(0 == FreeLibrary((HMODULE)handle)) return -1;
     8896  C_dlerror = (char *)C_strerror(errno);
    88698897
    88708898# endif
     
    88818909C_dynamic_library_load(C_word c, C_word closure, C_word k, C_word name)
    88828910{
    8883   C_word done = C_SCHEME_FALSE;
    8884   C_char *mname;
    8885   void *handle;
     8911  C_word succ = C_SCHEME_FALSE;
     8912  C_char *pname;
    88868913
    88878914  if(c != 3) C_bad_argc(c, 3);
    88888915
    8889   if (C_immediatep(name) || C_STRING_TYPE != C_header_bits(name))
    8890     barf(C_BAD_ARGUMENT_TYPE_ERROR, "##sys#dynamic-library-load", name);
    8891 
    8892   mname = C_c_string(name);
    8893   handle = C_dynamic_library_open(mname);
    8894   if(NULL != handle) {
    8895     C_char *sname = C_strdup(mname);
    8896     if(NULL != sname) {
    8897       LF_LIST *node = make_lf_list_node(NULL, 0, NULL, sname, handle);
     8916  pname = checked_string_argument("##sys#dynamic-library-load", name); /* only free'ed on err */
     8917
     8918  if(NULL == find_lf_list_node(pname)) {
     8919    void *handle = C_dynamic_library_open(pname);
     8920    if(NULL != handle) {
     8921      LF_LIST *node = make_lf_list_node(NULL, 0, NULL, pname, handle);
    88988922      if(NULL != node) {
    88998923        link_lf_list_node(node);
    8900         done = C_SCHEME_TRUE;
     8924        succ = C_SCHEME_TRUE;
    89018925      }
    89028926      else {
    8903         C_free(sname);
     8927        C_free(pname);
     8928        C_dynamic_library_close(handle);
    89048929      }
    89058930    }
    8906   }
    8907 
    8908   C_kontinue(k, done);
    8909 }
    8910 
    8911 
    8912 C_regparm void * C_fcall
    8913 C_dynamic_library_symbol(C_word mname, C_word sname, C_word isprcsym)
    8914 {
    8915   void *ptr = NULL;
     8931    else
     8932      C_free(pname);
     8933  }
     8934  /* loading a loaded library is not an error & we don't bump the dload refcnt */
     8935  else succ = C_SCHEME_TRUE;
     8936
     8937  C_kontinue(k, succ);
     8938}
     8939
     8940
     8941void C_ccall
     8942C_dynamic_library_symbol(C_word c, C_word closure, C_word k, C_word mname, C_word sname, C_word isprcsym)
     8943{
     8944  C_word mptr = C_SCHEME_FALSE;
     8945  C_char *pmname, *psname;
    89168946  LF_LIST *node;
    89178947
    8918   if (C_immediatep(mname) || C_STRING_TYPE != C_header_bits(mname))
    8919     barf(C_BAD_ARGUMENT_TYPE_ERROR, "##sys#C_dynamic_library_symbol", mname);
    8920   if (C_immediatep(sname) || C_STRING_TYPE != C_header_bits(sname))
    8921     barf(C_BAD_ARGUMENT_TYPE_ERROR, "##sys#C_dynamic_library_symbol", sname);
    8922 
    8923   node = find_lf_list_node(C_c_string(mname));
     8948  if(c != 5) C_bad_argc(c, 5);
     8949
     8950  pmname = checked_string_argument("##sys#dynamic-library-symbol", mname);
     8951  psname = checked_string_argument("##sys#dynamic-library-symbol", sname);
     8952
     8953  node = find_lf_list_node(pmname);
    89248954  if(NULL != node) {
    8925     ptr = C_truep(isprcsym)
    8926             ? C_dynamic_library_procedure(node->module_handle, C_c_string(sname))
    8927             : C_dynamic_library_variable(node->module_handle, C_c_string(sname));
     8955    /* note that this cannot fail out-of-line - so tmp strs will be free'ed */
     8956    void *ptr = C_truep(isprcsym)
     8957                  ? C_dynamic_library_procedure(node->module_handle, psname)
     8958                  : C_dynamic_library_variable(node->module_handle, psname);
     8959    mptr = C_mpointer_or_false(C_heaptop, ptr);
    89288960  }   
    89298961
    8930   return ptr;
     8962  if(psname) C_free(psname);
     8963  if(pmname) C_free(pmname);
     8964
     8965  C_kontinue(k, mptr);
    89318966}
    89328967
     
    89358970C_dynamic_library_unload(C_word c, C_word closure, C_word k, C_word name)
    89368971{
    8937   C_word done = C_SCHEME_FALSE;
     8972  C_word succ = C_SCHEME_FALSE;
     8973  C_char *pname;
    89388974  LF_LIST *node;
    89398975
    89408976  if(c != 3) C_bad_argc(c, 3);
    89418977
    8942   if (C_immediatep(name) || C_STRING_TYPE != C_header_bits(name))
    8943     barf(C_BAD_ARGUMENT_TYPE_ERROR, "##sys#dynamic-library-unload", name);
    8944 
    8945   node = find_lf_list_node(C_c_string(name));
     8978  pname = checked_string_argument("##sys#dynamic-library-unload", name);
     8979
     8980  node = find_lf_list_node(pname);
    89468981  if(NULL != node) {
     8982    /* note that this cannot fail out-of-line - so tmp str will be free'ed */
    89478983    int ret = C_dynamic_library_close(node->module_handle);
    8948     unmake_lf_list_node(node);
    8949     if(0 == ret) done = C_SCHEME_TRUE;
     8984    destroy_lf_list_node(node);
     8985    if(0 == ret) succ = C_SCHEME_TRUE;
    89508986  }   
    8951 
    8952   C_kontinue(k, done);
     8987 /* unloading an non-loaded library is not an error */
     8988  else succ = C_SCHEME_TRUE;
     8989
     8990  if(pname) C_free(pname);
     8991
     8992  C_kontinue(k, succ);
    89538993}
    89548994
Note: See TracChangeset for help on using the changeset viewer.