mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-14 08:50:48 -07:00
Code Issues Projects Releases Packages Wiki Activity

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.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-08-28 02:03:30 +02:00
parent 3556aae864
commit 3919ccdadc
10 changed files with 185 additions and 583 deletions
Download patch file Download diff file Expand all files Collapse all files

145
src/CHANGELOG
View file

@ -1,141 +1,20 @@
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 @ECL_LDRPATH@ 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.
- 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.
- 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.
- 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 ***

204
src/c/big.d
View file

@ -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_copy(cl_object old)
{
cl_object new_big = ecl_alloc_object(t_bignum);
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 = 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_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);
}

30
src/c/big_ll.d
View file

@ -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;

4
src/c/main.d
View file

@ -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

205
src/c/num_arith.d
View file

@ -15,6 +15,7 @@
*/
#include <ecl/ecl.h>
#include <ecl/number.h>
#include <stdlib.h>
#pragma fenv_access on
@ -34,13 +35,8 @@ cl_object
fixnum_times(cl_fixnum i, cl_fixnum j)
{
cl_object x = big_register0_get();
#ifdef WITH_GMP
mpz_set_si(x->big.big_num, i);
mpz_mul_si(x->big.big_num, x->big.big_num, (long int)j);
#else /* WITH_GMP */
x->big.big_num = (big_num_t)i * (big_num_t)j;
#endif /* WITH_GMP */
big_set_si(x, i);
big_mul_si(x, x, j);
return big_register_normalize(x);
}
@ -50,17 +46,14 @@ big_times_fix(cl_object b, cl_fixnum i)
cl_object z;
if (i == 1)
return(b);
if (i == -1)
return(big_minus(b));
return b;
z = big_register0_get();
#ifdef WITH_GMP
mpz_mul_si(z->big.big_num, b->big.big_num, (long int)i);
#else /* WITH_GMP */
z->big.big_num = b->big.big_num * i;
#endif /* WITH_GMP */
z = big_register_normalize(z);
return(z);
if (i == -1) {
big_complement(z, b);
} else {
big_mul_si(z, b, i);
}
return big_register_normalize(z);
}
static cl_object
@ -68,13 +61,8 @@ big_times_big(cl_object x, cl_object y)
{
cl_object z;
z = big_register0_get();
#ifdef WITH_GMP
mpz_mul(z->big.big_num, x->big.big_num, y->big.big_num);
#else /* WITH_GMP */
z->big.big_num = x->big.big_num * y->big.big_num;
#endif /* WITH_GMP */
z = big_register_normalize(z);
return(z);
big_mul(z, x, y);
return big_register_normalize(z);
}
cl_object
@ -91,8 +79,7 @@ ecl_times(cl_object x, cl_object y)
return big_times_fix(y, fix(x));
case t_ratio:
z = ecl_times(x, y->ratio.num);
z = ecl_make_ratio(z, y->ratio.den);
return(z);
return ecl_make_ratio(z, y->ratio.den);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(fix(x) * ecl_short_float(y));
@ -118,8 +105,7 @@ ecl_times(cl_object x, cl_object y)
return big_times_big(x, y);
case t_ratio:
z = ecl_times(x, y->ratio.num);
z = ecl_make_ratio(z, y->ratio.den);
return(z);
return ecl_make_ratio(z, y->ratio.den);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(ecl_to_double(x) * ecl_short_float(y));
@ -142,13 +128,11 @@ ecl_times(cl_object x, cl_object y)
case t_fixnum:
case t_bignum:
z = ecl_times(x->ratio.num, y);
z = ecl_make_ratio(z, x->ratio.den);
return(z);
return ecl_make_ratio(z, x->ratio.den);
case t_ratio:
z = ecl_times(x->ratio.num,y->ratio.num);
z1 = ecl_times(x->ratio.den,y->ratio.den);
z = ecl_make_ratio(z, z1);
return(z);
return ecl_make_ratio(z, z1);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(ecl_to_double(x) * ecl_short_float(y));
@ -240,7 +224,7 @@ ecl_times(cl_object x, cl_object y)
case t_complex: {
COMPLEX: /* INV: x is real, y is complex */
return ecl_make_complex(ecl_times(x, y->complex.real),
ecl_times(x, y->complex.imag));
ecl_times(x, y->complex.imag));
}
default:
FEtype_error_number(y);
@ -285,7 +269,7 @@ ecl_times(cl_object x, cl_object y)
z12 = ecl_times(x->complex.imag, y->complex.imag);
z21 = ecl_times(x->complex.imag, y->complex.real);
z22 = ecl_times(x->complex.real, y->complex.imag);
return(ecl_make_complex(ecl_minus(z11, z12), ecl_plus(z21, z22)));
return ecl_make_complex(ecl_minus(z11, z12), ecl_plus(z21, z22));
}
default:
FEtype_error_number(x);
@ -322,14 +306,10 @@ ecl_plus(cl_object x, cl_object y)
if ((i = fix(x)) == 0)
return(y);
z = big_register0_get();
#ifdef WITH_GMP
if (i > 0)
mpz_add_ui(z->big.big_num, y->big.big_num, (unsigned long)i);
big_add_ui(z, y, i);
else
mpz_sub_ui(z->big.big_num, y->big.big_num, (unsigned long)(-i));
#else /* WITH_GMP */
z->big.big_num = y->big.big_num + i;
#endif /* WITH_GMP */
big_sub_ui(z, y, -i);
z = big_register_normalize(z);
return(z);
case t_ratio:
@ -362,25 +342,19 @@ ecl_plus(cl_object x, cl_object y)
if ((j = fix(y)) == 0)
return(x);
z = big_register0_get();
#ifdef WITH_GMP
if (j > 0)
mpz_add_ui(z->big.big_num, x->big.big_num, (unsigned long)j);
big_add_ui(z, x, j);
else
mpz_sub_ui(z->big.big_num, x->big.big_num, (unsigned long)(-j));
#else /* WITH_GMP */
z->big.big_num = x->big.big_num + j;
#endif /* WITH_GMP */
z = big_register_normalize(z);
return(z);
big_sub_ui(z, x, (-j));
return big_register_normalize(z);
case t_bignum:
z = big_plus(x, y);
z = big_normalize(z);
return(z);
z = big_register0_get();
big_add(z, x, y);
return big_register_normalize(z);
case t_ratio:
z = ecl_times(x, y->ratio.den);
z = ecl_plus(z, y->ratio.num);
z = ecl_make_ratio(z, y->ratio.den);
return(z);
return ecl_make_ratio(z, y->ratio.den);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(ecl_to_double(x) + ecl_short_float(y));
@ -404,15 +378,13 @@ ecl_plus(cl_object x, cl_object y)
case t_bignum:
z = ecl_times(x->ratio.den, y);
z = ecl_plus(x->ratio.num, z);
z = ecl_make_ratio(z, x->ratio.den);
return(z);
return ecl_make_ratio(z, x->ratio.den);
case t_ratio:
z1 = ecl_times(x->ratio.num,y->ratio.den);
z = ecl_times(x->ratio.den,y->ratio.num);
z = ecl_plus(z1, z);
z1 = ecl_times(x->ratio.den,y->ratio.den);
z = ecl_make_ratio(z, z1);
return(z);
return ecl_make_ratio(z, z1);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(ecl_to_double(x) + ecl_short_float(y));
@ -534,8 +506,7 @@ ecl_plus(cl_object x, cl_object y)
}
z = ecl_plus(x->complex.real, y->complex.real);
z1 = ecl_plus(x->complex.imag, y->complex.imag);
z = ecl_make_complex(z, z1);
return(z);
return ecl_make_complex(z, z1);
default:
FEtype_error_number(x);
}
@ -565,28 +536,22 @@ ecl_minus(cl_object x, cl_object y)
case t_fixnum:
if ((k = fix(x) - fix(y)) >= MOST_NEGATIVE_FIXNUM &&
k <= MOST_POSITIVE_FIXNUM)
return(MAKE_FIXNUM(k));
return MAKE_FIXNUM(k);
else
return(bignum1(k));
return bignum1(k);
case t_bignum:
z = big_register0_get();
i = fix(x);
#ifdef WITH_GMP
if (i > 0)
mpz_sub_ui(z->big.big_num, y->big.big_num, (unsigned long)i);
big_sub_ui(z, y, i);
else
mpz_add_ui(z->big.big_num, y->big.big_num, (unsigned long)(-i));
#else /* WITH_GMP */
z->big.big_num = (big_num_t)i - y->big.big_num;
#endif /* WITH_GMP */
big_complement(z);
z = big_register_normalize(z);
return(z);
big_add_ui(z, y, -i);
big_complement(z, z);
return big_register_normalize(z);
case t_ratio:
z = ecl_times(x, y->ratio.den);
z = ecl_minus(z, y->ratio.num);
z = ecl_make_ratio(z, y->ratio.den);
return(z);
return ecl_make_ratio(z, y->ratio.den);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(fix(x) - ecl_short_float(y));
@ -610,26 +575,19 @@ ecl_minus(cl_object x, cl_object y)
if ((j = fix(y)) == 0)
return(x);
z = big_register0_get();
#ifdef WITH_GMP
if (j > 0)
mpz_sub_ui(z->big.big_num, x->big.big_num, (unsigned long)j);
big_sub_ui(z, x, j);
else
mpz_add_ui(z->big.big_num, x->big.big_num, (unsigned long)(-j));
#else /* WITH_GMP */
z->big.big_num = x->big.big_num - j;
#endif /* WITH_GMP */
z = big_register_normalize(z);
return(z);
big_add_ui(z, x, -j);
return big_register_normalize(z);
case t_bignum:
y = big_minus(y);
z = big_plus(x, y);
z = big_normalize(z);
return(z);
z = big_register0_get();
big_sub(z, x, y);
return big_register_normalize(z);
case t_ratio:
z = ecl_times(x, y->ratio.den);
z = ecl_minus(z, y->ratio.num);
z = ecl_make_ratio(z, y->ratio.den);
return(z);
return ecl_make_ratio(z, y->ratio.den);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(ecl_to_double(x) - ecl_short_float(y));
@ -653,15 +611,13 @@ ecl_minus(cl_object x, cl_object y)
case t_bignum:
z = ecl_times(x->ratio.den, y);
z = ecl_minus(x->ratio.num, z);
z = ecl_make_ratio(z, x->ratio.den);
return(z);
return ecl_make_ratio(z, x->ratio.den);
case t_ratio:
z = ecl_times(x->ratio.num,y->ratio.den);
z1 = ecl_times(x->ratio.den,y->ratio.num);
z = ecl_minus(z, z1);
z1 = ecl_times(x->ratio.den,y->ratio.den);
z = ecl_make_ratio(z, z1);
return(z);
return ecl_make_ratio(z, z1);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(ecl_to_double(x) - ecl_short_float(y));
@ -777,7 +733,7 @@ ecl_minus(cl_object x, cl_object y)
#endif
COMPLEX:
return ecl_make_complex(ecl_minus(x, y->complex.real),
ecl_negate(y->complex.imag));
ecl_negate(y->complex.imag));
case t_complex:
if (type_of(y) != t_complex) {
z = ecl_minus(x->complex.real, y);
@ -798,7 +754,7 @@ cl_conjugate(cl_object c)
switch (type_of(c)) {
case t_complex:
c = ecl_make_complex(c->complex.real,
ecl_negate(c->complex.imag));
ecl_negate(c->complex.imag));
case t_fixnum:
case t_bignum:
case t_ratio:
@ -833,11 +789,7 @@ ecl_negate(cl_object x)
}
case t_bignum:
z = big_register0_get();
#ifdef WITH_GMP
mpz_neg(z->big.big_num, x->big.big_num);
#else /* WITH_GMP */
z->big.big_num = -(x->big.big_num);
#endif /* WITH_GMP */
big_complement(z, x);
return big_register_normalize(z);
case t_ratio:
@ -845,7 +797,7 @@ ecl_negate(cl_object x)
z = ecl_alloc_object(t_ratio);
z->ratio.num = z1;
z->ratio.den = x->ratio.den;
return(z);
return z;
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
@ -854,12 +806,12 @@ ecl_negate(cl_object x)
case t_singlefloat:
z = ecl_alloc_object(t_singlefloat);
sf(z) = -sf(x);
return(z);
return z;
case t_doublefloat:
z = ecl_alloc_object(t_doublefloat);
df(z) = -df(x);
return(z);
return z;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
return ecl_make_longfloat(-ecl_long_float(x));
@ -867,9 +819,7 @@ ecl_negate(cl_object x)
case t_complex:
z = ecl_negate(x->complex.real);
z1 = ecl_negate(x->complex.imag);
z = ecl_make_complex(z, z1);
return(z);
return ecl_make_complex(z, z1);
default:
FEtype_error_number(x);
}
@ -905,12 +855,10 @@ ecl_divide(cl_object x, cl_object y)
x = ecl_negate(x);
y = ecl_negate(y);
}
z = ecl_make_ratio(x, y);
return(z);
return ecl_make_ratio(x, y);
case t_ratio:
z = ecl_times(x, y->ratio.den);
z = ecl_make_ratio(z, y->ratio.num);
return(z);
return ecl_make_ratio(z, y->ratio.num);
#ifdef ECL_SHORT_FLAOT
case t_shortfloat:
return make_shortfloat(ecl_to_double(x) / ecl_short_float(y));
@ -935,13 +883,11 @@ ecl_divide(cl_object x, cl_object y)
FEdivision_by_zero(x, y);
case t_bignum:
z = ecl_times(x->ratio.den, y);
z = ecl_make_ratio(x->ratio.num, z);
return(z);
return ecl_make_ratio(x->ratio.num, z);
case t_ratio:
z = ecl_times(x->ratio.num,y->ratio.den);
z1 = ecl_times(x->ratio.den,y->ratio.num);
z = ecl_make_ratio(z, z1);
return(z);
return ecl_make_ratio(z, z1);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
return make_shortfloat(ecl_to_double(x) / ecl_short_float(y));
@ -1101,14 +1047,10 @@ ecl_integer_divide(cl_object x, cl_object y)
* MOST_NEGATIVE_FIXNUM = - MOST_POSITIVE_FIXNUM.
*/
if (-MOST_NEGATIVE_FIXNUM > MOST_POSITIVE_FIXNUM) {
#ifdef WITH_GMP
if (mpz_cmp_si(y->big.big_num, -fix(x)))
if (big_cmp_si(y, -fix(x)))
return MAKE_FIXNUM(0);
else
return MAKE_FIXNUM(-1);
#else /* WITH_GMP */
return y->big.big_num != -fix(x) ? MAKE_FIXNUM(0) : MAKE_FIXNUM(-1);
#endif /* WITH_GMP */
} else {
return MAKE_FIXNUM(0);
}
@ -1118,20 +1060,12 @@ ecl_integer_divide(cl_object x, cl_object y)
if (tx == t_bignum) {
cl_object q = big_register0_get();
if (ty == t_bignum) {
#ifdef WITH_GMP
mpz_tdiv_q(q->big.big_num, x->big.big_num, y->big.big_num);
#else /* WITH_GMP */
q->big.big_num = x->big.big_num / y->big.big_num;
#endif /* WITH_GMP */
big_tdiv_q(q, x, y);
} else if (ty == t_fixnum) {
long j = fix(y);
#ifdef WITH_GMP
mpz_tdiv_q_ui(q->big.big_num, x->big.big_num, (unsigned long)labs(j));
big_tdiv_q_ui(q, x, labs(j));
if (j < 0)
mpz_neg(q->big.big_num, q->big.big_num);
#else /* WITH_GMP */
q->big.big_num = x->big.big_num / j;
#endif /* WITH_GMP */
big_complement(q, q);
} else {
FEtype_error_integer(y);
}
@ -1217,8 +1151,7 @@ ecl_gcd(cl_object x, cl_object y)
}
}
#endif /* WITH_GMP */
gcd = big_register_normalize(gcd);
return(gcd);
return big_register_normalize(gcd);
default:
FEtype_error_integer(y);
}
@ -1249,8 +1182,7 @@ ecl_one_plus(cl_object x)
case t_ratio:
z = ecl_plus(x->ratio.num, x->ratio.den);
z = ecl_make_ratio(z, x->ratio.den);
return(z);
return ecl_make_ratio(z, x->ratio.den);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
@ -1273,8 +1205,7 @@ ecl_one_plus(cl_object x)
case t_complex:
z = ecl_one_plus(x->complex.real);
z = ecl_make_complex(z, x->complex.imag);
return(z);
return ecl_make_complex(z, x->complex.imag);
default:
FEtype_error_number(x);
@ -1301,12 +1232,11 @@ ecl_one_minus(cl_object x)
return (cl_object)((cl_fixnum)x - ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG));
case t_bignum:
return(ecl_minus(x, MAKE_FIXNUM(1)));
return ecl_minus(x, MAKE_FIXNUM(1));
case t_ratio:
z = ecl_minus(x->ratio.num, x->ratio.den);
z = ecl_make_ratio(z, x->ratio.den);
return(z);
return ecl_make_ratio(z, x->ratio.den);
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
@ -1330,8 +1260,7 @@ ecl_one_minus(cl_object x)
case t_complex:
z = ecl_one_minus(x->complex.real);
z = ecl_make_complex(z, x->complex.imag);
return(z);
return ecl_make_complex(z, x->complex.imag);
default:
FEtype_error_real(x);

96
src/c/num_log.d
View file

@ -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

40
src/c/number.d
View file

@ -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);
}
}

6
src/c/read.d
View file

@ -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;

4
src/h/external.h
View file

@ -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;

34
src/h/number.h
View file

@ -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)
#define big_mul_ui(z, x, y) mpz_mul_ui((z)->big.big_num,(x)->big.big_num,(y))
#define big_mul_si(z, x, y) mpz_mul_si((z)->big.big_num,(x)->big.big_num,(y))
#define big_set_ui(x, i) mpz_set_ui(x->big.big_num, (unsigned long int)i)
#define big_set_si(x, i) mpz_set_ui(x->big.big_num, (long int)i)
#define big_set_si(x, i) mpz_set_si(x->big.big_num, (long int)i)
#define big_to_double(x) mpz_get_d(x->big.big_num)
#define big_to_long(x) mpz_get_si(x->big.big_num)
#define big_to_ulong(x) mpz_get_ui(x->big.big_num)
#define big_cmp_si(x,y) mpz_cmp_si((x)->big.big_num,(y))
#define big_tdiv_q(q, x, y) mpz_tdiv_q((q)->big.big_num,(x)->big.big_num,(y)->big.big_num)
#define big_tdiv_q_ui(q, x, y) mpz_tdiv_q_ui((q)->big.big_num, (x)->big.big_num, (y))
#define big_set_d(x, d) mpz_set_d((x)->big.big_num, (d))
#else /* WITH_GMP */
#define big_set(x,y) ((x)->big.big_num = (y)->big.big_num)
extern int big_num_t_sgn(big_num_t x);
#define big_odd_p(x) ((int)((x)->big.big_num&1) != 0)
#define big_even_p(x) ((int)((x)->big.big_num&1) == 0)
#define big_zerop(x) ((x)->big.big_num == (big_num_t)0)
#define big_sign(x) big_num_t_sgn((x)->big.big_num)
#define big_compare(x,y) big_num_t_sgn((x)->big.big_num - (y)->big.big_num)
#define big_complement(x) ((x)->big.big_num = -((x)->big.big_num))
#define big_add_ui(x, i) ((x)->big.big_num += (unsigned long)(i))
#define big_mul_ui(x, i) ((x)->big.big_num *= (unsigned long)(i))
#define big_complement(z, x) ((z)->big.big_num = -((x)->big.big_num))
#define big_add(z, x, y) (z)->big.big_num = (x)->big.big_num+(y)->big.big_num
#define big_sub(z, x, y) (z)->big.big_num = (x)->big.big_num-(y)->big.big_num
#define big_mul(z, x, y) (z)->big.big_num = (x)->big.big_num*(y)->big.big_num
#define big_add_ui(z, x, y) ((z)->big.big_num = (x)->big.big_num+(unsigned long)(y))
#define big_sub_ui(z, x, y) ((z)->big.big_num = (x)->big.big_num-(unsigned long)(y))
#define big_mul_ui(z, x, y) ((x)->big.big_num = (x)->big.big_num*(unsigned long)(y))
#define big_mul_si(z, x, y) (z)->big.big_num = (x)->big.big_num*(y)
#define big_set_ui(x, i) ((x)->big.big_num = ((big_num_t)((unsigned long int)i)))
#define big_set_si(x, i) ((x)->big.big_num = ((big_num_t)((long int)i)))
#define big_to_double(x) ((double)((x)->big.big_num))
#define big_to_long(x) ((long int)((x)->big.big_num))
#define big_to_ulong(x) ((unsigned long int)((x)->big.big_num))
#define big_cmp_si(x, y) ((x)->big.big_num!=(y))
#define big_tdiv_q(q, x, y) ((q)->big.big_num = (x)->big.big_num / (y)->big.big_num)
#define big_tdiv_q_ui(q, x, y) ((q)->big.big_num = (x)->big.big_num / (y))
#define big_set_d(x, d) ((x)->big.big_num = (big_num_t)(d))
#endif /* WITH_GMP */