From 276a102d6a4cf305cc2a1616fa54908bc60909a7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 6 Sep 2019 12:03:46 -0600 Subject: [PATCH] add `ffi-lib-unload` at the `#%foreign` level --- pkgs/base/info.rkt | 2 +- racket/src/cs/primitive/foreign.ss | 1 + racket/src/foreign/foreign.c | 62 +++++++++++++++- racket/src/foreign/foreign.rktc | 58 ++++++++++++++- racket/src/io/foreign/main.rkt | 33 ++++++--- racket/src/io/host/rktio.rkt | 2 +- racket/src/racket/include/scheme.h | 5 +- racket/src/racket/src/file.c | 6 +- racket/src/racket/src/schminc.h | 2 +- racket/src/racket/src/schvers.h | 2 +- racket/src/rktio/parse.rkt | 2 + racket/src/rktio/rktio.def | 1 + racket/src/rktio/rktio.h | 23 ++++-- racket/src/rktio/rktio.inc | 1 + racket/src/rktio/rktio.rktl | 11 ++- racket/src/rktio/rktio_dll.c | 112 +++++++++++++++++++++++++---- racket/src/start/embedded_dll.inc | 8 ++- 17 files changed, 291 insertions(+), 40 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 80060fafbc..c820bf932b 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.4.0.6") +(define version "7.4.0.7") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/cs/primitive/foreign.ss b/racket/src/cs/primitive/foreign.ss index 7d340f2f11..88b2bdc6fd 100644 --- a/racket/src/cs/primitive/foreign.ss +++ b/racket/src/cs/primitive/foreign.ss @@ -47,6 +47,7 @@ [ffi-callback-maker (known-procedure 60)] [ffi-lib (known-procedure 14)] [ffi-lib-name (known-procedure 2)] + [ffi-lib-unload (known-procedure 2)] [ffi-lib? (known-procedure 2)] [ffi-obj (known-procedure 4)] [ffi-obj-lib (known-procedure 2)] diff --git a/racket/src/foreign/foreign.c b/racket/src/foreign/foreign.c index 98a8a46d46..7bee558ab6 100644 --- a/racket/src/foreign/foreign.c +++ b/racket/src/foreign/foreign.c @@ -152,6 +152,7 @@ typedef struct ffi_lib_struct { NON_GCBALE_PTR(rktio_dll_t) handle; Scheme_Object* name; int is_global; + int refcount; } ffi_lib_struct; #define SCHEME_FFILIBP(x) (SCHEME_TYPE(x)==ffi_lib_tag) #define MYNAME "ffi-lib?" @@ -222,10 +223,12 @@ static Scheme_Object *foreign_ffi_lib(int argc, Scheme_Object *argv[]) lib->handle = (handle); lib->name = (argv[0]); lib->is_global = (!name); + lib->refcount = (1); scheme_hash_set(opened_libs, hashname, (Scheme_Object*)lib); /* no dlclose finalizer - since the hash table always keeps a reference */ /* maybe add some explicit unload at some point */ - } + } else + lib->refcount++; return (Scheme_Object*)lib; } #undef MYNAME @@ -240,6 +243,53 @@ static Scheme_Object *foreign_ffi_lib_name(int argc, Scheme_Object *argv[]) } #undef MYNAME +/* (ffi-lib-unload ffi-lib) -> (void) */ +#define MYNAME "ffi-lib-unload" +static Scheme_Object *foreign_ffi_lib_unload(int argc, Scheme_Object *argv[]) +{ + ffi_lib_struct *lib; + + if (!SCHEME_FFILIBP(argv[0])) + scheme_wrong_contract(MYNAME, "ffi-lib?", 0, argc, argv); + + lib = (ffi_lib_struct *)argv[0]; + if (!lib->handle) + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + MYNAME": couldn't close already-closed lib %V", + lib->name); + + --lib->refcount; + if (lib->refcount) + return scheme_void; + + if (rktio_dll_close(scheme_rktio, lib->handle)) { + Scheme_Object *hashname; + + lib->handle = NULL; + + if (SCHEME_FALSEP(lib->name)) + hashname = (Scheme_Object *)""; + else { + hashname = TO_PATH(lib->name); + hashname = (Scheme_Object *)SCHEME_PATH_VAL(hashname); + } + scheme_hash_set(opened_libs, hashname, NULL); + } else { + char *msg; + msg = rktio_dll_get_error(scheme_rktio); + if (msg) { + msg = scheme_strdup_and_free(msg); + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + MYNAME": couldn't close %V (%s)", lib->name, msg); + } else + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + MYNAME": couldn't close %V (%R)", lib->name); + } + + return scheme_void; +} +#undef MYNAME + /*****************************************************************************/ /* Pull pointers (mostly functions) out of ffi-lib objects */ @@ -295,6 +345,12 @@ static Scheme_Object *foreign_ffi_obj(int argc, Scheme_Object *argv[]) scheme_wrong_contract(MYNAME, "bytes?", 0, argc, argv); dlname = SCHEME_BYTE_STR_VAL(argv[0]); + if (!lib->handle) { + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + MYNAME": couldn't get \"%s\" from already-closed %V", + dlname, lib->name); + } + dlobj = rktio_dll_find_object(scheme_rktio, lib->handle, dlname); if (!dlobj) { char *msg; @@ -4947,6 +5003,8 @@ void scheme_init_foreign(Scheme_Startup_Env *env) scheme_make_noncm_prim(foreign_ffi_lib, "ffi-lib", 1, 3), env); scheme_addto_prim_instance("ffi-lib-name", scheme_make_noncm_prim(foreign_ffi_lib_name, "ffi-lib-name", 1, 1), env); + scheme_addto_prim_instance("ffi-lib-unload", + scheme_make_noncm_prim(foreign_ffi_lib_unload, "ffi-lib-unload", 1, 1), env); scheme_addto_prim_instance("ffi-obj?", scheme_make_immed_prim(foreign_ffi_obj_p, "ffi-obj?", 1, 1), env); scheme_addto_prim_instance("ffi-obj", @@ -5312,6 +5370,8 @@ void scheme_init_foreign(Scheme_Env *env) scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ffi-lib", 1, 3), env); scheme_addto_primitive_instance("ffi-lib-name", scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ffi-lib-name", 1, 1), env); + scheme_addto_primitive_instance("ffi-lib-unload", + scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ffi-lib-unload", 1, 1), env); scheme_addto_primitive_instance("ffi-obj?", scheme_make_immed_prim((Scheme_Prim *)unimplemented, "ffi-obj?", 1, 1), env); scheme_addto_primitive_instance("ffi-obj", diff --git a/racket/src/foreign/foreign.rktc b/racket/src/foreign/foreign.rktc index 296aec1766..7730823008 100755 --- a/racket/src/foreign/foreign.rktc +++ b/racket/src/foreign/foreign.rktc @@ -143,7 +143,8 @@ static intptr_t add_check_overflow(const char *who, intptr_t a, intptr_t b) @cdefstruct[ffi-lib [] [handle "NON_GCBALE_PTR(rktio_dll_t)"] [name "Scheme_Object*"] - [is_global "int"]] + [is_global "int"] + [refcount "int"]] THREAD_LOCAL_DECL(static Scheme_Hash_Table *opened_libs); @@ -181,11 +182,12 @@ THREAD_LOCAL_DECL(static Scheme_Hash_Table *opened_libs); MYNAME": couldn't open %V (%R)", argv[0]); } } - @cmake["lib" ffi-lib "handle" "argv[0]" "!name"] + @cmake["lib" ffi-lib "handle" "argv[0]" "!name" "1"] scheme_hash_set(opened_libs, hashname, (Scheme_Object*)lib); /* no dlclose finalizer - since the hash table always keeps a reference */ /* maybe add some explicit unload at some point */ - } + } else + lib->refcount++; return (Scheme_Object*)lib; } @@ -196,6 +198,50 @@ THREAD_LOCAL_DECL(static Scheme_Hash_Table *opened_libs); return ((ffi_lib_struct*)argv[0])->name; } +/* (ffi-lib-unload ffi-lib) -> (void) */ +@cdefine[ffi-lib-unload 1]{ + ffi_lib_struct *lib; + + if (!SCHEME_FFILIBP(argv[0])) + scheme_wrong_contract(MYNAME, "ffi-lib?", 0, argc, argv); + + lib = (ffi_lib_struct *)argv[0]; + if (!lib->handle) + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + MYNAME": couldn't close already-closed lib %V", + lib->name); + + --lib->refcount; + if (lib->refcount) + return scheme_void; + + if (rktio_dll_close(scheme_rktio, lib->handle)) { + Scheme_Object *hashname; + + lib->handle = NULL; + + if (SCHEME_FALSEP(lib->name)) + hashname = (Scheme_Object *)""; + else { + hashname = TO_PATH(lib->name); + hashname = (Scheme_Object *)SCHEME_PATH_VAL(hashname); + } + scheme_hash_set(opened_libs, hashname, NULL); + } else { + char *msg; + msg = rktio_dll_get_error(scheme_rktio); + if (msg) { + msg = scheme_strdup_and_free(msg); + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + MYNAME": couldn't close %V (%s)", lib->name, msg); + } else + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + MYNAME": couldn't close %V (%R)", lib->name); + } + + return scheme_void; +} + /*****************************************************************************/ /* Pull pointers (mostly functions) out of ffi-lib objects */ @@ -220,6 +266,12 @@ THREAD_LOCAL_DECL(static Scheme_Hash_Table *opened_libs); scheme_wrong_contract(MYNAME, "bytes?", 0, argc, argv); dlname = SCHEME_BYTE_STR_VAL(argv[0]); + if (!lib->handle) { + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + MYNAME": couldn't get \"%s\" from already-closed %V", + dlname, lib->name); + } + dlobj = rktio_dll_find_object(scheme_rktio, lib->handle, dlname); if (!dlobj) { char *msg; diff --git a/racket/src/io/foreign/main.rkt b/racket/src/io/foreign/main.rkt index ed0945ff14..b228fb1f33 100644 --- a/racket/src/io/foreign/main.rkt +++ b/racket/src/io/foreign/main.rkt @@ -10,6 +10,7 @@ "../locale/string.rkt") (provide ffi-get-lib + ffi-lib-unload ffi-get-obj current-load-extension) @@ -32,17 +33,20 @@ [else (define msg (string-append "could not load foreign library" "\n path: " (if bstr (bytes->string/locale bstr #\?) "[all opened]"))) - (cond - [err-str - (raise - (exn:fail:filesystem - (string-append (symbol->string who) ": " msg - "\n system error: " (->string err-str)) - (current-continuation-marks)))] - [else - (raise-filesystem-error who dll msg)])])] + (raise-dll-error who msg err-str dll)])] [else (success-k dll)])) +(define/who (ffi-lib-unload dll) + (start-atomic) + (define r (rktio_dll_close rktio dll)) + (cond + [(rktio-error? r) + (define err-str (dll-get-error r)) + (end-atomic) + (raise-dll-error who "could not unload foreign library" err-str r)] + [else + (end-atomic)])) + (define (ffi-get-obj who dll dll-name name success-k) (check who path-string? #:or-false dll-name) (check who bytes? name) @@ -79,6 +83,17 @@ (rktio_to_bytes p) (rktio_free p))])))) +(define (raise-dll-error who msg err-str v) + (cond + [err-str + (raise + (exn:fail:filesystem + (string-append (symbol->string who) ": " msg + "\n system error: " (->string err-str)) + (current-continuation-marks)))] + [else + (raise-filesystem-error who v msg)])) + (define (->string s) (if (bytes? s) (bytes->string/utf-8 s #\?) diff --git a/racket/src/io/host/rktio.rkt b/racket/src/io/host/rktio.rkt index f94f02fc07..04144bcbc0 100644 --- a/racket/src/io/host/rktio.rkt +++ b/racket/src/io/host/rktio.rkt @@ -11,7 +11,7 @@ rktio-errstep racket-error? rktio-place-init!) -;; More `provide`s are added by macros below +;; More `provide`s added by macros below (define rktio-table (or (primitive-table '#%rktio) diff --git a/racket/src/racket/include/scheme.h b/racket/src/racket/include/scheme.h index ec54c190a2..d4faff15dd 100644 --- a/racket/src/racket/include/scheme.h +++ b/racket/src/racket/include/scheme.h @@ -1933,7 +1933,10 @@ MZ_EXTERN void scheme_set_compiled_file_roots(Scheme_Object *list); MZ_EXTERN void scheme_set_dll_path(wchar_t *s); typedef void *(*scheme_dll_open_proc)(const char *name, int as_global); typedef void *(*scheme_dll_find_object_proc)(void *h, const char *name); -MZ_EXTERN void scheme_set_dll_procs(scheme_dll_open_proc, scheme_dll_find_object_proc); +typedef void (*scheme_dll_close_proc)(void *h); +MZ_EXTERN void scheme_set_dll_procs(scheme_dll_open_proc, + scheme_dll_find_object_proc, + scheme_dll_close_proc); #endif MZ_EXTERN void scheme_init_collection_paths(Scheme_Env *global_env, Scheme_Object *extra_dirs); diff --git a/racket/src/racket/src/file.c b/racket/src/racket/src/file.c index 284d7f84f9..9b228e4a62 100644 --- a/racket/src/racket/src/file.c +++ b/racket/src/racket/src/file.c @@ -5097,9 +5097,11 @@ wchar_t *scheme_get_dll_path(wchar_t *p) return r2; } -void scheme_set_dll_procs(scheme_dll_open_proc dll_open, scheme_dll_find_object_proc find_obj) +void scheme_set_dll_procs(scheme_dll_open_proc dll_open, + scheme_dll_find_object_proc find_obj, + scheme_dll_close_proc dll_close) { - rktio_set_dll_procs(dll_open, find_obj); + rktio_set_dll_procs(dll_open, find_obj, dll_close); alt_dll_open = dll_open; alt_find_obj = find_obj; } diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index e13c0274c4..52dcd03d52 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1455 +#define EXPECTED_PRIM_COUNT 1456 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 58b2c04dc7..a5c57705f7 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 4 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 6 +#define MZSCHEME_VERSION_W 7 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x diff --git a/racket/src/rktio/parse.rkt b/racket/src/rktio/parse.rkt index 4f6b915f24..be52b5a46a 100644 --- a/racket/src/rktio/parse.rkt +++ b/racket/src/rktio/parse.rkt @@ -131,6 +131,8 @@ (error 'parse "typedef struct names don't match at ~s" $5))] [(TYPEDEF STAR OPEN STAR CLOSE OPEN SEMI) `(define-type ,$6 function-pointer)] + [(TYPEDEF OPEN STAR CLOSE OPEN SEMI) + `(define-type ,$5 function-pointer)] [( OPEN SEMI) (let ([r-type (shift-stars $4 $3)] [id (unstar $4)]) diff --git a/racket/src/rktio/rktio.def b/racket/src/rktio/rktio.def index eeabe8f3fd..bc35980a9b 100644 --- a/racket/src/rktio/rktio.def +++ b/racket/src/rktio/rktio.def @@ -195,6 +195,7 @@ rktio_sha2_update rktio_sha2_final rktio_dll_open rktio_dll_find_object +rktio_dll_close rktio_dll_get_error rktio_set_dll_procs rktio_get_last_error_kind diff --git a/racket/src/rktio/rktio.h b/racket/src/rktio/rktio.h index 13b3cd8cd1..22b4c5b696 100644 --- a/racket/src/rktio/rktio.h +++ b/racket/src/rktio/rktio.h @@ -1241,15 +1241,27 @@ RKTIO_EXTERN rktio_dll_t *rktio_dll_open(rktio_t *rktio, rktio_const_string_t na reported, then rktio_dll_get_error() must be used before any other `rktio_dll_...` call to get an error string. - Currently, there's no way to close and unload a DLL. Even when the - given `rktio` is closed with `rktio_destroy`, loaded libraries - remain in the process. */ + If a DLL has been loaded with `name` already, the previous result + is returned again, but with an internal reference count returned. + The `as_global` argument matters only for the first load of a DLL + thrrough a given `name`. + + Unless the DLL is explicitly unloaded with `rktio_dll_close`, even + when the given `rktio` is closed with `rktio_destroy`, loaded + libraries remain in the process. */ RKTIO_EXTERN void *rktio_dll_find_object(rktio_t *rktio, rktio_dll_t *dll, rktio_const_string_t name); /* Find an address within `dll` for the `name` export. An error result can be `RKTIO_ERROR_DLL` as for `rktio_dll_open`. */ +RKTIO_EXTERN rktio_ok_t rktio_dll_close(rktio_t *rktio, rktio_dll_t *dll); +/* Decrements the reference count on `dll`, and if it goes to zero, + unloads the DLL using system-provided functions and destroys the + `dll` argument. + + An error result can be `RKTIO_ERROR_DLL` as for `rktio_dll_open`. */ + RKTIO_EXTERN char *rktio_dll_get_error(rktio_t *rktio); /* Returns an error for a previous `rktio_dll_...` call, or NULL if no error string is available or has already been returned. @@ -1257,7 +1269,10 @@ RKTIO_EXTERN char *rktio_dll_get_error(rktio_t *rktio); typedef void *(*dll_open_proc)(rktio_const_string_t name, rktio_bool_t as_global); typedef void *(*dll_find_object_proc)(void *h, rktio_const_string_t name); -RKTIO_EXTERN void rktio_set_dll_procs(dll_open_proc dll_open, dll_find_object_proc dll_find_object); +typedef void (*dll_close_proc)(void *h); +RKTIO_EXTERN void rktio_set_dll_procs(dll_open_proc dll_open, + dll_find_object_proc dll_find_object, + dll_close_proc dll_close); /* Installs procedures that are tried before native mechanisms, currently only supported for Windows. */ diff --git a/racket/src/rktio/rktio.inc b/racket/src/rktio/rktio.inc index 6f864935fd..1459aeb9fd 100644 --- a/racket/src/rktio/rktio.inc +++ b/racket/src/rktio/rktio.inc @@ -195,6 +195,7 @@ Sforeign_symbol("rktio_sha2_update", (void *)rktio_sha2_update); Sforeign_symbol("rktio_sha2_final", (void *)rktio_sha2_final); Sforeign_symbol("rktio_dll_open", (void *)rktio_dll_open); Sforeign_symbol("rktio_dll_find_object", (void *)rktio_dll_find_object); +Sforeign_symbol("rktio_dll_close", (void *)rktio_dll_close); Sforeign_symbol("rktio_dll_get_error", (void *)rktio_dll_get_error); Sforeign_symbol("rktio_set_dll_procs", (void *)rktio_set_dll_procs); Sforeign_symbol("rktio_get_last_error_kind", (void *)rktio_get_last_error_kind); diff --git a/racket/src/rktio/rktio.rktl b/racket/src/rktio/rktio.rktl index 6f958a538f..4cb28e851a 100644 --- a/racket/src/rktio/rktio.rktl +++ b/racket/src/rktio/rktio.rktl @@ -204,6 +204,7 @@ (int is224))) (define-type dll_open_proc function-pointer) (define-type dll_find_object_proc function-pointer) +(define-type dll_close_proc function-pointer) (define-function () (ref rktio_t) rktio_init ()) (define-function () void rktio_destroy (((ref rktio_t) rktio))) (define-function () void rktio_free (((ref void) p))) @@ -1371,6 +1372,12 @@ (ref void) rktio_dll_find_object (((ref rktio_t) rktio) ((ref rktio_dll_t) dll) (rktio_const_string_t name))) +(define-function/errno + #f + () + rktio_ok_t + rktio_dll_close + (((ref rktio_t) rktio) ((ref rktio_dll_t) dll))) (define-function/errno NULL () @@ -1381,7 +1388,9 @@ () void rktio_set_dll_procs - ((dll_open_proc dll_open) (dll_find_object_proc dll_find_object))) + ((dll_open_proc dll_open) + (dll_find_object_proc dll_find_object) + (dll_close_proc dll_close))) (define-function () int rktio_get_last_error_kind (((ref rktio_t) rktio))) (define-function () int rktio_get_last_error (((ref rktio_t) rktio))) (define-function () int rktio_get_last_error_step (((ref rktio_t) rktio))) diff --git a/racket/src/rktio/rktio_dll.c b/racket/src/rktio/rktio_dll.c index a45fa1225e..761553562b 100644 --- a/racket/src/rktio/rktio_dll.c +++ b/racket/src/rktio/rktio_dll.c @@ -9,6 +9,8 @@ typedef struct rktio_dll_object_t rktio_dll_object_t; static void get_dl_error(rktio_t *rktio); #endif +static void free_dll(rktio_dll_t *dll); + /*========================================================================*/ /* Opening a DLL */ /*========================================================================*/ @@ -21,11 +23,13 @@ typedef void *dll_handle_t; #ifdef RKTIO_SYSTEM_WINDOWS typedef HANDLE dll_handle_t; static dll_open_proc LoadLibraryHook; +static dll_close_proc FreeLibraryHook; static dll_find_object_proc GetProcAddressHook; #endif struct rktio_dll_t { void *handle; + int refcount; #ifdef RKTIO_SYSTEM_WINDOWS int hook_handle; #endif @@ -33,7 +37,7 @@ struct rktio_dll_t { rktio_hash_t *objects_by_name; rktio_dll_object_t *all_objects; int search_exe; - rktio_dll_t *all_next; /* chain for all DLLs */ + rktio_dll_t *all_next, *all_prev; /* chain for all DLLs */ rktio_dll_t *hash_next; /* chain for hash collisions */ }; @@ -67,8 +71,10 @@ rktio_dll_t *rktio_dll_open(rktio_t *rktio, rktio_const_string_t name, rktio_boo dll = dll->hash_next; } - if (dll) + if (dll) { + dll->refcount++; return dll; + } #ifdef RKTIO_SYSTEM_UNIX # if defined(__ANDROID__) @@ -116,14 +122,83 @@ rktio_dll_t *rktio_dll_open(rktio_t *rktio, rktio_const_string_t name, rktio_boo dll->search_exe = (name == NULL); dll->all_next = rktio->all_dlls; + dll->all_prev = NULL; + if (rktio->all_dlls) + rktio->all_dlls->all_prev = dll; rktio->all_dlls = dll; dll->hash_next = dlls; rktio_hash_set(rktio->dlls_by_name, key, dll); + dll->refcount = 1; + return dll; } +rktio_ok_t rktio_dll_close(rktio_t *rktio, rktio_dll_t *dll) +{ + int ok = 1; + + dll->refcount--; + if (dll->refcount) + return ok; + + if (!dll->refcount) { +#ifdef RKTIO_SYSTEM_UNIX + if (dlclose(dll->handle)) { + ok = 0; + get_dl_error(rktio); + } +#endif + +#ifdef RKTIO_SYSTEM_WINDOWS + if (dll->hook_handle) { + FreeLibraryHook((void *)dll->handle); + /* assuming success! */ + } else { + if (!FreeLibrary((HMODULE)dll->handle)) { + ok = 0; + get_windows_error(); + } + } +#endif + } + + if (ok) { + intptr_t key; + rktio_dll_t *dlls; + + if (dll->name) + key = rktio_hash_string(dll->name); + else + key = 0; + + dlls = rktio_hash_get(rktio->dlls_by_name, key); + if (dlls == dll) + rktio_hash_set(rktio->dlls_by_name, key, dll->hash_next); + else if (dlls) { + while (dlls->hash_next) { + if (dlls->hash_next == dll) { + dlls->hash_next = dll->hash_next; + break; + } else + dlls = dlls->hash_next; + } + } + + if (dll->all_next) + dll->all_next->all_prev = dll->all_prev; + if (dll->all_prev) + dll->all_prev->all_next = dll->all_next; + else + rktio->all_dlls = dll->all_next; + + free_dll(dll); + } + + return ok; +} + /*========================================================================*/ /* Searching all DLLs on Windows */ /*========================================================================*/ @@ -350,11 +425,14 @@ RKTIO_EXTERN char *rktio_dll_get_error(rktio_t *rktio) /* Support in-memory DLLs and similar by allowing the application to install replacements for LoadLibrary and GetProcAddress. */ -void rktio_set_dll_procs(dll_open_proc dll_open, dll_find_object_proc dll_find_object) +void rktio_set_dll_procs(dll_open_proc dll_open, + dll_find_object_proc dll_find_object, + dll_close_proc dll_close) { #ifdef RKTIO_SYSTEM_WINDOWS LoadLibraryHook = dll_open; GetProcAddressHook = dll_find_object; + FreeLibraryHook = dll_close; #endif } @@ -375,23 +453,29 @@ void *rktio_get_proc_address(HANDLE m, rktio_const_string_t name) /* Clean up */ /*========================================================================*/ +static void free_dll(rktio_dll_t *dll) +{ + rktio_dll_object_t *obj, *next_obj; + + for (obj = dll->all_objects; obj; obj = next_obj) { + next_obj = obj->all_next; + free(obj->name); + free(obj); + } + if (dll->name) + free(dll->name); + if (dll->objects_by_name) + rktio_hash_free(dll->objects_by_name, 0); + free(dll); +} + void rktio_dll_clean(rktio_t *rktio) { rktio_dll_t *dll, *next_dll; - rktio_dll_object_t *obj, *next_obj; for (dll = rktio->all_dlls; dll; dll = next_dll) { next_dll = dll->all_next; - for (obj = dll->all_objects; obj; obj = next_obj) { - next_obj = obj->all_next; - free(obj->name); - free(obj); - } - if (dll->name) - free(dll->name); - if (dll->objects_by_name) - rktio_hash_free(dll->objects_by_name, 0); - free(dll); + free_dll(dll); } if (rktio->dlls_by_name) diff --git a/racket/src/start/embedded_dll.inc b/racket/src/start/embedded_dll.inc index 0ef5ea02f4..f3b85870c1 100644 --- a/racket/src/start/embedded_dll.inc +++ b/racket/src/start/embedded_dll.inc @@ -153,10 +153,16 @@ static long in_memory_get_offset(const char *name) return 0; } +static void in_memory_close(void *h) +{ + if (h) + MemoryFreeLibrary((HMEMORYMODULE)h); +} + static void register_embedded_dll_hooks() { if (embedded_dlls) { - scheme_set_dll_procs(in_memory_open, in_memory_find_object); + scheme_set_dll_procs(in_memory_open, in_memory_find_object, in_memory_close); } }