Fix interplay between old garbage collector and new method for allocating

symbols. The old GC still has a leak, so disable it.

src/c/Makefile.in

@@ -77,9 +77,9 @@ $(DPP): $(srcdir)/dpp.c $(srcdir)/symbols_list.h $(srcdir)/functions_list.h
 # dangerous to optimize due to assembler hack
 #	$(CC) $(CFLAGS) -O0 -g apply.c -o $@
 assignment.o: assignment.c $(HFILES)
-	$(CC) $(CFLAGS) assignment.c -o $@
+	$(CC) $(CFLAGS) -O0 assignment.c -o $@
 gbc.o: gbc.c $(HFILES)
-	$(CC) $(CFLAGS) gbc.c -o $@
+	$(CC) $(CFLAGS) -O0 gbc.c -o $@
 symbols_def.o: $(srcdir)/symbols_list.h
 	echo '#include "ecl.h"' > symbols_def.c
 	cat $(srcdir)/symbols_list.h | grep 'SW("' | grep -v 'NULL[,)]' | sed 's/SW(".*&\([a-zA-Z_0-9]*\)),/cl_object \1;/g' >> symbols_def.c

src/c/all_symbols.d

@@ -4,7 +4,7 @@
 
 #include "symbols_list.h"
 
-struct symbol cl_symbols[393];
+cl_index cl_num_symbols_in_core = 0;
 
 @(defun si::mangle-name (symbol &optional as_symbol)
 	int l;
@@ -17,18 +17,19 @@ struct symbol cl_symbols[393];
 	assert_type_symbol(symbol);
 	is_symbol = (as_symbol == Cnil);
 	if (is_symbol) {
+		cl_fixnum p;
+
 		if (symbol == Cnil)
 			@(return Ct make_simple_string("Cnil"))
 		else if (symbol == Ct)
 			@(return Ct make_simple_string("Ct"))
-		for (l = 0; all_symbols[l].name != NULL; l++) {
-			if (symbol == (cl_object)(cl_symbols + l)) {
-				found = Ct;
-				output = @format(3, Cnil,
-						 make_constant_string("((cl_object)(cl_symbols+~A))"),
-						 MAKE_FIXNUM(l));
-				@(return found output)
-			}
+		p  = (cl_symbol_initializer*)symbol - cl_symbols;
+		if (p >= 0 && p <= cl_num_symbols_in_core) {
+			found = Ct;
+			output = @format(3, Cnil,
+					 make_constant_string("((cl_object)(cl_symbols+~A))"),
+					 MAKE_FIXNUM(p));
+			@(return found output)
 		}
 	} else {
 		cl_object fun;
@@ -119,6 +120,7 @@ make_this_symbol(int index, const char *name, cl_object package, bool special)
 {
 	cl_object s = (cl_object)(cl_symbols + index);
 	s->symbol.t = t_symbol;
+	s->symbol.mflag = FALSE;
 	SYM_VAL(s) = OBJNULL;
 	SYM_FUN(s) = OBJNULL;
 	s->symbol.plist = Cnil;
@@ -126,14 +128,14 @@ make_this_symbol(int index, const char *name, cl_object package, bool special)
 	s->symbol.stype = special? stp_special : stp_ordinary;
 	s->symbol.mflag = FALSE;
 	s->symbol.isform = FALSE;
-	s->symbol.name = make_constant_string(name);
 	s->symbol.hpack = package;
-	cl_import(s, package);
+	s->symbol.name = make_constant_string(name);
 	sethash(s->symbol.name, package->pack.external, s);
 	if (package == keyword_package) {
 		s->symbol.stype = stp_constant;
 		SYM_VAL(s) = s;
 	}
+	cl_num_symbols_in_core = index + 1;
 }
 
 void
@@ -142,24 +144,26 @@ init_all_symbols(void)
 	int i;
 
 	/* We skip NIL and T */
-	for (i = 2; all_symbols[i].name != NULL; i++) {
-		switch (all_symbols[i].type) {
+	for (i = 2; cl_symbols[i].init.name != NULL; i++) {
+		cl_object *loc = cl_symbols[i].init.loc;
+
+		switch (cl_symbols[i].init.type) {
 		case CL_ORDINARY:
-			make_this_symbol(i, all_symbols[i].name, lisp_package, FALSE);
+			make_this_symbol(i, cl_symbols[i].init.name, lisp_package, FALSE);
 			break;
 		case CL_SPECIAL:
-			make_this_symbol(i, all_symbols[i].name, lisp_package, TRUE);
+			make_this_symbol(i, cl_symbols[i].init.name, lisp_package, TRUE);
 			break;
 		case SI_ORDINARY:
-			make_this_symbol(i, all_symbols[i].name+4, system_package, FALSE);
+			make_this_symbol(i, cl_symbols[i].init.name+4, system_package, FALSE);
 			break;
 		case SI_SPECIAL:
-			make_this_symbol(i, all_symbols[i].name+4, system_package, TRUE);
+			make_this_symbol(i, cl_symbols[i].init.name+4, system_package, TRUE);
 			break;
 		case KEYWORD:
-			make_this_symbol(i, all_symbols[i].name+1, keyword_package, TRUE);
+			make_this_symbol(i, cl_symbols[i].init.name+1, keyword_package, TRUE);
 		}
-		if (all_symbols[i].loc != NULL)
-		  *(all_symbols[i].loc) = (cl_object)(cl_symbols+i);
+		if (loc != NULL)
+			*loc = (cl_object)(cl_symbols+i);
 	}
 }

src/c/alloc.d

@@ -36,7 +36,7 @@
 #include "ecl.h"
 #include "page.h"
 
-#define USE_MMAP
+#undef USE_MMAP
 #ifdef USE_MMAP
 #include <sys/types.h>
 #include <sys/mman.h>
@@ -749,17 +749,17 @@ t_from_type(cl_object type)
 	@(return Ct)
 @)
 
-@(defun si::maxpage (type)
+@(defun si::maximum-allocatable-pages (type)
 @
 	@(return MAKE_FIXNUM(tm_of(t_from_type(type))->tm_maxpage))
 @)
 
-@(defun si::allocated_pages (type)
+@(defun si::allocated-pages (type)
 @
 	@(return MAKE_FIXNUM(tm_of(t_from_type(type))->tm_npage))
 @)
 
-@(defun si::alloc_contpage (qty &optional (now Cnil))
+@(defun si::allocate-contiguous-pages (qty &optional (now Cnil))
 	cl_index i, m;
 	cl_ptr p;
 @
@@ -782,12 +782,12 @@ since ~D pages are already allocated.",
 	@(return Ct)
 @)
 
-@(defun si::ncbpage ()
+@(defun si::allocated-contiguous-pages ()
 @
 	@(return MAKE_FIXNUM(ncbpage))
 @)
 
-@(defun si::maxcbpage ()
+@(defun si::maximum-contiguous-pages ()
 @
 	@(return MAKE_FIXNUM(maxcbpage))
 @)
@@ -815,17 +815,10 @@ since ~D pages are already allocated.",
 	@(return flag)
 @)
 
-static cl_object @'si::*lisp-maxpages*', @'si::+lisp_pagesize+';
-
 void
 init_alloc_function(void)
 {
 	ignore_maximum_pages = TRUE;
-	@'si::*lisp-maxpages*' =
-		make_si_special("*LISP-MAXPAGES*", MAKE_FIXNUM(real_maxpage));
-	@'si::+lisp_pagesize+' =
-		make_si_constant("+LISP-PAGESIZE+", MAKE_FIXNUM(LISP_PAGESIZE));
-	SYM_VAL(@'si::*lisp-maxpages*') = MAKE_FIXNUM(real_maxpage);
 }
 
 #ifdef NEED_MALLOC

src/c/assignment.d

@@ -167,6 +167,7 @@ record_source_pathname(cl_object sym, cl_object def)
 void
 init_assignment(void)
 {
+	SYM_VAL(@'si::*inhibit-macro-special*') = Cnil;
 #ifdef PDE
 	SYM_VAL(@'si::*record-source-pathname-p*') = Cnil;
 #endif

src/c/dpp.c

@@ -225,9 +225,9 @@ search_keyword(const char *name)
 	if (i == 255)
 		error("Too long keyword");
 	c[i] = 0;
-	for (i = 0; all_symbols[i].name != NULL; i++) {
-		if (all_symbols[i].name[0] == ':')
-			if (!strcasecmp(c, all_symbols[i].name+1))
+	for (i = 0; cl_symbols[i].name != NULL; i++) {
+		if (cl_symbols[i].name[0] == ':')
+			if (!strcasecmp(c, cl_symbols[i].name+1))
 				return i;
 	}
 	printf("Keyword not found: %s.\n", c);
@@ -248,8 +248,8 @@ read_symbol()
 	}
 	pushc(0);
 
-	for (i = 0; all_symbols[i].name != NULL; i++) {
-		if (!strcasecmp(name, all_symbols[i].name)) {
+	for (i = 0; cl_symbols[i].name != NULL; i++) {
+		if (!strcasecmp(name, cl_symbols[i].name)) {
 			poolp = name;
 			pushstr("(cl_object)(cl_symbols+");
 			if (i >= 100)

src/c/error.d

@@ -210,12 +210,7 @@ FEinvalid_function(cl_object obj)
 static
 @(defun "universal_error_handler" (c err args)
 @
-	printf("\nLisp initialization error.\n");
-	@print(1, err);
-	@print(1, args);
-#ifndef ALFA
-	exit(0);
-#endif
+	error("\nLisp initialization error.\n");
 @)
 
 void

src/c/functions_list.h

@@ -20,13 +20,14 @@ const struct {
 
 	/* alloc.c */
 
+	{"LOAD", SW("clLload",clLload,cl)},
 #if !defined(GBC_BOEHM)
 	{"SI::ALLOCATE", SW("siLallocate",siLallocate,si)},
 	{"SI::ALLOCATED-PAGES", SW("siLallocated_pages",siLallocated_pages,si)},
-	{"SI::MAXIMUM-ALLOCATABLE-PAGES", SW("siLmaxpage",siLmaxpage,si)},
-	{"SI::ALLOCATE-CONTIGUOUS-PAGES", SW("siLalloc_contpage",siLalloc_contpage,si)},
-	{"SI::ALLOCATED-CONTIGUOUS-PAGES", SW("siLncbpage",siLncbpage,si)},
-	{"SI::MAXIMUM-CONTIGUOUS-PAGES", SW("siLmaxcbpage",siLmaxcbpage,si)},
+	{"SI::MAXIMUM-ALLOCATABLE-PAGES", SW("siLmaximum_allocatable_pages",siLmaximum_allocatable_pages,si)},
+	{"SI::ALLOCATE-CONTIGUOUS-PAGES", SW("siLallocate_contiguous_pages",siLallocate_contiguous_pages,si)},
+	{"SI::ALLOCATED-CONTIGUOUS-PAGES", SW("siLallocated_contiguous_pages",siLallocated_contiguous_pages,si)},
+	{"SI::MAXIMUM-CONTIGUOUS-PAGES", SW("siLmaximum_contiguous_pages",siLmaximum_contiguous_pages,si)},
 	{"SI::GET-HOLE-SIZE", SW("siLget_hole_size",siLget_hole_size,si)},
 	{"SI::SET-HOLE-SIZE", SW("siLset_hole_size",siLset_hole_size,si)},
 	{"SI::IGNORE-MAXIMUM-PAGES", SW("siLignore_maximum_pages",siLignore_maximum_pages,si)},
@@ -373,7 +374,6 @@ const struct {
 
 	/* load.d */
 
-	{"LOAD", SW("clLload",clLload,cl)},
 #ifdef ENABLE_DLOPEN
 	{"SI::LOAD-BINARY", SW("siLload_binary",siLload_binary,si)},
 #endif

src/c/gbc.d

@@ -448,8 +448,15 @@ mark_phase(void)
 	frame_ptr frp;
 	cl_object *sp;
 
-	mark_object(Cnil);
-	mark_object(Ct);
+	/* mark registered symbols & keywords */
+	for (i=0; i<cl_num_symbols_in_core; i++) {
+		cl_object s = (cl_object)(cl_symbols + i);
+		s->symbol.m = FALSE;
+	}
+	for (i=0; i<cl_num_symbols_in_core; i++) {
+		cl_object s = (cl_object)(cl_symbols + i);
+		mark_object(s);
+	}
 
 #ifdef THREADS
 	{
@@ -537,17 +544,6 @@ mark_phase(void)
 	/* mark roots */
 	for (i = 0; i < gc_roots;  i++)
 		mark_object(*gc_root[i]);
-
-	/* mark registered symbols & keywords */
-	{
-	int i;
-	for (i=0; i<ECL_NUM_SYMBOLS_IN_CORE; i++)
-		mark_object((cl_object)(cl_symbols + i));
-
-	if (debug) {
-		printf("symbol navigation\n");
-		fflush(stdout);
-	}
 }
 
 static void
@@ -736,7 +732,7 @@ gc(cl_type t)
 #endif /* THREADS */
 
     if (GC_enter_hook != NULL)
-      (*GC_enter_hook)(0);
+      (*GC_enter_hook)();
 
     interrupt_enable = FALSE;
 

src/c/hash.d

@@ -452,10 +452,7 @@ cl_make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
 	h->hash.data = NULL;	/* for GC sake */
 	h->hash.data = (struct hashtable_entry *)
 	cl_alloc(hsize * sizeof(struct hashtable_entry));
-	for(i = 0;  i < hsize;  i++) {
-		h->hash.data[i].key = OBJNULL;
-		h->hash.data[i].value = OBJNULL;
-	}
+	cl_clear_hash_table(h);
 	return h;
 }
 

src/c/init.d

@@ -31,15 +31,17 @@ init_lisp(void)
 	init_symbol();
 	init_package();
 
+	/* These must come _after_ init_symbol() and init_package() */
+	GC_disable();
+	init_all_symbols();
+	init_all_functions();
+	GC_enable();
+
 #if !defined(GBC_BOEHM)
 	/* We need this because a lot of stuff is to be created */
 	init_GC();
 #endif
 
-	/* These must come _after_ init_symbol() and init_package() */
-	init_all_symbols();
-	init_all_functions();
-
 	SYM_VAL(@'*package*') = lisp_package;
 	SYM_VAL(@'*gensym_counter*') = MAKE_FIXNUM(0);
 

src/c/package.d

@@ -84,11 +84,9 @@ make_package_hashtable()
 	h->hash.rehash_size = make_shortfloat(1.5);
 	h->hash.threshold = make_shortfloat(0.7);
 	h->hash.entries = 0;
+	h->hash.data = NULL; /* for GC sake */
 	h->hash.data = (struct hashtable_entry *)cl_alloc(hsize * sizeof(struct hashtable_entry));
-	for(i = 0;  i < hsize;  i++) {
-		h->hash.data[i].key = OBJNULL;
-		h->hash.data[i].value = OBJNULL;
-	}
+	cl_clear_hash_table(h);
 	return h;
 }
 

src/c/symbols_list.h

@@ -7,18 +7,17 @@
 #ifdef DPP
 #define SW(a,b,c) a
 #else
-#define SW(a,b,c) {a, b, c}
+#define SW(a,b,c) {{a, b, c}}
 #endif
 
-#define ECL_NUM_SYMBOLS_IN_CORE	393
-
-const struct {
+#ifdef DPP
+struct {
 	const char *name;
-#ifndef DPP
-	int type;
-	cl_object *loc;
+}
+#else
+cl_symbol_initializer
 #endif
-} all_symbols[ECL_NUM_SYMBOLS_IN_CORE + 1] = {
+cl_symbols[] = {
 
 SW("NIL", CL_ORDINARY, NULL),
 SW("T", CL_ORDINARY, NULL),

src/configure.in

@@ -53,9 +53,9 @@ dnl 	clx="$enableval")
 AC_ARG_WITH(tcp,
 	[--with-tcp             Include socket interface.],
 	tcp="yes")
-AC_ARG_ENABLE(boehm,
-	[--disable-boehm        Disable Boehm's garbage collector.],
-	boehm="${enableval}",boehm="yes")
+dnl AC_ARG_ENABLE(boehm,
+dnl	[--disable-boehm        Disable Boehm's garbage collector.],
+dnl	boehm="${enableval}",boehm="yes")
 AC_ARG_ENABLE(local-boehm,
 	[--enable-local-boehm   Use already installed Boehm GC library.],
 	[local_boehm="${enableval}" boehm="yes"],local_boehm="no")

src/h/external.h

@@ -39,7 +39,16 @@ extern void init_all_functions(void);
 
 
 /* all_symbols */
-extern struct symbol cl_symbols[];
+typedef union {
+	struct {
+		const char *name;
+		int type;
+		cl_object *loc;
+	} init;
+	struct symbol data;
+} cl_symbol_initializer;
+extern cl_symbol_initializer cl_symbols[];
+extern cl_index cl_num_symbols_in_core;
 extern void init_all_symbols(void);
 
 

src/h/internal.h

@@ -16,6 +16,10 @@
 extern "C" {
 #endif
 
+/* all_symbols.d */
+
+extern cl_index cl_num_symbols_in_core;
+
 /* all_functions.d */
 
 extern const struct {

src/h/lisp_external.h

@@ -10,13 +10,12 @@ extern "C" {
 
 #if !defined(GBC_BOEHM)
 extern cl_object siLallocate _ARGS((int narg, cl_object type, cl_object qty, ...));
-extern cl_object siLmaxpage _ARGS((int narg, cl_object type));
+extern cl_object siLmaximum_allocatable_pages _ARGS((int narg, cl_object type));
 extern cl_object siLallocated_pages _ARGS((int narg, cl_object type));
 extern cl_object siLalloc_contpage _ARGS((int narg, cl_object qty, ...));
-extern cl_object siLncbpage _ARGS((int narg));
-extern cl_object siLmaxcbpage _ARGS((int narg));
-extern cl_object siLalloc_relpage _ARGS((int narg, cl_object qty, cl_object now));
-extern cl_object siLnrbpage _ARGS((int narg));
+extern cl_object siLallocated_contiguous_pages _ARGS((int narg));
+extern cl_object siLmaximum_contiguous_pages _ARGS((int narg));
+extern cl_object siLallocate_contiguous_pages _ARGS((int narg, cl_object qty, ...));
 extern cl_object siLget_hole_size _ARGS((int narg));
 extern cl_object siLset_hole_size _ARGS((int narg, cl_object size));
 extern cl_object siLignore_maximum_pages _ARGS((int narg, ...));

src/lsp/export.lsp

@@ -318,7 +318,6 @@
 		`(si::fset ',name ,function))))
 	  t)
 
-
 (si::fset 'in-package
 	  #'(lambda-block in-package (def env)
 	      `(si::select-package ,(string (second def))))