~ chicken-core (chicken-5) 8f1cabaabadf89361ce3b594903cbd2c43c3deec
commit 8f1cabaabadf89361ce3b594903cbd2c43c3deec
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Jul 3 12:09:02 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jul 3 12:09:02 2011 +0200
removed remaining support for reloading/unloading .so's
diff --git a/chicken.h b/chicken.h
index 17ff7787..72fec0fb 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1667,7 +1667,7 @@ C_fctexport void C_ccall C_software_version(C_word c, C_word closure, C_word k)
C_fctexport void C_ccall C_build_platform(C_word c, C_word closure, C_word k) C_noret;
C_fctexport void C_ccall C_register_finalizer(C_word c, C_word closure, C_word k, C_word x, C_word proc) C_noret;
C_fctexport void C_ccall C_set_dlopen_flags(C_word c, C_word closure, C_word k, C_word now, C_word global) C_noret;
-C_fctexport void C_ccall C_dload(C_word c, C_word closure, C_word k, C_word name, C_word entry, C_word reloadable) C_noret;
+C_fctexport void C_ccall C_dload(C_word c, C_word closure, C_word k, C_word name, C_word entry) C_noret;
C_fctexport void C_ccall C_become(C_word c, C_word closure, C_word k, C_word table) C_noret;
C_fctexport void C_ccall C_locative_ref(C_word c, C_word closure, C_word k, C_word loc) C_noret;
C_fctexport void C_ccall C_call_with_cthulhu(C_word c, C_word self, C_word k, C_word proc) C_noret;
@@ -1815,7 +1815,6 @@ C_fctexport C_word C_fcall C_i_foreign_unsigned_integer64_argumentp(C_word x) C_
C_fctexport C_char *C_lookup_procedure_id(void *ptr);
C_fctexport void *C_lookup_procedure_ptr(C_char *id);
-C_fctexport C_word C_dunload(C_word name);
C_fctexport C_char *C_executable_path();
#ifdef C_SIXTY_FOUR
diff --git a/eval.scm b/eval.scm
index 0ff35fcb..33b67b6c 100644
--- a/eval.scm
+++ b/eval.scm
@@ -930,13 +930,13 @@
(display " ...\n")
(flush-output)] )
(or (and fname
- (or (##sys#dload (##sys#make-c-string fname 'load) topentry #t)
+ (or (##sys#dload (##sys#make-c-string fname 'load) topentry)
(and (not (has-sep? fname))
(##sys#dload
(##sys#make-c-string
(##sys#string-append "./" fname)
'load)
- topentry #t) ) ) )
+ topentry) ) ) )
(call-with-current-continuation
(lambda (abrt)
(fluid-let ((##sys#read-error-with-line-number #t)
@@ -1044,7 +1044,7 @@
(display " ...\n") )
(let loop ([libs libs])
(cond [(null? libs) #f]
- [(##sys#dload (##sys#make-c-string (##sys#slot libs 0) 'load-library) top #f)
+ [(##sys#dload (##sys#make-c-string (##sys#slot libs 0) 'load-library) top)
(unless (memq id ##sys#features) (set! ##sys#features (cons id ##sys#features)))
#t]
[else (loop (##sys#slot libs 1))] ) ) ) ) ) ) ) )
diff --git a/library.scm b/library.scm
index c6ed34b7..63c6c964 100644
--- a/library.scm
+++ b/library.scm
@@ -345,12 +345,6 @@ EOF
(define ##sys#dload (##core#primitive "C_dload"))
(define ##sys#set-dlopen-flags! (##core#primitive "C_set_dlopen_flags"))
-;; Dynamic Unload not available on all platforms and to be used with caution!
-(define (##sys#dunload name)
- (and-let* ((r (##core#inline "C_dunload" (##sys#make-c-string name))))
- (##sys#gc #t)
- #t ) )
-
;;; Operations on booleans:
diff --git a/manual/Unit eval b/manual/Unit eval
index 7392f8ee..69eaeca5 100644
--- a/manual/Unit eval
+++ b/manual/Unit eval
@@ -34,11 +34,9 @@ code.
If source code is loaded from a port, then that port is closed after
all expressions have been read.
-Compiled code can be re-loaded, but care has to be taken, if code
-from the replaced dynamically loaded module is still executing (i.e.
-if an active continuation refers to compiled code in the old module).
+A compiled file can only be loaded once. Subsequent attempts to load the
+same file have no effect.
-Support for reloading compiled code dynamically is still experimental.
==== load-relative
diff --git a/runtime.c b/runtime.c
index ab6456b6..b06f6ef3 100644
--- a/runtime.c
+++ b/runtime.c
@@ -429,9 +429,7 @@ static C_TLS double
timer_accumulated_gc_ms,
interrupt_time,
last_interrupt_latency;
-static C_TLS LF_LIST
- *lf_list,
- *reload_lf;
+static C_TLS LF_LIST *lf_list;
static C_TLS int signal_mapping_table[ NSIG ];
static C_TLS int
locative_table_size,
@@ -712,7 +710,6 @@ int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel)
allocated_finalizer_count = 0;
current_module_name = NULL;
current_module_handle = NULL;
- reload_lf = NULL;
callback_continuation_level = 0;
gc_ms = 0;
C_randomize(time(NULL));
@@ -723,7 +720,7 @@ int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel)
static C_PTABLE_ENTRY *create_initial_ptable()
{
/* hardcoded table size - this must match the number of C_pte calls! */
- C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 62);
+ C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 61);
int i = 0;
if(pt == NULL)
@@ -784,7 +781,6 @@ static C_PTABLE_ENTRY *create_initial_ptable()
C_pte(C_register_finalizer);
C_pte(C_locative_ref);
C_pte(C_call_with_cthulhu);
- C_pte(C_dunload);
C_pte(C_copy_closure);
C_pte(C_dump_heap_state);
C_pte(C_filter_heap_objects);
@@ -1863,34 +1859,15 @@ void *C_register_lf2(C_word *lf, int count, C_PTABLE_ENTRY *ptable)
node->lf = lf;
node->count = count;
node->ptable = ptable;
- node->module_name = NULL;
- node->module_handle = NULL;
-
- if(reload_lf != NULL) {
- if(debug_mode)
- C_dbg(C_text("debug"), C_text("replacing previous LF-entry for `%s'\n"), current_module_name);
-
- C_free(reload_lf->module_name);
- reload_lf->lf = lf;
- reload_lf->count = count;
- reload_lf->ptable = ptable;
- C_free(node);
- node = reload_lf;
- }
-
node->module_name = current_module_name;
node->module_handle = current_module_handle;
current_module_handle = NULL;
- if(reload_lf != node) {
- if(lf_list) lf_list->prev = node;
-
- node->next = lf_list;
- node->prev = NULL;
- lf_list = node;
- }
- else reload_lf = NULL;
+ if(lf_list) lf_list->prev = node;
+ node->next = lf_list;
+ node->prev = NULL;
+ lf_list = node;
return (void *)node;
}
@@ -8071,12 +8048,12 @@ void C_ccall C_set_dlopen_flags(C_word c, C_word closure, C_word k, C_word now,
}
-void C_ccall C_dload(C_word c, C_word closure, C_word k, C_word name, C_word entry, C_word reloadable)
+void C_ccall C_dload(C_word c, C_word closure, C_word k, C_word name, C_word entry)
{
#if !defined(NO_DLOAD2) && (defined(HAVE_DLFCN_H) || defined(HAVE_DL_H) || (defined(HAVE_LOADLIBRARY) && defined(HAVE_GETPROCADDRESS)))
/* Force minor GC: otherwise the lf may contain pointers to stack-data
(stack allocated interned symbols, for example) */
- C_save_and_reclaim(dload_2, NULL, 4, k, name, entry, reloadable);
+ C_save_and_reclaim(dload_2, NULL, 3, k, name, entry);
#endif
C_kontinue(k, C_SCHEME_FALSE);
@@ -8093,8 +8070,7 @@ void C_ccall C_dload(C_word c, C_word closure, C_word k, C_word name, C_word ent
void dload_2(void *dummy)
{
void *handle, *p;
- C_word reloadable = C_restore,
- entry = C_restore,
+ C_word entry = C_restore,
name = C_restore,
k = C_restore;
C_char *mname = (C_char *)C_data_pointer(name);
@@ -8106,12 +8082,6 @@ void dload_2(void *dummy)
* (char *) C_data_pointer(entry));
*/
- if(C_truep(reloadable) && (reload_lf = find_module_handle(mname)) != NULL) {
- if(shl_unload((shl_t)reload_lf->module_handle) != 0)
- panic(C_text("Unable to unload previously loaded compiled code"));
- }
- else reload_lf = NULL;
-
if ((handle = (void *) shl_load(mname,
BIND_IMMEDIATE | DYNAMIC_PATH,
0L)) != NULL) {
@@ -8123,13 +8093,8 @@ void dload_2(void *dummy)
current_module_handle = handle;
if(debug_mode) {
- if(reload_lf != NULL)
- C_dbg(C_text("debug"), C_text("reloading compiled module `%s' (previous handle was " UWORD_FORMAT_STRING ", new is "
- UWORD_FORMAT_STRING ")\n"), current_module_name, (C_uword)reload_lf->module_handle,
- (C_uword)current_module_handle);
- else
- C_dbg(C_text("debug"), C_text("loading compiled module `%s' (handle is " UWORD_FORMAT_STRING ")\n"),
- current_module_name, (C_uword)current_module_handle);
+ C_dbg(C_text("debug"), C_text("loading compiled module `%s' (handle is " UWORD_FORMAT_STRING ")\n"),
+ current_module_name, (C_uword)current_module_handle);
}
((C_proc2)p)(2, C_SCHEME_UNDEFINED, k);
@@ -8154,7 +8119,6 @@ void dload_2(void *dummy)
{
void *handle, *p, *p2;
C_word
- reloadable = C_restore,
entry = C_restore,
name = C_restore,
k = C_restore;
@@ -8162,12 +8126,6 @@ void dload_2(void *dummy)
C_char *mname = (C_char *)C_data_pointer(name);
C_char *tmp;
- if(C_truep(reloadable) && (reload_lf = find_module_handle(mname)) != NULL) {
- if(C_dlclose(reload_lf->module_handle) != 0)
- panic(C_text("Unable to unload previously loaded compiled code"));
- }
- else reload_lf = NULL;
-
if((handle = C_dlopen(mname, dlopen_flags)) != NULL) {
if((p = C_dlsym(handle, topname)) == NULL) {
tmp = (C_char *)C_malloc(C_strlen(topname) + 2);
@@ -8186,13 +8144,8 @@ void dload_2(void *dummy)
current_module_handle = handle;
if(debug_mode) {
- if(reload_lf != NULL)
- C_dbg(C_text("debug"), C_text("reloading compiled module `%s' (previous handle was " UWORD_FORMAT_STRING ", new is "
- UWORD_FORMAT_STRING ")\n"), current_module_name, (C_uword)reload_lf->module_handle,
- (C_uword)current_module_handle);
- else
- C_dbg(C_text("debug"), C_text("loading compiled module `%s' (handle is " UWORD_FORMAT_STRING ")\n"),
- current_module_name, (C_uword)current_module_handle);
+ C_dbg(C_text("debug"), C_text("loading compiled module `%s' (handle is " UWORD_FORMAT_STRING ")\n"),
+ current_module_name, (C_uword)current_module_handle);
}
((C_proc2)p)(2, C_SCHEME_UNDEFINED, k); /* doesn't return */
@@ -8215,7 +8168,6 @@ void dload_2(void *dummy)
HINSTANCE handle;
FARPROC p = NULL, p2;
C_word
- reloadable = C_restore,
entry = C_restore,
name = C_restore,
k = C_restore;
@@ -8231,25 +8183,14 @@ void dload_2(void *dummy)
C_kontinue(k, C_SCHEME_FALSE);
}
- if(C_truep(reloadable) && (reload_lf = find_module_handle((char *)C_data_pointer(name))) != NULL) {
- if(FreeLibrary((HINSTANCE)reload_lf->module_handle) == 0)
- panic(C_text("Unable to unload previously loaded compiled code"));
- }
- else reload_lf = NULL;
-
if((handle = LoadLibrary(mname)) != NULL) {
if ((p = GetProcAddress(handle, topname)) != NULL) {
current_module_name = C_strdup(mname);
current_module_handle = handle;
if(debug_mode) {
- if(reload_lf != NULL)
- C_dbg(C_text("debug"), C_text("reloading compiled module `%s' (previous handle was " UWORD_FORMAT_STRING ", new is "
- UWORD_FORMAT_STRING ")\n"), current_module_name, (C_uword)reload_lf->module_handle,
- (C_uword)current_module_handle);
- else
- C_dbg(C_text("debug"), C_text("loading compiled module `%s' (handle is " UWORD_FORMAT_STRING ")\n"),
- current_module_name, (C_uword)current_module_handle);
+ C_dbg(C_text("debug"), C_text("loading compiled module `%s' (handle is " UWORD_FORMAT_STRING ")\n"),
+ current_module_name, (C_uword)current_module_handle);
}
((C_proc2)p)(2, C_SCHEME_UNDEFINED, k);
@@ -8263,31 +8204,6 @@ void dload_2(void *dummy)
#endif
-C_word C_ccall C_dunload(C_word name)
-{
- LF_LIST *m = find_module_handle(C_c_string(name));
-
- if(m == NULL) return C_SCHEME_FALSE;
-
-#ifndef NO_DLOAD2
-# if defined(__hpux__) && defined(HAVE_DL_H)
- if(shl_unload((shl_t)m->module_handle) != 0) return C_SCHEME_FALSE;
-# elif defined(HAVE_DLFCN_H)
- if(dlclose(m->module_handle) != 0) return C_SCHEME_FALSE;
-# elif defined(HAVE_LOADLIBRARY)
- if(FreeLibrary(m->module_handle) == 0) return C_SCHEME_FALSE;
-# else
- return C_SCHEME_FALSE;
-# endif
-# else
- return C_SCHEME_FALSE;
-#endif
-
- C_unregister_lf(m);
- return C_SCHEME_TRUE;
-}
-
-
void C_ccall C_become(C_word c, C_word closure, C_word k, C_word table)
{
C_word tp, x, old, new, i, *p;
Trap