DLLs and files have now termination procedures, which unload the DLL or close

the file, when these objects are garbage collected.

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.

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 : "<anonymous>");
+		*/
+		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;
 }
 

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

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
 }")
 

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

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