suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add ffi-lib-unload at the #%foreign level

Browse Source
This commit is contained in:
Matthew Flatt 2019-09-06 12:03:46 -06:00
parent 5147771b04
commit 276a102d6a
17 changed files with 291 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -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]))

1
racket/src/cs/primitive/foreign.ss
View File

@ -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)]

62
racket/src/foreign/foreign.c
View File

@ -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",

58
racket/src/foreign/foreign.rktc
View File

@ -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;

33
racket/src/io/foreign/main.rkt
View File

@ -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 #\?)

2
racket/src/io/host/rktio.rkt
View File

@ -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)

5
racket/src/racket/include/scheme.h
View File

@ -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);

6
racket/src/racket/src/file.c
View File

@ -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;
}

2
racket/src/racket/src/schminc.h
View File

@ -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

2
racket/src/racket/src/schvers.h
View File

@ -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

2
racket/src/rktio/parse.rkt
View File

@ -131,6 +131,8 @@
(error 'parse "typedef struct names don't match at ~s" $5))]
[(TYPEDEF <type> STAR OPEN STAR <id> CLOSE OPEN <params> SEMI)
`(define-type ,$6 function-pointer)]
[(TYPEDEF <type> OPEN STAR <id> CLOSE OPEN <params> SEMI)
`(define-type ,$5 function-pointer)]
[(<extern> <blocking> <return-type> <id> OPEN <params> SEMI)
(let ([r-type (shift-stars $4 $3)]
[id (unstar $4)])

1
racket/src/rktio/rktio.def
View File

@ -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

23
racket/src/rktio/rktio.h
View File

@ -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. */

1
racket/src/rktio/rktio.inc
View File

@ -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);

11
racket/src/rktio/rktio.rktl
View File

@ -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)))

112
racket/src/rktio/rktio_dll.c
View File

@ -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)

8
racket/src/start/embedded_dll.inc
View File

@ -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);
}
}