Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: e8dd76f)
ffi: implement si_unload_foreign_module.
authorDaniel Kochmanski <dkochmanski@hellsgate.pl>
Sun, 18 Jan 2015 12:57:20 +0000 (13:57 +0100)
committerDaniel Kochmanski <dkochmanski@hellsgate.pl>
Sun, 18 Jan 2015 12:57:20 +0000 (13:57 +0100)
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>
src/c/ffi.d patch | blob | blame | history
src/c/ffi/libraries.d patch | blob | blame | history
src/c/symbols_list.h patch | blob | blame | history
src/c/symbols_list2.h patch | blob | blame | history
src/h/external.h patch | blob | blame | history

diff --git a/src/c/ffi.d b/src/c/ffi.d
index 6adb964..ae33ffb 100644 (file)
--- a/src/c/ffi.d
+++ b/src/c/ffi.d
@@ -729,6 +729,33 @@ si_load_foreign_module(cl_object filename)
 }
 
 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)
 {
 #if !defined(ENABLE_DLOPEN)
diff --git a/src/c/ffi/libraries.d b/src/c/ffi/libraries.d
index 9adb734..530f152 100644 (file)
--- a/src/c/ffi/libraries.d
+++ b/src/c/ffi/libraries.d
@@ -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
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 47851b5..5a5f64c 100755 (executable)
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -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},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 5d99c94..70fdd1a 100644 (file)
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -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"},
diff --git a/src/h/external.h b/src/h/external.h
index e3dee77..8b79f4a 100755 (executable)
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -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, ...);
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)