diff --git a/src/CHANGELOG b/src/CHANGELOG index 05003c655..8e392f703 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -1197,6 +1197,9 @@ ECLS 0.9 - The compiler might get into an infinite loop when dealing with compiler-macros. + - When the functions/macros in a DLL are no longer used, and the + garbage collector notices this, the library is properly deallocated. + * Errors of the interpreter: - CASE should use EQL to compare objects, not EQ. diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 61cf000d6..74a19ecc0 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -29,6 +29,36 @@ struct typemanager tm_table[(int)t_end]; #undef alloc_object #endif +static void +finalize(cl_object o, cl_object data) +{ + switch (type_of(o)) { +#ifdef ENABLE_DLOPEN + case t_codeblock: + AGAIN: + /* + printf("\n;;; Freeing library %s \n", o->cblock.name? + o->cblock.name->string.self : ""); + */ + if (o->cblock.handle != NULL) { + dlclose(o->cblock.handle); + GC_free(o->cblock.data); + } else { + o = o->cblock.next; + if (o != NULL && o->cblock.handle != NULL) + goto AGAIN; + } + break; +#endif + case t_stream: + if (o->stream.file != NULL) + fclose(o->stream.file); + o->stream.file = NULL; + break; + default: + } +} + cl_object cl_alloc_object(cl_type t) { @@ -37,20 +67,28 @@ cl_alloc_object(cl_type t) switch (t) { case t_fixnum: - return MAKE_FIXNUM(0); /* Immediate fixnum */ + return MAKE_FIXNUM(0); /* Immediate fixnum */ case t_character: - return CODE_CHAR(' '); /* Immediate character */ + return CODE_CHAR(' '); /* Immediate character */ } if (t < t_start || t >= t_end) { - printf("\ttype = %d\n", t); - error("alloc botch."); + printf("\ttype = %d\n", t); + error("alloc botch."); } tm = tm_of(t); obj = (cl_object)GC_malloc(tm->tm_size); obj->d.t = t; /* GC_malloc already resets objects */ - + if (t == t_stream +#ifdef ENABLE_DLOPEN + || t == t_codeblock +#endif + ) { + GC_finalization_proc ofn; + void *odata; + GC_register_finalizer_no_order(obj, finalize, NULL, &ofn, &odata); + } return obj; } diff --git a/src/c/read.d b/src/c/read.d index 3855fcaa6..6bbeabda4 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -1851,7 +1851,7 @@ init_read(void) * *---------------------------------------------------------------------- */ -void +cl_object read_VV(cl_object block, void *entry) { typedef void (*entry_point_ptr)(cl_object); @@ -1900,5 +1900,7 @@ read_VV(cl_object block, void *entry) if (in != OBJNULL) close_stream(in, 0); } CL_UNWIND_PROTECT_END; + + return block; } diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index 4dfa15f5a..c235cf870 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -134,10 +134,11 @@ main(int argc, char **argv) #ifdef __cplusplus extern \"C\" #endif -int init_~A(cl_object foo) +int init_~A(cl_object cblock) { + cl_object next; ~A -~{ read_VV(OBJNULL,init_~A);~%~} +~{ next = read_VV(OBJNULL,init_~A); next->cblock.next = cblock; cblock = next; ~%~} ~A }") diff --git a/src/h/external.h b/src/h/external.h index 8b32ad4df..6ada061dc 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1032,7 +1032,7 @@ extern int ecl_current_read_base(void); extern char ecl_current_read_default_float_format(void); extern cl_object c_string_to_object(const char *s); extern void init_read(void); -extern void read_VV(cl_object block, void *entry); +extern cl_object read_VV(cl_object block, void *entry); /* reference.c */ diff --git a/src/h/object.h b/src/h/object.h index 56376138f..be8914b36 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -348,6 +348,7 @@ struct codeblock { int data_size; const char *data_text; /* string with objects to be defined */ int data_text_size; + cl_object next; /* next codeblock within same library */ #ifdef PDE int source_pathname; #endif