sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Generalize fixint/fixnnint and create make_integer/make_unsigned_integer so

Browse source 
that C long integers which exceed the fixnum representation are promoted
to bignums. This is particularly important when exporting addresses to lisp code.
This commit is contained in:
jjgarcia 2001-07-23 08:43:05 +00:00
parent e8d4cf7438
commit 63fb67ed0c
2 changed files with 40 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
src/c/number.d
View file

@ -19,21 +19,28 @@
cl_object shortfloat_zero;
cl_object longfloat_zero;
int
cl_fixnum
fixint(cl_object x)
{
if (!FIXNUMP(x))
FEwrong_type_argument(@'fixnum', x);
return fix(x);
if (FIXNUMP(x))
return fix(x);
if (type_of(x) == t_bignum) {
if (x->big.big_size == 1 || x->big.big_size == -1)
return big_to_long(x);
}
FEwrong_type_argument(@'fixnum', x);
}
int
cl_index
fixnnint(cl_object x)
{
if (FIXNUMP(x)) {
cl_fixnum i = fix(x);
if (i >= 0)
return i;
} else if (type_of(x) == t_bignum) {
if (x->big.big_size == 1)
return big_to_long(x);
}
FEcondition(9, @'simple-type-error', @':format-control',
make_simple_string("Not a non-negative fixnum ~S"),
@ -41,6 +48,28 @@ fixnnint(cl_object x)
@':expected-type', @'fixnum', @':datum', x);
}
cl_object
make_integer(cl_fixnum l)
{
if (l > MOST_POSITIVE_FIX || l < MOST_NEGATIVE_FIX) {
cl_object z = alloc_object(t_bignum);
mpz_init_set_si(z->big.big_num, l);
return z;
}
return MAKE_FIXNUM(l);
}
cl_object
make_unsigned_integer(cl_index l)
{
if (l > MOST_POSITIVE_FIX) {
cl_object z = alloc_object(t_bignum);
mpz_init_set_ui(z->big.big_num, l);
return z;
}
return MAKE_FIXNUM(l);
}
cl_object
make_ratio(cl_object num, cl_object den)
{

13
src/h/external.h
View file

@ -447,7 +447,6 @@ extern void init_list(void);
extern void init_load(void);
extern void load_until_tag(cl_object stream, cl_object end_tag);
extern void build_symbol_table();
/* lwp.c */
#ifdef THREADS
@ -508,8 +507,10 @@ extern void init_num_arith(void);
extern cl_object shortfloat_zero;
extern cl_object longfloat_zero;
extern int fixint(cl_object x);
extern int fixnnint(cl_object x);
extern cl_fixnum fixint(cl_object x);
extern cl_index fixnnint(cl_object x);
extern cl_object make_integer(cl_fixnum i);
extern cl_object make_unsigned_integer(cl_index i);
extern cl_object make_ratio(cl_object num, cl_object den);
extern cl_object make_shortfloat(float f);
extern cl_object make_longfloat(double f);
@ -730,7 +731,7 @@ extern cl_object current_readtable(void);
extern cl_object string_to_object(cl_object x);
extern void init_read(void);
extern void init_read_function(void);
extern void read_VV(cl_object, void *);
extern void read_VV(cl_object block, void *entry);
/* reference.c */
@ -950,12 +951,10 @@ extern void init_unixfsys(void);
extern int interrupt_enable;
extern int interrupt_flag;
extern void sigalrm(void);
extern void sigint(void);
extern void sigfpe(void);
extern void signal_catcher(int sig, int code, int scp);
extern void enable_interrupt(void);
extern void init_interrupt(void);
extern void sigint(void);
/* unixsys.c */