The routines for allocating bignums in a compact way is exported to alloc_2.d so that it can be applied to other objects.

src/c/alloc_2.d

@@ -204,6 +204,20 @@ ecl_alloc_object(cl_type t)
 	}
 }
 
+cl_object
+ecl_alloc_compact_object(cl_type t, cl_index extra_space)
+{
+	const cl_env_ptr the_env = ecl_process_env();
+        cl_index size = type_size[t];
+        cl_object x;
+        ecl_disable_interrupts_env(the_env);
+        x = (cl_object)GC_MALLOC_ATOMIC(size + extra_space);
+        ecl_enable_interrupts_env(the_env);
+        x->array.t = t;
+        x->array.displaced = (void*)(((char*)x) + size);
+        return x;
+}
+
 cl_object
 ecl_cons(cl_object a, cl_object d)
 {

src/c/big.d

@@ -37,11 +37,9 @@ _ecl_big_copy(cl_object old)
         cl_fixnum size = old->big.big_size;
         cl_index dim = (size < 0)? (-size) : size;
         cl_index bytes = dim * sizeof(mp_limb_t);
-#ifdef GBC_BOEHM
-        char *data = ecl_alloc_atomic(bytes + sizeof(struct ecl_bignum));
-        cl_object new_big = (cl_object)data;
-        new_big->big.t = t_bignum;
-        new_big->big.big_limbs = ((char *)new_big) + sizeof(struct ecl_bignum);
+#ifdef ECL_COMPACT_OBJECT_EXTRA
+        cl_object new_big = ecl_alloc_compact_object(t_bignum, bytes);
+        new_big->big.big_limbs = ECL_COMPACT_OBJECT_EXTRA(new_big);
 #else
 	cl_object new_big = ecl_alloc_object(t_bignum);
         new_big->big.big_limbs = ecl_alloc_atomic(bytes);

src/c/print.d

@@ -694,68 +694,15 @@ write_double(DBL_TYPE d, int e, int n, cl_object stream, cl_object o)
 
 #ifdef WITH_GMP
 
-struct powers {
-	cl_object number;
-	cl_index n_digits;
-	int base;
-};
-
-static void
-do_write_integer(cl_object x, struct powers *powers, cl_index len,
-		 cl_object stream)
-{
-	cl_object left;
-	do {
-		if (FIXNUMP(x)) {
-			write_positive_fixnum(fix(x), powers->base, len, stream);
-			return;
-		}
-		while (ecl_number_compare(x, powers->number) < 0) {
-			if (len)
-				write_positive_fixnum(0, powers->base, len, stream);
-			powers--;
-		}
-		left = ecl_floor2(x, powers->number);
-		x = VALUES(1);
-		if (len) len -= powers->n_digits;
-		do_write_integer(left, powers-1, len, stream);
-		len = powers->n_digits;
-		powers--;
-	} while(1);
-}
-
 static void
 write_bignum(cl_object x, cl_object stream)
 {
 	int base = ecl_print_base();
 	cl_index str_size = mpz_sizeinbase(x->big.big_num, base);
-	cl_fixnum num_powers = ecl_fixnum_bit_length(str_size-1);
-#ifdef __GNUC__
-	struct powers powers[num_powers];
-#else
-	struct powers *powers = (struct powers*)malloc(sizeof(struct powers)*num_powers);
-	CL_UNWIND_PROTECT_BEGIN(ecl_process_env()) {
-#endif
-		cl_object p;
-		cl_index i, n_digits;
-		powers[0].number = p = MAKE_FIXNUM(base);
-		powers[0].n_digits = n_digits = 1;
-		powers[0].base = base;
-		for (i = 1; i < num_powers; i++) {
-			powers[i].number = p = ecl_times(p, p);
-			powers[i].n_digits = n_digits = 2*n_digits;
-			powers[i].base = base;
-		}
-		if (ecl_minusp(x)) {
-			write_ch('-', stream);
-			x = ecl_negate(x);
-		}
-		do_write_integer(x, &powers[num_powers-1], 0, stream);
-#ifndef __GNUC__
-	} CL_UNWIND_PROTECT_EXIT {
-		free(powers);
-	} CL_UNWIND_PROTECT_END;
-#endif
+        char *txt = ecl_alloc_atomic(str_size + 1);
+        mpz_get_str(txt, base, x->big.big_num);
+        write_str(txt, stream);
+        ecl_dealloc(txt);
 }
 
 #else  /* WITH_GMP */

src/h/external.h

@@ -252,6 +252,7 @@ extern ECL_API void ecl_dealloc(void *);
 #define ecl_alloc_align(s,d) ecl_alloc(s)
 #define ecl_alloc_atomic_align(s,d) ecl_alloc_atomic(s)
 #define ecl_register_static_root(x) ecl_register_root(x)
+extern ECL_API cl_object ecl_alloc_compact_object(cl_type t, cl_index extra_space);
 #else
 extern ECL_API cl_object si_allocate _ARGS((cl_narg narg, cl_object type, cl_object qty, ...));
 extern ECL_API cl_object si_maximum_allocatable_pages _ARGS((cl_narg narg, cl_object type));

src/h/internal.h

@@ -55,6 +55,9 @@ extern void _ecl_dealloc_env(cl_env_ptr);
 
 /* alloc.d/alloc_2.d */
 
+#ifdef GBC_BOEHM
+#define ECL_COMPACT_OBJECT_EXTRA(x) ((void*)((x)->array.displaced))
+#endif
 extern void _ecl_set_max_heap_size(cl_index new_size);
 extern cl_object ecl_alloc_bytecodes(cl_index data_size, cl_index code_size);