On Sun, 2024-07-14 at 20:30 +0200, Jonas Hahnfeld wrote: > On Wed, 2024-03-20 at 21:28 +0100, Jonas Hahnfeld wrote: > > I'm also explicitly CC'ing Andy and Ludo - we really need a statement > > by a maintainer whether this can land. From my point of view, it's a > > clear improvement in terms of supported platforms, plus tested by > > LilyPond since some time now which is probably one of the bigger > > "customers". > > Another ping on this topic... I'm a bit disappointed that Guile 3.0.10 > was released without even a comment on this thread by a maintainer > after multiple developers and users expressed their interest in seeing > a natively working 64-bit Guile on Windows. We continue to carry the > patches downstream in LilyPond, and recently Michael Käppler (CC'ed) > investigated and provided fixes for some more problems with 32-bit long > on Windows that would ideally find their way upstream. > > To potentially make some progress, maybe we can start by reviewing the > refactoring patches that should be less contentious? I'm attaching > rebased versions of them that should apply to current main. I'm also > including the patch to store hashes in uintptr_t, as also done by Jan > Nieuwenhuizen, Mike Gran, and Andy Wingo in the wip-mingw branch, which > has no direct relationship to the GMP function discussion.
Another ping on this thread. Just to remind, this is important for LilyPond, which is a fellow GNU project. I'm attaching the first five patches required to support 64-bit Windows. They originate from October 2023 and are 15 months old by now. If they were human, they would start talking and walking - maybe they can make it into the repository before kindergarten? The sixth patch is for supporting JIT - I also submitted it to https://gitlab.com/wingo/lightening/-/merge_requests/26 I would be very happy to see this moving forward... Jonas
From b9e22ebb9edc8be6af425fa74ce436bd8c55946b Mon Sep 17 00:00:00 2001
From: Jonas Hahnfeld <hah...@hahnjo.de>
Date: Wed, 30 Aug 2023 17:07:10 +0200
Subject: [PATCH 1/6] scm_i_divide2double: Refactor to use scm_to_mpz
* libguile/numbers.c (scm_i_divide2double): Refactor to use scm_to_mpz.
---
libguile/numbers.c | 12 +++---------
1 file changed, 3 insertions(+), 9 deletions(-)
diff --git a/libguile/numbers.c b/libguile/numbers.c
index ae2aa7766..fc598694a 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -294,16 +294,11 @@ scm_i_divide2double (SCM n, SCM d)
else
return 0.0 / 0.0;
}
-
- mpz_init_set_si (dd, SCM_I_INUM (d));
}
- else
- scm_integer_init_set_mpz_z (scm_bignum (d), dd);
- if (SCM_I_INUMP (n))
- mpz_init_set_si (nn, SCM_I_INUM (n));
- else
- scm_integer_init_set_mpz_z (scm_bignum (n), nn);
+ mpz_inits (nn, dd, lo, hi, x, NULL);
+ scm_to_mpz (d, dd);
+ scm_to_mpz (n, nn);
neg = (mpz_sgn (nn) < 0) ^ (mpz_sgn (dd) < 0);
mpz_abs (nn, nn);
@@ -351,7 +346,6 @@ scm_i_divide2double (SCM n, SCM d)
/* Compute the initial values of lo, x, and hi
based on the initial guess of e */
- mpz_inits (lo, hi, x, NULL);
mpz_mul_2exp (x, nn, 2 + ((e < 0) ? -e : 0));
mpz_mul (lo, dd, scm_i_divide2double_lo2b);
if (e > 0)
--
2.48.1
From 8139d610a31204ed4111c3f0f61ff7582d2238e9 Mon Sep 17 00:00:00 2001
From: Jonas Hahnfeld <hah...@hahnjo.de>
Date: Wed, 30 Aug 2023 17:36:30 +0200
Subject: [PATCH 2/6] scm_integer_modulo_expt_nnn: Refactor to use scm_to_mpz
* libguile/integers.c (scm_integer_modulo_expt_nnn): Refactor to use
scm_to_mpz.
(integer_init_mpz): Remove helper function.
---
libguile/integers.c | 28 ++++++++++------------------
1 file changed, 10 insertions(+), 18 deletions(-)
diff --git a/libguile/integers.c b/libguile/integers.c
index cc62d1c78..81ee06206 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -2318,21 +2318,6 @@ scm_integer_expt_zi (struct scm_bignum *n, scm_t_inum k)
return take_mpz (res);
}
-static void
-integer_init_mpz (mpz_ptr z, SCM n)
-{
- if (SCM_I_INUMP (n))
- mpz_init_set_si (z, SCM_I_INUM (n));
- else
- {
- ASSERT (SCM_BIGP (n));
- mpz_t zn;
- alias_bignum_to_mpz (scm_bignum (n), zn);
- mpz_init_set (z, zn);
- scm_remember_upto_here_1 (n);
- }
-}
-
SCM
scm_integer_modulo_expt_nnn (SCM n, SCM k, SCM m)
{
@@ -2341,9 +2326,16 @@ scm_integer_modulo_expt_nnn (SCM n, SCM k, SCM m)
mpz_t n_tmp, k_tmp, m_tmp;
- integer_init_mpz (n_tmp, n);
- integer_init_mpz (k_tmp, k);
- integer_init_mpz (m_tmp, m);
+#if (! HAVE_DECL_MPZ_INITS) || SCM_ENABLE_MINI_GMP
+ mpz_init (n_tmp);
+ mpz_init (k_tmp);
+ mpz_init (m_tmp);
+#else
+ mpz_inits (n_tmp, k_tmp, m_tmp, NULL);
+#endif
+ scm_to_mpz (n, n_tmp);
+ scm_to_mpz (k, k_tmp);
+ scm_to_mpz (m, m_tmp);
/* if the exponent K is negative, and we simply call mpz_powm, we
will get a divide-by-zero exception when an inverse 1/n mod m
--
2.48.1
From 820b10c9e22386379adaab00b280c9f5ed7016e8 Mon Sep 17 00:00:00 2001
From: Jonas Hahnfeld <hah...@hahnjo.de>
Date: Sat, 2 Sep 2023 16:38:59 +0200
Subject: [PATCH 3/6] Rename functions that should accept scm_t_inum
* libguile/integers.c (long_to_bignum): Rename to inum_to_bignum.
(long_to_scm): Rename to scm_from_inum.
---
libguile/integers.c | 52 ++++++++++++++++++++++-----------------------
1 file changed, 26 insertions(+), 26 deletions(-)
diff --git a/libguile/integers.c b/libguile/integers.c
index 81ee06206..b4090e5bf 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -245,7 +245,7 @@ ulong_to_bignum (unsigned long u)
};
static struct scm_bignum *
-long_to_bignum (long i)
+inum_to_bignum (scm_t_inum i)
{
if (i > 0)
return ulong_to_bignum (i);
@@ -260,11 +260,11 @@ scm_from_bignum (struct scm_bignum *x)
}
static SCM
-long_to_scm (long i)
+scm_from_inum (scm_t_inum i)
{
if (SCM_FIXABLE (i))
return SCM_I_MAKINUM (i);
- return scm_from_bignum (long_to_bignum (i));
+ return scm_from_bignum (inum_to_bignum (i));
}
static SCM
@@ -328,7 +328,7 @@ take_mpz (mpz_ptr mpz)
{
SCM ret;
if (mpz_fits_slong_p (mpz))
- ret = long_to_scm (mpz_get_si (mpz));
+ ret = scm_from_inum (mpz_get_si (mpz));
else
ret = scm_from_bignum (make_bignum_from_mpz (mpz));
mpz_clear (mpz);
@@ -516,7 +516,7 @@ scm_integer_abs_i (scm_t_inum i)
if (i >= 0)
return SCM_I_MAKINUM (i);
- return ulong_to_scm (long_magnitude (i));
+ return scm_from_inum (-i);
}
SCM
@@ -541,7 +541,7 @@ scm_integer_floor_quotient_ii (scm_t_inum x, scm_t_inum y)
else if (x > 0)
x = x - y - 1;
scm_t_inum q = x / y;
- return long_to_scm (q);
+ return scm_from_inum (q);
}
SCM
@@ -675,7 +675,7 @@ scm_integer_floor_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp)
q--;
}
- *qp = long_to_scm (q);
+ *qp = scm_from_inum (q);
*rp = SCM_I_MAKINUM (r);
}
@@ -768,7 +768,7 @@ scm_integer_ceiling_quotient_ii (scm_t_inum x, scm_t_inum y)
x = x + y + 1;
scm_t_inum q = x / y;
- return long_to_scm (q);
+ return scm_from_inum (q);
}
SCM
@@ -935,7 +935,7 @@ 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 = scm_from_inum (q);
*rp = SCM_I_MAKINUM (r);
}
}
@@ -1034,7 +1034,7 @@ scm_integer_truncate_quotient_ii (scm_t_inum x, scm_t_inum y)
else
{
scm_t_inum q = x / y;
- return long_to_scm (q);
+ return scm_from_inum (q);
}
}
@@ -1096,7 +1096,7 @@ scm_integer_truncate_remainder_ii (scm_t_inum x, scm_t_inum y)
else
{
scm_t_inum q = x % y;
- return long_to_scm (q);
+ return scm_from_inum (q);
}
}
@@ -1150,7 +1150,7 @@ scm_integer_truncate_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp)
{
scm_t_inum q = x / y;
scm_t_inum r = x % y;
- *qp = long_to_scm (q);
+ *qp = scm_from_inum (q);
*rp = SCM_I_MAKINUM (r);
}
}
@@ -1284,13 +1284,13 @@ scm_integer_centered_quotient_ii (scm_t_inum x, scm_t_inum y)
q++;
}
}
- return long_to_scm (q);
+ return scm_from_inum (q);
}
SCM
scm_integer_centered_quotient_iz (scm_t_inum x, struct scm_bignum *y)
{
- return integer_centered_quotient_zz (long_to_bignum (x),
+ return integer_centered_quotient_zz (inum_to_bignum (x),
y);
}
@@ -1409,7 +1409,7 @@ 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)
{
- return integer_centered_remainder_zz (long_to_bignum (x),
+ return integer_centered_remainder_zz (inum_to_bignum (x),
y);
}
@@ -1525,14 +1525,14 @@ 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 = scm_from_inum (q);
*rp = SCM_I_MAKINUM (r);
}
void
scm_integer_centered_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *rp)
{
- integer_centered_divide_zz (long_to_bignum (x), y, qp, rp);
+ integer_centered_divide_zz (inum_to_bignum (x), y, qp, rp);
}
void
@@ -1643,13 +1643,13 @@ scm_integer_round_quotient_ii (scm_t_inum x, scm_t_inum y)
else if (r2 < -ay)
q--;
}
- return long_to_scm (q);
+ return scm_from_inum (q);
}
SCM
scm_integer_round_quotient_iz (scm_t_inum x, struct scm_bignum *y)
{
- return integer_round_quotient_zz (long_to_bignum (x), y);
+ return integer_round_quotient_zz (inum_to_bignum (x), y);
}
SCM
@@ -1789,7 +1789,7 @@ 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)
{
- return integer_round_remainder_zz (long_to_bignum (x), y);
+ return integer_round_remainder_zz (inum_to_bignum (x), y);
}
SCM
@@ -1902,14 +1902,14 @@ 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 = scm_from_inum (q);
*rp = SCM_I_MAKINUM (r);
}
void
scm_integer_round_divide_iz (scm_t_inum x, struct scm_bignum *y, SCM *qp, SCM *rp)
{
- integer_round_divide_zz (long_to_bignum (x), y, qp, rp);
+ integer_round_divide_zz (inum_to_bignum (x), y, qp, rp);
}
void
@@ -2004,7 +2004,7 @@ scm_integer_gcd_ii (scm_t_inum x, scm_t_inum y)
}
result = u << k;
}
- return ulong_to_scm (result);
+ return scm_from_inum (result);
}
SCM
@@ -2831,7 +2831,7 @@ scm_integer_from_double (double val)
SCM
scm_integer_add_ii (scm_t_inum x, scm_t_inum y)
{
- return long_to_scm (x + y);
+ return scm_from_inum (x + y);
}
static SCM
@@ -2949,7 +2949,7 @@ scm_integer_add_zz (struct scm_bignum *x, struct scm_bignum *y)
SCM
scm_integer_negate_i (scm_t_inum x)
{
- return long_to_scm (-x);
+ return scm_from_inum (-x);
}
SCM
@@ -3229,7 +3229,7 @@ scm_integer_from_int32 (int32_t n)
{
if (SCM_FIXABLE (n))
return SCM_I_MAKINUM (n);
- return scm_from_bignum (long_to_bignum (n));
+ return scm_from_bignum (inum_to_bignum (n));
}
SCM
--
2.48.1
From f7be078d6a4a914fbf790bb031957ee1abf7378b Mon Sep 17 00:00:00 2001
From: Jonas Hahnfeld <hah...@hahnjo.de>
Date: Sat, 2 Sep 2023 16:15:37 +0200
Subject: [PATCH 4/6] Decouple scm_t_inum from long datatype
Guile expects that scm_t_inum (a typedef to long before this patch)
has the same size as pointers to get compatible bytecode on different
platforms. This assumption breaks on 64-bit Windows where longs are
still 32 bit. Instead use intptr_t as the underlying datatype.
Unfortunately, this comes with an additional challenge because GMP
functions accept unsigned longs as arguments. So instead, in such
configurations where long < scm_t_inum, split the values into two
longs to convert to mpz.
* libguile/scm.h: Define SCM_INTPTR_T_BIT.
* libguile/numbers.h (scm_t_inum): Typedef to intptr_t. Update the
definitions of SCM_I_FIXNUM_BIT and SCM_MOST_NEGATIVE_FIXNUM.
* libguile/numbers.c: Update verify.
(scm_to_mpz): Implement if SCM_LONG_BIT < SCM_I_FIXNUM_BIT.
* libguile/integers.c (inum_to_bignum, scm_integer_gcd_zi): Implement
if SCM_LONG_BIT < SCM_I_FIXNUM_BIT.
---
libguile/integers.c | 12 ++++++++++++
libguile/numbers.c | 25 ++++++++++++++++++++++---
libguile/numbers.h | 10 ++++------
libguile/scm.h | 2 ++
4 files changed, 40 insertions(+), 9 deletions(-)
diff --git a/libguile/integers.c b/libguile/integers.c
index b4090e5bf..23bd2c0d5 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -247,10 +247,14 @@ ulong_to_bignum (unsigned long u)
static struct scm_bignum *
inum_to_bignum (scm_t_inum i)
{
+#if SCM_LONG_BIT >= SCM_I_FIXNUM_BIT
if (i > 0)
return ulong_to_bignum (i);
return i == 0 ? make_bignum_0 () : make_bignum_1 (1, long_magnitude (i));
+#else
+ return make_bignum_from_int64 (i);
+#endif
};
static inline SCM
@@ -2015,6 +2019,14 @@ scm_integer_gcd_zi (struct scm_bignum *x, scm_t_inum y)
return scm_integer_abs_z (x);
if (y < 0)
y = -y;
+#if SCM_I_FIXNUM_BIT > SCM_LONG_BIT
+ if (y > ULONG_MAX)
+ {
+ struct scm_bignum *y_bignum = inum_to_bignum (y);
+ return scm_integer_gcd_zz (x, y_bignum);
+ }
+#endif
+
mpz_t zx;
alias_bignum_to_mpz (x, zx);
result = mpz_gcd_ui (NULL, zx, y);
diff --git a/libguile/numbers.c b/libguile/numbers.c
index fc598694a..2ef5faa07 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -94,10 +94,10 @@ verify (FLT_RADIX == 2);
/* Make sure that scm_t_inum fits within a SCM value. */
verify (sizeof (scm_t_inum) <= sizeof (scm_t_bits));
-/* Several functions below assume that fixnums fit within a long, and
+/* Several functions below assume that fixnums fit within an intptr_t, 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'. */
@@ -6868,7 +6868,26 @@ void
scm_to_mpz (SCM val, mpz_t rop)
{
if (SCM_I_INUMP (val))
- mpz_set_si (rop, SCM_I_INUM (val));
+ {
+ scm_t_inum inum = SCM_I_INUM (val);
+#if SCM_LONG_BIT >= SCM_I_FIXNUM_BIT
+ // Cast to long and directly pass to GMP.
+ mpz_set_si (rop, (long)inum);
+#elif (2 * SCM_LONG_BIT) > SCM_I_FIXNUM_BIT
+ scm_t_inum inum_abs = inum;
+ if (inum < 0)
+ inum_abs *= -1;
+ long high = inum_abs >> (SCM_LONG_BIT - 1);
+ long low = (long)(inum_abs & ((((scm_t_inum)1) << (SCM_LONG_BIT - 1)) - 1));
+ mpz_set_si (rop, high);
+ mpz_mul_2exp (rop, rop, SCM_LONG_BIT - 1);
+ mpz_add_ui (rop, rop, low);
+ if (inum < 0)
+ mpz_neg (rop, rop);
+#else
+#error Unknown configuration
+#endif
+ }
else if (SCM_BIGP (val))
scm_integer_set_mpz_z (scm_bignum (val), rop);
else
diff --git a/libguile/numbers.h b/libguile/numbers.h
index 84ad5466f..8bc87829a 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -52,12 +52,10 @@ extern "C++" {
*
* Inums are exact integers that fit within an SCM word
* (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)
-#define SCM_MOST_NEGATIVE_FIXNUM (-1L << (SCM_I_FIXNUM_BIT - 1))
+ */
+typedef intptr_t scm_t_inum;
+#define SCM_I_FIXNUM_BIT (SCM_INTPTR_T_BIT - 2)
+#define SCM_MOST_NEGATIVE_FIXNUM (((scm_t_inum) -1) << (SCM_I_FIXNUM_BIT - 1))
#define SCM_MOST_POSITIVE_FIXNUM (- (SCM_MOST_NEGATIVE_FIXNUM + 1))
/* SCM_SRS (X, Y) is signed right shift, defined as floor (X / 2^Y),
diff --git a/libguile/scm.h b/libguile/scm.h
index 4d079b1a8..e053c9883 100644
--- a/libguile/scm.h
+++ b/libguile/scm.h
@@ -843,6 +843,8 @@ typedef struct scm_thread scm_thread;
# define SCM_LONG_BIT (SCM_SIZEOF_LONG * 8)
#endif
+#define SCM_INTPTR_T_BIT (SCM_SIZEOF_INTPTR_T * 8)
+
/* Cast pointer through (void *) in order to avoid compiler warnings
--
2.48.1
From 7428fa0fbb286eedf6d8cbdc587c32008819c15c Mon Sep 17 00:00:00 2001
From: Jonas Hahnfeld <hah...@hahnjo.de>
Date: Tue, 24 Oct 2023 23:47:41 +0200
Subject: [PATCH 5/6] Store hashes as uintptr_t
As for scm_t_inum, Guile expects that hashes have the same size as
pointers to get compatible bytecode (with respect to interned symbols)
on different platforms. This assumption breaks on 64-bit Windows where
longs are still 32 bit. Instead use uintptr_t as the datatype.
Based on changes by Jan Nieuwenhuizen, Mike Gran, and Andy Wingo.
* libguile/hash.c:
* libguile/hash.h:
* libguile/strings.c:
* libguile/strings.h:
* libguile/symbols.c:
* libguile/symbols.h: Use uintptr_t to store hashes.
---
libguile/hash.c | 66 +++++++++++++++++++++++-----------------------
libguile/hash.h | 22 ++++++++--------
libguile/strings.c | 2 +-
libguile/strings.h | 2 +-
libguile/symbols.c | 24 ++++++++---------
libguile/symbols.h | 6 ++---
6 files changed, 61 insertions(+), 61 deletions(-)
diff --git a/libguile/hash.c b/libguile/hash.c
index b7ad03309..8aeff4bed 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -112,25 +112,25 @@ 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;
@@ -138,7 +138,7 @@ wide_string_hash (const scm_t_wchar *str, size_t len)
/* If you change this to a different hash, also update (language cps
guile-vm). */
-unsigned long
+uintptr_t
scm_i_string_hash (SCM str)
{
size_t len = scm_i_string_length (str);
@@ -150,13 +150,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)
@@ -166,7 +166,7 @@ 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)
{
if (len == (size_t) -1)
@@ -223,8 +223,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;
@@ -232,16 +232,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);
@@ -261,7 +261,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)
@@ -287,7 +287,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))
@@ -305,7 +305,7 @@ scm_raw_ihash (SCM obj, size_t depth)
SCM n = SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM);
if (scm_is_inexact (obj))
obj = scm_inexact_to_exact (obj);
- return scm_raw_ihashq (scm_to_ulong (scm_modulo (obj, n)));
+ return scm_raw_ihashq (scm_to_uintptr_t (scm_modulo (obj, n)));
}
else
return scm_i_string_hash (scm_number_to_string (obj, scm_from_int (10)));
@@ -322,7 +322,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);
@@ -330,7 +330,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);
@@ -369,8 +369,8 @@ scm_raw_ihash (SCM obj, size_t depth)
-unsigned long
-scm_ihashq (SCM obj, unsigned long n)
+uintptr_t
+scm_ihashq (SCM obj, uintptr_t n)
{
return scm_raw_ihashq (SCM_UNPACK (obj)) % n;
}
@@ -390,8 +390,8 @@ 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);
- return scm_from_ulong (scm_ihashq (key, sz));
+ uintptr_t sz = scm_to_unsigned_integer (size, 1, UINTPTR_MAX);
+ return scm_from_unsigned_integer (scm_ihashq (key, sz));
}
#undef FUNC_NAME
@@ -399,8 +399,8 @@ SCM_DEFINE (scm_hashq, "hashq", 2, 0, 0,
-unsigned long
-scm_ihashv (SCM obj, unsigned long n)
+uintptr_t
+scm_ihashv (SCM obj, uintptr_t n)
{
if (SCM_NUMP(obj))
return scm_raw_ihash (obj, 10) % n;
@@ -423,8 +423,8 @@ 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);
- return scm_from_ulong (scm_ihashv (key, sz));
+ uintptr_t sz = scm_to_unsigned_integer (size, 1, UINTPTR_MAX);
+ return scm_from_unsigned_integer (scm_ihashv (key, sz));
}
#undef FUNC_NAME
@@ -432,10 +432,10 @@ SCM_DEFINE (scm_hashv, "hashv", 2, 0, 0,
-unsigned long
-scm_ihash (SCM obj, unsigned long n)
+uintptr_t
+scm_ihash (SCM obj, uintptr_t n)
{
- return (unsigned long) scm_raw_ihash (obj, 10) % n;
+ return scm_raw_ihash (obj, 10) % n;
}
SCM_DEFINE (scm_hash, "hash", 2, 0, 0,
@@ -446,8 +446,8 @@ 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);
- return scm_from_ulong (scm_ihash (key, sz));
+ uintptr_t sz = scm_to_unsigned_integer (size, 1, UINTPTR_MAX);
+ return scm_from_unsigned_integer (scm_ihash (key, sz));
}
#undef FUNC_NAME
diff --git a/libguile/hash.h b/libguile/hash.h
index 0e82b4afc..580d2ce93 100644
--- a/libguile/hash.h
+++ b/libguile/hash.h
@@ -26,19 +26,19 @@
-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 unsigned long scm_i_string_hash (SCM str);
-SCM_API unsigned long scm_ihashq (SCM obj, unsigned long n);
+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 uintptr_t scm_i_string_hash (SCM str);
+SCM_API uintptr_t scm_ihashq (SCM obj, uintptr_t n);
SCM_API SCM scm_hashq (SCM obj, SCM n);
-SCM_API unsigned long scm_ihashv (SCM obj, unsigned long n);
+SCM_API uintptr_t scm_ihashv (SCM obj, uintptr_t n);
SCM_API SCM scm_hashv (SCM obj, SCM n);
-SCM_API unsigned long scm_ihash (SCM obj, unsigned long n);
+SCM_API uintptr_t scm_ihash (SCM obj, uintptr_t n);
SCM_API SCM scm_hash (SCM obj, SCM n);
SCM_INTERNAL void scm_init_hash (void);
diff --git a/libguile/strings.c b/libguile/strings.c
index 5eebb3300..572c554c3 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -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);
diff --git a/libguile/strings.h b/libguile/strings.h
index d417514f8..f44799da8 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -250,7 +250,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 292941e9d..b3ddab67d 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -71,8 +71,8 @@ SCM_DEFINE (scm_sys_symbols, "%symbols", 0, 0, 0,
/* {Symbols}
*/
-unsigned long
-scm_i_hash_symbol (SCM obj, unsigned long n, void *closure)
+uintptr_t
+scm_i_hash_symbol (SCM obj, uintptr_t n, void *closure)
{
return scm_i_symbol_hash (obj) % n;
}
@@ -80,7 +80,7 @@ scm_i_hash_symbol (SCM obj, unsigned long n, void *closure)
struct string_lookup_data
{
SCM string;
- unsigned long string_hash;
+ uintptr_t string_hash;
};
static int
@@ -102,7 +102,7 @@ string_lookup_predicate_fn (SCM sym, void *closure)
}
static SCM
-lookup_interned_symbol (SCM name, unsigned long raw_hash)
+lookup_interned_symbol (SCM name, uintptr_t raw_hash)
{
struct string_lookup_data data;
@@ -118,7 +118,7 @@ struct latin1_lookup_data
{
const char *str;
size_t len;
- unsigned long string_hash;
+ uintptr_t string_hash;
};
static int
@@ -134,7 +134,7 @@ latin1_lookup_predicate_fn (SCM sym, void *closure)
static SCM
lookup_interned_latin1_symbol (const char *str, size_t len,
- unsigned long raw_hash)
+ uintptr_t raw_hash)
{
struct latin1_lookup_data data;
@@ -151,7 +151,7 @@ struct utf8_lookup_data
{
const char *str;
size_t len;
- unsigned long string_hash;
+ uintptr_t string_hash;
};
static int
@@ -201,7 +201,7 @@ utf8_lookup_predicate_fn (SCM sym, void *closure)
static SCM
lookup_interned_utf8_symbol (const char *str, size_t len,
- unsigned long raw_hash)
+ uintptr_t raw_hash)
{
struct utf8_lookup_data data;
@@ -239,7 +239,7 @@ static SCM
scm_i_str2symbol (SCM str)
{
SCM symbol;
- unsigned long raw_hash = scm_i_string_hash (str);
+ uintptr_t raw_hash = scm_i_string_hash (str);
symbol = lookup_interned_symbol (str, raw_hash);
if (scm_is_true (symbol))
@@ -261,7 +261,7 @@ scm_i_str2symbol (SCM str)
static SCM
scm_i_str2uninterned_symbol (SCM str)
{
- unsigned long raw_hash = scm_i_string_hash (str);
+ uintptr_t raw_hash = scm_i_string_hash (str);
return scm_i_make_symbol (str, SCM_I_F_SYMBOL_UNINTERNED, raw_hash);
}
@@ -416,7 +416,7 @@ scm_from_latin1_symbol (const char *sym)
SCM
scm_from_latin1_symboln (const char *sym, size_t len)
{
- unsigned long hash;
+ uintptr_t hash;
SCM ret;
if (len == (size_t) -1)
@@ -442,7 +442,7 @@ scm_from_utf8_symbol (const char *sym)
SCM
scm_from_utf8_symboln (const char *sym, size_t len)
{
- unsigned long hash;
+ uintptr_t hash;
SCM ret;
if (len == (size_t) -1)
diff --git a/libguile/symbols.h b/libguile/symbols.h
index e8bc3346f..f541f5126 100644
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -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))
@@ -122,8 +122,8 @@ SCM_API SCM scm_take_utf8_symboln (char *sym, size_t len);
/* internal functions. */
-SCM_INTERNAL unsigned long scm_i_hash_symbol (SCM obj, unsigned long n,
- void *closure);
+SCM_INTERNAL uintptr_t scm_i_hash_symbol (SCM obj, uintptr_t n,
+ void *closure);
SCM_INTERNAL void scm_symbols_prehistory (void);
SCM_INTERNAL void scm_init_symbols (void);
--
2.48.1
From 62659aa84688504e389da7fc306da1554a2b5650 Mon Sep 17 00:00:00 2001
From: Jonas Hahnfeld <hah...@hahnjo.de>
Date: Wed, 20 Mar 2024 20:26:36 +0100
Subject: [PATCH 6/6] Fix lightening x86_64 Windows calling convention
* libguile/lightening/lightening/x86.c:
* libguile/lightening/lightening/x86.h: Check _WIN64 macro as set for
mingw64.
---
libguile/lightening/lightening/x86.c | 10 +++++-----
libguile/lightening/lightening/x86.h | 2 +-
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/libguile/lightening/lightening/x86.c b/libguile/lightening/lightening/x86.c
index f8ac4b0b8..6963d90fd 100644
--- a/libguile/lightening/lightening/x86.c
+++ b/libguile/lightening/lightening/x86.c
@@ -237,7 +237,7 @@ jit_init(jit_state_t *_jit)
static const jit_gpr_t abi_gpr_args[] = {
#if __X32
/* No GPRs in args. */
-#elif __CYGWIN__
+#elif defined(__CYGWIN__) || defined(_WIN64)
_RCX, _RDX, _R8, _R9
#else
_RDI, _RSI, _RDX, _RCX, _R8, _R9
@@ -247,7 +247,7 @@ static const jit_gpr_t abi_gpr_args[] = {
static const jit_fpr_t abi_fpr_args[] = {
#if __X32
/* No FPRs in args. */
-#elif __CYGWIN__
+#elif defined(__CYGWIN__) || defined(_WIN64)
_XMM0, _XMM1, _XMM2, _XMM3
#else
_XMM0, _XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7
@@ -317,7 +317,7 @@ reset_abi_arg_iterator(struct abi_arg_iterator *iter, size_t argc,
memset(iter, 0, sizeof *iter);
iter->argc = argc;
iter->args = args;
-#if __CYGWIN__ && __X64
+#if (defined(__CYGWIN__) || defined(_WIN64)) && __X64
// Reserve slots on the stack for 4 register parameters (8 bytes each).
iter->stack_size = 32;
#endif
@@ -330,12 +330,12 @@ next_abi_arg(struct abi_arg_iterator *iter, jit_operand_t *arg)
enum jit_operand_abi abi = iter->args[iter->arg_idx].abi;
if (is_gpr_arg(abi) && iter->gpr_idx < abi_gpr_arg_count) {
*arg = jit_operand_gpr (abi, abi_gpr_args[iter->gpr_idx++]);
-#ifdef __CYGWIN__
+#if defined(__CYGWIN__) || defined(_WIN64)
iter->fpr_idx++;
#endif
} else if (is_fpr_arg(abi) && iter->fpr_idx < abi_fpr_arg_count) {
*arg = jit_operand_fpr (abi, abi_fpr_args[iter->fpr_idx++]);
-#ifdef __CYGWIN__
+#if defined(__CYGWIN__) || defined(_WIN64)
iter->gpr_idx++;
#endif
} else {
diff --git a/libguile/lightening/lightening/x86.h b/libguile/lightening/lightening/x86.h
index 983ebdb8f..7da8c5977 100644
--- a/libguile/lightening/lightening/x86.h
+++ b/libguile/lightening/lightening/x86.h
@@ -92,7 +92,7 @@
# define JIT_F6 _XMM6
# define JIT_FTMP _XMM7
# define JIT_PLATFORM_CALLEE_SAVE_GPRS JIT_TMP0
-#elif __CYGWIN__
+#elif defined(__CYGWIN__) || defined(_WIN64)
# define JIT_R0 _RAX
# define JIT_R1 _RCX
# define JIT_R2 _RDX
--
2.48.1
signature.asc
Description: This is a digitally signed message part
