diff --git a/configure.ac b/configure.ac index b3879df1f..9196d247b 100644 --- a/configure.ac +++ b/configure.ac @@ -693,6 +693,12 @@ AC_ARG_ENABLE(mini-gmp, if test "x$enable_mini_gmp" = xyes || test "x$enable_mini_gmp" = xy; then SCM_I_GSC_ENABLE_MINI_GMP=1 else + case $host in + x86_64-*-mingw*) + AC_MSG_ERROR([mini-gmp is required; use --enable-mini-gmp]) + ;; + *) ;; + esac AC_LIB_HAVE_LINKFLAGS([gmp],[],[#include ], [mpz_import (0,0,0,0,0,0,0);]) if test "x$HAVE_LIBGMP" != "xyes"; then AC_MSG_ERROR([GNU MP 4.1 or greater not found; either install it, or pass '--enable-mini-gmp' to use included less-optimal arbitrary-precision integer support.]) diff --git a/libguile/array-map.c b/libguile/array-map.c index ce0f7ba09..5695b6bc7 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -576,14 +576,14 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, static int array_compare (scm_t_array_handle *hx, scm_t_array_handle *hy, - size_t dim, unsigned long posx, unsigned long posy) + size_t dim, uintptr_t posx, uintptr_t posy) { if (dim == scm_array_handle_rank (hx)) return scm_is_true (scm_equal_p (scm_array_handle_ref (hx, posx), scm_array_handle_ref (hy, posy))); else { - long incx, incy; + intptr_t incx, incy; size_t i; if (hx->dims[dim].lbnd != hy->dims[dim].lbnd diff --git a/libguile/arrays.c b/libguile/arrays.c index 924ee0094..9fd810f26 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -240,11 +240,11 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, for (k = 0; k < ndim; k++) { - long ind; + intptr_t ind; if (!scm_is_pair (args)) SCM_WRONG_NUM_ARGS (); - ind = scm_to_long (SCM_CAR (args)); + ind = scm_to_intptr_t (SCM_CAR (args)); args = SCM_CDR (args); if (ind < s[k].lbnd || ind > s[k].ubnd) @@ -377,14 +377,14 @@ SCM_DEFINE (scm_i_array_set_x, "array-set!", 2, 2, 1, static SCM -array_to_list (scm_t_array_handle *h, size_t dim, unsigned long pos) +array_to_list (scm_t_array_handle *h, size_t dim, uintptr_t pos) { if (dim == scm_array_handle_rank (h)) return scm_array_handle_ref (h, pos); else { SCM res = SCM_EOL; - long inc; + intptr_t inc; size_t i; i = h->dims[dim].ubnd - h->dims[dim].lbnd + 1; @@ -620,7 +620,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, SCM imap; size_t k; ssize_t i; - long old_base, old_min, new_min, old_max, new_max; + ssize_t old_base, old_min, new_min, old_max, new_max; scm_t_array_dim *s; SCM_VALIDATE_REST_ARGUMENT (dims); @@ -1023,8 +1023,8 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, return SCM_BOOL_F; if (scm_is_bitvector (SCM_I_ARRAY_V (ra)) && (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) || - SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT || - len % SCM_LONG_BIT)) + SCM_I_ARRAY_BASE (ra) % SCM_INTPTR_T_BIT || + len % SCM_INTPTR_T_BIT)) return SCM_BOOL_F; } diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index bbc23f449..58e398b61 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -75,8 +75,13 @@ #define is_unsigned_int8(_x) ((_x) <= 255UL) #define is_signed_int16(_x) (((_x) >= -32768L) && ((_x) <= 32767L)) #define is_unsigned_int16(_x) ((_x) <= 65535UL) +#if !(__MINGW32__ && __x86_64__) #define is_signed_int32(_x) (((_x) >= -2147483648L) && ((_x) <= 2147483647L)) #define is_unsigned_int32(_x) ((_x) <= 4294967295UL) +#else /* (__MINGW32__ && __x86_64__) */ +#define is_signed_int32(_x) (((_x) >= -2147483648LL) && ((_x) <= 2147483647LL)) +#define is_unsigned_int32(_x) ((_x) <= 4294967295ULL) +#endif /* (__MINGW32__ && __x86_64__) */ #define SIGNEDNESS_signed 1 #define SIGNEDNESS_unsigned 0 @@ -825,14 +830,14 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0, static inline void twos_complement (mpz_t value, size_t size) { - unsigned long bit_count; + uintptr_t bit_count; - /* We expect BIT_COUNT to fit in a unsigned long thanks to the range + /* We expect BIT_COUNT to fit in a uintptr_t thanks to the range checking on SIZE performed earlier. */ - bit_count = (unsigned long) size << 3UL; + bit_count = (uintptr_t) size << 3ULL; - if (SCM_LIKELY (bit_count < sizeof (unsigned long))) - mpz_ui_sub (value, 1UL << bit_count, value); + if (SCM_LIKELY (bit_count < sizeof (uintptr_t))) + mpz_ui_sub (value, 1ULL << bit_count, value); else { mpz_t max; diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 0df946482..8a7f43b6f 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -823,7 +823,7 @@ scm_i_normbig (SCM b) /* presume b is a bignum */ if (mpz_fits_slong_p (SCM_I_BIG_MPZ (b))) { - scm_t_inum val = mpz_get_si (SCM_I_BIG_MPZ (b)); + intptr_t val = mpz_get_si (SCM_I_BIG_MPZ (b)); if (SCM_FIXABLE (val)) b = SCM_I_MAKINUM (val); } diff --git a/libguile/hash.c b/libguile/hash.c index c192ac2e5..af5772892 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -112,31 +112,31 @@ extern double floor(); the hash on a 64-bit system are equal to the hash on a 32-bit \ system. The low 32 bits just add more entropy. */ \ if (sizeof (ret) == 8) \ - ret = (((unsigned long) c) << 32) | b; \ + ret = (((uintptr_t) c) << 32) | b; \ else \ ret = c; \ } while (0) -static unsigned long +static uintptr_t narrow_string_hash (const uint8_t *str, size_t len) { - unsigned long ret; + uintptr_t ret; JENKINS_LOOKUP3_HASHWORD2 (str, len, ret); ret >>= 2; /* Ensure that it fits in a fixnum. */ return ret; } -static unsigned long +static uintptr_t wide_string_hash (const scm_t_wchar *str, size_t len) { - unsigned long ret; + uintptr_t ret; JENKINS_LOOKUP3_HASHWORD2 (str, len, ret); ret >>= 2; /* Ensure that it fits in a fixnum. */ return ret; } -unsigned long +uintptr_t scm_i_string_hash (SCM str) { size_t len = scm_i_string_length (str); @@ -148,13 +148,13 @@ scm_i_string_hash (SCM str) return wide_string_hash (scm_i_string_wide_chars (str), len); } -unsigned long +uintptr_t scm_i_locale_string_hash (const char *str, size_t len) { return scm_i_string_hash (scm_from_locale_stringn (str, len)); } -unsigned long +uintptr_t scm_i_latin1_string_hash (const char *str, size_t len) { if (len == (size_t) -1) @@ -164,11 +164,11 @@ scm_i_latin1_string_hash (const char *str, size_t len) } /* A tricky optimization, but probably worth it. */ -unsigned long +uintptr_t scm_i_utf8_string_hash (const char *str, size_t len) { const uint8_t *end, *ustr = (const uint8_t *) str; - unsigned long ret; + uintptr_t ret; /* The length of the string in characters. This name corresponds to Jenkins' original name. */ @@ -219,8 +219,8 @@ scm_i_utf8_string_hash (const char *str, size_t len) final (a, b, c); - if (sizeof (unsigned long) == 8) - ret = (((unsigned long) c) << 32) | b; + if (sizeof (uintptr_t) == 8) + ret = (((uintptr_t) c) << 32) | b; else ret = c; @@ -228,16 +228,16 @@ scm_i_utf8_string_hash (const char *str, size_t len) return ret; } -static unsigned long scm_raw_ihashq (scm_t_bits key); -static unsigned long scm_raw_ihash (SCM obj, size_t depth); +static uintptr_t scm_raw_ihashq (scm_t_bits key); +static uintptr_t scm_raw_ihash (SCM obj, size_t depth); /* Return the hash of struct OBJ. Traverse OBJ's fields to compute the result, unless DEPTH is zero. Assumes that OBJ is a struct. */ -static unsigned long +static uintptr_t scm_i_struct_hash (SCM obj, size_t depth) { size_t struct_size, field_num; - unsigned long hash; + uintptr_t hash; struct_size = SCM_STRUCT_SIZE (obj); @@ -257,7 +257,7 @@ scm_i_struct_hash (SCM obj, size_t depth) /* Thomas Wang's integer hasher, from http://www.cris.com/~Ttwang/tech/inthash.htm. */ -static unsigned long +static uintptr_t scm_raw_ihashq (scm_t_bits key) { if (sizeof (key) < 8) @@ -283,7 +283,7 @@ scm_raw_ihashq (scm_t_bits key) } /* `depth' is used to limit recursion. */ -static unsigned long +static uintptr_t scm_raw_ihash (SCM obj, size_t depth) { if (SCM_IMP (obj)) @@ -318,7 +318,7 @@ scm_raw_ihash (SCM obj, size_t depth) { size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj); size_t i = depth / 2; - unsigned long h = scm_raw_ihashq (SCM_CELL_WORD_0 (obj)); + uintptr_t h = scm_raw_ihashq (SCM_CELL_WORD_0 (obj)); if (len) while (i--) h ^= scm_raw_ihash (scm_c_vector_ref (obj, h % len), i); @@ -326,7 +326,7 @@ scm_raw_ihash (SCM obj, size_t depth) } case scm_tc7_syntax: { - unsigned long h; + uintptr_t h; h = scm_raw_ihash (scm_syntax_expression (obj), depth); h ^= scm_raw_ihash (scm_syntax_wrap (obj), depth); h ^= scm_raw_ihash (scm_syntax_module (obj), depth); @@ -386,7 +386,7 @@ SCM_DEFINE (scm_hashq, "hashq", 2, 0, 0, "different values, since @code{foo} will be garbage collected.") #define FUNC_NAME s_scm_hashq { - unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX); + uintptr_t sz = scm_to_unsigned_integer (size, 1, UINTPTR_MAX); return scm_from_ulong (scm_ihashq (key, sz)); } #undef FUNC_NAME @@ -419,7 +419,7 @@ SCM_DEFINE (scm_hashv, "hashv", 2, 0, 0, "different values, since @code{foo} will be garbage collected.") #define FUNC_NAME s_scm_hashv { - unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX); + uintptr_t sz = scm_to_unsigned_integer (size, 1, UINTPTR_MAX); return scm_from_ulong (scm_ihashv (key, sz)); } #undef FUNC_NAME @@ -442,7 +442,7 @@ SCM_DEFINE (scm_hash, "hash", 2, 0, 0, "integer in the range 0 to @var{size} - 1.") #define FUNC_NAME s_scm_hash { - unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX); + uintptr_t sz = scm_to_unsigned_integer (size, 1, UINTPTR_MAX); return scm_from_ulong (scm_ihash (key, sz)); } #undef FUNC_NAME diff --git a/libguile/hash.h b/libguile/hash.h index 0e82b4afc..985d5360f 100644 --- a/libguile/hash.h +++ b/libguile/hash.h @@ -23,17 +23,15 @@ #include "libguile/scm.h" +#include "libguile/numbers.h" -SCM_INTERNAL unsigned long scm_i_locale_string_hash (const char *str, - size_t len); -SCM_INTERNAL unsigned long scm_i_latin1_string_hash (const char *str, - size_t len); -SCM_INTERNAL unsigned long scm_i_utf8_string_hash (const char *str, - size_t len); +SCM_INTERNAL uintptr_t scm_i_locale_string_hash (const char *str, size_t len); +SCM_INTERNAL uintptr_t scm_i_latin1_string_hash (const char *str, size_t len); +SCM_INTERNAL uintptr_t scm_i_utf8_string_hash (const char *str, size_t len); -SCM_INTERNAL unsigned long scm_i_string_hash (SCM str); +SCM_INTERNAL uintptr_t scm_i_string_hash (SCM str); SCM_API unsigned long scm_ihashq (SCM obj, unsigned long n); SCM_API SCM scm_hashq (SCM obj, SCM n); SCM_API unsigned long scm_ihashv (SCM obj, unsigned long n); diff --git a/libguile/integers.c b/libguile/integers.c index cc62d1c78..dca15d5d3 100644 --- a/libguile/integers.c +++ b/libguile/integers.c @@ -42,6 +42,12 @@ verify (SCM_MOST_POSITIVE_FIXNUM <= (mp_limb_t) -1); #define NLIMBS_MAX (SSIZE_MAX / sizeof(mp_limb_t)) +#if !(__MINGW32__ && __x86_64__) +#define L1 1L +#else /* (__MINGW32__ && __x86_64__) */ +#define L1 1LL +#endif /* (__MINGW32__ && __x86_64__) */ + #ifndef NDEBUG #define ASSERT(x) \ do { \ @@ -102,17 +108,17 @@ bignum_limbs (struct scm_bignum *z) return z->u.z.limbs; } -static inline unsigned long -long_magnitude (long l) +static inline uintptr_t +intptr_t_magnitude (intptr_t l) { - unsigned long mag = l; + uintptr_t mag = l; return l < 0 ? ~mag + 1 : mag; } -static inline long -negative_long (unsigned long mag) +static inline intptr_t +negative_intptr_t (uintptr_t mag) { - ASSERT (mag <= (unsigned long) LONG_MIN); + ASSERT (mag <= (uintptr_t) INTPTR_MIN); return ~mag + 1; } @@ -133,7 +139,7 @@ int64_magnitude (int64_t i) } static inline scm_t_bits -inum_magnitude (scm_t_inum i) +inum_magnitude (intptr_t i) { scm_t_bits mag = i; if (i < 0) @@ -223,7 +229,7 @@ make_bignum_2 (int is_negative, mp_limb_t lo, mp_limb_t hi) static struct scm_bignum * make_bignum_from_uint64 (uint64_t val) { -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 if (val > UINT32_MAX) return make_bignum_2 (0, val, val >> 32); #endif @@ -239,18 +245,18 @@ make_bignum_from_int64 (int64_t val) } static struct scm_bignum * -ulong_to_bignum (unsigned long u) +uintptr_t_to_bignum (uintptr_t u) { return u == 0 ? make_bignum_0 () : make_bignum_1 (0, u); }; static struct scm_bignum * -long_to_bignum (long i) +intptr_t_to_bignum (intptr_t i) { if (i > 0) - return ulong_to_bignum (i); + return uintptr_t_to_bignum (i); - return i == 0 ? make_bignum_0 () : make_bignum_1 (1, long_magnitude (i)); + return i == 0 ? make_bignum_0 () : make_bignum_1 (1, intptr_t_magnitude (i)); }; static inline SCM @@ -260,19 +266,19 @@ scm_from_bignum (struct scm_bignum *x) } static SCM -long_to_scm (long i) +intptr_t_to_scm (intptr_t i) { if (SCM_FIXABLE (i)) return SCM_I_MAKINUM (i); - return scm_from_bignum (long_to_bignum (i)); + return scm_from_bignum (intptr_t_to_bignum (i)); } static SCM -ulong_to_scm (unsigned long i) +uintptr_t_to_scm (uintptr_t i) { if (SCM_POSFIXABLE (i)) return SCM_I_MAKINUM (i); - return scm_from_bignum (ulong_to_bignum (i)); + return scm_from_bignum (uintptr_t_to_bignum (i)); } static struct scm_bignum * @@ -309,7 +315,7 @@ normalize_bignum (struct scm_bignum *z) { case -1: if (bignum_limbs (z)[0] <= inum_magnitude (SCM_MOST_NEGATIVE_FIXNUM)) - return SCM_I_MAKINUM (negative_long (bignum_limbs (z)[0])); + return SCM_I_MAKINUM (negative_intptr_t (bignum_limbs (z)[0])); break; case 0: return SCM_INUM0; @@ -328,7 +334,7 @@ take_mpz (mpz_ptr mpz) { SCM ret; if (mpz_fits_slong_p (mpz)) - ret = long_to_scm (mpz_get_si (mpz)); + ret = intptr_t_to_scm (mpz_get_si (mpz)); else ret = scm_from_bignum (make_bignum_from_mpz (mpz)); mpz_clear (mpz); @@ -336,7 +342,7 @@ take_mpz (mpz_ptr mpz) } static int -long_sign (long l) +intptr_t_sign (intptr_t l) { if (l < 0) return -1; if (l == 0) return 0; @@ -366,7 +372,7 @@ bignum_to_int64 (struct scm_bignum *z, int64_t *val) { switch (bignum_size (z)) { -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 case -2: { uint64_t mag = bignum_limbs (z)[0]; @@ -381,7 +387,7 @@ bignum_to_int64 (struct scm_bignum *z, int64_t *val) return 1; case 1: return positive_uint64_to_int64 (bignum_limbs (z)[0], val); -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 case 2: { uint64_t mag = bignum_limbs (z)[0]; @@ -405,7 +411,7 @@ bignum_to_uint64 (struct scm_bignum *z, uint64_t *val) case 1: *val = bignum_limbs (z)[0]; return 1; -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 case 2: { uint64_t mag = bignum_limbs (z)[0]; @@ -419,13 +425,13 @@ bignum_to_uint64 (struct scm_bignum *z, uint64_t *val) } } -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 static int negative_uint32_to_int32 (uint32_t magnitude, int32_t *val) { - if (magnitude > long_magnitude (INT32_MIN)) + if (magnitude > intptr_t_magnitude (INT32_MIN)) return 0; - *val = negative_long (magnitude); + *val = negative_intptr_t (magnitude); return 1; } @@ -473,22 +479,22 @@ bignum_to_uint32 (struct scm_bignum *z, uint32_t *val) #endif static int -bignum_cmp_long (struct scm_bignum *z, long l) +bignum_cmp_intptr_t (struct scm_bignum *z, intptr_t l) { switch (bignum_size (z)) { case -1: if (l >= 0) return -1; - return long_sign (long_magnitude (l) - bignum_limbs (z)[0]); + return intptr_t_sign (intptr_t_magnitude (l) - bignum_limbs (z)[0]); case 0: - return long_sign (l); + return intptr_t_sign (l); case 1: if (l <= 0) return 1; - return long_sign (bignum_limbs (z)[0] - (unsigned long) l); + return intptr_t_sign (bignum_limbs (z)[0] - (uintptr_t) l); default: - return long_sign (bignum_size (z)); + return intptr_t_sign (bignum_size (z)); } } @@ -499,7 +505,7 @@ scm_integer_from_mpz (const mpz_t mpz) } int -scm_is_integer_odd_i (scm_t_inum i) +scm_is_integer_odd_i (intptr_t i) { return i & 1; } @@ -511,12 +517,12 @@ scm_is_integer_odd_z (struct scm_bignum *z) } SCM -scm_integer_abs_i (scm_t_inum i) +scm_integer_abs_i (intptr_t i) { if (i >= 0) return SCM_I_MAKINUM (i); - return ulong_to_scm (long_magnitude (i)); + return uintptr_t_to_scm (intptr_t_magnitude (i)); } SCM @@ -529,7 +535,7 @@ scm_integer_abs_z (struct scm_bignum *z) } SCM -scm_integer_floor_quotient_ii (scm_t_inum x, scm_t_inum y) +scm_integer_floor_quotient_ii (intptr_t x, intptr_t y) { if (y > 0) { @@ -540,12 +546,12 @@ scm_integer_floor_quotient_ii (scm_t_inum x, scm_t_inum y) scm_num_overflow ("floor-quotient"); else if (x > 0) x = x - y - 1; - scm_t_inum q = x / y; - return long_to_scm (q); + intptr_t q = x / y; + return intptr_t_to_scm (q); } SCM -scm_integer_floor_quotient_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_floor_quotient_iz (intptr_t x, struct scm_bignum *y) { if (x == 0 || ((x < 0) == bignum_is_negative (y))) return SCM_INUM0; @@ -553,7 +559,7 @@ scm_integer_floor_quotient_iz (scm_t_inum x, struct scm_bignum *y) } SCM -scm_integer_floor_quotient_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_floor_quotient_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("floor-quotient"); @@ -587,11 +593,11 @@ scm_integer_floor_quotient_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_floor_remainder_ii (scm_t_inum x, scm_t_inum y) +scm_integer_floor_remainder_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("floor-remainder"); - scm_t_inum r = x % y; + intptr_t r = x % y; int needs_adjustment = (y > 0) ? (r < 0) : (r > 0); if (needs_adjustment) r += y; @@ -599,7 +605,7 @@ scm_integer_floor_remainder_ii (scm_t_inum x, scm_t_inum y) } SCM -scm_integer_floor_remainder_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_floor_remainder_iz (intptr_t x, struct scm_bignum *y) { if (bignum_is_positive (y)) { @@ -629,13 +635,13 @@ scm_integer_floor_remainder_iz (scm_t_inum x, struct scm_bignum *y) } SCM -scm_integer_floor_remainder_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_floor_remainder_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("floor-remainder"); else { - scm_t_inum r; + intptr_t r; mpz_t zx; alias_bignum_to_mpz (x, zx); if (y > 0) @@ -660,13 +666,13 @@ scm_integer_floor_remainder_zz (struct scm_bignum *x, struct scm_bignum *y) } void -scm_integer_floor_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_floor_divide_ii (intptr_t x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("floor-divide"); - scm_t_inum q = x / y; - scm_t_inum r = x % y; + intptr_t q = x / y; + intptr_t r = x % y; int needs_adjustment = (y > 0) ? (r < 0) : (r > 0); if (needs_adjustment) @@ -675,12 +681,12 @@ scm_integer_floor_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) q--; } - *qp = long_to_scm (q); + *qp = intptr_t_to_scm (q); *rp = SCM_I_MAKINUM (r); } void -scm_integer_floor_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *rp) +scm_integer_floor_divide_iz (intptr_t x, struct scm_bignum *y, SCM *qp, SCM *rp) { if (bignum_is_positive (y)) { @@ -718,7 +724,7 @@ scm_integer_floor_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *r } void -scm_integer_floor_divide_zi (struct scm_bignum *x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_floor_divide_zi (struct scm_bignum *x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("floor-divide"); @@ -754,7 +760,7 @@ scm_integer_floor_divide_zz (struct scm_bignum *x, struct scm_bignum *y, SCM *qp } SCM -scm_integer_ceiling_quotient_ii (scm_t_inum x, scm_t_inum y) +scm_integer_ceiling_quotient_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("ceiling-quotient"); @@ -766,20 +772,20 @@ scm_integer_ceiling_quotient_ii (scm_t_inum x, scm_t_inum y) } else if (x < 0) x = x + y + 1; - scm_t_inum q = x / y; + intptr_t q = x / y; - return long_to_scm (q); + return intptr_t_to_scm (q); } SCM -scm_integer_ceiling_quotient_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_ceiling_quotient_iz (intptr_t x, struct scm_bignum *y) { if (bignum_is_positive (y)) { if (x > 0) return SCM_INUM1; else if (x == SCM_MOST_NEGATIVE_FIXNUM && - bignum_cmp_long (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) + bignum_cmp_intptr_t (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) { /* Special case: x == fixnum-min && y == abs (fixnum-min) */ scm_remember_upto_here_1 (y); @@ -795,7 +801,7 @@ scm_integer_ceiling_quotient_iz (scm_t_inum x, struct scm_bignum *y) } SCM -scm_integer_ceiling_quotient_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_ceiling_quotient_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("ceiling-quotient"); @@ -831,12 +837,12 @@ scm_integer_ceiling_quotient_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_ceiling_remainder_ii (scm_t_inum x, scm_t_inum y) +scm_integer_ceiling_remainder_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("ceiling-remainder"); - scm_t_inum r = x % y; + intptr_t r = x % y; int needs_adjustment = (y > 0) ? (r > 0) : (r < 0); if (needs_adjustment) r -= y; @@ -845,7 +851,7 @@ scm_integer_ceiling_remainder_ii (scm_t_inum x, scm_t_inum y) } SCM -scm_integer_ceiling_remainder_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_ceiling_remainder_iz (intptr_t x, struct scm_bignum *y) { if (bignum_is_positive (y)) { @@ -860,7 +866,7 @@ scm_integer_ceiling_remainder_iz (scm_t_inum x, struct scm_bignum *y) return take_mpz (r); } else if (x == SCM_MOST_NEGATIVE_FIXNUM && - bignum_cmp_long (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) + bignum_cmp_intptr_t (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) { /* Special case: x == fixnum-min && y == abs (fixnum-min) */ scm_remember_upto_here_1 (y); @@ -884,7 +890,7 @@ scm_integer_ceiling_remainder_iz (scm_t_inum x, struct scm_bignum *y) } SCM -scm_integer_ceiling_remainder_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_ceiling_remainder_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("ceiling-remainder"); @@ -892,7 +898,7 @@ scm_integer_ceiling_remainder_zi (struct scm_bignum *x, scm_t_inum y) { mpz_t zx; alias_bignum_to_mpz (x, zx); - scm_t_inum r; + intptr_t r; if (y > 0) r = -mpz_cdiv_ui (zx, y); else @@ -915,14 +921,14 @@ scm_integer_ceiling_remainder_zz (struct scm_bignum *x, struct scm_bignum *y) } void -scm_integer_ceiling_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_ceiling_divide_ii (intptr_t x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("ceiling-divide"); else { - scm_t_inum q = x / y; - scm_t_inum r = x % y; + intptr_t q = x / y; + intptr_t r = x % y; int needs_adjustment; if (y > 0) @@ -935,13 +941,13 @@ scm_integer_ceiling_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) r -= y; q++; } - *qp = long_to_scm (q); + *qp = intptr_t_to_scm (q); *rp = SCM_I_MAKINUM (r); } } void -scm_integer_ceiling_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *rp) +scm_integer_ceiling_divide_iz (intptr_t x, struct scm_bignum *y, SCM *qp, SCM *rp) { if (bignum_is_positive (y)) { @@ -957,7 +963,7 @@ scm_integer_ceiling_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *rp = take_mpz (r); } else if (x == SCM_MOST_NEGATIVE_FIXNUM && - bignum_cmp_long (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) + bignum_cmp_intptr_t (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) { /* Special case: x == fixnum-min && y == abs (fixnum-min) */ scm_remember_upto_here_1 (y); @@ -989,7 +995,7 @@ scm_integer_ceiling_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM } void -scm_integer_ceiling_divide_zi (struct scm_bignum *x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_ceiling_divide_zi (struct scm_bignum *x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("ceiling-divide"); @@ -1027,22 +1033,22 @@ scm_integer_ceiling_divide_zz (struct scm_bignum *x, struct scm_bignum *y, SCM * } SCM -scm_integer_truncate_quotient_ii (scm_t_inum x, scm_t_inum y) +scm_integer_truncate_quotient_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("truncate-quotient"); else { - scm_t_inum q = x / y; - return long_to_scm (q); + intptr_t q = x / y; + return intptr_t_to_scm (q); } } SCM -scm_integer_truncate_quotient_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_truncate_quotient_iz (intptr_t x, struct scm_bignum *y) { if (x == SCM_MOST_NEGATIVE_FIXNUM && - bignum_cmp_long (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) + bignum_cmp_intptr_t (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) { /* Special case: x == fixnum-min && y == abs (fixnum-min) */ scm_remember_upto_here_1 (y); @@ -1053,7 +1059,7 @@ scm_integer_truncate_quotient_iz (scm_t_inum x, struct scm_bignum *y) } SCM -scm_integer_truncate_quotient_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_truncate_quotient_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("truncate-quotient"); @@ -1089,22 +1095,22 @@ scm_integer_truncate_quotient_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_truncate_remainder_ii (scm_t_inum x, scm_t_inum y) +scm_integer_truncate_remainder_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("truncate-remainder"); else { - scm_t_inum q = x % y; - return long_to_scm (q); + intptr_t q = x % y; + return intptr_t_to_scm (q); } } SCM -scm_integer_truncate_remainder_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_truncate_remainder_iz (intptr_t x, struct scm_bignum *y) { if (x == SCM_MOST_NEGATIVE_FIXNUM && - bignum_cmp_long (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) + bignum_cmp_intptr_t (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) { /* Special case: x == fixnum-min && y == abs (fixnum-min) */ scm_remember_upto_here_1 (y); @@ -1115,7 +1121,7 @@ scm_integer_truncate_remainder_iz (scm_t_inum x, struct scm_bignum *y) } SCM -scm_integer_truncate_remainder_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_truncate_remainder_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("truncate-remainder"); @@ -1123,7 +1129,7 @@ scm_integer_truncate_remainder_zi (struct scm_bignum *x, scm_t_inum y) { mpz_t zx; alias_bignum_to_mpz (x, zx); - scm_t_inum r = mpz_tdiv_ui (zx, (y > 0) ? y : -y) * mpz_sgn (zx); + intptr_t r = mpz_tdiv_ui (zx, (y > 0) ? y : -y) * mpz_sgn (zx); scm_remember_upto_here_1 (x); return SCM_I_MAKINUM (r); } @@ -1142,24 +1148,24 @@ scm_integer_truncate_remainder_zz (struct scm_bignum *x, struct scm_bignum *y) } void -scm_integer_truncate_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_truncate_divide_ii (intptr_t x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("truncate-divide"); else { - scm_t_inum q = x / y; - scm_t_inum r = x % y; - *qp = long_to_scm (q); + intptr_t q = x / y; + intptr_t r = x % y; + *qp = intptr_t_to_scm (q); *rp = SCM_I_MAKINUM (r); } } void -scm_integer_truncate_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *rp) +scm_integer_truncate_divide_iz (intptr_t x, struct scm_bignum *y, SCM *qp, SCM *rp) { if (x == SCM_MOST_NEGATIVE_FIXNUM && - bignum_cmp_long (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) + bignum_cmp_intptr_t (y, -SCM_MOST_NEGATIVE_FIXNUM) == 0) { /* Special case: x == fixnum-min && y == abs (fixnum-min) */ scm_remember_upto_here_1 (y); @@ -1174,7 +1180,7 @@ scm_integer_truncate_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM } void -scm_integer_truncate_divide_zi (struct scm_bignum *x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_truncate_divide_zi (struct scm_bignum *x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("truncate-divide"); @@ -1183,7 +1189,7 @@ scm_integer_truncate_divide_zi (struct scm_bignum *x, scm_t_inum y, SCM *qp, SCM mpz_t q, zx; mpz_init (q); alias_bignum_to_mpz (x, zx); - scm_t_inum r; + intptr_t r; if (y > 0) r = mpz_tdiv_q_ui (q, zx, y); else @@ -1251,13 +1257,13 @@ integer_centered_quotient_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_centered_quotient_ii (scm_t_inum x, scm_t_inum y) +scm_integer_centered_quotient_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("centered-quotient"); - scm_t_inum q = x / y; - scm_t_inum r = x % y; + intptr_t q = x / y; + intptr_t r = x % y; if (x > 0) { if (y > 0) @@ -1284,18 +1290,18 @@ scm_integer_centered_quotient_ii (scm_t_inum x, scm_t_inum y) q++; } } - return long_to_scm (q); + return intptr_t_to_scm (q); } SCM -scm_integer_centered_quotient_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_centered_quotient_iz (intptr_t x, struct scm_bignum *y) { - return integer_centered_quotient_zz (long_to_bignum (x), + return integer_centered_quotient_zz (intptr_t_to_bignum (x), y); } SCM -scm_integer_centered_quotient_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_centered_quotient_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("centered-quotient"); @@ -1306,7 +1312,7 @@ scm_integer_centered_quotient_zi (struct scm_bignum *x, scm_t_inum y) mpz_t q, zx; mpz_init (q); alias_bignum_to_mpz (x, zx); - scm_t_inum r; + intptr_t r; /* Arrange for r to initially be non-positive, because that simplifies the test to see if it is within the needed bounds. */ @@ -1371,12 +1377,12 @@ integer_centered_remainder_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_centered_remainder_ii (scm_t_inum x, scm_t_inum y) +scm_integer_centered_remainder_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("centered-remainder"); - scm_t_inum r = x % y; + intptr_t r = x % y; if (x > 0) { if (y > 0) @@ -1407,14 +1413,14 @@ scm_integer_centered_remainder_ii (scm_t_inum x, scm_t_inum y) } SCM -scm_integer_centered_remainder_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_centered_remainder_iz (intptr_t x, struct scm_bignum *y) { - return integer_centered_remainder_zz (long_to_bignum (x), + return integer_centered_remainder_zz (intptr_t_to_bignum (x), y); } SCM -scm_integer_centered_remainder_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_centered_remainder_zi (struct scm_bignum *x, intptr_t y) { mpz_t zx; alias_bignum_to_mpz (x, zx); @@ -1422,7 +1428,7 @@ scm_integer_centered_remainder_zi (struct scm_bignum *x, scm_t_inum y) if (y == 0) scm_num_overflow ("centered-remainder"); - scm_t_inum r; + intptr_t r; /* Arrange for r to initially be non-positive, because that simplifies the test to see if it is within the needed bounds. */ if (y > 0) @@ -1492,13 +1498,13 @@ integer_centered_divide_zz (struct scm_bignum *x, struct scm_bignum *y, } void -scm_integer_centered_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_centered_divide_ii (intptr_t x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("centered-divide"); - scm_t_inum q = x / y; - scm_t_inum r = x % y; + intptr_t q = x / y; + intptr_t r = x % y; if (x > 0) { if (y > 0) @@ -1525,18 +1531,18 @@ scm_integer_centered_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) { q++; r -= y; } } } - *qp = long_to_scm (q); + *qp = intptr_t_to_scm (q); *rp = SCM_I_MAKINUM (r); } void -scm_integer_centered_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *rp) +scm_integer_centered_divide_iz (intptr_t x, struct scm_bignum *y, SCM *qp, SCM *rp) { - integer_centered_divide_zz (long_to_bignum (x), y, qp, rp); + integer_centered_divide_zz (intptr_t_to_bignum (x), y, qp, rp); } void -scm_integer_centered_divide_zi (struct scm_bignum *x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_centered_divide_zi (struct scm_bignum *x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("centered-divide"); @@ -1544,7 +1550,7 @@ scm_integer_centered_divide_zi (struct scm_bignum *x, scm_t_inum y, SCM *qp, SCM mpz_t q, zx; mpz_init (q); alias_bignum_to_mpz (x, zx); - scm_t_inum r; + intptr_t r; /* Arrange for r to initially be non-positive, because that simplifies the test to see if it is within the needed bounds. */ @@ -1613,15 +1619,15 @@ integer_round_quotient_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_round_quotient_ii (scm_t_inum x, scm_t_inum y) +scm_integer_round_quotient_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("round-quotient"); - scm_t_inum q = x / y; - scm_t_inum r = x % y; - scm_t_inum ay = y; - scm_t_inum r2 = 2 * r; + intptr_t q = x / y; + intptr_t r = x % y; + intptr_t ay = y; + intptr_t r2 = 2 * r; if (y < 0) { @@ -1629,7 +1635,7 @@ scm_integer_round_quotient_ii (scm_t_inum x, scm_t_inum y) r2 = -r2; } - if (q & 1L) + if (q & L1) { if (r2 >= ay) q++; @@ -1643,17 +1649,17 @@ scm_integer_round_quotient_ii (scm_t_inum x, scm_t_inum y) else if (r2 < -ay) q--; } - return long_to_scm (q); + return intptr_t_to_scm (q); } SCM -scm_integer_round_quotient_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_round_quotient_iz (intptr_t x, struct scm_bignum *y) { - return integer_round_quotient_zz (long_to_bignum (x), y); + return integer_round_quotient_zz (intptr_t_to_bignum (x), y); } SCM -scm_integer_round_quotient_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_round_quotient_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("round-quotient"); @@ -1663,7 +1669,7 @@ scm_integer_round_quotient_zi (struct scm_bignum *x, scm_t_inum y) mpz_t q, zx; mpz_init (q); alias_bignum_to_mpz (x, zx); - scm_t_inum r; + intptr_t r; int needs_adjustment; if (y > 0) @@ -1752,15 +1758,15 @@ integer_round_remainder_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_round_remainder_ii (scm_t_inum x, scm_t_inum y) +scm_integer_round_remainder_ii (intptr_t x, intptr_t y) { if (y == 0) scm_num_overflow ("round-remainder"); - scm_t_inum q = x / y; - scm_t_inum r = x % y; - scm_t_inum ay = y; - scm_t_inum r2 = 2 * r; + intptr_t q = x / y; + intptr_t r = x % y; + intptr_t ay = y; + intptr_t r2 = 2 * r; if (y < 0) { @@ -1768,7 +1774,7 @@ scm_integer_round_remainder_ii (scm_t_inum x, scm_t_inum y) r2 = -r2; } - if (q & 1L) + if (q & L1) { if (r2 >= ay) r -= y; @@ -1787,19 +1793,19 @@ scm_integer_round_remainder_ii (scm_t_inum x, scm_t_inum y) } SCM -scm_integer_round_remainder_iz (scm_t_inum x, struct scm_bignum *y) +scm_integer_round_remainder_iz (intptr_t x, struct scm_bignum *y) { - return integer_round_remainder_zz (long_to_bignum (x), y); + return integer_round_remainder_zz (intptr_t_to_bignum (x), y); } SCM -scm_integer_round_remainder_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_round_remainder_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) scm_num_overflow ("round-remainder"); mpz_t q, zx; - scm_t_inum r; + intptr_t r; int needs_adjustment; mpz_init (q); @@ -1872,15 +1878,15 @@ integer_round_divide_zz (struct scm_bignum *x, struct scm_bignum *y, } void -scm_integer_round_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_round_divide_ii (intptr_t x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("round-divide"); - scm_t_inum q = x / y; - scm_t_inum r = x % y; - scm_t_inum ay = y; - scm_t_inum r2 = 2 * r; + intptr_t q = x / y; + intptr_t r = x % y; + intptr_t ay = y; + intptr_t r2 = 2 * r; if (y < 0) { @@ -1888,7 +1894,7 @@ scm_integer_round_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) r2 = -r2; } - if (q & 1L) + if (q & L1) { if (r2 >= ay) { q++; r -= y; } @@ -1902,18 +1908,18 @@ scm_integer_round_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp) else if (r2 < -ay) { q--; r += y; } } - *qp = long_to_scm (q); + *qp = intptr_t_to_scm (q); *rp = SCM_I_MAKINUM (r); } void -scm_integer_round_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *rp) +scm_integer_round_divide_iz (intptr_t x, struct scm_bignum *y, SCM *qp, SCM *rp) { - integer_round_divide_zz (long_to_bignum (x), y, qp, rp); + integer_round_divide_zz (intptr_t_to_bignum (x), y, qp, rp); } void -scm_integer_round_divide_zi (struct scm_bignum *x, scm_t_inum y, SCM *qp, SCM *rp) +scm_integer_round_divide_zi (struct scm_bignum *x, intptr_t y, SCM *qp, SCM *rp) { if (y == 0) scm_num_overflow ("round-divide"); @@ -1921,7 +1927,7 @@ scm_integer_round_divide_zi (struct scm_bignum *x, scm_t_inum y, SCM *qp, SCM *r mpz_t q, zx; mpz_init (q); alias_bignum_to_mpz (x, zx); - scm_t_inum r; + intptr_t r; int needs_adjustment; if (y > 0) @@ -1958,11 +1964,11 @@ scm_integer_round_divide_zz (struct scm_bignum *x, struct scm_bignum *y, SCM *qp } SCM -scm_integer_gcd_ii (scm_t_inum x, scm_t_inum y) +scm_integer_gcd_ii (intptr_t x, intptr_t y) { - scm_t_inum u = x < 0 ? -x : x; - scm_t_inum v = y < 0 ? -y : y; - scm_t_inum result; + intptr_t u = x < 0 ? -x : x; + intptr_t v = y < 0 ? -y : y; + intptr_t result; if (x == 0) result = v; else if (y == 0) @@ -2004,11 +2010,11 @@ scm_integer_gcd_ii (scm_t_inum x, scm_t_inum y) } result = u << k; } - return ulong_to_scm (result); + return uintptr_t_to_scm (result); } SCM -scm_integer_gcd_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_gcd_zi (struct scm_bignum *x, intptr_t y) { scm_t_bits result; if (y == 0) @@ -2019,7 +2025,7 @@ scm_integer_gcd_zi (struct scm_bignum *x, scm_t_inum y) alias_bignum_to_mpz (x, zx); result = mpz_gcd_ui (NULL, zx, y); scm_remember_upto_here_1 (x); - return ulong_to_scm (result); + return uintptr_t_to_scm (result); } SCM @@ -2035,7 +2041,7 @@ scm_integer_gcd_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y) +scm_integer_lcm_ii (intptr_t x, intptr_t y) { SCM d = scm_integer_gcd_ii (x, y); if (scm_is_eq (d, SCM_INUM0)) @@ -2046,7 +2052,7 @@ scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y) } SCM -scm_integer_lcm_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_lcm_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) return SCM_INUM0; if (y < 0) y = - y; @@ -2108,13 +2114,13 @@ scm_integer_lcm_zz (struct scm_bignum *x, struct scm_bignum *y) */ SCM -scm_integer_logand_ii (scm_t_inum x, scm_t_inum y) +scm_integer_logand_ii (intptr_t x, intptr_t y) { return SCM_I_MAKINUM (x & y); } SCM -scm_integer_logand_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_logand_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) return SCM_INUM0; @@ -2154,13 +2160,13 @@ scm_integer_logand_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_logior_ii (scm_t_inum x, scm_t_inum y) +scm_integer_logior_ii (intptr_t x, intptr_t y) { return SCM_I_MAKINUM (x | y); } SCM -scm_integer_logior_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_logior_zi (struct scm_bignum *x, intptr_t y) { if (y == 0) return scm_from_bignum (x); @@ -2188,13 +2194,13 @@ scm_integer_logior_zz (struct scm_bignum *x, struct scm_bignum *y) } SCM -scm_integer_logxor_ii (scm_t_inum x, scm_t_inum y) +scm_integer_logxor_ii (intptr_t x, intptr_t y) { return SCM_I_MAKINUM (x ^ y); } SCM -scm_integer_logxor_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_logxor_zi (struct scm_bignum *x, intptr_t y) { mpz_t result, zx, zy; mpz_init (result); @@ -2219,13 +2225,13 @@ scm_integer_logxor_zz (struct scm_bignum *x, struct scm_bignum *y) } int -scm_integer_logtest_ii (scm_t_inum x, scm_t_inum y) +scm_integer_logtest_ii (intptr_t x, intptr_t y) { return (x & y) ? 1 : 0; } int -scm_integer_logtest_zi (struct scm_bignum *x, scm_t_inum y) +scm_integer_logtest_zi (struct scm_bignum *x, intptr_t y) { return scm_is_eq (scm_integer_logand_zi (x, y), SCM_INUM0); } @@ -2237,9 +2243,9 @@ scm_integer_logtest_zz (struct scm_bignum *x, struct scm_bignum *y) } int -scm_integer_logbit_ui (unsigned long index, scm_t_inum n) +scm_integer_logbit_ui (uintptr_t index, intptr_t n) { - if (index < SCM_LONG_BIT) + if (index < SCM_INTPTR_T_BIT) /* Assume two's complement representation. */ return (n >> index) & 1; else @@ -2247,7 +2253,7 @@ scm_integer_logbit_ui (unsigned long index, scm_t_inum n) } int -scm_integer_logbit_uz (unsigned long index, struct scm_bignum *n) +scm_integer_logbit_uz (uintptr_t index, struct scm_bignum *n) { mpz_t zn; alias_bignum_to_mpz (n, zn); @@ -2257,7 +2263,7 @@ scm_integer_logbit_uz (unsigned long index, struct scm_bignum *n) } SCM -scm_integer_lognot_i (scm_t_inum n) +scm_integer_lognot_i (intptr_t n) { return SCM_I_MAKINUM (~n); } @@ -2274,7 +2280,7 @@ scm_integer_lognot_z (struct scm_bignum *n) } SCM -scm_integer_expt_ii (scm_t_inum n, scm_t_inum k) +scm_integer_expt_ii (intptr_t n, intptr_t k) { ASSERT (k >= 0); if (k == 0) @@ -2286,7 +2292,7 @@ scm_integer_expt_ii (scm_t_inum n, scm_t_inum k) if (n == 2) { if (k < SCM_I_FIXNUM_BIT - 1) - return SCM_I_MAKINUM (1L << k); + return SCM_I_MAKINUM (L1 << k); if (k < 64) return scm_integer_from_uint64 (((uint64_t) 1) << k); size_t nlimbs = k / (sizeof (mp_limb_t)*8) + 1; @@ -2307,7 +2313,7 @@ scm_integer_expt_ii (scm_t_inum n, scm_t_inum k) } SCM -scm_integer_expt_zi (struct scm_bignum *n, scm_t_inum k) +scm_integer_expt_zi (struct scm_bignum *n, intptr_t k) { ASSERT (k >= 0); mpz_t res, zn; @@ -2378,7 +2384,7 @@ scm_integer_modulo_expt_nnn (SCM n, SCM k, SCM m) /* Efficiently compute (N * 2^COUNT), where N is an exact integer, and COUNT > 0. */ SCM -scm_integer_lsh_iu (scm_t_inum n, unsigned long count) +scm_integer_lsh_iu (intptr_t n, uintptr_t count) { ASSERT (count > 0); /* Left shift of count >= SCM_I_FIXNUM_BIT-1 will almost[*] always @@ -2406,7 +2412,7 @@ scm_integer_lsh_iu (scm_t_inum n, unsigned long count) } SCM -scm_integer_lsh_zu (struct scm_bignum *n, unsigned long count) +scm_integer_lsh_zu (struct scm_bignum *n, uintptr_t count) { ASSERT (count > 0); mpz_t result, zn; @@ -2420,7 +2426,7 @@ scm_integer_lsh_zu (struct scm_bignum *n, unsigned long count) /* Efficiently compute floor (N / 2^COUNT), where N is an exact integer and COUNT > 0. */ SCM -scm_integer_floor_rsh_iu (scm_t_inum n, unsigned long count) +scm_integer_floor_rsh_iu (intptr_t n, uintptr_t count) { ASSERT (count > 0); if (count >= SCM_I_FIXNUM_BIT) @@ -2430,7 +2436,7 @@ scm_integer_floor_rsh_iu (scm_t_inum n, unsigned long count) } SCM -scm_integer_floor_rsh_zu (struct scm_bignum *n, unsigned long count) +scm_integer_floor_rsh_zu (struct scm_bignum *n, uintptr_t count) { ASSERT (count > 0); mpz_t result, zn; @@ -2444,26 +2450,26 @@ scm_integer_floor_rsh_zu (struct scm_bignum *n, unsigned long count) /* Efficiently compute round (N / 2^COUNT), where N is an exact integer and COUNT > 0. */ SCM -scm_integer_round_rsh_iu (scm_t_inum n, unsigned long count) +scm_integer_round_rsh_iu (intptr_t n, uintptr_t count) { ASSERT (count > 0); if (count >= SCM_I_FIXNUM_BIT) return SCM_INUM0; else { - scm_t_inum q = SCM_SRS (n, count); + intptr_t q = SCM_SRS (n, count); - if (0 == (n & (1L << (count-1)))) + if (0 == (n & (L1 << (count-1)))) return SCM_I_MAKINUM (q); /* round down */ - else if (n & ((1L << (count-1)) - 1)) + else if (n & ((L1 << (count-1)) - 1)) return SCM_I_MAKINUM (q + 1); /* round up */ else - return SCM_I_MAKINUM ((~1L) & (q + 1)); /* round to even */ + return SCM_I_MAKINUM ((~L1) & (q + 1)); /* round to even */ } } SCM -scm_integer_round_rsh_zu (struct scm_bignum *n, unsigned long count) +scm_integer_round_rsh_zu (struct scm_bignum *n, uintptr_t count) { ASSERT (count > 0); mpz_t q, zn; @@ -2480,8 +2486,8 @@ scm_integer_round_rsh_zu (struct scm_bignum *n, unsigned long count) #define MIN(A, B) ((A) <= (B) ? (A) : (B)) SCM -scm_integer_bit_extract_i (scm_t_inum n, unsigned long start, - unsigned long bits) +scm_integer_bit_extract_i (intptr_t n, uintptr_t start, + uintptr_t bits) { /* 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 "n". */ @@ -2500,11 +2506,11 @@ scm_integer_bit_extract_i (scm_t_inum n, unsigned long start, /* mask down to requisite bits */ bits = MIN (bits, SCM_I_FIXNUM_BIT); - return SCM_I_MAKINUM (n & ((1L << bits) - 1)); + return SCM_I_MAKINUM (n & ((L1 << bits) - 1)); } SCM -scm_integer_bit_extract_z (struct scm_bignum *n, unsigned long start, unsigned long bits) +scm_integer_bit_extract_z (struct scm_bignum *n, uintptr_t start, uintptr_t bits) { mpz_t zn; alias_bignum_to_mpz (n, zn); @@ -2532,9 +2538,9 @@ static const char scm_logtab[] = { }; SCM -scm_integer_logcount_i (scm_t_inum n) +scm_integer_logcount_i (intptr_t n) { - unsigned long c = 0; + uintptr_t c = 0; if (n < 0) n = -1 - n; while (n) @@ -2548,7 +2554,7 @@ scm_integer_logcount_i (scm_t_inum n) SCM scm_integer_logcount_z (struct scm_bignum *n) { - unsigned long count; + uintptr_t count; mpz_t zn; alias_bignum_to_mpz (n, zn); if (mpz_sgn (zn) >= 0) @@ -2561,7 +2567,7 @@ scm_integer_logcount_z (struct scm_bignum *n) mpz_clear (z_negative_one); } scm_remember_upto_here_1 (n); - return scm_from_ulong (count); + return scm_from_uintptr_t (count); } static const char scm_ilentab[] = { @@ -2569,9 +2575,9 @@ static const char scm_ilentab[] = { }; SCM -scm_integer_length_i (scm_t_inum n) +scm_integer_length_i (intptr_t n) { - unsigned long c = 0; + uintptr_t c = 0; unsigned int l = 4; if (n < 0) n = -1 - n; @@ -2594,14 +2600,14 @@ scm_integer_length_z (struct scm_bignum *n) alias_bignum_to_mpz (n, zn); size_t size = mpz_sizeinbase (zn, 2); /* If negative and no 0 bits above the lowest 1, adjust result. */ - if (mpz_sgn (zn) < 0 && mpz_scan0 (zn, mpz_scan1 (zn, 0)) == ULONG_MAX) + if (mpz_sgn (zn) < 0 && mpz_scan0 (zn, mpz_scan1 (zn, 0)) == UINTPTR_MAX) size--; scm_remember_upto_here_1 (n); return scm_from_size_t (size); } SCM -scm_integer_to_string_i (scm_t_inum n, int base) +scm_integer_to_string_i (intptr_t n, int base) { // FIXME: Use mpn_get_str instead. char num_buf [SCM_INTBUFLEN]; @@ -2625,7 +2631,7 @@ scm_integer_to_string_z (struct scm_bignum *n, int base) } int -scm_is_integer_equal_ir (scm_t_inum x, double y) +scm_is_integer_equal_ir (intptr_t x, double y) { /* On a 32-bit system an inum fits a double, we can cast the inum to a double and compare. @@ -2639,15 +2645,15 @@ scm_is_integer_equal_ir (scm_t_inum x, double y) An alternative (for any size system actually) would be to check y is an integer (with floor) and is in range of an inum (compare - against appropriate powers of 2) then test x==(scm_t_inum)y. It's + against appropriate powers of 2) then test x==(intptr_t)y. It's just a matter of which casts/comparisons might be fastest or easiest for the cpu. */ return (double) x == y - && (DBL_MANT_DIG >= SCM_I_FIXNUM_BIT-1 || x == (scm_t_inum) y); + && (DBL_MANT_DIG >= SCM_I_FIXNUM_BIT-1 || x == (intptr_t) y); } int -scm_is_integer_equal_ic (scm_t_inum x, double real, double imag) +scm_is_integer_equal_ic (intptr_t x, double real, double imag) { return imag == 0.0 && scm_is_integer_equal_ir (x, real); } @@ -2682,7 +2688,7 @@ scm_is_integer_equal_zc (struct scm_bignum *x, double real, double imag) } int -scm_is_integer_less_than_ir (scm_t_inum x, double y) +scm_is_integer_less_than_ir (intptr_t x, double y) { /* We can safely take the ceiling of y without changing the result of x= 0); if (k == 0) @@ -3336,7 +3342,7 @@ scm_integer_exact_sqrt_z (struct scm_bignum *k, SCM *s, SCM *r) } int -scm_is_integer_perfect_square_i (scm_t_inum k) +scm_is_integer_perfect_square_i (intptr_t k) { if (k < 0) return 0; @@ -3357,7 +3363,7 @@ scm_is_integer_perfect_square_z (struct scm_bignum *k) } SCM -scm_integer_floor_sqrt_i (scm_t_inum k) +scm_integer_floor_sqrt_i (intptr_t k) { if (k <= 0) return SCM_INUM0; @@ -3379,7 +3385,7 @@ scm_integer_floor_sqrt_z (struct scm_bignum *k) } double -scm_integer_inexact_sqrt_i (scm_t_inum k) +scm_integer_inexact_sqrt_i (intptr_t k) { if (k < 0) return -sqrt ((double) -k); @@ -3389,7 +3395,7 @@ scm_integer_inexact_sqrt_i (scm_t_inum k) double scm_integer_inexact_sqrt_z (struct scm_bignum *k) { - long expon; + intptr_t expon; double signif = scm_integer_frexp_z (k, &expon); int negative = signif < 0; if (negative) @@ -3405,7 +3411,7 @@ scm_integer_inexact_sqrt_z (struct scm_bignum *k) } SCM -scm_integer_scan1_i (scm_t_inum n) +scm_integer_scan1_i (intptr_t n) { if (n == 0) return SCM_I_MAKINUM (-1); @@ -3418,7 +3424,7 @@ scm_integer_scan1_z (struct scm_bignum *n) { mpz_t zn; alias_bignum_to_mpz (n, zn); - unsigned long pos = mpz_scan1 (zn, 0L); + uintptr_t pos = mpz_scan1 (zn, 0L); scm_remember_upto_here_1 (n); - return ulong_to_scm (pos); + return uintptr_t_to_scm (pos); } diff --git a/libguile/integers.h b/libguile/integers.h index 3fc53f019..cb66c0139 100644 --- a/libguile/integers.h +++ b/libguile/integers.h @@ -36,41 +36,41 @@ SCM_INTERNAL SCM scm_integer_from_mpz (const mpz_t n); SCM_INTERNAL void scm_integer_set_mpz_z (struct scm_bignum *z, mpz_t n); SCM_INTERNAL void scm_integer_init_set_mpz_z (struct scm_bignum *z, mpz_t n); -SCM_INTERNAL int scm_is_integer_odd_i (scm_t_inum i); +SCM_INTERNAL int scm_is_integer_odd_i (intptr_t i); SCM_INTERNAL int scm_is_integer_odd_z (struct scm_bignum *z); -SCM_INTERNAL SCM scm_integer_abs_i (scm_t_inum i); +SCM_INTERNAL SCM scm_integer_abs_i (intptr_t i); SCM_INTERNAL SCM scm_integer_abs_z (struct scm_bignum *z); #define DECLARE_QUOTIENT_OPERATORS(stem) \ - SCM_INTERNAL SCM scm_integer_##stem##_quotient_ii (scm_t_inum x, \ - scm_t_inum y); \ - SCM_INTERNAL SCM scm_integer_##stem##_quotient_iz (scm_t_inum x, \ + SCM_INTERNAL SCM scm_integer_##stem##_quotient_ii (intptr_t x, \ + intptr_t y); \ + SCM_INTERNAL SCM scm_integer_##stem##_quotient_iz (intptr_t x, \ struct scm_bignum *y); \ SCM_INTERNAL SCM scm_integer_##stem##_quotient_zi (struct scm_bignum *x, \ - scm_t_inum y); \ + intptr_t y); \ SCM_INTERNAL SCM scm_integer_##stem##_quotient_zz (struct scm_bignum *x, \ struct scm_bignum *y); #define DECLARE_REMAINDER_OPERATORS(stem) \ - SCM_INTERNAL SCM scm_integer_##stem##_remainder_ii (scm_t_inum x, \ - scm_t_inum y); \ - SCM_INTERNAL SCM scm_integer_##stem##_remainder_iz (scm_t_inum x, \ + SCM_INTERNAL SCM scm_integer_##stem##_remainder_ii (intptr_t x, \ + intptr_t y); \ + SCM_INTERNAL SCM scm_integer_##stem##_remainder_iz (intptr_t x, \ struct scm_bignum *y); \ SCM_INTERNAL SCM scm_integer_##stem##_remainder_zi (struct scm_bignum *x, \ - scm_t_inum y); \ + intptr_t y); \ SCM_INTERNAL SCM scm_integer_##stem##_remainder_zz (struct scm_bignum *x, \ struct scm_bignum *y); #define DECLARE_DIVIDE_OPERATORS(stem) \ - SCM_INTERNAL void scm_integer_##stem##_divide_ii (scm_t_inum x, \ - scm_t_inum y, \ + SCM_INTERNAL void scm_integer_##stem##_divide_ii (intptr_t x, \ + intptr_t y, \ SCM *qp, SCM *rp); \ - SCM_INTERNAL void scm_integer_##stem##_divide_iz (scm_t_inum x, \ + SCM_INTERNAL void scm_integer_##stem##_divide_iz (intptr_t x, \ struct scm_bignum *y, \ SCM *qp, SCM *rp); \ SCM_INTERNAL void scm_integer_##stem##_divide_zi (struct scm_bignum *x, \ - scm_t_inum y, \ + intptr_t y, \ SCM *qp, SCM *rp); \ SCM_INTERNAL void scm_integer_##stem##_divide_zz (struct scm_bignum *x, \ struct scm_bignum *y, \ @@ -87,75 +87,75 @@ DECLARE_DIVISION_OPERATORS(truncate); DECLARE_DIVISION_OPERATORS(centered); DECLARE_DIVISION_OPERATORS(round); -SCM_INTERNAL SCM scm_integer_gcd_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL SCM scm_integer_gcd_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_gcd_ii (intptr_t x, intptr_t y); +SCM_INTERNAL SCM scm_integer_gcd_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL SCM scm_integer_gcd_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL SCM scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL SCM scm_integer_lcm_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_lcm_ii (intptr_t x, intptr_t y); +SCM_INTERNAL SCM scm_integer_lcm_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL SCM scm_integer_lcm_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL SCM scm_integer_logand_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL SCM scm_integer_logand_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_logand_ii (intptr_t x, intptr_t y); +SCM_INTERNAL SCM scm_integer_logand_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL SCM scm_integer_logand_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL SCM scm_integer_logior_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL SCM scm_integer_logior_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_logior_ii (intptr_t x, intptr_t y); +SCM_INTERNAL SCM scm_integer_logior_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL SCM scm_integer_logior_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL SCM scm_integer_logxor_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL SCM scm_integer_logxor_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_logxor_ii (intptr_t x, intptr_t y); +SCM_INTERNAL SCM scm_integer_logxor_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL SCM scm_integer_logxor_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL int scm_integer_logtest_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL int scm_integer_logtest_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL int scm_integer_logtest_ii (intptr_t x, intptr_t y); +SCM_INTERNAL int scm_integer_logtest_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL int scm_integer_logtest_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL int scm_integer_logbit_ui (unsigned long bit, scm_t_inum n); -SCM_INTERNAL int scm_integer_logbit_uz (unsigned long bit, +SCM_INTERNAL int scm_integer_logbit_ui (uintptr_t bit, intptr_t n); +SCM_INTERNAL int scm_integer_logbit_uz (uintptr_t bit, struct scm_bignum *n); -SCM_INTERNAL SCM scm_integer_lognot_i (scm_t_inum n); +SCM_INTERNAL SCM scm_integer_lognot_i (intptr_t n); SCM_INTERNAL SCM scm_integer_lognot_z (struct scm_bignum *n); -SCM_INTERNAL SCM scm_integer_expt_ii (scm_t_inum n, scm_t_inum k); -SCM_INTERNAL SCM scm_integer_expt_zi (struct scm_bignum *n, scm_t_inum k); +SCM_INTERNAL SCM scm_integer_expt_ii (intptr_t n, intptr_t k); +SCM_INTERNAL SCM scm_integer_expt_zi (struct scm_bignum *n, intptr_t k); SCM_INTERNAL SCM scm_integer_modulo_expt_nnn (SCM n, SCM k, SCM m); -SCM_INTERNAL SCM scm_integer_lsh_iu (scm_t_inum n, unsigned long count); +SCM_INTERNAL SCM scm_integer_lsh_iu (intptr_t n, uintptr_t count); SCM_INTERNAL SCM scm_integer_lsh_zu (struct scm_bignum *n, - unsigned long count); -SCM_INTERNAL SCM scm_integer_floor_rsh_iu (scm_t_inum n, unsigned long count); + uintptr_t count); +SCM_INTERNAL SCM scm_integer_floor_rsh_iu (intptr_t n, uintptr_t count); SCM_INTERNAL SCM scm_integer_floor_rsh_zu (struct scm_bignum *n, - unsigned long count); -SCM_INTERNAL SCM scm_integer_round_rsh_iu (scm_t_inum n, unsigned long count); + uintptr_t count); +SCM_INTERNAL SCM scm_integer_round_rsh_iu (intptr_t n, uintptr_t count); SCM_INTERNAL SCM scm_integer_round_rsh_zu (struct scm_bignum *n, - unsigned long count); + uintptr_t count); -SCM_INTERNAL SCM scm_integer_bit_extract_i (scm_t_inum n, unsigned long start, - unsigned long bits); +SCM_INTERNAL SCM scm_integer_bit_extract_i (intptr_t n, uintptr_t start, + uintptr_t bits); SCM_INTERNAL SCM scm_integer_bit_extract_z (struct scm_bignum *n, - unsigned long start, - unsigned long bits); + uintptr_t start, + uintptr_t bits); -SCM_INTERNAL SCM scm_integer_logcount_i (scm_t_inum n); +SCM_INTERNAL SCM scm_integer_logcount_i (intptr_t n); SCM_INTERNAL SCM scm_integer_logcount_z (struct scm_bignum *n); -SCM_INTERNAL SCM scm_integer_length_i (scm_t_inum n); +SCM_INTERNAL SCM scm_integer_length_i (intptr_t n); SCM_INTERNAL SCM scm_integer_length_z (struct scm_bignum *n); -SCM_INTERNAL SCM scm_integer_to_string_i (scm_t_inum n, int base); +SCM_INTERNAL SCM scm_integer_to_string_i (intptr_t n, int base); SCM_INTERNAL SCM scm_integer_to_string_z (struct scm_bignum *n, int base); -SCM_INTERNAL int scm_is_integer_equal_ir (scm_t_inum x, double y); -SCM_INTERNAL int scm_is_integer_equal_ic (scm_t_inum x, +SCM_INTERNAL int scm_is_integer_equal_ir (intptr_t x, double y); +SCM_INTERNAL int scm_is_integer_equal_ic (intptr_t x, double real, double imag); SCM_INTERNAL int scm_is_integer_equal_zz (struct scm_bignum *x, struct scm_bignum *y); @@ -163,8 +163,8 @@ SCM_INTERNAL int scm_is_integer_equal_zr (struct scm_bignum *x, double y); SCM_INTERNAL int scm_is_integer_equal_zc (struct scm_bignum *x, double real, double imag); -SCM_INTERNAL int scm_is_integer_less_than_ir (scm_t_inum x, double y); -SCM_INTERNAL int scm_is_integer_less_than_ri (double x, scm_t_inum y); +SCM_INTERNAL int scm_is_integer_less_than_ir (intptr_t x, double y); +SCM_INTERNAL int scm_is_integer_less_than_ri (double x, intptr_t y); SCM_INTERNAL int scm_is_integer_less_than_zz (struct scm_bignum *x, struct scm_bignum *y); SCM_INTERNAL int scm_is_integer_less_than_zr (struct scm_bignum *x, double y); @@ -173,41 +173,41 @@ SCM_INTERNAL int scm_is_integer_less_than_rz (double y, struct scm_bignum *x); SCM_INTERNAL int scm_is_integer_positive_z (struct scm_bignum *x); SCM_INTERNAL int scm_is_integer_negative_z (struct scm_bignum *x); -SCM_INTERNAL double scm_integer_frexp_z (struct scm_bignum *x, long *exp); +SCM_INTERNAL double scm_integer_frexp_z (struct scm_bignum *x, intptr_t *exp); SCM_INTERNAL double scm_integer_to_double_z (struct scm_bignum *x); SCM_INTERNAL SCM scm_integer_from_double (double val); -SCM_INTERNAL SCM scm_integer_add_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL SCM scm_integer_add_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_add_ii (intptr_t x, intptr_t y); +SCM_INTERNAL SCM scm_integer_add_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL SCM scm_integer_add_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL SCM scm_integer_negate_i (scm_t_inum x); +SCM_INTERNAL SCM scm_integer_negate_i (intptr_t x); SCM_INTERNAL SCM scm_integer_negate_z (struct scm_bignum *x); -SCM_INTERNAL SCM scm_integer_sub_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL SCM scm_integer_sub_iz (scm_t_inum x, struct scm_bignum *y); -SCM_INTERNAL SCM scm_integer_sub_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_sub_ii (intptr_t x, intptr_t y); +SCM_INTERNAL SCM scm_integer_sub_iz (intptr_t x, struct scm_bignum *y); +SCM_INTERNAL SCM scm_integer_sub_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL SCM scm_integer_sub_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL SCM scm_integer_mul_ii (scm_t_inum x, scm_t_inum y); -SCM_INTERNAL SCM scm_integer_mul_zi (struct scm_bignum *x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_mul_ii (intptr_t x, intptr_t y); +SCM_INTERNAL SCM scm_integer_mul_zi (struct scm_bignum *x, intptr_t y); SCM_INTERNAL SCM scm_integer_mul_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL int scm_is_integer_divisible_ii (scm_t_inum x, scm_t_inum y); +SCM_INTERNAL int scm_is_integer_divisible_ii (intptr_t x, intptr_t y); SCM_INTERNAL int scm_is_integer_divisible_zi (struct scm_bignum *x, - scm_t_inum y); + intptr_t y); SCM_INTERNAL int scm_is_integer_divisible_zz (struct scm_bignum *x, struct scm_bignum *y); -SCM_INTERNAL SCM scm_integer_exact_quotient_ii (scm_t_inum n, scm_t_inum d); -SCM_INTERNAL SCM scm_integer_exact_quotient_iz (scm_t_inum n, +SCM_INTERNAL SCM scm_integer_exact_quotient_ii (intptr_t n, intptr_t d); +SCM_INTERNAL SCM scm_integer_exact_quotient_iz (intptr_t n, struct scm_bignum *d); SCM_INTERNAL SCM scm_integer_exact_quotient_zi (struct scm_bignum *n, - scm_t_inum d); + intptr_t d); SCM_INTERNAL SCM scm_integer_exact_quotient_zz (struct scm_bignum *n, struct scm_bignum *d); -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 SCM_INTERNAL SCM scm_integer_from_int32 (int32_t n); SCM_INTERNAL SCM scm_integer_from_uint32 (uint32_t n); SCM_INTERNAL int scm_integer_to_int32_z (struct scm_bignum *z, int32_t *val); @@ -219,18 +219,18 @@ SCM_INTERNAL int scm_integer_to_uint64_z (struct scm_bignum *z, uint64_t *val); SCM_INTERNAL SCM scm_integer_from_int64 (int64_t n); SCM_INTERNAL SCM scm_integer_from_uint64 (uint64_t n); -SCM_INTERNAL void scm_integer_exact_sqrt_i (scm_t_inum k, SCM *s, SCM *r); +SCM_INTERNAL void scm_integer_exact_sqrt_i (intptr_t k, SCM *s, SCM *r); SCM_INTERNAL void scm_integer_exact_sqrt_z (struct scm_bignum *k, SCM *s, SCM *r); -SCM_INTERNAL int scm_is_integer_perfect_square_i (scm_t_inum k); +SCM_INTERNAL int scm_is_integer_perfect_square_i (intptr_t k); SCM_INTERNAL int scm_is_integer_perfect_square_z (struct scm_bignum *k); -SCM_INTERNAL SCM scm_integer_floor_sqrt_i (scm_t_inum k); +SCM_INTERNAL SCM scm_integer_floor_sqrt_i (intptr_t k); SCM_INTERNAL SCM scm_integer_floor_sqrt_z (struct scm_bignum *k); -SCM_INTERNAL double scm_integer_inexact_sqrt_i (scm_t_inum k); +SCM_INTERNAL double scm_integer_inexact_sqrt_i (intptr_t k); SCM_INTERNAL double scm_integer_inexact_sqrt_z (struct scm_bignum *k); -SCM_INTERNAL SCM scm_integer_scan1_i (scm_t_inum n); +SCM_INTERNAL SCM scm_integer_scan1_i (intptr_t n); SCM_INTERNAL SCM scm_integer_scan1_z (struct scm_bignum *n); diff --git a/libguile/mini-gmp.c b/libguile/mini-gmp.c index f7634cc05..415676dfb 100644 --- a/libguile/mini-gmp.c +++ b/libguile/mini-gmp.c @@ -2,7 +2,7 @@ Contributed to the GNU project by Niels Möller -Copyright 1991-1997, 1999-2019 Free Software Foundation, Inc. +Copyright 1991-1997, 1999-2019,2021 Free Software Foundation, Inc. This file is part of the GNU MP Library. @@ -48,6 +48,7 @@ see https://www.gnu.org/licenses/. */ #include #include #include +#include #include #include #include @@ -68,8 +69,8 @@ see https://www.gnu.org/licenses/. */ #define GMP_HLIMB_BIT ((mp_limb_t) 1 << (GMP_LIMB_BITS / 2)) #define GMP_LLIMB_MASK (GMP_HLIMB_BIT - 1) -#define GMP_ULONG_BITS (sizeof(unsigned long) * CHAR_BIT) -#define GMP_ULONG_HIGHBIT ((unsigned long) 1 << (GMP_ULONG_BITS - 1)) +#define GMP_ULONG_BITS (sizeof(uintptr_t) * CHAR_BIT) +#define GMP_ULONG_HIGHBIT ((uintptr_t) 1 << (GMP_ULONG_BITS - 1)) #define GMP_ABS(x) ((x) >= 0 ? (x) : -(x)) #define GMP_NEG_CAST(T,x) (-((T)((x) + 1) - 1)) @@ -144,7 +145,7 @@ see https://www.gnu.org/licenses/. */ } \ else if (GMP_ULONG_BITS >= 2 * GMP_LIMB_BITS) \ { \ - unsigned long int __ww = (unsigned long int) (u) * (v); \ + uintptr_t __ww = (uintptr_t) (u) * (v); \ w0 = (mp_limb_t) __ww; \ w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \ } \ @@ -1466,25 +1467,25 @@ mpz_realloc (mpz_t r, mp_size_t size) /* MPZ assignment and basic conversions. */ void -mpz_set_si (mpz_t r, signed long int x) +mpz_set_si (mpz_t r, intptr_t x) { if (x >= 0) mpz_set_ui (r, x); else /* (x < 0) */ if (GMP_LIMB_BITS < GMP_ULONG_BITS) { - mpz_set_ui (r, GMP_NEG_CAST (unsigned long int, x)); + mpz_set_ui (r, GMP_NEG_CAST (uintptr_t, x)); mpz_neg (r, r); } else { r->_mp_size = -1; - MPZ_REALLOC (r, 1)[0] = GMP_NEG_CAST (unsigned long int, x); + MPZ_REALLOC (r, 1)[0] = GMP_NEG_CAST (uintptr_t, x); } } void -mpz_set_ui (mpz_t r, unsigned long int x) +mpz_set_ui (mpz_t r, uintptr_t x) { if (x > 0) { @@ -1522,14 +1523,14 @@ mpz_set (mpz_t r, const mpz_t x) } void -mpz_init_set_si (mpz_t r, signed long int x) +mpz_init_set_si (mpz_t r, intptr_t x) { mpz_init (r); mpz_set_si (r, x); } void -mpz_init_set_ui (mpz_t r, unsigned long int x) +mpz_init_set_ui (mpz_t r, uintptr_t x) { mpz_init (r); mpz_set_ui (r, x); @@ -1545,8 +1546,8 @@ mpz_init_set (mpz_t r, const mpz_t x) int mpz_fits_slong_p (const mpz_t u) { - return (LONG_MAX + LONG_MIN == 0 || mpz_cmp_ui (u, LONG_MAX) <= 0) && - mpz_cmpabs_ui (u, GMP_NEG_CAST (unsigned long int, LONG_MIN)) <= 0; + return (INTPTR_MAX + INTPTR_MIN == 0 || mpz_cmp_ui (u, INTPTR_MAX) <= 0) && + mpz_cmpabs_ui (u, GMP_NEG_CAST (uintptr_t, INTPTR_MIN)) <= 0; } static int @@ -1569,26 +1570,26 @@ mpz_fits_ulong_p (const mpz_t u) return us >= 0 && mpn_absfits_ulong_p (u->_mp_d, us); } -long int +intptr_t mpz_get_si (const mpz_t u) { - unsigned long r = mpz_get_ui (u); - unsigned long c = -LONG_MAX - LONG_MIN; + uintptr_t r = mpz_get_ui (u); + uintptr_t c = -INTPTR_MAX - INTPTR_MIN; if (u->_mp_size < 0) - /* This expression is necessary to properly handle -LONG_MIN */ - return -(long) c - (long) ((r - c) & LONG_MAX); + /* This expression is necessary to properly handle -INTPTR_MIN */ + return -(intptr_t) c - (intptr_t) ((r - c) & INTPTR_MAX); else - return (long) (r & LONG_MAX); + return (intptr_t) (r & INTPTR_MAX); } -unsigned long int +uintptr_t mpz_get_ui (const mpz_t u) { if (GMP_LIMB_BITS < GMP_ULONG_BITS) { int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; - unsigned long r = 0; + uintptr_t r = 0; mp_size_t n = GMP_ABS (u->_mp_size); n = GMP_MIN (n, 1 + (mp_size_t) (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS); while (--n >= 0) @@ -1831,7 +1832,7 @@ mpz_sgn (const mpz_t u) } int -mpz_cmp_si (const mpz_t u, long v) +mpz_cmp_si (const mpz_t u, intptr_t v) { mp_size_t usize = u->_mp_size; @@ -1840,11 +1841,11 @@ mpz_cmp_si (const mpz_t u, long v) else if (usize >= 0) return 1; else - return - mpz_cmpabs_ui (u, GMP_NEG_CAST (unsigned long int, v)); + return - mpz_cmpabs_ui (u, GMP_NEG_CAST (uintptr_t, v)); } int -mpz_cmp_ui (const mpz_t u, unsigned long v) +mpz_cmp_ui (const mpz_t u, uintptr_t v) { mp_size_t usize = u->_mp_size; @@ -1869,7 +1870,7 @@ mpz_cmp (const mpz_t a, const mpz_t b) } int -mpz_cmpabs_ui (const mpz_t u, unsigned long v) +mpz_cmpabs_ui (const mpz_t u, uintptr_t v) { mp_size_t un = GMP_ABS (u->_mp_size); @@ -1877,7 +1878,7 @@ mpz_cmpabs_ui (const mpz_t u, unsigned long v) return 1; else { - unsigned long uu = mpz_get_ui (u); + uintptr_t uu = mpz_get_ui (u); return GMP_CMP(uu, v); } } @@ -1916,7 +1917,7 @@ mpz_swap (mpz_t u, mpz_t v) void -mpz_add_ui (mpz_t r, const mpz_t a, unsigned long b) +mpz_add_ui (mpz_t r, const mpz_t a, uintptr_t b) { mpz_t bb; mpz_init_set_ui (bb, b); @@ -1925,14 +1926,14 @@ mpz_add_ui (mpz_t r, const mpz_t a, unsigned long b) } void -mpz_sub_ui (mpz_t r, const mpz_t a, unsigned long b) +mpz_sub_ui (mpz_t r, const mpz_t a, uintptr_t b) { mpz_ui_sub (r, b, a); mpz_neg (r, r); } void -mpz_ui_sub (mpz_t r, unsigned long a, const mpz_t b) +mpz_ui_sub (mpz_t r, uintptr_t a, const mpz_t b) { mpz_neg (r, b); mpz_add_ui (r, r, a); @@ -2014,11 +2015,11 @@ mpz_sub (mpz_t r, const mpz_t a, const mpz_t b) /* MPZ multiplication */ void -mpz_mul_si (mpz_t r, const mpz_t u, long int v) +mpz_mul_si (mpz_t r, const mpz_t u, intptr_t v) { if (v < 0) { - mpz_mul_ui (r, u, GMP_NEG_CAST (unsigned long int, v)); + mpz_mul_ui (r, u, GMP_NEG_CAST (uintptr_t, v)); mpz_neg (r, r); } else @@ -2026,7 +2027,7 @@ mpz_mul_si (mpz_t r, const mpz_t u, long int v) } void -mpz_mul_ui (mpz_t r, const mpz_t u, unsigned long int v) +mpz_mul_ui (mpz_t r, const mpz_t u, uintptr_t v) { mpz_t vv; mpz_init_set_ui (vv, v); @@ -2108,7 +2109,7 @@ mpz_mul_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t bits) } void -mpz_addmul_ui (mpz_t r, const mpz_t u, unsigned long int v) +mpz_addmul_ui (mpz_t r, const mpz_t u, uintptr_t v) { mpz_t t; mpz_init_set_ui (t, v); @@ -2118,7 +2119,7 @@ mpz_addmul_ui (mpz_t r, const mpz_t u, unsigned long int v) } void -mpz_submul_ui (mpz_t r, const mpz_t u, unsigned long int v) +mpz_submul_ui (mpz_t r, const mpz_t u, uintptr_t v) { mpz_t t; mpz_init_set_ui (t, v); @@ -2514,11 +2515,11 @@ mpz_congruent_p (const mpz_t a, const mpz_t b, const mpz_t m) return res; } -static unsigned long +static uintptr_t mpz_div_qr_ui (mpz_t q, mpz_t r, - const mpz_t n, unsigned long d, enum mpz_div_round_mode mode) + const mpz_t n, uintptr_t d, enum mpz_div_round_mode mode) { - unsigned long ret; + uintptr_t ret; mpz_t rr, dd; mpz_init (rr); @@ -2534,90 +2535,90 @@ mpz_div_qr_ui (mpz_t q, mpz_t r, return ret; } -unsigned long -mpz_cdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) +uintptr_t +mpz_cdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (q, r, n, d, GMP_DIV_CEIL); } -unsigned long -mpz_fdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) +uintptr_t +mpz_fdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (q, r, n, d, GMP_DIV_FLOOR); } -unsigned long -mpz_tdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d) +uintptr_t +mpz_tdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (q, r, n, d, GMP_DIV_TRUNC); } -unsigned long -mpz_cdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) +uintptr_t +mpz_cdiv_q_ui (mpz_t q, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_CEIL); } -unsigned long -mpz_fdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) +uintptr_t +mpz_fdiv_q_ui (mpz_t q, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_FLOOR); } -unsigned long -mpz_tdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d) +uintptr_t +mpz_tdiv_q_ui (mpz_t q, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_TRUNC); } -unsigned long -mpz_cdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) +uintptr_t +mpz_cdiv_r_ui (mpz_t r, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_CEIL); } -unsigned long -mpz_fdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) +uintptr_t +mpz_fdiv_r_ui (mpz_t r, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_FLOOR); } -unsigned long -mpz_tdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d) +uintptr_t +mpz_tdiv_r_ui (mpz_t r, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_TRUNC); } -unsigned long -mpz_cdiv_ui (const mpz_t n, unsigned long d) +uintptr_t +mpz_cdiv_ui (const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_CEIL); } -unsigned long -mpz_fdiv_ui (const mpz_t n, unsigned long d) +uintptr_t +mpz_fdiv_ui (const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_FLOOR); } -unsigned long -mpz_tdiv_ui (const mpz_t n, unsigned long d) +uintptr_t +mpz_tdiv_ui (const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_TRUNC); } -unsigned long -mpz_mod_ui (mpz_t r, const mpz_t n, unsigned long d) +uintptr_t +mpz_mod_ui (mpz_t r, const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_FLOOR); } void -mpz_divexact_ui (mpz_t q, const mpz_t n, unsigned long d) +mpz_divexact_ui (mpz_t q, const mpz_t n, uintptr_t d) { gmp_assert_nocarry (mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_TRUNC)); } int -mpz_divisible_ui_p (const mpz_t n, unsigned long d) +mpz_divisible_ui_p (const mpz_t n, uintptr_t d) { return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_TRUNC) == 0; } @@ -2667,8 +2668,8 @@ mpn_gcd_11 (mp_limb_t u, mp_limb_t v) return u << shift; } -unsigned long -mpz_gcd_ui (mpz_t g, const mpz_t u, unsigned long v) +uintptr_t +mpz_gcd_ui (mpz_t g, const mpz_t u, uintptr_t v) { mpz_t t; mpz_init_set_ui(t, v); @@ -2770,7 +2771,7 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v) if (u->_mp_size == 0) { /* g = 0 u + sgn(v) v */ - signed long sign = mpz_sgn (v); + intptr_t sign = mpz_sgn (v); mpz_abs (g, v); if (s) s->_mp_size = 0; @@ -2782,7 +2783,7 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v) if (v->_mp_size == 0) { /* g = sgn(u) u + 0 v */ - signed long sign = mpz_sgn (u); + intptr_t sign = mpz_sgn (u); mpz_abs (g, u); if (s) mpz_set_si (s, sign); @@ -2965,7 +2966,7 @@ mpz_lcm (mpz_t r, const mpz_t u, const mpz_t v) } void -mpz_lcm_ui (mpz_t r, const mpz_t u, unsigned long v) +mpz_lcm_ui (mpz_t r, const mpz_t u, uintptr_t v) { if (v == 0 || u->_mp_size == 0) { @@ -3015,9 +3016,9 @@ mpz_invert (mpz_t r, const mpz_t u, const mpz_t m) /* Higher level operations (sqrt, pow and root) */ void -mpz_pow_ui (mpz_t r, const mpz_t b, unsigned long e) +mpz_pow_ui (mpz_t r, const mpz_t b, uintptr_t e) { - unsigned long bit; + uintptr_t bit; mpz_t tr; mpz_init_set_ui (tr, 1); @@ -3036,7 +3037,7 @@ mpz_pow_ui (mpz_t r, const mpz_t b, unsigned long e) } void -mpz_ui_pow_ui (mpz_t r, unsigned long blimb, unsigned long e) +mpz_ui_pow_ui (mpz_t r, uintptr_t blimb, uintptr_t e) { mpz_t b; @@ -3151,7 +3152,7 @@ mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m) } void -mpz_powm_ui (mpz_t r, const mpz_t b, unsigned long elimb, const mpz_t m) +mpz_powm_ui (mpz_t r, const mpz_t b, uintptr_t elimb, const mpz_t m) { mpz_t e; @@ -3162,7 +3163,7 @@ mpz_powm_ui (mpz_t r, const mpz_t b, unsigned long elimb, const mpz_t m) /* x=trunc(y^(1/z)), r=y-x^z */ void -mpz_rootrem (mpz_t x, mpz_t r, const mpz_t y, unsigned long z) +mpz_rootrem (mpz_t x, mpz_t r, const mpz_t y, uintptr_t z) { int sgn; mpz_t t, u; @@ -3222,7 +3223,7 @@ mpz_rootrem (mpz_t x, mpz_t r, const mpz_t y, unsigned long z) } int -mpz_root (mpz_t x, const mpz_t y, unsigned long z) +mpz_root (mpz_t x, const mpz_t y, uintptr_t z) { int res; mpz_t r; @@ -3293,7 +3294,7 @@ mpn_sqrtrem (mp_ptr sp, mp_ptr rp, mp_srcptr p, mp_size_t n) /* Combinatorics */ void -mpz_mfac_uiui (mpz_t x, unsigned long n, unsigned long m) +mpz_mfac_uiui (mpz_t x, uintptr_t n, uintptr_t m) { mpz_set_ui (x, n + (n == 0)); if (m + 1 < 2) return; @@ -3302,19 +3303,19 @@ mpz_mfac_uiui (mpz_t x, unsigned long n, unsigned long m) } void -mpz_2fac_ui (mpz_t x, unsigned long n) +mpz_2fac_ui (mpz_t x, uintptr_t n) { mpz_mfac_uiui (x, n, 2); } void -mpz_fac_ui (mpz_t x, unsigned long n) +mpz_fac_ui (mpz_t x, uintptr_t n) { mpz_mfac_uiui (x, n, 1); } void -mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k) +mpz_bin_uiui (mpz_t r, uintptr_t n, uintptr_t k) { mpz_t t; @@ -3393,10 +3394,10 @@ gmp_lucas_step_k_2k (mpz_t V, mpz_t Qk, const mpz_t n) /* Computes V_k, Q^k (mod n) for the Lucas' sequence */ /* with P=1, Q=Q; k = (n>>b0)|1. */ -/* Requires an odd n > 4; b0 > 0; -2*Q must not overflow a long */ +/* Requires an odd n > 4; b0 > 0; -2*Q must not overflow a intptr_t */ /* Returns (U_k == 0) and sets V=V_k and Qk=Q^k. */ static int -gmp_lucas_mod (mpz_t V, mpz_t Qk, long Q, +gmp_lucas_mod (mpz_t V, mpz_t Qk, intptr_t Q, mp_bitcnt_t b0, const mpz_t n) { mp_bitcnt_t bs; @@ -3404,8 +3405,8 @@ gmp_lucas_mod (mpz_t V, mpz_t Qk, long Q, int res; assert (b0 > 0); - assert (Q <= - (LONG_MIN / 2)); - assert (Q >= - (LONG_MAX / 2)); + assert (Q <= - (INTPTR_MIN / 2)); + assert (Q >= - (INTPTR_MAX / 2)); assert (mpz_cmp_ui (n, 4) > 0); assert (mpz_odd_p (n)); @@ -3459,7 +3460,7 @@ gmp_stronglucas (const mpz_t x, mpz_t Qk) mp_bitcnt_t b0; mpz_t V, n; mp_limb_t maxD, D; /* The absolute value is stored. */ - long Q; + intptr_t Q; mp_limb_t tl; /* Test on the absolute value. */ @@ -3494,7 +3495,7 @@ gmp_stronglucas (const mpz_t x, mpz_t Qk) b0 = mpz_scan0 (n, 0); /* D= P^2 - 4Q; P = 1; Q = (1-D)/4 */ - Q = (D & 2) ? (long) (D >> 2) + 1 : -(long) (D >> 2); + Q = (D & 2) ? (intptr_t) (D >> 2) + 1 : -(intptr_t) (D >> 2); if (! gmp_lucas_mod (V, Qk, Q, b0, n)) /* If Ud != 0 */ while (V->_mp_size != 0 && --b0 != 0) /* while Vk != 0 */ @@ -3588,7 +3589,7 @@ mpz_probab_prime_p (const mpz_t n, int reps) for (j = 0; is_prime & (j < reps); j++) { - mpz_set_ui (y, (unsigned long) j*j+j+41); + mpz_set_ui (y, (uintptr_t) j*j+j+41); if (mpz_cmp (y, nm1) >= 0) { /* Don't try any further bases. This "early" break does not affect diff --git a/libguile/mini-gmp.h b/libguile/mini-gmp.h index d575f7d13..feb53f78e 100644 --- a/libguile/mini-gmp.h +++ b/libguile/mini-gmp.h @@ -1,6 +1,6 @@ /* mini-gmp, a minimalistic implementation of a GNU GMP subset. -Copyright 2011-2015, 2017, 2019-2020 Free Software Foundation, Inc. +Copyright 2011-2015, 2017, 2019-2021 Free Software Foundation, Inc. This file is part of the GNU MP Library. @@ -53,17 +53,14 @@ void mp_get_memory_functions (void *(**) (size_t), void *(**) (void *, size_t, size_t), void (**) (void *, size_t)); -#ifndef MINI_GMP_LIMB_TYPE -#define MINI_GMP_LIMB_TYPE long -#endif - -typedef unsigned MINI_GMP_LIMB_TYPE mp_limb_t; +typedef uintptr_t mp_limb_t; typedef long mp_size_t; typedef unsigned long mp_bitcnt_t; typedef mp_limb_t *mp_ptr; typedef const mp_limb_t *mp_srcptr; + typedef struct { int _mp_alloc; /* Number of *limbs* allocated and pointed @@ -131,10 +128,10 @@ void mpz_clear (mpz_t); #define mpz_even_p(z) (! mpz_odd_p (z)) int mpz_sgn (const mpz_t); -int mpz_cmp_si (const mpz_t, long); -int mpz_cmp_ui (const mpz_t, unsigned long); +int mpz_cmp_si (const mpz_t, intptr_t); +int mpz_cmp_ui (const mpz_t, uintptr_t); int mpz_cmp (const mpz_t, const mpz_t); -int mpz_cmpabs_ui (const mpz_t, unsigned long); +int mpz_cmpabs_ui (const mpz_t, uintptr_t); int mpz_cmpabs (const mpz_t, const mpz_t); int mpz_cmp_d (const mpz_t, double); int mpz_cmpabs_d (const mpz_t, double); @@ -143,19 +140,19 @@ void mpz_abs (mpz_t, const mpz_t); void mpz_neg (mpz_t, const mpz_t); void mpz_swap (mpz_t, mpz_t); -void mpz_add_ui (mpz_t, const mpz_t, unsigned long); +void mpz_add_ui (mpz_t, const mpz_t, uintptr_t); void mpz_add (mpz_t, const mpz_t, const mpz_t); -void mpz_sub_ui (mpz_t, const mpz_t, unsigned long); -void mpz_ui_sub (mpz_t, unsigned long, const mpz_t); +void mpz_sub_ui (mpz_t, const mpz_t, uintptr_t); +void mpz_ui_sub (mpz_t, uintptr_t, const mpz_t); void mpz_sub (mpz_t, const mpz_t, const mpz_t); -void mpz_mul_si (mpz_t, const mpz_t, long int); -void mpz_mul_ui (mpz_t, const mpz_t, unsigned long int); +void mpz_mul_si (mpz_t, const mpz_t, intptr_t); +void mpz_mul_ui (mpz_t, const mpz_t, uintptr_t); void mpz_mul (mpz_t, const mpz_t, const mpz_t); void mpz_mul_2exp (mpz_t, const mpz_t, mp_bitcnt_t); -void mpz_addmul_ui (mpz_t, const mpz_t, unsigned long int); +void mpz_addmul_ui (mpz_t, const mpz_t, uintptr_t); void mpz_addmul (mpz_t, const mpz_t, const mpz_t); -void mpz_submul_ui (mpz_t, const mpz_t, unsigned long int); +void mpz_submul_ui (mpz_t, const mpz_t, uintptr_t); void mpz_submul (mpz_t, const mpz_t, const mpz_t); void mpz_cdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t); @@ -182,29 +179,29 @@ void mpz_divexact (mpz_t, const mpz_t, const mpz_t); int mpz_divisible_p (const mpz_t, const mpz_t); int mpz_congruent_p (const mpz_t, const mpz_t, const mpz_t); -unsigned long mpz_cdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); -unsigned long mpz_fdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); -unsigned long mpz_tdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long); -unsigned long mpz_cdiv_q_ui (mpz_t, const mpz_t, unsigned long); -unsigned long mpz_fdiv_q_ui (mpz_t, const mpz_t, unsigned long); -unsigned long mpz_tdiv_q_ui (mpz_t, const mpz_t, unsigned long); -unsigned long mpz_cdiv_r_ui (mpz_t, const mpz_t, unsigned long); -unsigned long mpz_fdiv_r_ui (mpz_t, const mpz_t, unsigned long); -unsigned long mpz_tdiv_r_ui (mpz_t, const mpz_t, unsigned long); -unsigned long mpz_cdiv_ui (const mpz_t, unsigned long); -unsigned long mpz_fdiv_ui (const mpz_t, unsigned long); -unsigned long mpz_tdiv_ui (const mpz_t, unsigned long); +uintptr_t mpz_cdiv_qr_ui (mpz_t, mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_fdiv_qr_ui (mpz_t, mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_tdiv_qr_ui (mpz_t, mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_cdiv_q_ui (mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_fdiv_q_ui (mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_tdiv_q_ui (mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_cdiv_r_ui (mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_fdiv_r_ui (mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_tdiv_r_ui (mpz_t, const mpz_t, uintptr_t); +uintptr_t mpz_cdiv_ui (const mpz_t, uintptr_t); +uintptr_t mpz_fdiv_ui (const mpz_t, uintptr_t); +uintptr_t mpz_tdiv_ui (const mpz_t, uintptr_t); -unsigned long mpz_mod_ui (mpz_t, const mpz_t, unsigned long); +uintptr_t mpz_mod_ui (mpz_t, const mpz_t, uintptr_t); -void mpz_divexact_ui (mpz_t, const mpz_t, unsigned long); +void mpz_divexact_ui (mpz_t, const mpz_t, uintptr_t); -int mpz_divisible_ui_p (const mpz_t, unsigned long); +int mpz_divisible_ui_p (const mpz_t, uintptr_t); -unsigned long mpz_gcd_ui (mpz_t, const mpz_t, unsigned long); +uintptr_t mpz_gcd_ui (mpz_t, const mpz_t, uintptr_t); void mpz_gcd (mpz_t, const mpz_t, const mpz_t); void mpz_gcdext (mpz_t, mpz_t, mpz_t, const mpz_t, const mpz_t); -void mpz_lcm_ui (mpz_t, const mpz_t, unsigned long); +void mpz_lcm_ui (mpz_t, const mpz_t, uintptr_t); void mpz_lcm (mpz_t, const mpz_t, const mpz_t); int mpz_invert (mpz_t, const mpz_t, const mpz_t); @@ -212,18 +209,18 @@ void mpz_sqrtrem (mpz_t, mpz_t, const mpz_t); void mpz_sqrt (mpz_t, const mpz_t); int mpz_perfect_square_p (const mpz_t); -void mpz_pow_ui (mpz_t, const mpz_t, unsigned long); -void mpz_ui_pow_ui (mpz_t, unsigned long, unsigned long); +void mpz_pow_ui (mpz_t, const mpz_t, uintptr_t); +void mpz_ui_pow_ui (mpz_t, uintptr_t, uintptr_t); void mpz_powm (mpz_t, const mpz_t, const mpz_t, const mpz_t); -void mpz_powm_ui (mpz_t, const mpz_t, unsigned long, const mpz_t); +void mpz_powm_ui (mpz_t, const mpz_t, uintptr_t, const mpz_t); -void mpz_rootrem (mpz_t, mpz_t, const mpz_t, unsigned long); -int mpz_root (mpz_t, const mpz_t, unsigned long); +void mpz_rootrem (mpz_t, mpz_t, const mpz_t, uintptr_t); +int mpz_root (mpz_t, const mpz_t, uintptr_t); -void mpz_fac_ui (mpz_t, unsigned long); -void mpz_2fac_ui (mpz_t, unsigned long); -void mpz_mfac_uiui (mpz_t, unsigned long, unsigned long); -void mpz_bin_uiui (mpz_t, unsigned long, unsigned long); +void mpz_fac_ui (mpz_t, uintptr_t); +void mpz_2fac_ui (mpz_t, uintptr_t); +void mpz_mfac_uiui (mpz_t, uintptr_t, uintptr_t); +void mpz_bin_uiui (mpz_t, uintptr_t, uintptr_t); int mpz_probab_prime_p (const mpz_t, int); @@ -244,8 +241,8 @@ mp_bitcnt_t mpz_scan1 (const mpz_t, mp_bitcnt_t); int mpz_fits_slong_p (const mpz_t); int mpz_fits_ulong_p (const mpz_t); -long int mpz_get_si (const mpz_t); -unsigned long int mpz_get_ui (const mpz_t); +intptr_t mpz_get_si (const mpz_t); +uintptr_t mpz_get_ui (const mpz_t); double mpz_get_d (const mpz_t); size_t mpz_size (const mpz_t); mp_limb_t mpz_getlimbn (const mpz_t, mp_size_t); @@ -259,13 +256,13 @@ mpz_srcptr mpz_roinit_n (mpz_t, mp_srcptr, mp_size_t); #define MPZ_ROINIT_N(xp, xs) {{0, (xs),(xp) }} -void mpz_set_si (mpz_t, signed long int); -void mpz_set_ui (mpz_t, unsigned long int); +void mpz_set_si (mpz_t, intptr_t); +void mpz_set_ui (mpz_t, uintptr_t); void mpz_set (mpz_t, const mpz_t); void mpz_set_d (mpz_t, double); -void mpz_init_set_si (mpz_t, signed long int); -void mpz_init_set_ui (mpz_t, unsigned long int); +void mpz_init_set_si (mpz_t, intptr_t); +void mpz_init_set_ui (mpz_t, uintptr_t); void mpz_init_set (mpz_t, const mpz_t); void mpz_init_set_d (mpz_t, double); diff --git a/libguile/numbers.c b/libguile/numbers.c index 30a826f13..52721d3f3 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -91,27 +91,33 @@ /* FIXME: We assume that FLT_RADIX is 2 */ verify (FLT_RADIX == 2); -/* Make sure that scm_t_inum fits within a SCM value. */ -verify (sizeof (scm_t_inum) <= sizeof (scm_t_bits)); +/* Make sure that intptr_t fits within a SCM value. */ +verify (sizeof (intptr_t) <= sizeof (scm_t_bits)); + +#if !(__MINGW32__ && __x86_64__) +#define L1 1L +#define UL1 1UL +#else /* (__MINGW32__ && __x86_64__) */ +#define L1 1LL +#define UL1 1ULL +#endif /* (__MINGW32__ && __x86_64__) */ /* Several functions below assume that fixnums fit within a long, and furthermore that there is some headroom to spare for other operations without overflowing. */ -verify (SCM_I_FIXNUM_BIT <= SCM_LONG_BIT - 2); +verify (SCM_I_FIXNUM_BIT <= SCM_INTPTR_T_BIT - 2); /* Some functions that use GMP's mpn functions assume that a non-negative fixnum will always fit in a 'mp_limb_t'. */ verify (SCM_MOST_POSITIVE_FIXNUM <= (mp_limb_t) -1); -#define scm_from_inum(x) (scm_from_signed_integer (x)) - /* Test an inum to see if it can be converted to a double without loss of precision. Note that this will sometimes return 0 even when 1 could have been returned, e.g. for large powers of 2. It is designed to be a fast check to optimize common cases. */ #define INUM_LOSSLESSLY_CONVERTIBLE_TO_DOUBLE(n) \ (SCM_I_FIXNUM_BIT-1 <= DBL_MANT_DIG \ - || ((n) ^ ((n) >> (SCM_I_FIXNUM_BIT-1))) < (1L << DBL_MANT_DIG)) + || ((n) ^ ((n) >> (SCM_I_FIXNUM_BIT-1))) < (L1 << DBL_MANT_DIG)) #if (! HAVE_DECL_MPZ_INITS) || SCM_ENABLE_MINI_GMP @@ -2854,8 +2860,8 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_logbit_p { - unsigned long int iindex; - iindex = scm_to_ulong (index); + uintptr_t iindex; + iindex = scm_to_uintptr_t (index); if (SCM_I_INUMP (j)) return scm_from_bool (scm_integer_logbit_ui (iindex, SCM_I_INUM (j))); @@ -3030,13 +3036,13 @@ lsh (SCM n, SCM count, const char *fn) { if (scm_is_eq (n, SCM_INUM0)) return n; - if (!scm_is_unsigned_integer (count, 0, ULONG_MAX)) + if (!scm_is_unsigned_integer (count, 0, UINTPTR_MAX)) scm_num_overflow (fn); - unsigned long ucount = scm_to_ulong (count); + uintptr_t ucount = scm_to_uintptr_t (count); if (ucount == 0) return n; - if (ucount / (sizeof (int) * 8) >= (unsigned long) INT_MAX) + if (ucount / (sizeof (int) * 8) >= (uintptr_t) INT_MAX) scm_num_overflow (fn); if (SCM_I_INUMP (n)) return scm_integer_lsh_iu (SCM_I_INUM (n), ucount); @@ -3046,10 +3052,10 @@ lsh (SCM n, SCM count, const char *fn) static SCM floor_rsh (SCM n, SCM count) { - if (!scm_is_unsigned_integer (count, 0, ULONG_MAX)) + if (!scm_is_unsigned_integer (count, 0, UINTPTR_MAX)) return scm_is_false (scm_negative_p (n)) ? SCM_INUM0 : SCM_I_MAKINUM (-1); - unsigned long ucount = scm_to_ulong (count); + uintptr_t ucount = scm_to_uintptr_t (count); if (ucount == 0) return n; if (SCM_I_INUMP (n)) @@ -3060,10 +3066,10 @@ floor_rsh (SCM n, SCM count) static SCM round_rsh (SCM n, SCM count) { - if (!scm_is_unsigned_integer (count, 0, ULONG_MAX)) + if (!scm_is_unsigned_integer (count, 0, UINTPTR_MAX)) return SCM_INUM0; - unsigned long ucount = scm_to_ulong (count); + uintptr_t ucount = scm_to_uintptr_t (count); if (ucount == 0) return n; if (SCM_I_INUMP (n)) @@ -3153,10 +3159,10 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, if (!scm_is_exact_integer (n)) SCM_WRONG_TYPE_ARG (SCM_ARG1, n); - unsigned long istart = scm_to_ulong (start); - unsigned long iend = scm_to_ulong (end); + uintptr_t istart = scm_to_uintptr_t (start); + uintptr_t iend = scm_to_uintptr_t (end); SCM_ASSERT_RANGE (3, end, (iend >= istart)); - unsigned long bits = iend - istart; + uintptr_t bits = iend - istart; if (SCM_I_INUMP (n)) return scm_integer_bit_extract_i (SCM_I_INUM (n), istart, bits); @@ -5308,7 +5314,7 @@ scm_product (SCM x, SCM y) if (SCM_UNBNDP (y)) { if (SCM_UNBNDP (x)) - return SCM_I_MAKINUM (1L); + return SCM_I_MAKINUM (L1); else if (SCM_NUMBERP (x)) return x; else @@ -5436,7 +5442,7 @@ divide (SCM x, SCM y) return scm_i_make_ratio (x, y); else if (SCM_REALP (y)) /* FIXME: Precision may be lost here due to: - (1) The cast from 'scm_t_inum' to 'double' + (1) The cast from 'intptr_t' to 'double' (2) Double rounding */ return scm_i_from_double ((double) SCM_I_INUM (x) / SCM_REAL_VALUE (y)); else if (SCM_COMPLEXP (y)) @@ -5476,7 +5482,7 @@ divide (SCM x, SCM y) double rx = SCM_REAL_VALUE (x); if (SCM_I_INUMP (y)) /* FIXME: Precision may be lost here due to: - (1) The cast from 'scm_t_inum' to 'double' + (1) The cast from 'intptr_t' to 'double' (2) Double rounding */ return scm_i_from_double (rx / (double) SCM_I_INUM (y)); else if (SCM_BIGP (y)) @@ -5500,7 +5506,7 @@ divide (SCM x, SCM y) if (SCM_I_INUMP (y)) { /* FIXME: Precision may be lost here due to: - (1) The conversion from 'scm_t_inum' to double + (1) The conversion from 'intptr_t' to double (2) Double rounding */ double d = SCM_I_INUM (y); return scm_c_make_rectangular (rx / d, ix / d); @@ -6616,18 +6622,18 @@ range_error (SCM bad_val, SCM min, SCM max) } #define scm_i_range_error range_error -static scm_t_inum -inum_in_range (SCM x, scm_t_inum min, scm_t_inum max) +static intptr_t +inum_in_range (SCM x, intptr_t min, intptr_t max) { if (SCM_LIKELY (SCM_I_INUMP (x))) { - scm_t_inum val = SCM_I_INUM (x); + intptr_t val = SCM_I_INUM (x); if (min <= val && val <= max) return val; } else if (!SCM_BIGP (x)) scm_wrong_type_arg_msg (NULL, 0, x, "exact integer"); - range_error (x, scm_from_long (min), scm_from_long (max)); + range_error (x, scm_from_intptr_t (min), scm_from_intptr_t (max)); } SCM @@ -6667,7 +6673,7 @@ scm_to_unsigned_integer (SCM arg, uintmax_t min, uintmax_t max) uint64_t ret; if (SCM_I_INUMP (arg)) { - scm_t_inum n = SCM_I_INUM (arg); + intptr_t n = SCM_I_INUM (arg); if (n < 0) goto out_of_range; ret = n; @@ -6736,7 +6742,7 @@ scm_from_uint16 (uint16_t arg) int32_t scm_to_int32 (SCM arg) { -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 if (SCM_I_INUMP (arg)) return SCM_I_INUM (arg); else if (!SCM_BIGP (arg)) @@ -6746,7 +6752,7 @@ scm_to_int32 (SCM arg) return ret; range_error (arg, scm_integer_from_int32 (INT32_MIN), scm_integer_from_int32 (INT32_MAX)); -#elif SCM_SIZEOF_LONG == 8 +#elif SCM_SIZEOF_INTPTR_T == 8 return inum_in_range (arg, INT32_MIN, INT32_MAX); #else #error bad inum size @@ -6756,9 +6762,9 @@ scm_to_int32 (SCM arg) SCM scm_from_int32 (int32_t arg) { -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 return scm_integer_from_int32 (arg); -#elif SCM_SIZEOF_LONG == 8 +#elif SCM_SIZEOF_INTPTR_T == 8 return SCM_I_MAKINUM (arg); #else #error bad inum size @@ -6768,7 +6774,7 @@ scm_from_int32 (int32_t arg) uint32_t scm_to_uint32 (SCM arg) { -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 if (SCM_I_INUMP (arg)) { if (SCM_I_INUM (arg) >= 0) @@ -6783,7 +6789,7 @@ scm_to_uint32 (SCM arg) else scm_wrong_type_arg_msg (NULL, 0, arg, "exact integer"); range_error (arg, scm_integer_from_uint32 (0), scm_integer_from_uint32 (UINT32_MAX)); -#elif SCM_SIZEOF_LONG == 8 +#elif SCM_SIZEOF_INTPTR_T == 8 return inum_in_range (arg, 0, UINT32_MAX); #else #error bad inum size @@ -6793,9 +6799,9 @@ scm_to_uint32 (SCM arg) SCM scm_from_uint32 (uint32_t arg) { -#if SCM_SIZEOF_LONG == 4 +#if SCM_SIZEOF_INTPTR_T == 4 return scm_integer_from_uint32 (arg); -#elif SCM_SIZEOF_LONG == 8 +#elif SCM_SIZEOF_INTPTR_T == 8 return SCM_I_MAKINUM (arg); #else #error bad inum size @@ -6965,7 +6971,7 @@ scm_is_number (SCM z) /* Returns log(x * 2^shift) */ static SCM -log_of_shifted_double (double x, long shift) +log_of_shifted_double (double x, intptr_t shift) { /* cf scm_log10 */ double ans = log (fabs (x)) + shift * M_LN2; @@ -6983,7 +6989,7 @@ log_of_exact_integer (SCM n) return log_of_shifted_double (SCM_I_INUM (n), 0); else if (SCM_BIGP (n)) { - long expon; + intptr_t expon; double signif = scm_integer_frexp_z (scm_bignum (n), &expon); return log_of_shifted_double (signif, expon); } @@ -6995,8 +7001,8 @@ log_of_exact_integer (SCM n) static SCM log_of_fraction (SCM n, SCM d) { - long n_size = scm_to_long (scm_integer_length (n)); - long d_size = scm_to_long (scm_integer_length (d)); + intptr_t n_size = scm_to_intptr_t (scm_integer_length (n)); + intptr_t d_size = scm_to_intptr_t (scm_integer_length (d)); if (labs (n_size - d_size) > 1) return (scm_difference (log_of_exact_integer (n), @@ -7152,7 +7158,7 @@ scm_exact_integer_sqrt (SCM k, SCM *sp, SCM *rp) { if (SCM_I_INUMP (k)) { - scm_t_inum kk = SCM_I_INUM (k); + intptr_t kk = SCM_I_INUM (k); if (kk >= 0) return scm_integer_exact_sqrt_i (kk, sp, rp); } @@ -7183,7 +7189,7 @@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0, { if (SCM_I_INUMP (z)) { - scm_t_inum i = SCM_I_INUM (z); + intptr_t i = SCM_I_INUM (z); if (scm_is_integer_perfect_square_i (i)) return scm_integer_floor_sqrt_i (i); double root = scm_integer_inexact_sqrt_i (i); @@ -7232,16 +7238,16 @@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0, double xx = scm_i_divide2double (n, d); double abs_xx = fabs (xx); - long shift = 0; + intptr_t shift = 0; if (abs_xx > DBL_MAX || abs_xx < DBL_MIN) { - shift = (scm_to_long (scm_integer_length (n)) - - scm_to_long (scm_integer_length (d))) / 2; + shift = (scm_to_intptr_t (scm_integer_length (n)) + - scm_to_intptr_t (scm_integer_length (d))) / 2; if (shift > 0) - d = lsh (d, scm_from_long (2 * shift), FUNC_NAME); + d = lsh (d, scm_from_intptr_t (2 * shift), FUNC_NAME); else - n = lsh (n, scm_from_long (-2 * shift), FUNC_NAME); + n = lsh (n, scm_from_intptr_t (-2 * shift), FUNC_NAME); xx = scm_i_divide2double (n, d); } diff --git a/libguile/numbers.h b/libguile/numbers.h index 84ad5466f..5fcee1a04 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -54,10 +54,17 @@ extern "C++" { * (along with two tagging bits). * * In the current implementation, Inums must also fit within a long - * because that's what GMP's mpz_*_si functions accept. */ -typedef long scm_t_inum; -#define SCM_I_FIXNUM_BIT (SCM_LONG_BIT - 2) + * because that's what GMP's mpz_*_si functions accept. + * + * When using mini-gmp, we use intptr_t instead. + */ + +#define SCM_I_FIXNUM_BIT (SCM_INTPTR_T_BIT - 2) +#if !(__MINGW32__ && __x86_64__) #define SCM_MOST_NEGATIVE_FIXNUM (-1L << (SCM_I_FIXNUM_BIT - 1)) +#else /* __MINGW32__ && __x86_64__ */ +#define SCM_MOST_NEGATIVE_FIXNUM (-1LL << (SCM_I_FIXNUM_BIT - 1)) +#endif /* __MINGW32__ && __x86_64__ */ #define SCM_MOST_POSITIVE_FIXNUM (- (SCM_MOST_NEGATIVE_FIXNUM + 1)) /* SCM_SRS (X, Y) is signed right shift, defined as floor (X / 2^Y), @@ -85,12 +92,12 @@ typedef long scm_t_inum; NOTE: X must not perform side effects. */ #ifdef __GNUC__ -# define SCM_I_INUM(x) (SCM_SRS ((scm_t_inum) SCM_UNPACK (x), 2)) +# define SCM_I_INUM(x) (SCM_SRS ((intptr_t) SCM_UNPACK (x), 2)) #else # define SCM_I_INUM(x) \ (SCM_UNPACK (x) > SCM_T_SIGNED_BITS_MAX \ - ? -1 - (scm_t_inum) (~SCM_UNPACK (x) >> 2) \ - : (scm_t_inum) (SCM_UNPACK (x) >> 2)) + ? -1 - (intptr_t) (~SCM_UNPACK (x) >> 2) \ + : (intptr_t) (SCM_UNPACK (x) >> 2)) #endif #define SCM_I_INUMP(x) (2 & SCM_UNPACK (x)) diff --git a/libguile/scm.h b/libguile/scm.h index e69552893..7ffc85c53 100644 --- a/libguile/scm.h +++ b/libguile/scm.h @@ -837,10 +837,8 @@ typedef struct scm_thread scm_thread; # define SCM_CHAR_BIT 8 #endif -#ifdef LONG_BIT -# define SCM_LONG_BIT LONG_BIT -#else -# define SCM_LONG_BIT (SCM_SIZEOF_LONG * 8) +#ifndef INTPTR_T_BIT +# define SCM_INTPTR_T_BIT (SCM_SIZEOF_INTPTR_T * 8) #endif diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index 975d2bd18..c056a897b 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -1,4 +1,4 @@ -/* Copyright 1995-2002,2004,2006-2009,2011,2013-2014,2017-2018 +/* Copyright 1995-2002,2004,2006-2009,2011,2013-2014,2017-2018,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -344,9 +344,9 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, query_only = 1; else if (scm_is_integer (handler)) { - long handler_int = scm_to_long (handler); + intptr_t handler_int = scm_to_intptr_t (handler); - if (handler_int == (long) SIG_DFL || handler_int == (long) SIG_IGN) + if (handler_int == (intptr_t) SIG_DFL || handler_int == (intptr_t) SIG_IGN) { #ifdef HAVE_SIGACTION action.sa_handler = (void (*) (int)) handler_int; @@ -442,7 +442,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, orig_handlers[csig] = old_action; } if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN) - old_handler = scm_from_long ((long) old_action.sa_handler); + old_handler = scm_from_intptr_t ((intptr_t) old_action.sa_handler); scm_dynwind_end (); @@ -463,7 +463,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, orig_handlers[csig] = old_chandler; } if (old_chandler == SIG_DFL || old_chandler == SIG_IGN) - old_handler = scm_from_long ((long) old_chandler); + old_handler = scm_from_intptr_t ((intptr_t) old_chandler); scm_dynwind_end (); @@ -727,8 +727,8 @@ scm_init_scmsigs () } scm_c_define ("NSIG", scm_from_long (NSIG)); - scm_c_define ("SIG_IGN", scm_from_long ((long) SIG_IGN)); - scm_c_define ("SIG_DFL", scm_from_long ((long) SIG_DFL)); + scm_c_define ("SIG_IGN", scm_from_intptr_t ((intptr_t) SIG_IGN)); + scm_c_define ("SIG_DFL", scm_from_intptr_t ((intptr_t) SIG_DFL)); #ifdef SA_NOCLDSTOP scm_c_define ("SA_NOCLDSTOP", scm_from_long (SA_NOCLDSTOP)); #endif diff --git a/libguile/srfi-60.c b/libguile/srfi-60.c index 93bc68875..616ce074f 100644 --- a/libguile/srfi-60.c +++ b/libguile/srfi-60.c @@ -1,6 +1,6 @@ /* srfi-60.c --- Integers as Bits - Copyright 2005-2006,2008,2010,2014,2018,2022 + Copyright 2005-2006,2008,2010,2014,2018,2021,2022 Free Software Foundation, Inc. This file is part of Guile. @@ -76,10 +76,10 @@ SCM_DEFINE (scm_srfi60_copy_bit, "copy-bit", 3, 0, 0, "@end example") #define FUNC_NAME s_scm_srfi60_copy_bit { - unsigned long ii; + uintptr_t ii; int bb; - ii = scm_to_ulong (index); + ii = scm_to_uintptr_t (index); bb = scm_to_bool (newbit); if (SCM_I_INUMP (n)) @@ -113,9 +113,9 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0, "@end example") #define FUNC_NAME s_scm_srfi60_rotate_bit_field { - unsigned long ss = scm_to_ulong (start); - unsigned long ee = scm_to_ulong (end); - unsigned long ww, cc; + uintptr_t ss = scm_to_uintptr_t (start); + uintptr_t ee = scm_to_uintptr_t (end); + uintptr_t ww, cc; SCM_ASSERT_RANGE (3, end, (ee >= ss)); ww = ee - ss; @@ -125,45 +125,46 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0, if (ww <= 1) cc = 0; else - cc = scm_to_ulong (scm_modulo (count, scm_difference (end, start))); + cc = scm_to_uintptr_t (scm_modulo (count, scm_difference (end, start))); mpz_t zn; if (SCM_I_INUMP (n)) { - long nn = SCM_I_INUM (n); + intptr_t nn = SCM_I_INUM (n); - if (ee <= SCM_LONG_BIT-1) + if (ee <= SCM_INTPTR_T_BIT-1) { - /* Everything fits within a long. To avoid undefined behavior - when shifting negative numbers, we do all operations using - unsigned values, and then convert to signed at the end. */ - unsigned long unn = nn; - unsigned long below = unn & ((1UL << ss) - 1); /* below start */ - unsigned long above = unn & ~((1UL << ee) - 1); /* above end */ - unsigned long fmask = ((1UL << ww) - 1) << ss; /* field mask */ - unsigned long ff = unn & fmask; /* field */ - unsigned long uresult = (above + /* Everything fits within a intptr_t. To avoid undefined + behavior when shifting negative numbers, we do all + operations using unsigned values, and then convert to + signed at the end. */ + uintptr_t unn = nn; + uintptr_t below = unn & ((1UL << ss) - 1); /* below start */ + uintptr_t above = unn & ~((1UL << ee) - 1); /* above end */ + uintptr_t fmask = ((1UL << ww) - 1) << ss; /* field mask */ + uintptr_t ff = unn & fmask; /* field */ + uintptr_t uresult = (above | ((ff << cc) & fmask) | ((ff >> (ww-cc)) & fmask) | below); - long result; + intptr_t result; - if (uresult > LONG_MAX) + if (uresult > INTPTR_MAX) /* The high bit is set in uresult, so the result is negative. We have to handle the conversion to signed integer carefully, to avoid undefined behavior. First we compute ~uresult, equivalent to (ULONG_MAX - uresult), which will be between 0 and LONG_MAX (inclusive): exactly - the set of numbers that can be represented as both signed - and unsigned longs and thus convertible between them. We + the set of numbers that can be represented as both intptr_t + and uintptr_p and thus convertible between them. We cast that difference to a signed long and then substract it from -1. */ - result = -1 - (long) ~uresult; + result = -1 - (intptr_t) ~uresult; else - result = (long) uresult; + result = (intptr_t) uresult; - return scm_from_long (result); + return scm_from_intptr_t (result); } else { @@ -230,31 +231,31 @@ SCM_DEFINE (scm_srfi60_reverse_bit_field, "reverse-bit-field", 3, 0, 0, "@end example") #define FUNC_NAME s_scm_srfi60_reverse_bit_field { - long ss = scm_to_long (start); - long ee = scm_to_long (end); - long swaps = (ee - ss) / 2; /* number of swaps */ + intptr_t ss = scm_to_intptr_t (start); + intptr_t ee = scm_to_intptr_t (end); + intptr_t swaps = (ee - ss) / 2; /* number of swaps */ mpz_t b; if (SCM_I_INUMP (n)) { - long nn = SCM_I_INUM (n); + intptr_t nn = SCM_I_INUM (n); - if (ee <= SCM_LONG_BIT-1) + if (ee <= SCM_INTPTR_T_BIT-1) { - /* all within a long */ - long smask = 1L << ss; - long emask = 1L << (ee-1); + /* all within a intptr_t */ + intptr_t smask = 1L << ss; + intptr_t emask = 1L << (ee-1); for ( ; swaps > 0; swaps--) { - long sbit = nn & smask; - long ebit = nn & emask; + intptr_t sbit = nn & smask; + intptr_t ebit = nn & emask; nn ^= sbit ^ (ebit ? smask : 0) /* zap sbit, put ebit value */ ^ ebit ^ (sbit ? emask : 0); /* zap ebit, put sbit value */ smask <<= 1; emask >>= 1; } - return scm_from_long (nn); + return scm_from_intptr_t (nn); } else { @@ -319,22 +320,22 @@ SCM_DEFINE (scm_srfi60_integer_to_list, "integer->list", 1, 1, 0, #define FUNC_NAME s_scm_srfi60_integer_to_list { SCM ret = SCM_EOL; - unsigned long ll; + uintptr_t ll; if (SCM_UNBNDP (len)) len = scm_integer_length (n); - ll = scm_to_ulong (len); + ll = scm_to_uintptr_t (len); if (SCM_I_INUMP (n)) { - scm_t_inum nn = SCM_I_INUM (n); - for (unsigned long i = 0; i < ll; i++) + intptr_t nn = SCM_I_INUM (n); + for (uintptr_t i = 0; i < ll; i++) ret = scm_cons (scm_from_bool (scm_integer_logbit_ui (i, nn)), ret); } else if (SCM_BIGP (n)) { struct scm_bignum *nn = scm_bignum (n); - for (unsigned long i = 0; i < ll; i++) + for (uintptr_t i = 0; i < ll; i++) ret = scm_cons (scm_from_bool (scm_integer_logbit_uz (i, nn)), ret); } else @@ -357,7 +358,7 @@ SCM_DEFINE (scm_srfi60_list_to_integer, "list->integer", 1, 0, 0, "@end example") #define FUNC_NAME s_scm_srfi60_list_to_integer { - long len; + intptr_t len; /* strip high zero bits from lst; after this the length tells us whether an inum or bignum is required */ @@ -369,7 +370,7 @@ SCM_DEFINE (scm_srfi60_list_to_integer, "list->integer", 1, 0, 0, if (len <= SCM_I_FIXNUM_BIT - 1) { /* fits an inum (a positive inum) */ - long n = 0; + intptr_t n = 0; while (scm_is_pair (lst)) { n <<= 1; diff --git a/libguile/strings.c b/libguile/strings.c index 5eebb3300..27cafebc4 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -1,4 +1,4 @@ -/* Copyright 1995-1996,1998,2000-2001,2004,2006,2008-2016,2018-2019 +/* Copyright 1995-1996,1998,2000-2001,2004,2006,2008-2016,2018-2019,2021 Free Software Foundation, Inc. This file is part of Guile. @@ -760,7 +760,7 @@ scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr) #define SYMBOL_STRINGBUF SCM_CELL_OBJECT_1 SCM -scm_i_make_symbol (SCM name, scm_t_bits flags, unsigned long hash) +scm_i_make_symbol (SCM name, scm_t_bits flags, uintptr_t hash) { SCM buf, symbol; size_t start, length = STRING_LENGTH (name); @@ -1219,7 +1219,7 @@ SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0, #define FUNC_NAME s_scm_string_ref { size_t len; - unsigned long idx; + uintptr_t idx; SCM_VALIDATE_STRING (1, str); @@ -1256,7 +1256,7 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0, #define FUNC_NAME s_scm_string_set_x { size_t len; - unsigned long idx; + uintptr_t idx; SCM_VALIDATE_STRING (1, str); diff --git a/libguile/strings.h b/libguile/strings.h index f28ef3246..276ddf222 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -1,7 +1,7 @@ #ifndef SCM_STRINGS_H #define SCM_STRINGS_H -/* Copyright 1995-1998,2000-2001,2004-2006,2008-2011,2013,2015-2019,2022 +/* Copyright 1995-1998,2000-2001,2004-2006,2008-2011,2013,2015-2019,2021,2022 Free Software Foundation, Inc. This file is part of Guile. @@ -26,6 +26,7 @@ #include #include "libguile/inline.h" #include +#include "libguile/numbers.h" @@ -250,7 +251,7 @@ SCM_INTERNAL void scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr); /* internal functions related to symbols. */ SCM_INTERNAL SCM scm_i_make_symbol (SCM name, scm_t_bits flags, - unsigned long hash); + uintptr_t hash); SCM_INTERNAL const char *scm_i_symbol_chars (SCM sym); SCM_INTERNAL const scm_t_wchar *scm_i_symbol_wide_chars (SCM sym); SCM_INTERNAL size_t scm_i_symbol_length (SCM sym); diff --git a/libguile/symbols.c b/libguile/symbols.c index 02be7c1c4..360470556 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -1,4 +1,4 @@ -/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009,2011,2013,2015,2018,2022 +/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009,2011,2013,2015,2018 Free Software Foundation, Inc. This file is part of Guile. @@ -415,7 +415,7 @@ SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0, #define FUNC_NAME s_scm_symbol_hash { SCM_VALIDATE_SYMBOL (1, symbol); - return scm_from_ulong (scm_i_symbol_hash (symbol)); + return scm_from_uintptr_t (scm_i_symbol_hash (symbol)); } #undef FUNC_NAME