mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-17 14:51:20 -08:00
Code Issues Projects Releases Packages Wiki Activity

fixint()/fixnnint() did not work when sizeof(long) < sizeof(fixnum)

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-01-01 19:32:32 +01:00
parent edee87b62b
commit cc83b4c01f
4 changed files with 53 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

45
src/c/big.d
View file

@ -314,6 +314,24 @@ _ecl_big_set_index(cl_object x, cl_index f)
mpz_set_ui((x)->big.big_num,(f));
return x;
}
cl_fixnum
_ecl_big_get_fixnum(cl_object x)
{
return mpz_get_si((x)->big.big_num);
}
cl_index
_ecl_big_get_index(cl_object x)
{
return mpz_get_ui((x)->big.big_num);
}
bool
_ecl_big_fits_in_index(cl_object x)
{
return mpz_fits_ulong_p(x->big.big_num);
}
#elif GMP_LIMB_BITS >= FIXNUM_BITS
cl_object
_ecl_big_set_fixnum(cl_object x, cl_fixnum f)
@ -342,6 +360,33 @@ _ecl_big_set_index(cl_object x, cl_index f)
x->big.big_limbs[0] = -f;
}
}
cl_fixnum
_ecl_big_get_fixnum(cl_object x)
{
if (x->big.big_size == 0) {
return 0;
} else {
cl_fixnum n = x->big.big_limbs[0];
return (x->big.big_size > 0) ? n : -n;
}
}
cl_index
_ecl_big_get_index(cl_object x)
{
if (x->big.big_size == 0) {
return 0;
} else {
return (cl_index)x->big.big_limbs[0];
}
}
bool
_ecl_big_fits_in_index(cl_object x)
{
return (x->big.big_size & (~1)) == 0;
}
#else
# error "ECL cannot build with GMP when both long and mp_limb_t are smaller than cl_fixnum"
#endif /* FIXNUM_BITS > GMP_LIMB_BITS, ECL_LONG_BITS */

8
src/c/number.d
View file

@ -49,8 +49,8 @@ fixint(cl_object x)
if (FIXNUMP(x))
return fix(x);
if (ECL_BIGNUMP(x)) {
if (mpz_fits_slong_p(x->big.big_num)) {
return mpz_get_si(x->big.big_num);
if (_ecl_big_fits_in_index(x)) {
return _ecl_big_get_fixnum(x);
}
}
FEwrong_type_argument(@[fixnum], x);
@ -64,8 +64,8 @@ fixnnint(cl_object x)
if (i >= 0)
return i;
} else if (ECL_BIGNUMP(x)) {
if (mpz_fits_ulong_p(x->big.big_num)) {
return mpz_get_ui(x->big.big_num);
if (_ecl_big_fits_in_index(x)) {
return _ecl_big_get_index(x);
}
}
cl_error(9, @'simple-type-error', @':format-control',

1
src/h/external.h
View file

@ -1208,6 +1208,7 @@ extern ECL_API cl_object cl_logxor _ARGS((cl_narg narg, ...));
extern ECL_API cl_object cl_logand _ARGS((cl_narg narg, ...));
extern ECL_API cl_object cl_logeqv _ARGS((cl_narg narg, ...));
extern ECL_API cl_fixnum ecl_logand_index(cl_object n, cl_index i);
extern ECL_API cl_object ecl_boole(int op, cl_object x, cl_object y);
extern ECL_API cl_object ecl_ash(cl_object x, cl_fixnum w);
extern ECL_API int ecl_fixnum_bit_length(cl_fixnum l);

4
src/h/number.h
View file

@ -27,6 +27,9 @@
extern ECL_API cl_object _ecl_big_set_fixnum(cl_object x, cl_fixnum f);
extern ECL_API cl_object _ecl_big_set_index(cl_object x, cl_index f);
extern ECL_API cl_fixnum _ecl_big_get_fixnum(cl_object x);
extern ECL_API cl_index _ecl_big_get_index(cl_object x);
extern bool _ecl_big_fits_in_index(cl_object x);
#ifdef ECL_LONG_FLOAT
extern ECL_API long double _ecl_big_to_long_double(cl_object x);
#endif
@ -62,5 +65,4 @@ extern ECL_API _ecl_big_binary_op _ecl_big_boole_operator(int op);
#define _ecl_big_tdiv_q(q, x, y) mpz_tdiv_q((q)->big.big_num,(x)->big.big_num,(y)->big.big_num)
#define _ecl_big_tdiv_q_ui(q, x, y) mpz_tdiv_q_ui((q)->big.big_num, (x)->big.big_num, (y))
#define _ecl_big_set_d(x, d) mpz_set_d((x)->big.big_num, (d))
#endif /* ECL_NUMBER_H */