Changed the routines that manipulate bignums so that they use bignum registers...

Changed the routines that manipulate bignums so that they use bignum registers and free them when finished -- this should allow ECL work without changing GMP's memory functions.
parent 3556aae8
ECL 9.8.4:
ECL 9.9.1:
==========
* Bugs fixed:
- si_{set,get}_finalizer were not exported from ecl.dll and thus the library
TRIVIAL-GARBAGE failed to build in Windows
- The MSVC port did not define @[email protected] and failed to build ecl.dll
- The sequence functions did not understand the newest specialized array types.
* Visible changes:
- The configuration flag --with-__thread now defaults to NO because many
platforms do not support it and GCC does not complain, making reliable
detection impossible.
- For further compatibility with SBCL, ECL now supports two additional
buffer types :FULL and :LINE which are compatible with :FULLY-BUFFERED
and :LINE-BUFFERED (Thanks to Matthew Mondor)
- The sockets library can now be loaded using either (REQUIRE 'SOCKETS)
or (REQUIRE 'SB-BSD-SOCKETS).
ECL 9.8.3:
==========
* Bugs fixed:
- FLOAT-SIGN ignored the second argument.
ECL 9.8.2:
==========
* Bugs fixed:
- The C inline expansion for sin, cos, and tan were wrong due to three
recently introduced typos.
- The C inline form of SQRT did not work when ECL was built with
--enable-longdouble.
- When building FASL files, the output file name was not surrounded by
double quotes, thus breaking when the file name had spaces (only
mingw32).
* Visible changes:
- A new configuration flag, --enable-rpath, allows hardcoding in ECL the
location of its shared library. This is not needed in Windows, it should
work on all supported platforms and its purpose is to simplify the
installation of ECL in nonstandard locations.
ECL 9.8.1:
==========
* Important notes:
- The GMP library had to be patched to build with latest versions of GCC.
Since our patch only covers the main header and there might be some corners
left, it is recommended to build ECL against a better maintained version of
the library, such as MPIR or the versions supplied by your operating system.
- ECL now builds properly on a large number of platforms, including Windows
with and without Microsoft compilers. However, not always are all the
configuration options available or well supported. The fault is not always
ECL's, but also the libraries it depends on. Some of these problems are
detailed below, some are to be found. As a guide, the minimally supported
flags for each platform are those use for the automated testing process
http://ecls.sourceforge.net/logs.html
* Ports:
- The Windows/MSVC port now boots also when built without support for Unicode.
- The Windows/mingw32 port builds without threads. For multithreading, the
user will have to build version 7.2-alpha2 of the garbage collector
manually and build ECL with it.
- The NetBSD port builds with default values using the garbage collector
in the pkgsrc distribution.
- The Solaris port (Intel and Sparc) now builds with the given libraries (GMP
and Boehm).
* Compiler:
- The compiler now understands FFI types :[u]int{8,16,32,64}-t.
- The FFI code emitted to convert from a lisp type to :uint or :unsigned-int
rejected bignum inputs, even if they were in the range from 0 to UINT_MAX.
Similar problem with :int
* Visible changes:
- New functions ecl_make_[u]int(), ecl_make_[u]long(), ecl_to_[u]int(),
ecl_to_[u]long(), ecl_to_bool(), ecl_make_bool(), convert between C types
and cl_object.
- The C structures ecl_array, ecl_vector, ecl_base_string and ecl_string have
changed. Instead of using bitfields for hasfillp and adjustable we now
use a single integer field, and handle the bits manually. See the
new macros ECL_ADJUSTABLE_ARRAY_P and ECL_ARRAY_HAS_FILL_POINTER_P.
- Four new command-line arguments, --encoding, --input-encoding,
--output-encoding and --error-encoding, allow the user to change the
external formats of the default streams.
- For places defined with the simple form of DEFSETF, SETF now produces
a simpler expansion, without a surrounding LET* form.
- The dynamic FFI is now implemented using libffi. This extends the portability
and removes the previous, error prone implementation.
- A new function, (SI:SAFE-EVAL form env &optional error-value), can be used
to evaluate lisp forms in a safe way. If supplied three values, when an
error happens, it returns ERROR-VALUE; otherwise it will invoke a debugger.
- Two new functions, ecl_read_from_cstring(s) and
ecl_read_from_cstring_safe(s,v) read an object from a C string (char *). The
first one is unsafe and will enter a debugger when there is a syntax
error. The second one will return V when an error happens.
- Modules which are loaded with REQUIRE, but which belong to ECL, are now
registered with ASDF and can be used in dependencies.
* Bugs fixed:
- SI:GET-LIBRARY-PATHNAME did not work properly in Windows.
- STEP did not work properly because the bytecompiler introduced an extra
opcode after STEPCALL.
- --enable-slow-config works again.
- EXT:CHDIR got broken when using Unicode.
- When embedded, ECL may coexist with code that uses the GMP library in
different ways, and sometimes that code may use different memory allocation
routines. In order to solve this problem ECL introduces a new option,
ECL_OPT_SET_GMP_MEMORY_FUNCTIONS, which determines whether GMP will use the
Boehm-Weiser garbage collector to allocate memory or not.
- The previous change also implies that ECL must do all bignum computations
using GMP-allocated numbers that are then automatically freed. More
precisely, this is done using big_register[0-2]_get() and
big_register_normalize() everywhere and operating destructively on those
numbers. These functions have been made aware of the fact that GMP may
use other allocation routines and always call mpz_clear() to free memory.
;;; Local Variables: ***
;;; mode:text ***
......
......@@ -39,54 +39,60 @@
cl_object
big_register0_get(void)
{
cl_env.big_register[0]->big.big_size = 0;
return cl_env.big_register[0];
cl_object output = cl_env.big_register[0];
output->big.big_limbs = cl_env.big_register_limbs[0];
output->big.big_size = 0;
output->big.big_dim = BIGNUM_REGISTER_SIZE;
return output;
}
cl_object
big_register1_get(void)
{
cl_env.big_register[1]->big.big_size = 0;
return cl_env.big_register[1];
cl_object output = cl_env.big_register[1];
output->big.big_limbs = cl_env.big_register_limbs[1];
output->big.big_size = 0;
output->big.big_dim = BIGNUM_REGISTER_SIZE;
return output;
}
cl_object
big_register2_get(void)
{
cl_env.big_register[2]->big.big_size = 0;
return cl_env.big_register[2];
cl_object output = cl_env.big_register[2];
output->big.big_limbs = cl_env.big_register_limbs[2];
output->big.big_size = 0;
output->big.big_dim = BIGNUM_REGISTER_SIZE;
return output;
}
void
big_register_free(cl_object x)
{
/* FIXME! Is this thread safe? */
if (x == cl_env.big_register[0])
x->big.big_limbs = cl_env.big_register_limbs[0];
else if (x == cl_env.big_register[1])
x->big.big_limbs = cl_env.big_register_limbs[1];
else if (x == cl_env.big_register[2])
x->big.big_limbs = cl_env.big_register_limbs[2];
else
ecl_internal_error("big_register_free: unknown register");
x->big.big_size = 0;
x->big.big_dim = BIGNUM_REGISTER_SIZE;
/* We only need to free the integer when it has been reallocated */
if (x->big.big_dim > BIGNUM_REGISTER_SIZE) {
mpz_clear(x->big.big_num);
}
}
cl_object
big_register_copy(cl_object old)
big_copy(cl_object old)
{
cl_object new_big = ecl_alloc_object(t_bignum);
if (old->big.big_dim > BIGNUM_REGISTER_SIZE) {
/* The object already has suffered a mpz_realloc() so
we can use the pointer */
new_big->big = old->big;
big_register_free(old);
} else {
/* As the bignum points to the cl_env.big_register_limbs[] area
we must duplicate its contents. */
mpz_init_set(new_big->big.big_num,old->big.big_num);
}
cl_index dim, bytes;
new_big->big.big_size = old->big.big_size;
new_big->big.big_dim = dim = old->big.big_dim;
bytes = dim * sizeof(mp_limb_t);
new_big->big.big_limbs = ecl_alloc_atomic(bytes);
memcpy(new_big->big.big_limbs, old->big.big_limbs, bytes);
return new_big;
}
cl_object
big_register_copy(cl_object old)
{
cl_object new_big = big_copy(old);
big_register_free(old);
return new_big;
}
......@@ -94,62 +100,26 @@ cl_object
big_register_normalize(cl_object x)
{
int s = x->big.big_size;
mp_limb_t y;
if (s == 0)
return(MAKE_FIXNUM(0));
y = x->big.big_limbs[0];
return(MAKE_FIXNUM(0));
if (s == 1) {
if (y <= MOST_POSITIVE_FIXNUM)
return(MAKE_FIXNUM(y));
mp_limb_t y = x->big.big_limbs[0];
if (y <= MOST_POSITIVE_FIXNUM)
return MAKE_FIXNUM(y);
} else if (s == -1) {
if (y <= -MOST_NEGATIVE_FIXNUM)
return(MAKE_FIXNUM(-y));
mp_limb_t y = x->big.big_limbs[0];
if (y <= -MOST_NEGATIVE_FIXNUM)
return MAKE_FIXNUM(-y);
}
return big_register_copy(x);
}
/*
* Different from mpz_init since we initialize with NULL limbs
*/
static cl_object
big_alloc(int size)
{
volatile cl_object x = ecl_alloc_object(t_bignum);
if (size <= 0)
ecl_internal_error("negative or zero size for bignum in big_alloc");
x->big.big_dim = size;
x->big.big_size = 0;
x->big.big_limbs = (mp_limb_t *)ecl_alloc_atomic_align(size * sizeof(mp_limb_t), sizeof(mp_limb_t));
return(x);
}
cl_object
bignum1(cl_fixnum val)
{
volatile cl_object z = ecl_alloc_object(t_bignum);
mpz_init_set_si(z->big.big_num, val);
return(z);
}
cl_object
bignum2(mp_limb_t hi, mp_limb_t lo)
{
cl_object z;
z = big_alloc(2);
z->big.big_size = 2;
z->big.big_limbs[0] = lo;
z->big.big_limbs[1] = hi;
return(z);
}
cl_object
big_copy(cl_object x)
{
volatile cl_object y = ecl_alloc_object(t_bignum);
mpz_init_set(y->big.big_num, x->big.big_num);
return(y);
cl_object aux = big_register0_get();
mpz_init_set_si(aux->big.big_num, val);
return big_register_copy(aux);
}
/*
......@@ -176,88 +146,6 @@ big_copy(cl_object x)
#define big_compare(x, y) mpz_cmp(x->big.big_num, y->big.big_num)
*/
/*
big_complement(x) destructively takes
the complement of bignum x.
#define big_complement(x) mpz_neg(x->big.big_num, x->big.num);
*/
/*
big_minus(x) returns the complement of bignum x.
*/
cl_object
big_minus(cl_object x)
{
volatile cl_object y = big_copy(x);
mpz_neg(y->big.big_num, y->big.big_num);
return y;
}
/*
big_add_ui(x, i) destructively adds non-negative int i
to bignum x.
I should be non-negative.
mpz_add_ui(x->big.big_num, x->big.big_num, i)
*/
/*
big_sub_ui(x, i) destructively subtracts non-negative int i
from bignum x.
I should be non-negative.
mpz_sub_ui(x->big.big_num, x->big.big_num, i)
*/
/*
big_mul_ui(x, i) destructively multiplies non-negative bignum x
by non-negative int i.
I should be non-negative.
X should be non-negative.
mpn_mul(&x->big.big_limbs, &x->big.big_limbs, x->big.big_size, &i, 1)
*/
/*
big_div_ui(x, i) destructively divides non-negative bignum x
by positive int i.
X will hold the remainder of the division.
div_int_big(i, x) returns the remainder of the division.
I should be positive.
X should be non-negative.
mp_limb_t q[x->big.big_size];
mpn_div(q, &x->big.big_limbs, &x->big.big_size, &i, 1), x
*/
/*
big_plus(x, y) returns the sum of bignum x and bignum y.
X and y may be any bignum.
*/
cl_object
big_plus(cl_object x, cl_object y)
{
volatile cl_object z = big_register0_get();
mpz_add(z->big.big_num, x->big.big_num, y->big.big_num);
return(big_register_copy(z));
}
cl_object
big_normalize(cl_object x)
{
int s = x->big.big_size;
mp_limb_t y;
if (s == 0)
return(MAKE_FIXNUM(0));
y = x->big.big_limbs[0];
if (s == 1 && y <= MOST_POSITIVE_FIXNUM)
return(MAKE_FIXNUM(y));
if (s == -1 && y <= -MOST_NEGATIVE_FIXNUM)
return(MAKE_FIXNUM(-y));
return(x);
}
static void *
mp_alloc(size_t size)
{
......@@ -286,7 +174,6 @@ void init_big_registers(cl_env_ptr env)
int i;
for (i = 0; i < 3; i++) {
env->big_register[i] = ecl_alloc_object(t_bignum);
big_register_free(env->big_register[i]);
}
}
......@@ -294,5 +181,6 @@ void
init_big(cl_env_ptr env)
{
init_big_registers(env);
mp_set_memory_functions(mp_alloc, mp_realloc, mp_free);
if (ecl_get_option(ECL_OPT_SET_GMP_MEMORY_FUNCTIONS))
mp_set_memory_functions(mp_alloc, mp_realloc, mp_free);
}
......@@ -68,7 +68,6 @@ big_alloc(int size)
return x;
}
cl_object
bignum1(cl_fixnum val)
{
......@@ -95,35 +94,6 @@ big_copy(cl_object x)
return(y);
}
/*
big_minus(x) returns the complement of bignum x.
*/
cl_object
big_minus(cl_object x)
{
volatile cl_object y = big_copy(x);
y->big.big_num = -x->big.big_num;
return y;
}
cl_object
big_plus(cl_object x, cl_object y)
{
volatile cl_object z = big_register0_get();
z->big.big_num = x->big.big_num + y->big.big_num;
return(big_register_copy(z));
}
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);
}
int big_num_t_sgn(big_num_t x)
{
return ( x == (big_num_t)0 ) ? 0 : (x < (big_num_t)0) ? -1 : 1;
......
......@@ -81,6 +81,7 @@ static cl_fixnum option_values[ECL_OPT_LIMIT+1] = {
256*1024*1024, /* ECL_OPT_HEAP_SIZE */
1024*1024, /* ECL_OPT_HEAP_SAFETY_AREA */
0, /* ECL_OPT_THREAD_INTERRUPT_SIGNAL */
1, /* ECL_OPT_SET_GMP_MEMORY_FUNCTIONS */
0};
#if !defined(GBC_BOEHM)
......@@ -588,6 +589,8 @@ cl_boot(int argc, char **argv)
cl_core.gentemp_prefix = make_constant_base_string("T");
cl_core.gentemp_counter = MAKE_FIXNUM(0);
init_number();
ECL_SET(@'si::c-int-max', ecl_make_integer(INT_MAX));
ECL_SET(@'si::c-int-min', ecl_make_integer(INT_MIN));
ECL_SET(@'si::c-long-max', ecl_make_integer(LONG_MAX));
......@@ -595,7 +598,6 @@ cl_boot(int argc, char **argv)
ECL_SET(@'si::c-uint-max', ecl_make_unsigned_integer(UINT_MAX));
ECL_SET(@'si::c-ulong-max', ecl_make_unsigned_integer(ULONG_MAX));
init_number();
init_unixtime();
#ifdef ECL_THREADS
......
This diff is collapsed.
......@@ -328,7 +328,6 @@ static bignum_bit_operator bignum_operations[16] = {
static cl_object
log_op(cl_narg narg, int op, cl_va_list ARGS)
{
#if 1
cl_object x, y;
/* FIXME! This can be optimized */
x = cl_va_arg(ARGS);
......@@ -341,66 +340,6 @@ log_op(cl_narg narg, int op, cl_va_list ARGS)
} while (--narg);
}
return x;
#else
cl_object x, numi;
bit_operator fix_log_op;
bignum_bit_operator big_log_op;
int i = 1;
cl_fixnum j;
x = cl_va_arg(ARGS);
switch (type_of(x)) {
case t_fixnum:
break;
case t_bignum:
x = big_copy(x); /* since big_log_op clobbers it */
goto BIG_OP;
default:
FEtype_error_integer(x);
}
if (narg == 1)
return x;
j = fix(x);
fix_log_op = fixnum_operations[op];
for (; i < narg; i++) {
numi = cl_va_arg(ARGS);
switch (type_of(numi)) {
case t_fixnum:
j = (*fix_log_op)(j, fix(numi));
break;
case t_bignum:
big_log_op = bignum_operations[op];
x = bignum1(j);
goto BIG_OP2;
default:
FEtype_error_integer(numi);
}
}
return(MAKE_FIXNUM(j));
BIG_OP:
if (narg == 1)
return x;
big_log_op = bignum_operations[op];
for (; i < narg; i++) {
numi = cl_va_arg(ARGS);
switch (type_of(numi)) {
case t_fixnum: {
cl_object z = big_register1_get();
mpz_set_si(z->big.big_num, fix(numi));
(*big_log_op)(x, z);
big_register_free(z);
break;
}
case t_bignum: BIG_OP2:
(*big_log_op)(x, numi);
break;
default:
FEtype_error_integer(numi);
}
}
return(big_normalize(x));
#endif
}
cl_object
......@@ -410,49 +349,42 @@ ecl_boole(int op, cl_object x, cl_object y)
case t_fixnum:
switch (type_of(y)) {
case t_fixnum: {
cl_fixnum (*fix_log_op)(cl_fixnum, cl_fixnum);
fix_log_op = fixnum_operations[op];
return MAKE_FIXNUM((*fix_log_op)(fix(x), fix(y)));
cl_fixnum z = fixnum_operations[op](fix(x), fix(y));
return MAKE_FIXNUM(z);
}
case t_bignum: {
void (*big_log_op)(cl_object, cl_object);
big_log_op = bignum_operations[op];
x = bignum1(fix(x));
(*big_log_op)(x, y);
break;
cl_object x_copy = big_register0_get();
big_set_si(x_copy, fix(x));
bignum_operations[op](x_copy, y);
return big_register_normalize(x_copy);
}
default:
FEtype_error_integer(y);
}
break;
case t_bignum: {
void (*big_log_op)(cl_object, cl_object);
big_log_op = bignum_operations[op];
x = big_copy(x);
cl_object x_copy = big_register0_get();
big_set(x_copy, x);
switch (type_of(y)) {
case t_fixnum: {
cl_object z = big_register1_get();
#ifdef WITH_GMP
mpz_set_si(z->big.big_num, fix(y));
#else /* WITH_GMP */
z->big.big_num = fix(y);
#endif /* WITH_GMP */
(*big_log_op)(x, z);
big_set_si(z,fix(y));
bignum_operations[op](x_copy, z);
big_register_free(z);
break;
}
case t_bignum:
(*big_log_op)(x,y);
bignum_operations[op](x_copy, y);
break;
default:
FEtype_error_integer(y);
}
break;
return big_register_normalize(x_copy);
}
default:
FEtype_error_integer(x);
}
return big_normalize(x);
return x;
}
cl_object
......@@ -546,7 +478,7 @@ ecl_ash(cl_object x, cl_fixnum w)
y->big.big_num <<= w;
#endif /* WITH_GMP */
}
return(big_register_normalize(y));
return big_register_normalize(y);
}
int
......
......@@ -128,13 +128,9 @@ cl_object
ecl_make_integer(cl_fixnum l)
{
if (l > MOST_POSITIVE_FIXNUM || l < MOST_NEGATIVE_FIXNUM) {
cl_object z = ecl_alloc_object(t_bignum);
#ifdef WITH_GMP
mpz_init_set_si(z->big.big_num, l);
#else /* WITH_GMP */
z->big.big_num = l;
#endif /* WITH_GMP */
return z;
cl_object z = big_register0_get();
big_set_si(z, l);
return big_register_copy(z);
}
return MAKE_FIXNUM(l);
}
......@@ -143,13 +139,9 @@ cl_object
ecl_make_unsigned_integer(cl_index l)
{
if (l > MOST_POSITIVE_FIXNUM) {
cl_object z = ecl_alloc_object(t_bignum);
#ifdef WITH_GMP
mpz_init_set_ui(z->big.big_num, l);
#else /* WITH_GMP */
z->big.big_num = l;
#endif /* WITH_GMP */
return z;
cl_object z = big_register0_get();
big_set_ui(z, l);
return big_register_copy(z);
}
return MAKE_FIXNUM(l);
}
......@@ -890,13 +882,9 @@ double_to_integer(double d)
if (d <= MOST_POSITIVE_FIXNUM && d >= MOST_NEGATIVE_FIXNUM)
return MAKE_FIXNUM((cl_fixnum)d);
else {
cl_object x = big_register0_get();
#ifdef WITH_GMP
mpz_set_d(x->big.big_num, d);
#else /* WITH_GMP */
x->big.big_num = (big_num_t)d;
#endif /* WITH_GMP */
return big_register_copy(x);
cl_object z = big_register0_get();
big_set_d(z, d);
return big_register_copy(z);
}
}
......@@ -906,13 +894,9 @@ float_to_integer(float d)
if (d <= MOST_POSITIVE_FIXNUM && d >= MOST_NEGATIVE_FIXNUM)
return MAKE_FIXNUM((cl_fixnum)d);
else {
cl_object x = big_register0_get();
#ifdef WITH_GMP
mpz_set_d(x->big.big_num, d);
#else /* WITH_GMP */
x->big.big_num = (big_num_t)d;
#endif /* WITH_GMP */
return big_register_copy(x);
cl_object z = big_register0_get();
big_set_d(z, d);
return big_register_copy(z);
}
}
......
......@@ -604,11 +604,11 @@ ecl_parse_integer(cl_object str, cl_index start, cl_index end,
if (d < 0) {
break;
}
big_mul_ui(integer_part, radix);
big_add_ui(integer_part, d);
big_mul_ui(integer_part, integer_part, radix);
big_add_ui(integer_part, integer_part, d);
}
if (sign < 0) {
big_complement(integer_part);
big_complement(integer_part, integer_part);
}
output = big_register_normalize(integer_part);
*ep = i;
......
......@@ -369,9 +369,6 @@ extern ECL_API cl_object bignum2(cl_fixnum hi, cl_fixnum lo);
#endif /* WITH_GMP */
extern ECL_API cl_object big_set_fixnum(cl_object x, cl_object fix);
extern ECL_API cl_object big_copy(cl_object x);
extern ECL_API cl_object big_minus(cl_object x);
extern ECL_API cl_object big_plus(cl_object x, cl_object y);
extern ECL_API cl_object big_normalize(cl_object x);
extern ECL_API double big_to_double(cl_object x);
......@@ -911,6 +908,7 @@ typedef enum {
ECL_OPT_HEAP_SIZE,
ECL_OPT_HEAP_SAFETY_AREA,
ECL_OPT_THREAD_INTERRUPT_SIGNAL,
ECL_OPT_SET_GMP_MEMORY_FUNCTIONS,
ECL_OPT_LIMIT
} ecl_option;
......
......@@ -14,32 +14,52 @@
*/
#ifdef WITH_GMP
#define big_set(x,y) mpz_set((x)->big.big_num,(y)->big.big_num)
#define big_odd_p(x) ((mpz_get_ui(x->big.big_num) & 1) != 0)
#define big_even_p(x) ((mpz_get_ui(x->big.big_num) & 1) == 0)
#define big_zerop(x) ((x)->big.big_size == 0)
#define big_sign(x) ((x)->big.big_size)
#define big_compare(x, y) mpz_cmp(x->big.big_num, y->big.big_num)
#define big_complement(x) mpz_neg(x->big.big_num, x->big.big_num)
#define big_add_ui(x, i) mpz_add_ui(x->big.big_num, x->big.big_num, i)
#define big_mul_ui(x, i) mpz_mul_ui(x->big.big_num, x->big.big_num, i)
#define big_complement(z, x) mpz_neg((z)->big.big_num,(x)->big.big_num)
#define big_add(z, x, y) mpz_add((z)->big.big_num,(x)->big.big_num,(y)->big.big_num)
#define big_sub(z, x, y) mpz_sub((z)->big.big_num,(x)->big.big_num,(y)->big.big_num)
#define big_mul(z, x, y) mpz_mul((z)->big.big_num,(x)->big.big_num,(y)->big.big_num)
#define big_add_ui(z, x, i) mpz_add_ui(z->big.big_num, x->big.big_num, i)
#define big_sub_ui(z, x, i) mpz_sub_ui(z->big.big_num, x->big.big_num, i)