diff --git a/msvc/ecl/config.h.msvc6 b/msvc/ecl/config.h.msvc6 index 042cd7ca5..3d4678768 100755 --- a/msvc/ecl/config.h.msvc6 +++ b/msvc/ecl/config.h.msvc6 @@ -148,6 +148,8 @@ typedef unsigned int cl_index; typedef unsigned int cl_hashkey; #endif +#define ECL_BIGNUM_REGISTER_NUMBER 3 + /* * The character type */ diff --git a/src/c/big.d b/src/c/big.d index 193887c62..0026e6c48 100644 --- a/src/c/big.d +++ b/src/c/big.d @@ -2,7 +2,8 @@ /* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */ /* - * big.c - bignum routines based on the GMP + * big.c - bignum routines based on the GMP multiple precision + * integers. * * Copyright (c) 1990 Giuseppe Attardi * Copyright (c) 2001 Juan Jose Garcia Ripoll @@ -17,14 +18,38 @@ #include #include -/* - * Using GMP multiple precision integers. +/************************************************************* + * MEMORY MANAGEMENT WITH GMP + * + * A careful reader of the below code will note that there is no + * invocation of mpz_init anywhere. The reason for this is that we + * keep a number of initialized bignums in the thread local + * environment in what are called bignum registers. From these bignum + * registers, we obtain bignum objects that are passed around in user + * code by copying the contents of the mpz_t object into a compact + * object. This means that the bignum type and the contents of the + * corresponding mpz_t are allocated as a single block. + * + * A consequence of the above is that we also need not call mpz_clear, + * since a garbage collection of a compactly allocated bignum + * automatically leads to a deallocation of the contents of the + * corresponding mpz_t object. The exception to this rule are the + * bignum registers which are deallocated upon thread exit. + * + * The GMP library may also allocate temporary memory for its + * computations. It is configurable at runtime whether we use malloc + * and free or the corresponding equivalents from the garbage + * collector (ecl_alloc_uncollectable and ecl_free_uncollectable) for + * that. */ void _ecl_big_register_free(cl_object x) { - return; + /* We only need to free the integer when it gets too large */ + if (ECL_BIGNUM_DIM(x) > 4 * ECL_BIG_REGISTER_SIZE) { + _ecl_big_realloc2(x, ECL_BIG_REGISTER_SIZE); + } } static cl_object @@ -273,13 +298,13 @@ _ecl_fix_divided_by_big(cl_fixnum x, cl_object y) static void * mp_alloc(size_t size) { - return ecl_alloc_atomic(size); + return ecl_alloc_uncollectable(size); } static void mp_free(void *ptr, size_t size) { - ecl_dealloc(ptr); + ecl_free_uncollectable(ptr); } static void * diff --git a/src/c/main.d b/src/c/main.d index 70b4e9a62..8da2c0e41 100755 --- a/src/c/main.d +++ b/src/c/main.d @@ -130,6 +130,26 @@ ecl_set_option(int option, cl_fixnum value) } } +void +ecl_init_bignum_registers(cl_env_ptr env) +{ + int i; + for (i = 0; i < ECL_BIGNUM_REGISTER_NUMBER; i++) { + cl_object x = ecl_alloc_object(t_bignum); + _ecl_big_init2(x, ECL_BIG_REGISTER_SIZE); + env->big_register[i] = x; + } +} + +void +ecl_clear_bignum_registers(cl_env_ptr env) +{ + int i; + for (i = 0; i < ECL_BIGNUM_REGISTER_NUMBER; i++) { + _ecl_big_clear(env->big_register[i]); + } +} + void ecl_init_env(cl_env_ptr env) { @@ -167,14 +187,7 @@ ecl_init_env(cl_env_ptr env) init_stacks(env); - { - int i; - for (i = 0; i < 3; i++) { - cl_object x = ecl_alloc_object(t_bignum); - _ecl_big_init2(x, ECL_BIG_REGISTER_SIZE); - env->big_register[i] = x; - } - } + ecl_init_bignum_registers(env); env->trap_fpe_bits = 0; diff --git a/src/c/threads/process.d b/src/c/threads/process.d index f33c343ef..0c9440a96 100755 --- a/src/c/threads/process.d +++ b/src/c/threads/process.d @@ -194,7 +194,10 @@ thread_cleanup(void *aux) cl_env_ptr env = process->process.env; /* The following flags will disable all interrupts. */ AO_store_full((AO_t*)&process->process.phase, ECL_PROCESS_EXITING); - if (env) ecl_disable_interrupts_env(env); + if (env) { + ecl_clear_bignum_registers(env); + ecl_disable_interrupts_env(env); + } #ifdef HAVE_SIGPROCMASK /* ...but we might get stray signals. */ { diff --git a/src/c/unixint.d b/src/c/unixint.d index 073b845c4..db45a92d6 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -385,10 +385,15 @@ handle_all_queued_interrupt_safe(cl_env_ptr env) cl_object values[ECL_MULTIPLE_VALUES_LIMIT]; memcpy(values, env->values, ECL_MULTIPLE_VALUES_LIMIT*sizeof(cl_object)); cl_object stack_frame = env->stack_frame; - cl_object big_register[3]; - memcpy(big_register, env->big_register, 3*sizeof(cl_object)); cl_object packages_to_be_created = env->packages_to_be_created; cl_object packages_to_be_created_p = env->packages_to_be_created_p; + /* bignum registers need some special handling, because their + * contents are allocated as uncollectable memory. If we did + * not init and clear them before calling the interrupting + * code we would risk memory leaks. */ + cl_object big_register[ECL_BIGNUM_REGISTER_NUMBER]; + memcpy(big_register, env->big_register, ECL_BIGNUM_REGISTER_NUMBER*sizeof(cl_object)); + ecl_init_bignum_registers(env); /* We might have been interrupted while we push/pop in the * stack. Increasing env->stack_top ensures that we don't * overwrite the topmost stack value. */ @@ -407,9 +412,10 @@ handle_all_queued_interrupt_safe(cl_env_ptr env) memcpy(env->bds_top+1, &top_binding, sizeof(struct ecl_bds_frame)); memcpy(env->frs_top+1, &top_frame, sizeof(struct ecl_frame)); env->stack_top--; + ecl_clear_bignum_registers(env); + memcpy(env->big_register, big_register, ECL_BIGNUM_REGISTER_NUMBER*sizeof(cl_object)); env->packages_to_be_created_p = packages_to_be_created_p; env->packages_to_be_created = packages_to_be_created; - memcpy(env->big_register, big_register, 3*sizeof(cl_object)); env->stack_frame = stack_frame; memcpy(env->values, values, ECL_MULTIPLE_VALUES_LIMIT*sizeof(cl_object)); env->nvalues = nvalues; diff --git a/src/h/config.h.in b/src/h/config.h.in index 7f2d8ddca..7a68a3a43 100644 --- a/src/h/config.h.in +++ b/src/h/config.h.in @@ -151,6 +151,8 @@ typedef @CL_FIXNUM_TYPE@ cl_fixnum; typedef unsigned @CL_FIXNUM_TYPE@ cl_index; typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey; +#define ECL_BIGNUM_REGISTER_NUMBER 3 + /* * The character type */ diff --git a/src/h/external.h b/src/h/external.h index f2eb6d191..bc37b9461 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -107,11 +107,7 @@ struct cl_env_struct { #endif /* ... arithmetics ... */ - /* Note: if you change the size of these registers, change also - BIGNUM_REGISTER_SIZE in config.h */ - /* FIXME: actually use BIGNUM_REGISTER_SIZE; Also fix - handle_all_queued_interrupt_safe in unixint.d */ - cl_object big_register[3]; + cl_object big_register[ECL_BIGNUM_REGISTER_NUMBER]; cl_object own_process; /* The objects in this struct need to be writeable from a @@ -405,6 +401,7 @@ extern ECL_API cl_object mp_atomic_incf_symbol_value(cl_object x, cl_object incr /* big.c */ +/* Note: Needs to be adapted if ECL_BIGNUM_REGISTER_NUMBER changes */ #define _ecl_big_register0() ecl_process_env()->big_register[0] #define _ecl_big_register1() ecl_process_env()->big_register[1] #define _ecl_big_register2() ecl_process_env()->big_register[2] @@ -425,8 +422,6 @@ extern ECL_API cl_object _ecl_big_ceiling(cl_object x, cl_object y, cl_object *r extern ECL_API cl_object _ecl_big_floor(cl_object x, cl_object y, cl_object *r); extern ECL_API cl_object _ecl_big_negate(cl_object x); extern ECL_API void _ecl_big_register_free(cl_object x); -extern ECL_API cl_object bignum1(cl_fixnum val); - /* cfun.c */ diff --git a/src/h/internal.h b/src/h/internal.h index 93d2c5a9f..c0d431610 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -307,6 +307,9 @@ extern cl_object _ecl_long_double_to_integer(long double d); extern cl_fixnum ecl_option_values[ECL_OPT_LIMIT+1]; +extern void ecl_init_bignum_registers(cl_env_ptr env); +extern void ecl_clear_bignum_registers(cl_env_ptr env); + /* print.d */ extern cl_object _ecl_stream_or_default_output(cl_object stream); diff --git a/src/h/number.h b/src/h/number.h index 2a0e94ce5..e2fe43a2f 100644 --- a/src/h/number.h +++ b/src/h/number.h @@ -45,6 +45,7 @@ extern ECL_API _ecl_big_binary_op _ecl_big_boole_operator(int op); #define _ecl_big_set_index(x, f) mpz_set_ui((x)->big.big_num,(f)) #endif #define _ecl_big_init2(x,size) mpz_init2((x)->big.big_num,(size)*GMP_LIMB_BITS) +#define _ecl_big_realloc2(x,size) mpz_realloc2((x)->big.big_num,(size)*GMP_LIMB_BITS) #define _ecl_big_clear(x) mpz_clear((x)->big.big_num) #define _ecl_big_set(x,y) mpz_set((x)->big.big_num,(y)->big.big_num) #define _ecl_big_odd_p(x) ((mpz_get_ui(x->big.big_num) & 1) != 0) diff --git a/src/h/object.h b/src/h/object.h index ca0c32710..941a2607c 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -221,9 +221,9 @@ struct ecl_bignum { mpz_t big_num; }; -#define ECL_BIGNUM_DIM(x) ((x)->big.big_num->_mp_alloc) -#define ECL_BIGNUM_SIZE(x) ((x)->big.big_num->_mp_size) -#define ECL_BIGNUM_LIMBS(x) ((x)->big.big_num->_mp_d) +#define ECL_BIGNUM_DIM(x) ((x)->big.big_num->_mp_alloc) /* number of allocated limbs */ +#define ECL_BIGNUM_SIZE(x) ((x)->big.big_num->_mp_size) /* number of limbs in use times sign of the bignum */ +#define ECL_BIGNUM_LIMBS(x) ((x)->big.big_num->_mp_d) /* pointer to array of allocated limbs */ struct ecl_ratio { _ECL_HDR;