ECL can be built without GMP again

src/CHANGELOG

@@ -131,6 +131,8 @@ ECL 0.9k:
  - LOG lost accuracy when applied to a complex number where the either the
    real or the imaginary part was much larger than the other one.
 
+ - Building without GMP is again supported.
+
 * System design:
 
  - We introduce a new kind of lisp objects, the stack frames. These are objects

src/c/alloc.d

@@ -258,8 +258,10 @@ ONCE_MORE:
 	 */
 	switch (t) {
 	case t_bignum:
+#ifdef WITH_GMP
 	  obj->big.big_dim = obj->big.big_size = 0;
 	  obj->big.big_limbs = NULL;
+#endif
 	  break;
 	case t_ratio:
 	  obj->ratio.num = OBJNULL;

src/c/alloc_2.d

@@ -347,10 +347,15 @@ si_gc_stats(cl_object enable)
 	cl_object old_status = cl_core.gc_stats? Ct : Cnil;
 	cl_core.gc_stats = (enable != Cnil);
 	if (cl_core.bytes_consed == Cnil) {
+#ifndef WITH_GMP
+		cl_core.bytes_consed = MAKE_FIXNUM(0);
+		cl_core.gc_counter = MAKE_FIXNUM(0);
+#else
 		cl_core.bytes_consed = cl_alloc_object(t_bignum);
 		mpz_init2(cl_core.bytes_consed->big.big_num, 128);
 		cl_core.gc_counter = cl_alloc_object(t_bignum);
 		mpz_init2(cl_core.gc_counter->big.big_num, 128);
+#endif
 	}
 	@(return
 	  big_register_normalize(cl_core.bytes_consed)
@@ -369,6 +374,8 @@ finalize_queued()
 {
 	cl_object l = cl_core.to_be_finalized;
 	if (cl_core.gc_stats) {
+#ifdef WITH_GMP
+		/* Sorry, no gc stats if you do not use bignums */
 #if GBC_BOEHM == 0
 		mpz_add_ui(cl_core.bytes_consed->big.big_num,
 			   cl_core.bytes_consed->big.big_num,
@@ -395,6 +402,7 @@ finalize_queued()
 		mpz_add_ui(cl_core.gc_counter->big.big_num,
 			   cl_core.gc_counter->big.big_num,
 			   1);
+#endif
 	}
 	if (l != Cnil) {
 		cl_core.to_be_finalized = Cnil;

src/c/big_ll.d

@@ -61,30 +61,30 @@ big_register_normalize(cl_object x)
 static cl_object
 big_alloc(int size)
 {
-  volatile cl_object x = cl_alloc_object(t_bignum);
-  if (size <= 0)
-    ecl_internal_error("negative or zero size for bignum in big_alloc");
-  x->big.big_num = 0ll;
-  return x;
+	volatile cl_object x = cl_alloc_object(t_bignum);
+	if (size <= 0)
+		ecl_internal_error("negative or zero size for bignum in big_alloc");
+	x->big.big_num = 0ll;
+	return x;
 }
 
 
 cl_object
 bignum1(cl_fixnum val)
 {
-  volatile cl_object z = cl_alloc_object(t_bignum);
-  z->big.big_num = val;
-  return(z);
+	volatile cl_object z = cl_alloc_object(t_bignum);
+	z->big.big_num = val;
+	return(z);
 }
 
 cl_object
 bignum2(cl_fixnum hi, cl_fixnum lo)
 {
-  cl_object z;
+	cl_object z;
 
-  z = big_alloc(2);
-  z->big.big_num = hi<<32 + lo;
-  return(z);
+	z = big_alloc(2);
+	z->big.big_num = hi<<32 + lo;
+	return(z);
 }
 
 cl_object
@@ -117,16 +117,16 @@ big_plus(cl_object x, cl_object y)
 cl_object
 big_normalize(cl_object x)
 {
-  if (x->big.big_num == 0ll)
-    return(MAKE_FIXNUM(0));
-  if (x->big.big_num <= MOST_POSITIVE_FIXNUM && x->big.big_num >= MOST_NEGATIVE_FIXNUM)
-    return(MAKE_FIXNUM(x->big.big_num));
-  return(x);
+	if (x->big.big_num == 0ll)
+		return(MAKE_FIXNUM(0));
+	if (x->big.big_num <= MOST_POSITIVE_FIXNUM && x->big.big_num >= MOST_NEGATIVE_FIXNUM)
+		return(MAKE_FIXNUM(x->big.big_num));
+	return(x);
 }
 
 int big_num_t_sgn(big_num_t x)
 {
-     return ( x == (big_num_t)0 ) ? 0 : (x < (big_num_t)0) ? -1 : 1;
+	return ( x == (big_num_t)0 ) ? 0 : (x < (big_num_t)0) ? -1 : 1;
 }
 
 

src/c/gbc.d

@@ -120,11 +120,16 @@ BEGIN:
 	if (x == OBJNULL)
 		return;
 #endif
+	/* We need this, because sometimes we arrive to data structures
+	 * which have been created in the C stack (t_frame in gfun.d,
+	 * for instance) */
+	if (!VALID_DATA_ADDRESS(x))
+		return;
 	if (x->d.m) {
-	  if (x->d.m == FREE)
-	    ecl_internal_error("mark_object: pointer to free object.");
-	  else
-	    return;
+		if (x->d.m == FREE)
+			ecl_internal_error("mark_object: pointer to free object.");
+		else
+			return;
 	}
 	x->d.m = TRUE;
 
@@ -424,45 +429,49 @@ BEGIN:
 static void
 mark_stack_conservative(cl_ptr bottom, cl_ptr top)
 {
-  int p, m;
-  cl_object x;
-  struct typemanager *tm;
-  cl_ptr j;
+	int p, m;
+	cl_object x;
+	struct typemanager *tm;
+	cl_ptr j;
 
-  if (debug) { printf("Traversing C stack .."); fflush(stdout); }
+	if (debug) { printf("Traversing C stack .."); fflush(stdout); }
 
-  /* On machines which align local pointers on multiple of 2 rather
-     than 4 we need to mark twice
+	/* On machines which align local pointers on multiple of 2 rather
+	   than 4 we need to mark twice
 
-  if (offset) mark_stack_conservative(bottom, ((char *) top) + offset, 0);
-     */
-  for (j = bottom ; j < top ; j+=sizeof(cl_ptr)) {
-    cl_ptr aux = *((cl_ptr*)j);
-    /* improved Beppe: */
-    if (VALID_DATA_ADDRESS(aux) && type_map[p = page(aux)] < (char)t_end) {
-      tm = tm_of((cl_type)type_map[p]);
-      x = (cl_object)(aux - (aux - pagetochar(p)) % tm->tm_size);
-      m = x->d.m;
-      if (m != FREE && m != TRUE) {
-	if (m) {
-	  fprintf(stderr,
-		  "** bad value %d of d.m in gc page %d skipping mark **",
-		  m, p); fflush(stderr);
-	} else
-	  mark_object(x);
-      }
-    }}
-  if (debug) {printf(". done.\n"); fflush(stdout); }
+	   if (offset) mark_stack_conservative(bottom, ((char *) top) + offset, 0);
+	*/
+	for (j = bottom ; j < top ; j+=sizeof(cl_ptr)) {
+		cl_ptr aux = *((cl_ptr*)j);
+		/* improved Beppe: */
+		if (VALID_DATA_ADDRESS(aux) && type_map[p = page(aux)] < (char)t_end) {
+			tm = tm_of((cl_type)type_map[p]);
+			x = (cl_object)(aux - (aux - pagetochar(p)) % tm->tm_size);
+			m = x->d.m;
+			if (m != FREE && m != TRUE) {
+				if (m) {
+					fprintf(stderr,
+						"** bad value %d of d.m in gc page %d skipping mark **",
+						m, p); fflush(stderr);
+				} else {
+					mark_object(x);
+				}
+			}
+		}
+	}
+	if (debug) {
+		printf(". done.\n"); fflush(stdout);
+	}
 }
 
 static void
 mark_cl_env(struct cl_env_struct *env)
 {
-	int i;
-	cl_object where;
-	bds_ptr bdp;
-	ecl_frame_ptr frp;
-	struct ihs_frame *ihs;
+	int i = 0;
+	cl_object where = 0;
+	bds_ptr bdp = 0;
+	ecl_frame_ptr frp = 0;
+	struct ihs_frame *ihs = 0;
 
 	mark_contblock(env, sizeof(*env));
 
@@ -512,6 +521,14 @@ mark_cl_env(struct cl_env_struct *env)
 	mark_object(env->big_register[1]);
 	mark_object(env->big_register[2]);
 
+#ifdef CLOS
+#ifdef ECL_THREADS
+	mark_object(env->method_hash_clear_list);
+#endif
+	mark_object(env->method_hash);
+	mark_object(env->method_spec_vector);
+#endif
+
 #ifdef ECL_THREADS
 /* We should mark the stacks of the threads somehow!!! */
 #error "The old garbage collector does not support threads"
@@ -949,6 +966,18 @@ _mark_contblock(void *x, cl_index s)
 	@(return MAKE_FIXNUM(gc_time))
 @)
 
+cl_object
+si_get_finalizer(cl_object o)
+{
+	@(return Cnil)
+}
+
+cl_object
+si_set_finalizer(cl_object o, cl_object finalizer)
+{
+	@(return)
+}
+
 void
 init_GC(void)
 {

src/c/gfun.d

@@ -98,7 +98,8 @@ si_generic_function_p(cl_object x)
 
 #define RECORD_KEY(e) ((e)[0])
 #define RECORD_VALUE(e) ((e)[1])
-#define RECORD_GEN(e) (((cl_fixnum*)(e+2))[0])
+#define RECORD_GEN(e) fix((e+2)[0])
+#define RECORD_GEN_SET(e,v) ((e+2)[0]=MAKE_FIXNUM(v))
 
 static cl_object
 do_clear_method_hash(struct cl_env_struct *env, cl_object target)
@@ -260,7 +261,8 @@ search_method_hash(cl_object keys, cl_object table)
 	 * generation number does not become too large and we can
 	 * expire some elements.
 	 */
-	RECORD_GEN(min_e) = gen = cl_env.method_generation;
+	gen = cl_env.method_generation;
+	RECORD_GEN_SET(min_e, gen);
 	if (gen >= total_size/2) {
 		cl_object *e = table->vector.self.t;
 		gen = 0.5*gen;
@@ -272,7 +274,7 @@ search_method_hash(cl_object keys, cl_object table)
 				RECORD_VALUE(e) = Cnil;
 				g = 0;
 			}
-			RECORD_GEN(e) = g;
+			RECORD_GEN_SET(e, g);
 		}
 	}
 	return min_e;

src/c/main.d

@@ -30,6 +30,7 @@
 #   include <unistd.h>
 # endif
 #endif
+#include <stdio.h>
 #include <stdlib.h>
 #include <ecl/internal.h>
 extern int GC_dont_gc;
@@ -95,6 +96,9 @@ ecl_init_env(struct cl_env_struct *env)
 #endif
 
 #ifdef CLOS
+	env->method_hash = Cnil;
+	env->method_spec_vector = Cnil;
+	env->method_generation = 0;
 	_ecl_set_method_hash_size(env, 4096);
 #ifdef ECL_THREADS
 	env->method_hash_clear_list = Cnil;

src/c/symbols_list.h

@@ -1633,7 +1633,9 @@ cl_symbols[] = {
 
 {SYS_ "WRONG-TYPE-ARGUMENT", SI_ORDINARY, NULL, -1, OBJNULL},
 
+#ifdef GBC_BOEHM
 {SYS_ "GC-STATS", SI_ORDINARY, si_gc_stats, 1, OBJNULL},
+#endif
 
 {SYS_ "*CURRENT-FORM*", SI_SPECIAL, NULL, -1, OBJNULL},
 

src/c/symbols_list2.h

@@ -1633,7 +1633,9 @@ cl_symbols[] = {
 
 {SYS_ "WRONG-TYPE-ARGUMENT",NULL},
 
+#ifdef GBC_BOEHM
 {SYS_ "GC-STATS","si_gc_stats"},
+#endif
 
 {SYS_ "*CURRENT-FORM*",NULL},
 

src/configure.in

@@ -64,7 +64,7 @@ AC_ARG_WITH(system-boehm,
 
 AC_ARG_WITH(gmp,
   AS_HELP_STRING( [--with-gmp=args],
-                  [supply arguments for configuring GMP library])
+                  [supply arguments for configuring GMP library]),
   [], [with_gmp=""])
 
 AC_ARG_WITH(system-gmp,

src/h/external.h

@@ -142,9 +142,9 @@ struct cl_core_struct {
 	cl_object system_package;
 #ifdef CLOS
 	cl_object clos_package;
-#endif
-#ifdef ECL_CLOS_STREAMS
+# ifdef ECL_CLOS_STREAMS
 	cl_object gray_package;
+# endif
 #endif
 #ifdef ECL_THREADS
 	cl_object mp_package;

src/lsp/config.lsp.in

@@ -46,7 +46,7 @@ Returns, as a string, the location of the machine on which ECL runs."
 (defun lisp-implementation-version ()
   "Args:()
 Returns the version of your ECL as a string."
-  "@PACKAGE_VERSION@ (CVS 2008-04-22 11:44)")
+  "@PACKAGE_VERSION@ (CVS 2008-04-22 12:25)")
 
 (defun machine-type ()
   "Args: ()