mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

(scm_is_signed_integer, scm_is_unsigned_integer):

Browse source 
Rewritten using the same logic as scm_to_signed_integer and
scm_to_unsigned_integer, respectively, which is better(tm).  Also,
use CHAR_BIT instead of hardcoding 8.
(LLONG_MIN, LLONG_MAX, ULLONG_MAX): Removed and used
SCM_I_LLONG_MIN etc. instead.

* numbers.h (SCM_MAKINUM, SCM_I_MAKINUM): Renamed SCM_MAKINUM to
SCM_I_MAKINUM and changed all uses.
This commit is contained in:
Marius Vollmer 2004-07-08 15:54:05 +00:00
parent 5a572ca13c
commit d956fa6f91
1 changed files with 136 additions and 148 deletions
Download patch file Download diff file Expand all files Collapse all files

282
libguile/numbers.c
View file

@ -215,7 +215,7 @@ scm_i_dbl2num (double u)
if (u < (double) (SCM_MOST_POSITIVE_FIXNUM+1) if (u < (double) (SCM_MOST_POSITIVE_FIXNUM+1)
&& u >= (double) SCM_MOST_NEGATIVE_FIXNUM) && u >= (double) SCM_MOST_NEGATIVE_FIXNUM)
return SCM_MAKINUM ((long) u); return SCM_I_MAKINUM ((long) u);
else else
return scm_i_dbl2big (u); return scm_i_dbl2big (u);
} }
@ -297,7 +297,7 @@ scm_i_normbig (SCM b)
{ {
long val = mpz_get_si (SCM_I_BIG_MPZ (b)); long val = mpz_get_si (SCM_I_BIG_MPZ (b));
if (SCM_FIXABLE (val)) if (SCM_FIXABLE (val))
b = SCM_MAKINUM (val); b = SCM_I_MAKINUM (val);
} }
return b; return b;
} }
@ -310,7 +310,7 @@ scm_i_mpz2num (mpz_t b)
{ {
long val = mpz_get_si (b); long val = mpz_get_si (b);
if (SCM_FIXABLE (val)) if (SCM_FIXABLE (val))
return SCM_MAKINUM (val); return SCM_I_MAKINUM (val);
} }
{ {
@ -333,7 +333,7 @@ scm_make_ratio (SCM numerator, SCM denominator)
{ {
if (SCM_EQ_P (denominator, SCM_INUM0)) if (SCM_EQ_P (denominator, SCM_INUM0))
scm_num_overflow ("make-ratio"); scm_num_overflow ("make-ratio");
if (SCM_EQ_P (denominator, SCM_MAKINUM(1))) if (SCM_EQ_P (denominator, SCM_I_MAKINUM(1)))
return numerator; return numerator;
} }
else else
@ -365,9 +365,9 @@ scm_make_ratio (SCM numerator, SCM denominator)
long y; long y;
y = SCM_INUM (denominator); y = SCM_INUM (denominator);
if (x == y) if (x == y)
return SCM_MAKINUM(1); return SCM_I_MAKINUM(1);
if ((x % y) == 0) if ((x % y) == 0)
return SCM_MAKINUM (x / y); return SCM_I_MAKINUM (x / y);
} }
else else
{ {
@ -378,7 +378,7 @@ scm_make_ratio (SCM numerator, SCM denominator)
if (x == SCM_MOST_NEGATIVE_FIXNUM if (x == SCM_MOST_NEGATIVE_FIXNUM
&& mpz_cmp_ui (SCM_I_BIG_MPZ (denominator), && mpz_cmp_ui (SCM_I_BIG_MPZ (denominator),
- SCM_MOST_NEGATIVE_FIXNUM) == 0) - SCM_MOST_NEGATIVE_FIXNUM) == 0)
return SCM_MAKINUM(-1); return SCM_I_MAKINUM(-1);
} }
} }
else if (SCM_BIGP (numerator)) else if (SCM_BIGP (numerator))
@ -392,7 +392,7 @@ scm_make_ratio (SCM numerator, SCM denominator)
else else
{ {
if (SCM_EQ_P (numerator, denominator)) if (SCM_EQ_P (numerator, denominator))
return SCM_MAKINUM(1); return SCM_I_MAKINUM(1);
if (mpz_divisible_p (SCM_I_BIG_MPZ (numerator), if (mpz_divisible_p (SCM_I_BIG_MPZ (numerator),
SCM_I_BIG_MPZ (denominator))) SCM_I_BIG_MPZ (denominator)))
return scm_divide(numerator, denominator); return scm_divide(numerator, denominator);
@ -413,7 +413,7 @@ static void scm_i_fraction_reduce (SCM z)
{ {
SCM divisor; SCM divisor;
divisor = scm_gcd (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z)); divisor = scm_gcd (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z));
if (!(SCM_EQ_P (divisor, SCM_MAKINUM(1)))) if (!(SCM_EQ_P (divisor, SCM_I_MAKINUM(1))))
{ {
/* is this safe? */ /* is this safe? */
SCM_FRACTION_SET_NUMERATOR (z, scm_divide (SCM_FRACTION_NUMERATOR (z), divisor)); SCM_FRACTION_SET_NUMERATOR (z, scm_divide (SCM_FRACTION_NUMERATOR (z), divisor));
@ -648,7 +648,7 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
if (xx >= 0) if (xx >= 0)
return x; return x;
else if (SCM_POSFIXABLE (-xx)) else if (SCM_POSFIXABLE (-xx))
return SCM_MAKINUM (-xx); return SCM_I_MAKINUM (-xx);
else else
return scm_i_long2big (-xx); return scm_i_long2big (-xx);
} }
@ -700,7 +700,7 @@ scm_quotient (SCM x, SCM y)
{ {
long z = xx / yy; long z = xx / yy;
if (SCM_FIXABLE (z)) if (SCM_FIXABLE (z))
return SCM_MAKINUM (z); return SCM_I_MAKINUM (z);
else else
return scm_i_long2big (z); return scm_i_long2big (z);
} }
@ -713,10 +713,10 @@ scm_quotient (SCM x, SCM y)
{ {
/* Special case: x == fixnum-min && y == abs (fixnum-min) */ /* Special case: x == fixnum-min && y == abs (fixnum-min) */
scm_remember_upto_here_1 (y); scm_remember_upto_here_1 (y);
return SCM_MAKINUM (-1); return SCM_I_MAKINUM (-1);
} }
else else
return SCM_MAKINUM (0); return SCM_I_MAKINUM (0);
} }
else else
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient); SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
@ -782,7 +782,7 @@ scm_remainder (SCM x, SCM y)
else else
{ {
long z = SCM_INUM (x) % yy; long z = SCM_INUM (x) % yy;
return SCM_MAKINUM (z); return SCM_I_MAKINUM (z);
} }
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -793,7 +793,7 @@ scm_remainder (SCM x, SCM y)
{ {
/* Special case: x == fixnum-min && y == abs (fixnum-min) */ /* Special case: x == fixnum-min && y == abs (fixnum-min) */
scm_remember_upto_here_1 (y); scm_remember_upto_here_1 (y);
return SCM_MAKINUM (0); return SCM_I_MAKINUM (0);
} }
else else
return x; return x;
@ -874,7 +874,7 @@ scm_modulo (SCM x, SCM y)
else else
result = z; result = z;
} }
return SCM_MAKINUM (result); return SCM_I_MAKINUM (result);
} }
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -1021,7 +1021,7 @@ scm_gcd (SCM x, SCM y)
result = u * k; result = u * k;
} }
return (SCM_POSFIXABLE (result) return (SCM_POSFIXABLE (result)
? SCM_MAKINUM (result) ? SCM_I_MAKINUM (result)
: scm_i_long2big (result)); : scm_i_long2big (result));
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -1047,7 +1047,7 @@ scm_gcd (SCM x, SCM y)
result = mpz_gcd_ui (NULL, SCM_I_BIG_MPZ (x), yy); result = mpz_gcd_ui (NULL, SCM_I_BIG_MPZ (x), yy);
scm_remember_upto_here_1 (x); scm_remember_upto_here_1 (x);
return (SCM_POSFIXABLE (result) return (SCM_POSFIXABLE (result)
? SCM_MAKINUM (result) ? SCM_I_MAKINUM (result)
: scm_ulong2num (result)); : scm_ulong2num (result));
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -1076,8 +1076,8 @@ scm_lcm (SCM n1, SCM n2)
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2))
{ {
if (SCM_UNBNDP (n1)) if (SCM_UNBNDP (n1))
return SCM_MAKINUM (1L); return SCM_I_MAKINUM (1L);
n2 = SCM_MAKINUM (1L); n2 = SCM_I_MAKINUM (1L);
} }
SCM_GASSERT2 (SCM_INUMP (n1) || SCM_BIGP (n1), SCM_GASSERT2 (SCM_INUMP (n1) || SCM_BIGP (n1),
@ -1134,7 +1134,7 @@ scm_lcm (SCM n1, SCM n2)
#ifndef scm_long2num #ifndef scm_long2num
#define SCM_LOGOP_RETURN(x) scm_ulong2num(x) #define SCM_LOGOP_RETURN(x) scm_ulong2num(x)
#else #else
#define SCM_LOGOP_RETURN(x) SCM_MAKINUM(x) #define SCM_LOGOP_RETURN(x) SCM_I_MAKINUM(x)
#endif #endif
/* Emulating 2's complement bignums with sign magnitude arithmetic: /* Emulating 2's complement bignums with sign magnitude arithmetic:
@ -1188,7 +1188,7 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2))
{ {
if (SCM_UNBNDP (n1)) if (SCM_UNBNDP (n1))
return SCM_MAKINUM (-1); return SCM_I_MAKINUM (-1);
else if (!SCM_NUMBERP (n1)) else if (!SCM_NUMBERP (n1))
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
else if (SCM_NUMBERP (n1)) else if (SCM_NUMBERP (n1))
@ -1203,7 +1203,7 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
if (SCM_INUMP (n2)) if (SCM_INUMP (n2))
{ {
long nn2 = SCM_INUM (n2); long nn2 = SCM_INUM (n2);
return SCM_MAKINUM (nn1 & nn2); return SCM_I_MAKINUM (nn1 & nn2);
} }
else if SCM_BIGP (n2) else if SCM_BIGP (n2)
{ {
@ -1277,7 +1277,7 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
if (SCM_INUMP (n2)) if (SCM_INUMP (n2))
{ {
long nn2 = SCM_INUM (n2); long nn2 = SCM_INUM (n2);
return SCM_MAKINUM (nn1 | nn2); return SCM_I_MAKINUM (nn1 | nn2);
} }
else if (SCM_BIGP (n2)) else if (SCM_BIGP (n2))
{ {
@ -1353,7 +1353,7 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
if (SCM_INUMP (n2)) if (SCM_INUMP (n2))
{ {
long nn2 = SCM_INUM (n2); long nn2 = SCM_INUM (n2);
return SCM_MAKINUM (nn1 ^ nn2); return SCM_I_MAKINUM (nn1 ^ nn2);
} }
else if (SCM_BIGP (n2)) else if (SCM_BIGP (n2))
{ {
@ -1518,7 +1518,7 @@ SCM_DEFINE (scm_lognot, "lognot", 1, 0, 0,
Enhancement: No need to strip the tag and add it back, could just xor Enhancement: No need to strip the tag and add it back, could just xor
a block of 1 bits, if that worked with the various debug versions of a block of 1 bits, if that worked with the various debug versions of
the SCM typedef. */ the SCM typedef. */
return SCM_MAKINUM (~ SCM_INUM (n)); return SCM_I_MAKINUM (~ SCM_INUM (n));
} else if (SCM_BIGP (n)) { } else if (SCM_BIGP (n)) {
SCM result = scm_i_mkbig (); SCM result = scm_i_mkbig ();
@ -1666,12 +1666,12 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
long i2 = 0; long i2 = 0;
SCM z_i2 = SCM_BOOL_F; SCM z_i2 = SCM_BOOL_F;
int i2_is_big = 0; int i2_is_big = 0;
SCM acc = SCM_MAKINUM (1L); SCM acc = SCM_I_MAKINUM (1L);
/* 0^0 == 1 according to R5RS */ /* 0^0 == 1 according to R5RS */
if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc)) if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc))
return scm_is_false (scm_zero_p(k)) ? n : acc; return scm_is_false (scm_zero_p(k)) ? n : acc;
else if (SCM_EQ_P (n, SCM_MAKINUM (-1L))) else if (SCM_EQ_P (n, SCM_I_MAKINUM (-1L)))
return scm_is_false (scm_even_p (k)) ? n : acc; return scm_is_false (scm_even_p (k)) ? n : acc;
if (SCM_INUMP (k)) if (SCM_INUMP (k))
@ -1781,19 +1781,19 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
by div:=2^abs(cnt). However, to guarantee the floor by div:=2^abs(cnt). However, to guarantee the floor
rounding, negative values require some special treatment. rounding, negative values require some special treatment.
*/ */
SCM div = scm_integer_expt (SCM_MAKINUM (2), SCM div = scm_integer_expt (SCM_I_MAKINUM (2),
SCM_MAKINUM (-bits_to_shift)); SCM_I_MAKINUM (-bits_to_shift));
/* scm_quotient assumes its arguments are integers, but it's legal to (ash 1/2 -1) */ /* scm_quotient assumes its arguments are integers, but it's legal to (ash 1/2 -1) */
if (scm_is_false (scm_negative_p (n))) if (scm_is_false (scm_negative_p (n)))
return scm_quotient (n, div); return scm_quotient (n, div);
else else
return scm_sum (SCM_MAKINUM (-1L), return scm_sum (SCM_I_MAKINUM (-1L),
scm_quotient (scm_sum (SCM_MAKINUM (1L), n), div)); scm_quotient (scm_sum (SCM_I_MAKINUM (1L), n), div));
} }
else else
/* Shift left is done by multiplication with 2^CNT */ /* Shift left is done by multiplication with 2^CNT */
return scm_product (n, scm_integer_expt (SCM_MAKINUM (2), cnt)); return scm_product (n, scm_integer_expt (SCM_I_MAKINUM (2), cnt));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1842,14 +1842,14 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
/* mask down to requisite bits */ /* mask down to requisite bits */
bits = min (bits, SCM_I_FIXNUM_BIT); bits = min (bits, SCM_I_FIXNUM_BIT);
return SCM_MAKINUM (in & ((1L << bits) - 1)); return SCM_I_MAKINUM (in & ((1L << bits) - 1));
} }
else if (SCM_BIGP (n)) else if (SCM_BIGP (n))
{ {
SCM result; SCM result;
if (bits == 1) if (bits == 1)
{ {
result = SCM_MAKINUM (mpz_tstbit (SCM_I_BIG_MPZ (n), istart)); result = SCM_I_MAKINUM (mpz_tstbit (SCM_I_BIG_MPZ (n), istart));
} }
else else
{ {
@ -1902,7 +1902,7 @@ SCM_DEFINE (scm_logcount, "logcount", 1, 0, 0,
c += scm_logtab[15 & nn]; c += scm_logtab[15 & nn];
nn >>= 4; nn >>= 4;
} }
return SCM_MAKINUM (c); return SCM_I_MAKINUM (c);
} }
else if (SCM_BIGP (n)) else if (SCM_BIGP (n))
{ {
@ -1912,7 +1912,7 @@ SCM_DEFINE (scm_logcount, "logcount", 1, 0, 0,
else else
count = mpz_hamdist (SCM_I_BIG_MPZ (n), z_negative_one); count = mpz_hamdist (SCM_I_BIG_MPZ (n), z_negative_one);
scm_remember_upto_here_1 (n); scm_remember_upto_here_1 (n);
return SCM_MAKINUM (count); return SCM_I_MAKINUM (count);
} }
else else
SCM_WRONG_TYPE_ARG (SCM_ARG1, n); SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
@ -1952,7 +1952,7 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1, 0, 0,
l = scm_ilentab [15 & nn]; l = scm_ilentab [15 & nn];
nn >>= 4; nn >>= 4;
} }
return SCM_MAKINUM (c - 4 + l); return SCM_I_MAKINUM (c - 4 + l);
} }
else if (SCM_BIGP (n)) else if (SCM_BIGP (n))
{ {
@ -1965,7 +1965,7 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1, 0, 0,
mpz_scan1 (SCM_I_BIG_MPZ (n), 0)) == ULONG_MAX) mpz_scan1 (SCM_I_BIG_MPZ (n), 0)) == ULONG_MAX)
size--; size--;
scm_remember_upto_here_1 (n); scm_remember_upto_here_1 (n);
return SCM_MAKINUM (size); return SCM_I_MAKINUM (size);
} }
else else
SCM_WRONG_TYPE_ARG (SCM_ARG1, n); SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
@ -2405,7 +2405,7 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
return SCM_BOOL_F; return SCM_BOOL_F;
idx++; idx++;
result = SCM_MAKINUM (digit_value); result = SCM_I_MAKINUM (digit_value);
while (idx != len) while (idx != len)
{ {
char c = mem[idx]; char c = mem[idx];
@ -2428,9 +2428,9 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
idx++; idx++;
if (SCM_MOST_POSITIVE_FIXNUM / radix < shift) if (SCM_MOST_POSITIVE_FIXNUM / radix < shift)
{ {
result = scm_product (result, SCM_MAKINUM (shift)); result = scm_product (result, SCM_I_MAKINUM (shift));
if (add > 0) if (add > 0)
result = scm_sum (result, SCM_MAKINUM (add)); result = scm_sum (result, SCM_I_MAKINUM (add));
shift = radix; shift = radix;
add = digit_value; add = digit_value;
@ -2443,9 +2443,9 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
}; };
if (shift > 1) if (shift > 1)
result = scm_product (result, SCM_MAKINUM (shift)); result = scm_product (result, SCM_I_MAKINUM (shift));
if (add > 0) if (add > 0)
result = scm_sum (result, SCM_MAKINUM (add)); result = scm_sum (result, SCM_I_MAKINUM (add));
*p_idx = idx; *p_idx = idx;
if (hash_seen) if (hash_seen)
@ -2480,7 +2480,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
scm_t_bits shift = 1; scm_t_bits shift = 1;
scm_t_bits add = 0; scm_t_bits add = 0;
unsigned int digit_value; unsigned int digit_value;
SCM big_shift = SCM_MAKINUM (1); SCM big_shift = SCM_I_MAKINUM (1);
idx++; idx++;
while (idx != len) while (idx != len)
@ -2504,10 +2504,10 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
idx++; idx++;
if (SCM_MOST_POSITIVE_FIXNUM / 10 < shift) if (SCM_MOST_POSITIVE_FIXNUM / 10 < shift)
{ {
big_shift = scm_product (big_shift, SCM_MAKINUM (shift)); big_shift = scm_product (big_shift, SCM_I_MAKINUM (shift));
result = scm_product (result, SCM_MAKINUM (shift)); result = scm_product (result, SCM_I_MAKINUM (shift));
if (add > 0) if (add > 0)
result = scm_sum (result, SCM_MAKINUM (add)); result = scm_sum (result, SCM_I_MAKINUM (add));
shift = 10; shift = 10;
add = digit_value; add = digit_value;
@ -2521,9 +2521,9 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
if (add > 0) if (add > 0)
{ {
big_shift = scm_product (big_shift, SCM_MAKINUM (shift)); big_shift = scm_product (big_shift, SCM_I_MAKINUM (shift));
result = scm_product (result, SCM_MAKINUM (shift)); result = scm_product (result, SCM_I_MAKINUM (shift));
result = scm_sum (result, SCM_MAKINUM (add)); result = scm_sum (result, SCM_I_MAKINUM (add));
} }
result = scm_divide (result, big_shift); result = scm_divide (result, big_shift);
@ -2593,7 +2593,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
scm_out_of_range ("string->number", exp_num); scm_out_of_range ("string->number", exp_num);
} }
e = scm_integer_expt (SCM_MAKINUM (10), SCM_MAKINUM (exponent)); e = scm_integer_expt (SCM_I_MAKINUM (10), SCM_I_MAKINUM (exponent));
if (sign == 1) if (sign == 1)
result = scm_product (result, e); result = scm_product (result, e);
else else
@ -2656,7 +2656,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
else if (!isdigit ((int) (unsigned char) mem[idx + 1])) else if (!isdigit ((int) (unsigned char) mem[idx + 1]))
return SCM_BOOL_F; return SCM_BOOL_F;
else else
result = mem2decimal_from_point (SCM_MAKINUM (0), mem, len, result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem, len,
p_idx, p_exactness); p_idx, p_exactness);
} }
else else
@ -2700,7 +2700,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
/* When returning an inexact zero, make sure it is represented as a /* When returning an inexact zero, make sure it is represented as a
floating point value so that we can change its sign. floating point value so that we can change its sign.
*/ */
if (SCM_EQ_P (result, SCM_MAKINUM(0)) && *p_exactness == INEXACT) if (SCM_EQ_P (result, SCM_I_MAKINUM(0)) && *p_exactness == INEXACT)
result = scm_make_real (0.0); result = scm_make_real (0.0);
return result; return result;
@ -2749,7 +2749,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
if (idx != len) if (idx != len)
return SCM_BOOL_F; return SCM_BOOL_F;
return scm_make_rectangular (SCM_MAKINUM (0), SCM_MAKINUM (sign)); return scm_make_rectangular (SCM_I_MAKINUM (0), SCM_I_MAKINUM (sign));
} }
else else
return SCM_BOOL_F; return SCM_BOOL_F;
@ -2773,7 +2773,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
return SCM_BOOL_F; return SCM_BOOL_F;
if (idx != len) if (idx != len)
return SCM_BOOL_F; return SCM_BOOL_F;
return scm_make_rectangular (SCM_MAKINUM (0), ureal); return scm_make_rectangular (SCM_I_MAKINUM (0), ureal);
case '@': case '@':
/* polar input: <real>@<real>. */ /* polar input: <real>@<real>. */
@ -2826,7 +2826,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
SCM imag = mem2ureal (mem, len, &idx, radix, p_exactness); SCM imag = mem2ureal (mem, len, &idx, radix, p_exactness);
if (scm_is_false (imag)) if (scm_is_false (imag))
imag = SCM_MAKINUM (sign); imag = SCM_I_MAKINUM (sign);
else if (sign == -1 && scm_is_false (scm_nan_p (ureal))) else if (sign == -1 && scm_is_false (scm_nan_p (ureal)))
imag = scm_difference (imag, SCM_UNDEFINED); imag = scm_difference (imag, SCM_UNDEFINED);
@ -3851,7 +3851,7 @@ scm_sum (SCM x, SCM y)
long xx = SCM_INUM (x); long xx = SCM_INUM (x);
long yy = SCM_INUM (y); long yy = SCM_INUM (y);
long int z = xx + yy; long int z = xx + yy;
return SCM_FIXABLE (z) ? SCM_MAKINUM (z) : scm_i_long2big (z); return SCM_FIXABLE (z) ? SCM_I_MAKINUM (z) : scm_i_long2big (z);
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
@ -4030,7 +4030,7 @@ scm_difference (SCM x, SCM y)
{ {
long xx = -SCM_INUM (x); long xx = -SCM_INUM (x);
if (SCM_FIXABLE (xx)) if (SCM_FIXABLE (xx))
return SCM_MAKINUM (xx); return SCM_I_MAKINUM (xx);
else else
return scm_i_long2big (xx); return scm_i_long2big (xx);
} }
@ -4057,7 +4057,7 @@ scm_difference (SCM x, SCM y)
long int yy = SCM_INUM (y); long int yy = SCM_INUM (y);
long int z = xx - yy; long int z = xx - yy;
if (SCM_FIXABLE (z)) if (SCM_FIXABLE (z))
return SCM_MAKINUM (z); return SCM_I_MAKINUM (z);
else else
return scm_i_long2big (z); return scm_i_long2big (z);
} }
@ -4119,7 +4119,7 @@ scm_difference (SCM x, SCM y)
scm_remember_upto_here_1 (x); scm_remember_upto_here_1 (x);
if (sgn_x == 0) if (sgn_x == 0)
return SCM_FIXABLE (-yy) ? SCM_MAKINUM (-yy) : scm_long2num (-yy); return SCM_FIXABLE (-yy) ? SCM_I_MAKINUM (-yy) : scm_long2num (-yy);
else else
{ {
SCM result = scm_i_mkbig (); SCM result = scm_i_mkbig ();
@ -4256,7 +4256,7 @@ scm_product (SCM x, SCM y)
if (SCM_UNBNDP (y)) if (SCM_UNBNDP (y))
{ {
if (SCM_UNBNDP (x)) if (SCM_UNBNDP (x))
return SCM_MAKINUM (1L); return SCM_I_MAKINUM (1L);
else if (SCM_NUMBERP (x)) else if (SCM_NUMBERP (x))
return x; return x;
else else
@ -4280,7 +4280,7 @@ scm_product (SCM x, SCM y)
{ {
long yy = SCM_INUM (y); long yy = SCM_INUM (y);
long kk = xx * yy; long kk = xx * yy;
SCM k = SCM_MAKINUM (kk); SCM k = SCM_I_MAKINUM (kk);
if ((kk == SCM_INUM (k)) && (kk / xx == yy)) if ((kk == SCM_INUM (k)) && (kk / xx == yy))
return k; return k;
else else
@ -4504,14 +4504,14 @@ scm_i_divide (SCM x, SCM y, int inexact)
{ {
if (inexact) if (inexact)
return scm_make_real (1.0 / (double) xx); return scm_make_real (1.0 / (double) xx);
else return scm_make_ratio (SCM_MAKINUM(1), x); else return scm_make_ratio (SCM_I_MAKINUM(1), x);
} }
} }
else if (SCM_BIGP (x)) else if (SCM_BIGP (x))
{ {
if (inexact) if (inexact)
return scm_make_real (1.0 / scm_i_big2dbl (x)); return scm_make_real (1.0 / scm_i_big2dbl (x));
else return scm_make_ratio (SCM_MAKINUM(1), x); else return scm_make_ratio (SCM_I_MAKINUM(1), x);
} }
else if (SCM_REALP (x)) else if (SCM_REALP (x))
{ {
@ -4571,7 +4571,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
{ {
long z = xx / yy; long z = xx / yy;
if (SCM_FIXABLE (z)) if (SCM_FIXABLE (z))
return SCM_MAKINUM (z); return SCM_I_MAKINUM (z);
else else
return scm_i_long2big (z); return scm_i_long2big (z);
} }
@ -5020,7 +5020,7 @@ SCM_DEFINE (scm_round_number, "round", 1, 0, 0,
/* Adjust so that the scm_round is towards even. */ /* Adjust so that the scm_round is towards even. */
if (scm_is_true (scm_num_eq_p (plus_half, result)) if (scm_is_true (scm_num_eq_p (plus_half, result))
&& scm_is_true (scm_odd_p (result))) && scm_is_true (scm_odd_p (result)))
return scm_difference (result, SCM_MAKINUM (1)); return scm_difference (result, SCM_I_MAKINUM (1));
else else
return result; return result;
} }
@ -5050,7 +5050,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0,
/* For negative x, we need to return q-1 unless x is an /* For negative x, we need to return q-1 unless x is an
integer. But fractions are never integer, per our integer. But fractions are never integer, per our
assumptions. */ assumptions. */
return scm_difference (q, SCM_MAKINUM (1)); return scm_difference (q, SCM_I_MAKINUM (1));
} }
} }
else else
@ -5081,7 +5081,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0,
/* For positive x, we need to return q+1 unless x is an /* For positive x, we need to return q+1 unless x is an
integer. But fractions are never integer, per our integer. But fractions are never integer, per our
assumptions. */ assumptions. */
return scm_sum (q, SCM_MAKINUM (1)); return scm_sum (q, SCM_I_MAKINUM (1));
} }
} }
else else
@ -5298,9 +5298,9 @@ SCM
scm_denominator (SCM z) scm_denominator (SCM z)
{ {
if (SCM_INUMP (z)) if (SCM_INUMP (z))
return SCM_MAKINUM (1); return SCM_I_MAKINUM (1);
else if (SCM_BIGP (z)) else if (SCM_BIGP (z))
return SCM_MAKINUM (1); return SCM_I_MAKINUM (1);
else if (SCM_FRACTIONP (z)) else if (SCM_FRACTIONP (z))
{ {
scm_i_fraction_reduce (z); scm_i_fraction_reduce (z);
@ -5325,7 +5325,7 @@ scm_magnitude (SCM z)
if (zz >= 0) if (zz >= 0)
return z; return z;
else if (SCM_POSFIXABLE (-zz)) else if (SCM_POSFIXABLE (-zz))
return SCM_MAKINUM (-zz); return SCM_I_MAKINUM (-zz);
else else
return scm_i_long2big (-zz); return scm_i_long2big (-zz);
} }
@ -5473,9 +5473,9 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
SCM ex = scm_inexact_to_exact (x); SCM ex = scm_inexact_to_exact (x);
SCM int_part = scm_floor (ex); SCM int_part = scm_floor (ex);
SCM tt = SCM_MAKINUM (1); SCM tt = SCM_I_MAKINUM (1);
SCM a1 = SCM_MAKINUM (0), a2 = SCM_MAKINUM (1), a = SCM_MAKINUM (0); SCM a1 = SCM_I_MAKINUM (0), a2 = SCM_I_MAKINUM (1), a = SCM_I_MAKINUM (0);
SCM b1 = SCM_MAKINUM (1), b2 = SCM_MAKINUM (0), b = SCM_MAKINUM (0); SCM b1 = SCM_I_MAKINUM (1), b2 = SCM_I_MAKINUM (0), b = SCM_I_MAKINUM (0);
SCM rx; SCM rx;
int i = 0; int i = 0;
@ -5522,15 +5522,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
/* if you need to change this, change test-num2integral.c as well */
#if SCM_SIZEOF_LONG_LONG != 0
# ifndef LLONG_MAX
# define ULLONG_MAX ((unsigned long long) (-1))
# define LLONG_MAX ((long long) (ULLONG_MAX >> 1))
# define LLONG_MIN (~LLONG_MAX)
# endif
#endif
/* Parameters for creating integer conversion routines. /* Parameters for creating integer conversion routines.
Define the following preprocessor macros before including Define the following preprocessor macros before including
@ -5631,10 +5622,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
#if SCM_SIZEOF_LONG_LONG != 0 #if SCM_SIZEOF_LONG_LONG != 0
#ifndef ULONG_LONG_MAX
#define ULONG_LONG_MAX (~0ULL)
#endif
#define NUM2INTEGRAL scm_num2long_long #define NUM2INTEGRAL scm_num2long_long
#define INTEGRAL2NUM scm_long_long2num #define INTEGRAL2NUM scm_long_long2num
#define INTEGRAL2BIG scm_i_long_long2big #define INTEGRAL2BIG scm_i_long_long2big
@ -5684,43 +5671,40 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max)
if (min >= SCM_MOST_NEGATIVE_FIXNUM && max <= SCM_MOST_POSITIVE_FIXNUM) if (min >= SCM_MOST_NEGATIVE_FIXNUM && max <= SCM_MOST_POSITIVE_FIXNUM)
return 0; return 0;
else if (min >= LONG_MIN && max <= LONG_MAX) else if (min >= LONG_MIN && max <= LONG_MAX)
return (mpz_cmp_si (SCM_I_BIG_MPZ (val), min) >= 0
&& mpz_cmp_si (SCM_I_BIG_MPZ (val), max) <= 0);
else
{ {
/* Get the big hammer. */ if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val)))
mpz_t bigmin, bigmax;
int res;
mpz_init (bigmin);
if (min >= 0)
mpz_import (bigmin, 1, 1, sizeof (scm_t_intmax), 0, 0, &min);
else
{ {
/* Magically works for min == INTMAX_MIN as well. */ long n = mpz_get_si (SCM_I_BIG_MPZ (val));
min = -min; return n >= min && n <= max;
mpz_import (bigmin, 1, 1, sizeof (scm_t_intmax), 0, 0, &min);
mpz_neg (bigmin, bigmin);
} }
res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmin); else
mpz_clear (bigmin); return 0;
if (res < 0) }
else
{
scm_t_intmax n;
size_t count;
if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
> CHAR_BIT*sizeof (scm_t_uintmax))
return 0; return 0;
mpz_init (bigmax); mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
if (max >= 0) SCM_I_BIG_MPZ (val));
mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max);
if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0)
{
if (n < 0)
return 0;
}
else else
{ {
/* Magically works for max == INTMAX_MIN as well. */ n = -n;
max = -max; if (n >= 0)
mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); return 0;
mpz_neg (bigmax, bigmax);
} }
res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmax);
mpz_clear (bigmax); return n >= min && n <= max;
return res <= 0;
} }
} }
else if (SCM_REALP (val)) else if (SCM_REALP (val))
@ -5745,33 +5729,37 @@ scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max)
if (max <= SCM_MOST_POSITIVE_FIXNUM) if (max <= SCM_MOST_POSITIVE_FIXNUM)
return 0; return 0;
else if (max <= ULONG_MAX) else if (max <= ULONG_MAX)
return (mpz_cmp_ui (SCM_I_BIG_MPZ (val), min) >= 0 {
&& mpz_cmp_ui (SCM_I_BIG_MPZ (val), max) <= 0); if (mpz_fits_ulong_p (SCM_I_BIG_MPZ (val)))
{
unsigned long n = mpz_get_ui (SCM_I_BIG_MPZ (val));
return n >= min && n <= max;
}
else
return 0;
}
else else
{ {
/* Get the big hammer. */ scm_t_uintmax n;
size_t count;
mpz_t bigmin, bigmax; if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0)
int res;
mpz_init (bigmin);
mpz_import (bigmin, 1, 1, sizeof (scm_t_uintmax), 0, 0, &min);
res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmin);
mpz_clear (bigmin);
if (res < 0)
return 0; return 0;
mpz_init (bigmax); if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); > CHAR_BIT*sizeof (scm_t_uintmax))
res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmax); return 0;
mpz_clear (bigmax);
return res <= 0; mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
SCM_I_BIG_MPZ (val));
return n >= min && n <= max;
} }
} }
else if (SCM_REALP (val)) else if (SCM_REALP (val))
{ {
double n = SCM_REAL_VALUE (val); double n = SCM_REAL_VALUE (val);
return n == floor(n) && n >= min && n <= max; return n == floor (n) && n >= min && n <= max;
} }
else else
return 0; return 0;
@ -5815,7 +5803,7 @@ scm_to_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max)
size_t count; size_t count;
if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
> 8*sizeof (scm_t_uintmax)) > CHAR_BIT*sizeof (scm_t_uintmax))
goto out_of_range; goto out_of_range;
mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
@ -5898,7 +5886,7 @@ scm_to_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max)
goto out_of_range; goto out_of_range;
if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
> 8*sizeof (scm_t_uintmax)) > CHAR_BIT*sizeof (scm_t_uintmax))
goto out_of_range; goto out_of_range;
mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
@ -5932,7 +5920,7 @@ SCM
scm_from_signed_integer (scm_t_intmax val) scm_from_signed_integer (scm_t_intmax val)
{ {
if (SCM_FIXABLE (val)) if (SCM_FIXABLE (val))
return SCM_MAKINUM (val); return SCM_I_MAKINUM (val);
else if (val >= LONG_MIN && val <= LONG_MAX) else if (val >= LONG_MIN && val <= LONG_MAX)
{ {
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
@ -5961,7 +5949,7 @@ SCM
scm_from_unsigned_integer (scm_t_uintmax val) scm_from_unsigned_integer (scm_t_uintmax val)
{ {
if (SCM_POSFIXABLE (val)) if (SCM_POSFIXABLE (val))
return SCM_MAKINUM (val); return SCM_I_MAKINUM (val);
else if (val <= ULONG_MAX) else if (val <= ULONG_MAX)
{ {
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
@ -6052,9 +6040,9 @@ check_sanity ()
CHECK (long_long, 0LL); CHECK (long_long, 0LL);
CHECK (ulong_long, 0ULL); CHECK (ulong_long, 0ULL);
CHECK (long_long, -1LL); CHECK (long_long, -1LL);
CHECK (long_long, LLONG_MAX); CHECK (long_long, SCM_I_LLONG_MAX);
CHECK (long_long, LLONG_MIN); CHECK (long_long, SCM_I_LLONG_MIN);
CHECK (ulong_long, ULLONG_MAX); CHECK (ulong_long, SCM_I_ULLONG_MAX);
#endif #endif
} }
@ -6087,7 +6075,7 @@ SCM_DEFINE (scm_sys_check_number_conversions, "%check-number-conversions", 0, 0,
"Number conversion sanity checking.") "Number conversion sanity checking.")
#define FUNC_NAME s_scm_sys_check_number_conversions #define FUNC_NAME s_scm_sys_check_number_conversions
{ {
SCM data = SCM_MAKINUM (-1); SCM data = SCM_I_MAKINUM (-1);
CHECK; CHECK;
data = scm_int2num (INT_MIN); data = scm_int2num (INT_MIN);
CHECK; CHECK;
@ -6095,7 +6083,7 @@ SCM_DEFINE (scm_sys_check_number_conversions, "%check-number-conversions", 0, 0,
data = scm_difference (SCM_INUM0, data); data = scm_difference (SCM_INUM0, data);
CHECK; CHECK;
data = scm_ulong2num (ULONG_MAX); data = scm_ulong2num (ULONG_MAX);
data = scm_sum (SCM_MAKINUM (1), data); data = scm_difference (SCM_INUM0, data); data = scm_sum (SCM_I_MAKINUM (1), data); data = scm_difference (SCM_INUM0, data);
CHECK; CHECK;
data = scm_int2num (-10000); data = scm_product (data, data); data = scm_product (data, data); data = scm_int2num (-10000); data = scm_product (data, data); data = scm_product (data, data);
CHECK; CHECK;
@ -6118,9 +6106,9 @@ scm_init_numbers ()
* using these values, remember the two rules of program optimization: * using these values, remember the two rules of program optimization:
* 1st Rule: Don't do it. 2nd Rule (experts only): Don't do it yet. */ * 1st Rule: Don't do it. 2nd Rule (experts only): Don't do it yet. */
scm_c_define ("most-positive-fixnum", scm_c_define ("most-positive-fixnum",
SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)); SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM));
scm_c_define ("most-negative-fixnum", scm_c_define ("most-negative-fixnum",
SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)); SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM));
scm_add_feature ("complex"); scm_add_feature ("complex");
scm_add_feature ("inexact"); scm_add_feature ("inexact");
@ -6141,8 +6129,8 @@ scm_init_numbers ()
check_sanity (); check_sanity ();
#endif #endif
exactly_one_half = scm_permanent_object (scm_divide (SCM_MAKINUM (1), exactly_one_half = scm_permanent_object (scm_divide (SCM_I_MAKINUM (1),
SCM_MAKINUM (2))); SCM_I_MAKINUM (2)));
#include "libguile/numbers.x" #include "libguile/numbers.x"
} }