mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-05 12:00:32 -08:00
Code Issues Projects Releases Packages Wiki Activity

ffi: implement si_unload_foreign_module.

Browse source 
Patch is necessary to implement this function in cffi - a few libraries
depends on this functionality, and until now it throws an error.

Signed-off-by: Daniel Kochmanski <dkochmanski@hellsgate.pl>
This commit is contained in:
Daniel Kochmanski 2015-01-18 13:57:20 +01:00
parent e8dd76ffee
commit 45ebde8b39
5 changed files with 44 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

27
src/c/ffi.d
View file

@ -728,6 +728,33 @@ si_load_foreign_module(cl_object filename)
#endif
}
cl_object
si_unload_foreign_module(cl_object module)
{
#if !defined(ENABLE_DLOPEN)
FEerror("SI:UNLOAD-FOREIGN-MODULE does not work when ECL is statically linked", 0);
#else
cl_object output = ECL_NIL;
if (ecl_unlikely(ecl_t_of(module) != t_codeblock)) {
FEerror("UNLOAD-FOREIGN-MODULE: Argument is not a foreign module: ~S ",
1, module);
}
# ifdef ECL_THREADS
mp_get_lock(1, ecl_symbol_value(@'mp::+load-compile-lock+'));
ECL_UNWIND_PROTECT_BEGIN(ecl_process_env()) {
# endif
if (ecl_likely(ecl_library_close(module))) output = ECL_T;
# ifdef ECL_THREADS
(void)0; /* MSVC complains about missing ';' before '}' */
} ECL_UNWIND_PROTECT_EXIT {
mp_giveup_lock(ecl_symbol_value(@'mp::+load-compile-lock+'));
} ECL_UNWIND_PROTECT_END;
# endif
@(return output)
#endif
}
cl_object
si_find_foreign_symbol(cl_object var, cl_object module, cl_object type, cl_object size)
{

18
src/c/ffi/libraries.d
View file

@ -205,7 +205,7 @@ dlopen_wrapper(cl_object block)
set_library_error(block);
}
static void
static int
dlclose_wrapper(cl_object block)
{
if (block->cblock.handle != NULL) {
@ -219,7 +219,9 @@ dlclose_wrapper(cl_object block)
FreeLibrary(block->cblock.handle);
#endif
block->cblock.handle = NULL;
return TRUE;
}
return FALSE;
}
static cl_object
@ -419,18 +421,23 @@ ecl_library_error(cl_object block) {
return block->cblock.error;
}
void
bool
ecl_library_close(cl_object block) {
const cl_env_ptr the_env = ecl_process_env();
bool success = TRUE;
ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) {
ecl_disable_interrupts();
if (block->cblock.refs != ecl_make_fixnum(1)) {
/* is it ever a case? no matter how many times i call
load-foreign-module it seems that block->cblock.refs = 1 */
if (block->cblock.refs > ecl_make_fixnum(1)) {
block->cblock.refs = ecl_one_minus(block->cblock.refs);
block = ECL_NIL;
} else if (block->cblock.handle != NULL) {
GC_call_with_alloc_lock(dlclose_wrapper, block);
success = GC_call_with_alloc_lock(dlclose_wrapper, block);
cl_core.libraries = ecl_remove_eq(block, cl_core.libraries);
}
} else { /* block not loaded */
success = FALSE;
}
ecl_enable_interrupts();
} ECL_WITH_GLOBAL_LOCK_END;
if (block != ECL_NIL && block->cblock.self_destruct) {
@ -438,6 +445,7 @@ ecl_library_close(cl_object block) {
unlink((char*)block->cblock.name->base_string.self);
}
}
return success;
}
void

1
src/c/symbols_list.h
View file

@ -1485,6 +1485,7 @@ cl_symbols[] = {
{SYS_ "FREE-FOREIGN-DATA", SI_ORDINARY, si_free_foreign_data, 1, OBJNULL},
{SYS_ "MAKE-FOREIGN-DATA-FROM-ARRAY", SI_ORDINARY, si_make_foreign_data_from_array, 1, OBJNULL},
{SYS_ "LOAD-FOREIGN-MODULE", SI_ORDINARY, si_load_foreign_module, 1, OBJNULL},
{SYS_ "UNLOAD-FOREIGN-MODULE", SI_ORDINARY, si_unload_foreign_module, 1, OBJNULL},
{SYS_ "NULL-POINTER-P", SI_ORDINARY, si_null_pointer_p, 1, OBJNULL},
{SYS_ "SIZE-OF-FOREIGN-ELT-TYPE", SI_ORDINARY, si_size_of_foreign_elt_type, 1, OBJNULL},
{SYS_ "ALIGNMENT-OF-FOREIGN-ELT-TYPE", SI_ORDINARY, si_alignment_of_foreign_elt_type, 1, OBJNULL},

1
src/c/symbols_list2.h
View file

@ -1485,6 +1485,7 @@ cl_symbols[] = {
{SYS_ "FREE-FOREIGN-DATA","si_free_foreign_data"},
{SYS_ "MAKE-FOREIGN-DATA-FROM-ARRAY","si_make_foreign_data_from_array"},
{SYS_ "LOAD-FOREIGN-MODULE","si_load_foreign_module"},
{SYS_ "UNLOAD-FOREIGN-MODULE","si_unload_foreign_module"},
{SYS_ "NULL-POINTER-P","si_null_pointer_p"},
{SYS_ "SIZE-OF-FOREIGN-ELT-TYPE","si_size_of_foreign_elt_type"},
{SYS_ "ALIGNMENT-OF-FOREIGN-ELT-TYPE","si_alignment_of_foreign_elt_type"},

3
src/h/external.h
View file

@ -618,7 +618,7 @@ extern ECL_API cl_object ecl_make_codeblock();
extern ECL_API cl_object ecl_library_open(cl_object filename, bool force_reload);
extern ECL_API void *ecl_library_symbol(cl_object block, const char *symbol, bool lock);
extern ECL_API cl_object ecl_library_error(cl_object block);
extern ECL_API void ecl_library_close(cl_object block);
extern ECL_API bool ecl_library_close(cl_object block);
extern ECL_API void ecl_library_close_all(void);
/* ffi/mmap.d */
@ -650,6 +650,7 @@ extern ECL_API cl_object si_null_pointer_p(cl_object f);
extern ECL_API cl_object si_size_of_foreign_elt_type(cl_object tag);
extern ECL_API cl_object si_alignment_of_foreign_elt_type(cl_object tag);
extern ECL_API cl_object si_load_foreign_module(cl_object module);
extern ECL_API cl_object si_unload_foreign_module(cl_object module);
extern ECL_API cl_object si_find_foreign_symbol(cl_object var, cl_object module, cl_object type, cl_object size);
extern ECL_API cl_object si_call_cfun(cl_narg, cl_object fun, cl_object return_type, cl_object arg_types, cl_object args, ...);
extern ECL_API cl_object si_make_dynamic_callback(cl_narg, cl_object fun, cl_object sym, cl_object return_type, cl_object arg_types, ...);