1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-04 19:20:27 +02:00

More long integer fixes for x86_64-w64-mingw32

* libguile/gc.c (scm_object_address): use uintptr_t instead of ulong
* libguile/gen-scmconfig.c (main): handle different sizes of scm_off_t
* libguile/integers.c (scm_integer_length_z): the mask size is bitcnt_max,
    not UINTPTR_MAX
* libguile/ports.c (scm_set_port_line_x): test that line is an intptr_t,
    not a long
* libguile/srfi-60.c (scm_srfi60_rotate_bit_fields): use correct size of
    integer for bit-shifting
  (scm_srfi60_reverse_bit_field): use correct integer size for bit-shifting
* libguile/symbols.h (scm_i_symbol_hash): cast to uintptr_t, not unsigned long
This commit is contained in:
Michael Gran 2022-11-07 21:57:45 -08:00
parent 46bb667f20
commit 9a29293a88
6 changed files with 21 additions and 14 deletions

View file

@ -211,7 +211,7 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
"returned by this function for @var{obj}")
#define FUNC_NAME s_scm_object_address
{
return scm_from_ulong (SCM_UNPACK (obj));
return scm_from_uintptr_t (SCM_UNPACK (obj));
}
#undef FUNC_NAME

View file

@ -325,14 +325,18 @@ main (int argc, char *argv[])
pf ("typedef int64_t scm_t_off;\n");
pf ("#define SCM_T_OFF_MAX INT64_MAX\n");
pf ("#define SCM_T_OFF_MIN INT64_MIN\n");
#elif SIZEOF_OFF_T == SIZEOF_INT
pf ("typedef int scm_t_off;\n");
pf ("#define SCM_T_OFF_MAX INT_MAX\n");
pf ("#define SCM_T_OFF_MIN INT_MIN\n");
#else
#elif SIZEOF_OFF_T == SIZEOF_LONG
pf ("typedef long int scm_t_off;\n");
pf ("#define SCM_T_OFF_MAX LONG_MAX\n");
pf ("#define SCM_T_OFF_MIN LONG_MIN\n");
#elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
pf ("typedef long long int scm_t_off;\n");
pf ("#define SCM_T_OFF_MAX LONG_LONG_MAX\n");
pf ("#define SCM_T_OFF_MIN LONG_LONG_MIN\n");
#else
pf ("typedef int scm_t_off;\n");
pf ("#define SCM_T_OFF_MAX INT_MAX\n");
pf ("#define SCM_T_OFF_MIN INT_MIN\n");
#endif
pf ("/* Define to 1 if the compiler supports the "

View file

@ -2599,8 +2599,9 @@ scm_integer_length_z (struct scm_bignum *n)
mpz_t zn;
alias_bignum_to_mpz (n, zn);
size_t size = mpz_sizeinbase (zn, 2);
const mp_bitcnt_t bitcnt_max = (mp_bitcnt_t) ~ (mp_bitcnt_t) 0;
/* If negative and no 0 bits above the lowest 1, adjust result. */
if (mpz_sgn (zn) < 0 && mpz_scan0 (zn, mpz_scan1 (zn, 0)) == UINTPTR_MAX)
if (mpz_sgn (zn) < 0 && mpz_scan0 (zn, mpz_scan1 (zn, 0)) == bitcnt_max)
size--;
scm_remember_upto_here_1 (n);
return scm_from_size_t (size);

View file

@ -3915,7 +3915,7 @@ SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0,
{
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1, port);
scm_to_long (line);
scm_to_intptr_t (line);
scm_port_position_set_line (SCM_PORT (port)->position, line);
return SCM_UNSPECIFIED;
}

View file

@ -139,10 +139,11 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
behavior when shifting negative numbers, we do all
operations using unsigned values, and then convert to
signed at the end. */
const uintptr_t UL1 = 1UL;
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 below = unn & ((UL1 << ss) - 1); /* below start */
uintptr_t above = unn & ~((UL1 << ee) - 1); /* above end */
uintptr_t fmask = ((UL1 << ww) - 1) << ss; /* field mask */
uintptr_t ff = unn & fmask; /* field */
uintptr_t uresult = (above
| ((ff << cc) & fmask)
@ -243,8 +244,9 @@ SCM_DEFINE (scm_srfi60_reverse_bit_field, "reverse-bit-field", 3, 0, 0,
if (ee <= SCM_INTPTR_T_BIT-1)
{
/* all within a intptr_t */
intptr_t smask = 1L << ss;
intptr_t emask = 1L << (ee-1);
intptr_t L1 = 1L;
intptr_t smask = L1 << ss;
intptr_t emask = L1 << (ee-1);
for ( ; swaps > 0; swaps--)
{
intptr_t sbit = nn & smask;

View file

@ -31,7 +31,7 @@
#define scm_is_symbol(x) (SCM_HAS_TYP7 (x, scm_tc7_symbol))
#define scm_i_symbol_hash(x) ((unsigned long) SCM_CELL_WORD_2 (x))
#define scm_i_symbol_hash(x) ((uintptr_t) SCM_CELL_WORD_2 (x))
#define scm_i_symbol_is_interned(x) \
(!(SCM_CELL_WORD_0 (x) & SCM_I_F_SYMBOL_UNINTERNED))