diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 78daf7f59..76314ba1e 100644 --- a/src/c/alloc_2.d +++ b/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) { diff --git a/src/c/big.d b/src/c/big.d index db85f45fc..ee27f6852 100644 --- a/src/c/big.d +++ b/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); diff --git a/src/c/print.d b/src/c/print.d index ae84624f0..4f652203c 100644 --- a/src/c/print.d +++ b/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 */ diff --git a/src/h/external.h b/src/h/external.h index 8e10e6d56..182e55cca 100644 --- a/src/h/external.h +++ b/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)); diff --git a/src/h/internal.h b/src/h/internal.h index 625b819fe..a7f6a5470 100644 --- a/src/h/internal.h +++ b/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);