mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 20:30:28 +02:00
Code Activity

fix a number of assuptions that a long could hold an inum

Browse source 
* libguile/bytevectors.c:
* libguile/goops.c:
* libguile/instructions.c:
* libguile/numbers.c:
* libguile/random.c:
* libguile/read.c:
* libguile/vm-i-scheme.c: Fix a number of assumptions that a long could
  hold an inum. This is not the case on platforms whose void* is larger
  than their long.

* libguile/numbers.c (scm_i_inum2big): New helper, only implemented for
  sizeof(void*) == sizeof(long); produces a compile error on other
  platforms. Basically gmp doesn't have a nice interface for converting
  between mpz values and intmax_t.
This commit is contained in:
Andy Wingo 2010-11-19 11:29:26 +01:00
parent d2aed81f7c
commit e25f37271a
7 changed files with 149 additions and 126 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/bytevectors.c
View file

@ -131,7 +131,7 @@
SCM_VALIDATE_SYMBOL (3, endianness); \ SCM_VALIDATE_SYMBOL (3, endianness); \
\ \
{ \ { \
_sign long c_value; \ scm_t_signed_bits c_value; \
INT_TYPE (_len, _sign) c_value_short; \ INT_TYPE (_len, _sign) c_value_short; \
\ \
if (SCM_UNLIKELY (!SCM_I_INUMP (value))) \ if (SCM_UNLIKELY (!SCM_I_INUMP (value))) \
@ -156,7 +156,7 @@
INTEGER_ACCESSOR_PROLOGUE (_len, _sign); \ INTEGER_ACCESSOR_PROLOGUE (_len, _sign); \
\ \
{ \ { \
_sign long c_value; \ scm_t_signed_bits c_value; \
INT_TYPE (_len, _sign) c_value_short; \ INT_TYPE (_len, _sign) c_value_short; \
\ \
if (SCM_UNLIKELY (!SCM_I_INUMP (value))) \ if (SCM_UNLIKELY (!SCM_I_INUMP (value))) \
@ -735,7 +735,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
if (SCM_LIKELY (SCM_I_INUMP (item))) if (SCM_LIKELY (SCM_I_INUMP (item)))
{ {
long c_item; scm_t_signed_bits c_item;
c_item = SCM_I_INUM (item); c_item = SCM_I_INUM (item);
if (SCM_LIKELY ((c_item >= 0) && (c_item < 256))) if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
@ -951,7 +951,7 @@ bytevector_unsigned_ref (const char *c_bv, size_t c_size, SCM endianness)
#define GENERIC_INTEGER_SET(_sign) \ #define GENERIC_INTEGER_SET(_sign) \
if (c_size < 3) \ if (c_size < 3) \
{ \ { \
_sign int c_value; \ scm_t_signed_bits c_value; \
\ \
if (SCM_UNLIKELY (!SCM_I_INUMP (value))) \ if (SCM_UNLIKELY (!SCM_I_INUMP (value))) \
goto range_error; \ goto range_error; \

7
libguile/goops.c
View file

@ -1167,7 +1167,7 @@ SCM_DEFINE (scm_sys_fast_slot_ref, "%fast-slot-ref", 2, 0, 0,
"Return the slot value with index @var{index} from @var{obj}.") "Return the slot value with index @var{index} from @var{obj}.")
#define FUNC_NAME s_scm_sys_fast_slot_ref #define FUNC_NAME s_scm_sys_fast_slot_ref
{ {
unsigned long int i; scm_t_bits i;
SCM_VALIDATE_INSTANCE (1, obj); SCM_VALIDATE_INSTANCE (1, obj);
i = scm_to_unsigned_integer (index, 0, i = scm_to_unsigned_integer (index, 0,
@ -1184,7 +1184,7 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0,
"@var{value}.") "@var{value}.")
#define FUNC_NAME s_scm_sys_fast_slot_set_x #define FUNC_NAME s_scm_sys_fast_slot_set_x
{ {
unsigned long int i; scm_t_bits i;
SCM_VALIDATE_INSTANCE (1, obj); SCM_VALIDATE_INSTANCE (1, obj);
i = scm_to_unsigned_integer (index, 0, i = scm_to_unsigned_integer (index, 0,
@ -1442,8 +1442,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
#define FUNC_NAME s_scm_sys_allocate_instance #define FUNC_NAME s_scm_sys_allocate_instance
{ {
SCM obj; SCM obj;
long n; scm_t_signed_bits n, i;
long i;
SCM layout; SCM layout;
SCM_VALIDATE_CLASS (1, class); SCM_VALIDATE_CLASS (1, class);

2
libguile/instructions.c
View file

@ -177,7 +177,7 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_opcode_to_instruction #define FUNC_NAME s_scm_opcode_to_instruction
{ {
int opcode; scm_t_signed_bits opcode;
SCM ret = SCM_BOOL_F; SCM ret = SCM_BOOL_F;
SCM_MAKE_VALIDATE (1, op, I_INUMP); SCM_MAKE_VALIDATE (1, op, I_INUMP);

220
libguile/numbers.c
View file

@ -76,6 +76,9 @@
#define M_PI 3.14159265358979323846 #define M_PI 3.14159265358979323846
#endif #endif
typedef scm_t_signed_bits scm_t_inum;
#define scm_from_inum(x) (scm_from_signed_integer (x))
/* /*
@ -193,6 +196,21 @@ scm_i_mkbig ()
return z; return z;
} }
static SCM
scm_i_inum2big (scm_t_inum x)
{
/* Return a newly created bignum initialized to X. */
SCM z = make_bignum ();
#if SIZEOF_VOID_P == SIZEOF_LONG
mpz_init_set_si (SCM_I_BIG_MPZ (z), x);
#else
/* Note that in this case, you'll also have to check all mpz_*_ui and
mpz_*_si invocations in Guile. */
#error creation of mpz not implemented for this inum size
#endif
return z;
}
SCM SCM
scm_i_long2big (long x) scm_i_long2big (long x)
{ {
@ -262,7 +280,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_I_MAKINUM ((long) u); return SCM_I_MAKINUM ((scm_t_inum) u);
else else
return scm_i_dbl2big (u); return scm_i_dbl2big (u);
} }
@ -347,7 +365,7 @@ scm_i_normbig (SCM b)
/* presume b is a bignum */ /* presume b is a bignum */
if (mpz_fits_slong_p (SCM_I_BIG_MPZ (b))) if (mpz_fits_slong_p (SCM_I_BIG_MPZ (b)))
{ {
long val = mpz_get_si (SCM_I_BIG_MPZ (b)); scm_t_inum val = mpz_get_si (SCM_I_BIG_MPZ (b));
if (SCM_FIXABLE (val)) if (SCM_FIXABLE (val))
b = SCM_I_MAKINUM (val); b = SCM_I_MAKINUM (val);
} }
@ -360,7 +378,7 @@ scm_i_mpz2num (mpz_t b)
/* convert a mpz number to a SCM number. */ /* convert a mpz number to a SCM number. */
if (mpz_fits_slong_p (b)) if (mpz_fits_slong_p (b))
{ {
long val = mpz_get_si (b); scm_t_inum val = mpz_get_si (b);
if (SCM_FIXABLE (val)) if (SCM_FIXABLE (val))
return SCM_I_MAKINUM (val); return SCM_I_MAKINUM (val);
} }
@ -409,12 +427,12 @@ scm_i_make_ratio (SCM numerator, SCM denominator)
*/ */
if (SCM_I_INUMP (numerator)) if (SCM_I_INUMP (numerator))
{ {
long x = SCM_I_INUM (numerator); scm_t_inum x = SCM_I_INUM (numerator);
if (scm_is_eq (numerator, SCM_INUM0)) if (scm_is_eq (numerator, SCM_INUM0))
return SCM_INUM0; return SCM_INUM0;
if (SCM_I_INUMP (denominator)) if (SCM_I_INUMP (denominator))
{ {
long y; scm_t_inum y;
y = SCM_I_INUM (denominator); y = SCM_I_INUM (denominator);
if (x == y) if (x == y)
return SCM_I_MAKINUM(1); return SCM_I_MAKINUM(1);
@ -437,7 +455,7 @@ scm_i_make_ratio (SCM numerator, SCM denominator)
{ {
if (SCM_I_INUMP (denominator)) if (SCM_I_INUMP (denominator))
{ {
long yy = SCM_I_INUM (denominator); scm_t_inum yy = SCM_I_INUM (denominator);
if (mpz_divisible_ui_p (SCM_I_BIG_MPZ (numerator), yy)) if (mpz_divisible_ui_p (SCM_I_BIG_MPZ (numerator), yy))
return scm_divide (numerator, denominator); return scm_divide (numerator, denominator);
} }
@ -502,7 +520,7 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0,
{ {
if (SCM_I_INUMP (n)) if (SCM_I_INUMP (n))
{ {
long val = SCM_I_INUM (n); scm_t_inum val = SCM_I_INUM (n);
return scm_from_bool ((val & 1L) != 0); return scm_from_bool ((val & 1L) != 0);
} }
else if (SCM_BIGP (n)) else if (SCM_BIGP (n))
@ -537,7 +555,7 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0,
{ {
if (SCM_I_INUMP (n)) if (SCM_I_INUMP (n))
{ {
long val = SCM_I_INUM (n); scm_t_inum val = SCM_I_INUM (n);
return scm_from_bool ((val & 1L) == 0); return scm_from_bool ((val & 1L) == 0);
} }
else if (SCM_BIGP (n)) else if (SCM_BIGP (n))
@ -682,13 +700,13 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
{ {
if (SCM_I_INUMP (x)) if (SCM_I_INUMP (x))
{ {
long int xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (xx >= 0) if (xx >= 0)
return x; return x;
else if (SCM_POSFIXABLE (-xx)) else if (SCM_POSFIXABLE (-xx))
return SCM_I_MAKINUM (-xx); return SCM_I_MAKINUM (-xx);
else else
return scm_i_long2big (-xx); return scm_i_inum2big (-xx);
} }
else if (SCM_BIGP (x)) else if (SCM_BIGP (x))
{ {
@ -728,19 +746,19 @@ scm_quotient (SCM x, SCM y)
{ {
if (SCM_I_INUMP (x)) if (SCM_I_INUMP (x))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
scm_num_overflow (s_quotient); scm_num_overflow (s_quotient);
else else
{ {
long z = xx / yy; scm_t_inum z = xx / yy;
if (SCM_FIXABLE (z)) if (SCM_FIXABLE (z))
return SCM_I_MAKINUM (z); return SCM_I_MAKINUM (z);
else else
return scm_i_long2big (z); return scm_i_inum2big (z);
} }
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -763,7 +781,7 @@ scm_quotient (SCM x, SCM y)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
scm_num_overflow (s_quotient); scm_num_overflow (s_quotient);
else if (yy == 1) else if (yy == 1)
@ -814,12 +832,12 @@ scm_remainder (SCM x, SCM y)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
scm_num_overflow (s_remainder); scm_num_overflow (s_remainder);
else else
{ {
long z = SCM_I_INUM (x) % yy; scm_t_inum z = SCM_I_INUM (x) % yy;
return SCM_I_MAKINUM (z); return SCM_I_MAKINUM (z);
} }
} }
@ -843,7 +861,7 @@ scm_remainder (SCM x, SCM y)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
scm_num_overflow (s_remainder); scm_num_overflow (s_remainder);
else else
@ -885,10 +903,10 @@ scm_modulo (SCM x, SCM y)
{ {
if (SCM_I_INUMP (x)) if (SCM_I_INUMP (x))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
scm_num_overflow (s_modulo); scm_num_overflow (s_modulo);
else else
@ -896,8 +914,8 @@ scm_modulo (SCM x, SCM y)
/* C99 specifies that "%" is the remainder corresponding to a /* C99 specifies that "%" is the remainder corresponding to a
quotient rounded towards zero, and that's also traditional quotient rounded towards zero, and that's also traditional
for machine division, so z here should be well defined. */ for machine division, so z here should be well defined. */
long z = xx % yy; scm_t_inum z = xx % yy;
long result; scm_t_inum result;
if (yy < 0) if (yy < 0)
{ {
@ -962,7 +980,7 @@ scm_modulo (SCM x, SCM y)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
scm_num_overflow (s_modulo); scm_num_overflow (s_modulo);
else else
@ -1033,19 +1051,19 @@ scm_gcd (SCM x, SCM y)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
long u = xx < 0 ? -xx : xx; scm_t_inum u = xx < 0 ? -xx : xx;
long v = yy < 0 ? -yy : yy; scm_t_inum v = yy < 0 ? -yy : yy;
long result; scm_t_inum result;
if (xx == 0) if (xx == 0)
result = v; result = v;
else if (yy == 0) else if (yy == 0)
result = u; result = u;
else else
{ {
long k = 1; scm_t_inum k = 1;
long t; scm_t_inum t;
/* Determine a common factor 2^k */ /* Determine a common factor 2^k */
while (!(1 & (u | v))) while (!(1 & (u | v)))
{ {
@ -1075,7 +1093,7 @@ scm_gcd (SCM x, SCM y)
} }
return (SCM_POSFIXABLE (result) return (SCM_POSFIXABLE (result)
? SCM_I_MAKINUM (result) ? SCM_I_MAKINUM (result)
: scm_i_long2big (result)); : scm_i_inum2big (result));
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
@ -1089,8 +1107,8 @@ scm_gcd (SCM x, SCM y)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
unsigned long result; scm_t_bits result;
long yy; scm_t_inum yy;
big_inum: big_inum:
yy = SCM_I_INUM (y); yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
@ -1101,7 +1119,7 @@ scm_gcd (SCM x, SCM y)
scm_remember_upto_here_1 (x); scm_remember_upto_here_1 (x);
return (SCM_POSFIXABLE (result) return (SCM_POSFIXABLE (result)
? SCM_I_MAKINUM (result) ? SCM_I_MAKINUM (result)
: scm_from_ulong (result)); : scm_from_unsigned_integer (result));
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
@ -1168,7 +1186,7 @@ scm_lcm (SCM n1, SCM n2)
inumbig: inumbig:
{ {
SCM result = scm_i_mkbig (); SCM result = scm_i_mkbig ();
long nn1 = SCM_I_INUM (n1); scm_t_inum nn1 = SCM_I_INUM (n1);
if (nn1 == 0) return SCM_INUM0; if (nn1 == 0) return SCM_INUM0;
if (nn1 < 0) nn1 = - nn1; if (nn1 < 0) nn1 = - nn1;
mpz_lcm_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n2), nn1); mpz_lcm_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n2), nn1);
@ -1258,7 +1276,7 @@ SCM_DEFINE (scm_i_logand, "logand", 0, 2, 1,
SCM scm_logand (SCM n1, SCM n2) SCM scm_logand (SCM n1, SCM n2)
#define FUNC_NAME s_scm_logand #define FUNC_NAME s_scm_logand
{ {
long int nn1; scm_t_inum nn1;
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2))
{ {
@ -1277,7 +1295,7 @@ SCM scm_logand (SCM n1, SCM n2)
nn1 = SCM_I_INUM (n1); nn1 = SCM_I_INUM (n1);
if (SCM_I_INUMP (n2)) if (SCM_I_INUMP (n2))
{ {
long nn2 = SCM_I_INUM (n2); scm_t_inum nn2 = SCM_I_INUM (n2);
return SCM_I_MAKINUM (nn1 & nn2); return SCM_I_MAKINUM (nn1 & nn2);
} }
else if SCM_BIGP (n2) else if SCM_BIGP (n2)
@ -1348,7 +1366,7 @@ SCM_DEFINE (scm_i_logior, "logior", 0, 2, 1,
SCM scm_logior (SCM n1, SCM n2) SCM scm_logior (SCM n1, SCM n2)
#define FUNC_NAME s_scm_logior #define FUNC_NAME s_scm_logior
{ {
long int nn1; scm_t_inum nn1;
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2))
{ {
@ -1438,7 +1456,7 @@ SCM_DEFINE (scm_i_logxor, "logxor", 0, 2, 1,
SCM scm_logxor (SCM n1, SCM n2) SCM scm_logxor (SCM n1, SCM n2)
#define FUNC_NAME s_scm_logxor #define FUNC_NAME s_scm_logxor
{ {
long int nn1; scm_t_inum nn1;
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2))
{ {
@ -1455,7 +1473,7 @@ SCM scm_logxor (SCM n1, SCM n2)
nn1 = SCM_I_INUM (n1); nn1 = SCM_I_INUM (n1);
if (SCM_I_INUMP (n2)) if (SCM_I_INUMP (n2))
{ {
long nn2 = SCM_I_INUM (n2); scm_t_inum nn2 = SCM_I_INUM (n2);
return SCM_I_MAKINUM (nn1 ^ nn2); return SCM_I_MAKINUM (nn1 ^ nn2);
} }
else if (SCM_BIGP (n2)) else if (SCM_BIGP (n2))
@ -1513,14 +1531,14 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_logtest #define FUNC_NAME s_scm_logtest
{ {
long int nj; scm_t_inum nj;
if (SCM_I_INUMP (j)) if (SCM_I_INUMP (j))
{ {
nj = SCM_I_INUM (j); nj = SCM_I_INUM (j);
if (SCM_I_INUMP (k)) if (SCM_I_INUMP (k))
{ {
long nk = SCM_I_INUM (k); scm_t_inum nk = SCM_I_INUM (k);
return scm_from_bool (nj & nk); return scm_from_bool (nj & nk);
} }
else if (SCM_BIGP (k)) else if (SCM_BIGP (k))
@ -1774,7 +1792,7 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_integer_expt #define FUNC_NAME s_scm_integer_expt
{ {
long i2 = 0; scm_t_inum 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_I_MAKINUM (1L); SCM acc = SCM_I_MAKINUM (1L);
@ -1871,7 +1889,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
if (SCM_I_INUMP (n)) if (SCM_I_INUMP (n))
{ {
long nn = SCM_I_INUM (n); scm_t_inum nn = SCM_I_INUM (n);
if (bits_to_shift > 0) if (bits_to_shift > 0)
{ {
@ -1886,7 +1904,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
return n; return n;
if (bits_to_shift < SCM_I_FIXNUM_BIT-1 if (bits_to_shift < SCM_I_FIXNUM_BIT-1
&& ((unsigned long) && ((scm_t_bits)
(SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1) (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
<= 1)) <= 1))
{ {
@ -1894,7 +1912,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
} }
else else
{ {
SCM result = scm_i_long2big (nn); SCM result = scm_i_inum2big (nn);
mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result),
bits_to_shift); bits_to_shift);
return result; return result;
@ -1967,7 +1985,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
if (SCM_I_INUMP (n)) if (SCM_I_INUMP (n))
{ {
long int in = SCM_I_INUM (n); scm_t_inum in = SCM_I_INUM (n);
/* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to /* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to
SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in". */ SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in". */
@ -1979,7 +1997,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
* special case requires us to produce a result that has * special case requires us to produce a result that has
* more bits than can be stored in a fixnum. * more bits than can be stored in a fixnum.
*/ */
SCM result = scm_i_long2big (in); SCM result = scm_i_inum2big (in);
mpz_fdiv_r_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), mpz_fdiv_r_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result),
bits); bits);
return result; return result;
@ -2038,8 +2056,8 @@ SCM_DEFINE (scm_logcount, "logcount", 1, 0, 0,
{ {
if (SCM_I_INUMP (n)) if (SCM_I_INUMP (n))
{ {
unsigned long int c = 0; unsigned long c = 0;
long int nn = SCM_I_INUM (n); scm_t_inum nn = SCM_I_INUM (n);
if (nn < 0) if (nn < 0)
nn = -1 - nn; nn = -1 - nn;
while (nn) while (nn)
@ -2086,9 +2104,9 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1, 0, 0,
{ {
if (SCM_I_INUMP (n)) if (SCM_I_INUMP (n))
{ {
unsigned long int c = 0; unsigned long c = 0;
unsigned int l = 4; unsigned int l = 4;
long int nn = SCM_I_INUM (n); scm_t_inum nn = SCM_I_INUM (n);
if (nn < 0) if (nn < 0)
nn = -1 - nn; nn = -1 - nn;
while (nn) while (nn)
@ -3353,10 +3371,10 @@ scm_num_eq_p (SCM x, SCM y)
again: again:
if (SCM_I_INUMP (x)) if (SCM_I_INUMP (x))
{ {
long xx = SCM_I_INUM (x); scm_t_signed_bits xx = SCM_I_INUM (x);
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_signed_bits yy = SCM_I_INUM (y);
return scm_from_bool (xx == yy); return scm_from_bool (xx == yy);
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -3375,13 +3393,13 @@ scm_num_eq_p (SCM x, SCM y)
An alternative (for any size system actually) would be to check An alternative (for any size system actually) would be to check
yy is an integer (with floor) and is in range of an inum yy is an integer (with floor) and is in range of an inum
(compare against appropriate powers of 2) then test (compare against appropriate powers of 2) then test
xx==(long)yy. It's just a matter of which casts/comparisons xx==(scm_t_signed_bits)yy. It's just a matter of which
might be fastest or easiest for the cpu. */ casts/comparisons might be fastest or easiest for the cpu. */
double yy = SCM_REAL_VALUE (y); double yy = SCM_REAL_VALUE (y);
return scm_from_bool ((double) xx == yy return scm_from_bool ((double) xx == yy
&& (DBL_MANT_DIG >= SCM_I_FIXNUM_BIT-1 && (DBL_MANT_DIG >= SCM_I_FIXNUM_BIT-1
|| xx == (long) yy)); || xx == (scm_t_signed_bits) yy));
} }
else if (SCM_COMPLEXP (y)) else if (SCM_COMPLEXP (y))
return scm_from_bool (((double) xx == SCM_COMPLEX_REAL (y)) return scm_from_bool (((double) xx == SCM_COMPLEX_REAL (y))
@ -3432,10 +3450,10 @@ scm_num_eq_p (SCM x, SCM y)
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
/* see comments with inum/real above */ /* see comments with inum/real above */
long yy = SCM_I_INUM (y); scm_t_signed_bits yy = SCM_I_INUM (y);
return scm_from_bool (xx == (double) yy return scm_from_bool (xx == (double) yy
&& (DBL_MANT_DIG >= SCM_I_FIXNUM_BIT-1 && (DBL_MANT_DIG >= SCM_I_FIXNUM_BIT-1
|| (long) xx == yy)); || (scm_t_signed_bits) xx == yy));
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
@ -3573,10 +3591,10 @@ scm_less_p (SCM x, SCM y)
again: again:
if (SCM_I_INUMP (x)) if (SCM_I_INUMP (x))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
return scm_from_bool (xx < yy); return scm_from_bool (xx < yy);
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -3907,10 +3925,10 @@ scm_max (SCM x, SCM y)
if (SCM_I_INUMP (x)) if (SCM_I_INUMP (x))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
return (xx < yy) ? y : x; return (xx < yy) ? y : x;
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -4053,10 +4071,10 @@ scm_min (SCM x, SCM y)
if (SCM_I_INUMP (x)) if (SCM_I_INUMP (x))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
return (xx < yy) ? x : y; return (xx < yy) ? x : y;
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -4199,10 +4217,10 @@ scm_sum (SCM x, SCM y)
{ {
if (SCM_LIKELY (SCM_I_INUMP (y))) if (SCM_LIKELY (SCM_I_INUMP (y)))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
long int z = xx + yy; scm_t_inum z = xx + yy;
return SCM_FIXABLE (z) ? SCM_I_MAKINUM (z) : scm_i_long2big (z); return SCM_FIXABLE (z) ? SCM_I_MAKINUM (z) : scm_i_inum2big (z);
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
@ -4211,12 +4229,12 @@ scm_sum (SCM x, SCM y)
} }
else if (SCM_REALP (y)) else if (SCM_REALP (y))
{ {
long int xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
return scm_from_double (xx + SCM_REAL_VALUE (y)); return scm_from_double (xx + SCM_REAL_VALUE (y));
} }
else if (SCM_COMPLEXP (y)) else if (SCM_COMPLEXP (y))
{ {
long int xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
return scm_c_make_rectangular (xx + SCM_COMPLEX_REAL (y), return scm_c_make_rectangular (xx + SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (y)); SCM_COMPLEX_IMAG (y));
} }
@ -4230,7 +4248,7 @@ scm_sum (SCM x, SCM y)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long int inum; scm_t_inum inum;
int bigsgn; int bigsgn;
add_big_inum: add_big_inum:
inum = SCM_I_INUM (y); inum = SCM_I_INUM (y);
@ -4404,11 +4422,11 @@ scm_difference (SCM x, SCM y)
else else
if (SCM_I_INUMP (x)) if (SCM_I_INUMP (x))
{ {
long xx = -SCM_I_INUM (x); scm_t_inum xx = -SCM_I_INUM (x);
if (SCM_FIXABLE (xx)) if (SCM_FIXABLE (xx))
return SCM_I_MAKINUM (xx); return SCM_I_MAKINUM (xx);
else else
return scm_i_long2big (xx); return scm_i_inum2big (xx);
} }
else if (SCM_BIGP (x)) else if (SCM_BIGP (x))
/* Must scm_i_normbig here because -SCM_MOST_NEGATIVE_FIXNUM is a /* Must scm_i_normbig here because -SCM_MOST_NEGATIVE_FIXNUM is a
@ -4430,18 +4448,18 @@ scm_difference (SCM x, SCM y)
{ {
if (SCM_LIKELY (SCM_I_INUMP (y))) if (SCM_LIKELY (SCM_I_INUMP (y)))
{ {
long int xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
long int yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
long int z = xx - yy; scm_t_inum z = xx - yy;
if (SCM_FIXABLE (z)) if (SCM_FIXABLE (z))
return SCM_I_MAKINUM (z); return SCM_I_MAKINUM (z);
else else
return scm_i_long2big (z); return scm_i_inum2big (z);
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
/* inum-x - big-y */ /* inum-x - big-y */
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (xx == 0) if (xx == 0)
return scm_i_clonebig (y, 0); return scm_i_clonebig (y, 0);
@ -4469,12 +4487,12 @@ scm_difference (SCM x, SCM y)
} }
else if (SCM_REALP (y)) else if (SCM_REALP (y))
{ {
long int xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
return scm_from_double (xx - SCM_REAL_VALUE (y)); return scm_from_double (xx - SCM_REAL_VALUE (y));
} }
else if (SCM_COMPLEXP (y)) else if (SCM_COMPLEXP (y))
{ {
long int xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
return scm_c_make_rectangular (xx - SCM_COMPLEX_REAL (y), return scm_c_make_rectangular (xx - SCM_COMPLEX_REAL (y),
- SCM_COMPLEX_IMAG (y)); - SCM_COMPLEX_IMAG (y));
} }
@ -4491,13 +4509,13 @@ scm_difference (SCM x, SCM y)
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
/* big-x - inum-y */ /* big-x - inum-y */
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
int sgn_x = mpz_sgn (SCM_I_BIG_MPZ (x)); int sgn_x = mpz_sgn (SCM_I_BIG_MPZ (x));
scm_remember_upto_here_1 (x); scm_remember_upto_here_1 (x);
if (sgn_x == 0) if (sgn_x == 0)
return (SCM_FIXABLE (-yy) ? return (SCM_FIXABLE (-yy) ?
SCM_I_MAKINUM (-yy) : scm_from_long (-yy)); SCM_I_MAKINUM (-yy) : scm_from_inum (-yy));
else else
{ {
SCM result = scm_i_mkbig (); SCM result = scm_i_mkbig ();
@ -4667,7 +4685,7 @@ scm_product (SCM x, SCM y)
if (SCM_LIKELY (SCM_I_INUMP (x))) if (SCM_LIKELY (SCM_I_INUMP (x)))
{ {
long xx; scm_t_inum xx;
intbig: intbig:
xx = SCM_I_INUM (x); xx = SCM_I_INUM (x);
@ -4680,14 +4698,14 @@ scm_product (SCM x, SCM y)
if (SCM_LIKELY (SCM_I_INUMP (y))) if (SCM_LIKELY (SCM_I_INUMP (y)))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
long kk = xx * yy; scm_t_inum kk = xx * yy;
SCM k = SCM_I_MAKINUM (kk); SCM k = SCM_I_MAKINUM (kk);
if ((kk == SCM_I_INUM (k)) && (kk / xx == yy)) if ((kk == SCM_I_INUM (k)) && (kk / xx == yy))
return k; return k;
else else
{ {
SCM result = scm_i_long2big (xx); SCM result = scm_i_inum2big (xx);
mpz_mul_si (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), yy); mpz_mul_si (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), yy);
return scm_i_normbig (result); return scm_i_normbig (result);
} }
@ -4899,7 +4917,7 @@ do_divide (SCM x, SCM y, int inexact)
SCM_WTA_DISPATCH_0 (g_divide, s_divide); SCM_WTA_DISPATCH_0 (g_divide, s_divide);
else if (SCM_I_INUMP (x)) else if (SCM_I_INUMP (x))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (xx == 1 || xx == -1) if (xx == 1 || xx == -1)
return x; return x;
#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO
@ -4955,10 +4973,10 @@ do_divide (SCM x, SCM y, int inexact)
if (SCM_LIKELY (SCM_I_INUMP (x))) if (SCM_LIKELY (SCM_I_INUMP (x)))
{ {
long xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
if (SCM_LIKELY (SCM_I_INUMP (y))) if (SCM_LIKELY (SCM_I_INUMP (y)))
{ {
long yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
{ {
#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO
@ -4975,11 +4993,11 @@ do_divide (SCM x, SCM y, int inexact)
} }
else else
{ {
long z = xx / yy; scm_t_inum z = xx / yy;
if (SCM_FIXABLE (z)) if (SCM_FIXABLE (z))
return SCM_I_MAKINUM (z); return SCM_I_MAKINUM (z);
else else
return scm_i_long2big (z); return scm_i_inum2big (z);
} }
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
@ -5030,7 +5048,7 @@ do_divide (SCM x, SCM y, int inexact)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long int yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
if (yy == 0) if (yy == 0)
{ {
#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO
@ -5053,7 +5071,7 @@ do_divide (SCM x, SCM y, int inexact)
middle ground: test, then if divisible, use the faster div middle ground: test, then if divisible, use the faster div
func. */ func. */
long abs_yy = yy < 0 ? -yy : yy; scm_t_inum abs_yy = yy < 0 ? -yy : yy;
int divisible_p = mpz_divisible_ui_p (SCM_I_BIG_MPZ (x), abs_yy); int divisible_p = mpz_divisible_ui_p (SCM_I_BIG_MPZ (x), abs_yy);
if (divisible_p) if (divisible_p)
@ -5144,7 +5162,7 @@ do_divide (SCM x, SCM y, int inexact)
double rx = SCM_REAL_VALUE (x); double rx = SCM_REAL_VALUE (x);
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long int yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO
if (yy == 0) if (yy == 0)
scm_num_overflow (s_divide); scm_num_overflow (s_divide);
@ -5184,7 +5202,7 @@ do_divide (SCM x, SCM y, int inexact)
double ix = SCM_COMPLEX_IMAG (x); double ix = SCM_COMPLEX_IMAG (x);
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long int yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO
if (yy == 0) if (yy == 0)
scm_num_overflow (s_divide); scm_num_overflow (s_divide);
@ -5240,7 +5258,7 @@ do_divide (SCM x, SCM y, int inexact)
{ {
if (SCM_I_INUMP (y)) if (SCM_I_INUMP (y))
{ {
long int yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);
#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO
if (yy == 0) if (yy == 0)
scm_num_overflow (s_divide); scm_num_overflow (s_divide);
@ -5881,13 +5899,13 @@ scm_magnitude (SCM z)
{ {
if (SCM_I_INUMP (z)) if (SCM_I_INUMP (z))
{ {
long int zz = SCM_I_INUM (z); scm_t_inum zz = SCM_I_INUM (z);
if (zz >= 0) if (zz >= 0)
return z; return z;
else if (SCM_POSFIXABLE (-zz)) else if (SCM_POSFIXABLE (-zz))
return SCM_I_MAKINUM (-zz); return SCM_I_MAKINUM (-zz);
else else
return scm_i_long2big (-zz); return scm_i_inum2big (-zz);
} }
else if (SCM_BIGP (z)) else if (SCM_BIGP (z))
{ {
@ -6355,7 +6373,7 @@ scm_from_double (double val)
#if SCM_ENABLE_DEPRECATED == 1 #if SCM_ENABLE_DEPRECATED == 1
float float
scm_num2float (SCM num, unsigned long int pos, const char *s_caller) scm_num2float (SCM num, unsigned long pos, const char *s_caller)
{ {
scm_c_issue_deprecation_warning scm_c_issue_deprecation_warning
("`scm_num2float' is deprecated. Use scm_to_double instead."); ("`scm_num2float' is deprecated. Use scm_to_double instead.");
@ -6373,7 +6391,7 @@ scm_num2float (SCM num, unsigned long int pos, const char *s_caller)
} }
double double
scm_num2double (SCM num, unsigned long int pos, const char *s_caller) scm_num2double (SCM num, unsigned long pos, const char *s_caller)
{ {
scm_c_issue_deprecation_warning scm_c_issue_deprecation_warning
("`scm_num2double' is deprecated. Use scm_to_double instead."); ("`scm_num2double' is deprecated. Use scm_to_double instead.");

8
libguile/random.c
View file

@ -392,16 +392,16 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
SCM_VALIDATE_RSTATE (2, state); SCM_VALIDATE_RSTATE (2, state);
if (SCM_I_INUMP (n)) if (SCM_I_INUMP (n))
{ {
unsigned long m = (unsigned long) SCM_I_INUM (n); scm_t_bits m = (scm_t_bits) SCM_I_INUM (n);
SCM_ASSERT_RANGE (1, n, SCM_I_INUM (n) > 0); SCM_ASSERT_RANGE (1, n, SCM_I_INUM (n) > 0);
#if SCM_SIZEOF_UNSIGNED_LONG <= 4 #if SCM_SIZEOF_UINTPTR_T <= 4
return scm_from_uint32 (scm_c_random (SCM_RSTATE (state), return scm_from_uint32 (scm_c_random (SCM_RSTATE (state),
(scm_t_uint32) m)); (scm_t_uint32) m));
#elif SCM_SIZEOF_UNSIGNED_LONG <= 8 #elif SCM_SIZEOF_UINTPTR_T <= 8
return scm_from_uint64 (scm_c_random64 (SCM_RSTATE (state), return scm_from_uint64 (scm_c_random64 (SCM_RSTATE (state),
(scm_t_uint64) m)); (scm_t_uint64) m));
#else #else
#error "Cannot deal with this platform's unsigned long size" #error "Cannot deal with this platform's scm_t_bits size"
#endif #endif
} }
SCM_VALIDATE_NIM (1, n); SCM_VALIDATE_NIM (1, n);

4
libguile/read.c
View file

@ -965,7 +965,7 @@ scm_read_character (scm_t_wchar chr, SCM port)
SCM p = scm_string_to_number (charname, scm_from_uint (8)); SCM p = scm_string_to_number (charname, scm_from_uint (8));
if (SCM_I_INUMP (p)) if (SCM_I_INUMP (p))
{ {
scm_t_wchar c = SCM_I_INUM (p); scm_t_wchar c = scm_to_uint32 (p);
if (SCM_IS_UNICODE_CHAR (c)) if (SCM_IS_UNICODE_CHAR (c))
return SCM_MAKE_CHAR (c); return SCM_MAKE_CHAR (c);
else else
@ -984,7 +984,7 @@ scm_read_character (scm_t_wchar chr, SCM port)
scm_from_uint (16)); scm_from_uint (16));
if (SCM_I_INUMP (p)) if (SCM_I_INUMP (p))
{ {
scm_t_wchar c = SCM_I_INUM (p); scm_t_wchar c = scm_to_uint32 (p);
if (SCM_IS_UNICODE_CHAR (c)) if (SCM_IS_UNICODE_CHAR (c))
return SCM_MAKE_CHAR (c); return SCM_MAKE_CHAR (c);
else else

26
libguile/vm-i-scheme.c
View file

@ -399,13 +399,13 @@ VM_DEFINE_FUNCTION (159, ash, "ash", 2)
else else
/* Left shift. See comments in scm_ash. */ /* Left shift. See comments in scm_ash. */
{ {
long nn, bits_to_shift; scm_t_signed_bits nn, bits_to_shift;
nn = SCM_I_INUM (x); nn = SCM_I_INUM (x);
bits_to_shift = SCM_I_INUM (y); bits_to_shift = SCM_I_INUM (y);
if (bits_to_shift < SCM_I_FIXNUM_BIT-1 if (bits_to_shift < SCM_I_FIXNUM_BIT-1
&& ((unsigned long) && ((scm_t_bits)
(SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1) (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
<= 1)) <= 1))
RETURN (SCM_I_MAKINUM (nn << bits_to_shift)); RETURN (SCM_I_MAKINUM (nn << bits_to_shift));
@ -451,7 +451,7 @@ VM_DEFINE_FUNCTION (162, logxor, "logxor", 2)
VM_DEFINE_FUNCTION (163, vector_ref, "vector-ref", 2) VM_DEFINE_FUNCTION (163, vector_ref, "vector-ref", 2)
{ {
long i = 0; scm_t_signed_bits i = 0;
ARGS2 (vect, idx); ARGS2 (vect, idx);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect) if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
&& SCM_I_INUMP (idx) && SCM_I_INUMP (idx)
@ -467,7 +467,7 @@ VM_DEFINE_FUNCTION (163, vector_ref, "vector-ref", 2)
VM_DEFINE_INSTRUCTION (164, vector_set, "vector-set", 0, 3, 0) VM_DEFINE_INSTRUCTION (164, vector_set, "vector-set", 0, 3, 0)
{ {
long i = 0; scm_t_signed_bits i = 0;
SCM vect, idx, val; SCM vect, idx, val;
POP (val); POP (idx); POP (vect); POP (val); POP (idx); POP (vect);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect) if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
@ -570,6 +570,9 @@ VM_DEFINE_FUNCTION (169, struct_ref, "struct-ref", 2)
SCM vtable; SCM vtable;
scm_t_bits index, len; scm_t_bits index, len;
/* True, an inum is a signed value, but cast to unsigned it will
certainly be more than the length, so we will fall through if
index is negative. */
index = SCM_I_INUM (pos); index = SCM_I_INUM (pos);
vtable = SCM_STRUCT_VTABLE (obj); vtable = SCM_STRUCT_VTABLE (obj);
len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size); len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
@ -599,6 +602,7 @@ VM_DEFINE_FUNCTION (170, struct_set, "struct-set", 3)
SCM vtable; SCM vtable;
scm_t_bits index, len; scm_t_bits index, len;
/* See above regarding index being >= 0. */
index = SCM_I_INUM (pos); index = SCM_I_INUM (pos);
vtable = SCM_STRUCT_VTABLE (obj); vtable = SCM_STRUCT_VTABLE (obj);
len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size); len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
@ -627,6 +631,7 @@ VM_DEFINE_FUNCTION (171, class_of, "class-of", 1)
RETURN (scm_class_of (obj)); RETURN (scm_class_of (obj));
} }
/* FIXME: No checking whatsoever. */
VM_DEFINE_FUNCTION (172, slot_ref, "slot-ref", 2) VM_DEFINE_FUNCTION (172, slot_ref, "slot-ref", 2)
{ {
size_t slot; size_t slot;
@ -635,6 +640,7 @@ VM_DEFINE_FUNCTION (172, slot_ref, "slot-ref", 2)
RETURN (SCM_PACK (SCM_STRUCT_DATA (instance) [slot])); RETURN (SCM_PACK (SCM_STRUCT_DATA (instance) [slot]));
} }
/* FIXME: No checking whatsoever. */
VM_DEFINE_INSTRUCTION (173, slot_set, "slot-set", 0, 3, 0) VM_DEFINE_INSTRUCTION (173, slot_set, "slot-set", 0, 3, 0)
{ {
SCM instance, idx, val; SCM instance, idx, val;
@ -701,7 +707,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \ #define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
{ \ { \
long i; \ scm_t_signed_bits i; \
const scm_t_ ## type *int_ptr; \ const scm_t_ ## type *int_ptr; \
ARGS2 (bv, idx); \ ARGS2 (bv, idx); \
\ \
@ -723,7 +729,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
#define BV_INT_REF(stem, type, size) \ #define BV_INT_REF(stem, type, size) \
{ \ { \
long i; \ scm_t_signed_bits i; \
const scm_t_ ## type *int_ptr; \ const scm_t_ ## type *int_ptr; \
ARGS2 (bv, idx); \ ARGS2 (bv, idx); \
\ \
@ -754,7 +760,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
#define BV_FLOAT_REF(stem, fn_stem, type, size) \ #define BV_FLOAT_REF(stem, fn_stem, type, size) \
{ \ { \
long i; \ scm_t_signed_bits i; \
const type *float_ptr; \ const type *float_ptr; \
ARGS2 (bv, idx); \ ARGS2 (bv, idx); \
\ \
@ -841,7 +847,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
#define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \ #define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
{ \ { \
long i, j = 0; \ scm_t_signed_bits i, j = 0; \
SCM bv, idx, val; \ SCM bv, idx, val; \
scm_t_ ## type *int_ptr; \ scm_t_ ## type *int_ptr; \
\ \
@ -865,7 +871,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
#define BV_INT_SET(stem, type, size) \ #define BV_INT_SET(stem, type, size) \
{ \ { \
long i = 0; \ scm_t_signed_bits i = 0; \
SCM bv, idx, val; \ SCM bv, idx, val; \
scm_t_ ## type *int_ptr; \ scm_t_ ## type *int_ptr; \
\ \
@ -886,7 +892,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
#define BV_FLOAT_SET(stem, fn_stem, type, size) \ #define BV_FLOAT_SET(stem, fn_stem, type, size) \
{ \ { \
long i = 0; \ scm_t_signed_bits i = 0; \
SCM bv, idx, val; \ SCM bv, idx, val; \
type *float_ptr; \ type *float_ptr; \
\ \