mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-06 04:00:26 +02:00
Code Activity

More long integer fixes for x86_64-w64-mingw32

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

2
libguile/gc.c
View file

@ -211,7 +211,7 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
"returned by this function for @var{obj}") "returned by this function for @var{obj}")
#define FUNC_NAME s_scm_object_address #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 #undef FUNC_NAME

14
libguile/gen-scmconfig.c
View file

@ -325,14 +325,18 @@ main (int argc, char *argv[])
pf ("typedef int64_t scm_t_off;\n"); pf ("typedef int64_t scm_t_off;\n");
pf ("#define SCM_T_OFF_MAX INT64_MAX\n"); pf ("#define SCM_T_OFF_MAX INT64_MAX\n");
pf ("#define SCM_T_OFF_MIN INT64_MIN\n"); pf ("#define SCM_T_OFF_MIN INT64_MIN\n");
#elif SIZEOF_OFF_T == SIZEOF_INT #elif SIZEOF_OFF_T == SIZEOF_LONG
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
pf ("typedef long int scm_t_off;\n"); pf ("typedef long int scm_t_off;\n");
pf ("#define SCM_T_OFF_MAX LONG_MAX\n"); pf ("#define SCM_T_OFF_MAX LONG_MAX\n");
pf ("#define SCM_T_OFF_MIN LONG_MIN\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 #endif
pf ("/* Define to 1 if the compiler supports the " pf ("/* Define to 1 if the compiler supports the "

3
libguile/integers.c
View file

@ -2599,8 +2599,9 @@ scm_integer_length_z (struct scm_bignum *n)
mpz_t zn; mpz_t zn;
alias_bignum_to_mpz (n, zn); alias_bignum_to_mpz (n, zn);
size_t size = mpz_sizeinbase (zn, 2); 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 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--; size--;
scm_remember_upto_here_1 (n); scm_remember_upto_here_1 (n);
return scm_from_size_t (size); return scm_from_size_t (size);

2
libguile/ports.c
View file

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

12
libguile/srfi-60.c
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 behavior when shifting negative numbers, we do all
operations using unsigned values, and then convert to operations using unsigned values, and then convert to
signed at the end. */ signed at the end. */
const uintptr_t UL1 = 1UL;
uintptr_t unn = nn; uintptr_t unn = nn;
uintptr_t below = unn & ((1UL << ss) - 1); /* below start */ uintptr_t below = unn & ((UL1 << ss) - 1); /* below start */
uintptr_t above = unn & ~((1UL << ee) - 1); /* above end */ uintptr_t above = unn & ~((UL1 << ee) - 1); /* above end */
uintptr_t fmask = ((1UL << ww) - 1) << ss; /* field mask */ uintptr_t fmask = ((UL1 << ww) - 1) << ss; /* field mask */
uintptr_t ff = unn & fmask; /* field */ uintptr_t ff = unn & fmask; /* field */
uintptr_t uresult = (above uintptr_t uresult = (above
| ((ff << cc) & fmask) | ((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) if (ee <= SCM_INTPTR_T_BIT-1)
{ {
/* all within a intptr_t */ /* all within a intptr_t */
intptr_t smask = 1L << ss; intptr_t L1 = 1L;
intptr_t emask = 1L << (ee-1); intptr_t smask = L1 << ss;
intptr_t emask = L1 << (ee-1);
for ( ; swaps > 0; swaps--) for ( ; swaps > 0; swaps--)
{ {
intptr_t sbit = nn & smask; intptr_t sbit = nn & smask;

2
libguile/symbols.h
View file

@ -31,7 +31,7 @@
#define scm_is_symbol(x) (SCM_HAS_TYP7 (x, scm_tc7_symbol)) #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) \ #define scm_i_symbol_is_interned(x) \
(!(SCM_CELL_WORD_0 (x) & SCM_I_F_SYMBOL_UNINTERNED)) (!(SCM_CELL_WORD_0 (x) & SCM_I_F_SYMBOL_UNINTERNED))