* [PATCH wip-mingw-guile-2.2] mingw: Support for x86_64-w64-mingw32.
@ 2020-08-14 9:18 Jan Nieuwenhuizen
0 siblings, 0 replies; only message in thread
From: Jan Nieuwenhuizen @ 2020-08-14 9:18 UTC (permalink / raw)
To: Mike Gran; +Cc: guile-devel
[-- Attachment #1: Type: text/plain, Size: 473 bytes --]
Hello Mike!
I have been using your wip-mingw-guile-2.2 branch for a while (great!)
and have some (~10) half-finished patches to run 8sync (non-blocking
sockets), pipes and other stuff that could be interesting, some of them
backported from guile master, see
https://gitlab.com/janneke/guile/-/commits/wip-mingw-guile-2.2
The past days I looked into the x86_64-w64-mingw32 cross-build in
Guix and created a patch, maybe you want to have a look at it.
Greetings,
Janneke
[-- Attachment #2: 0001-mingw-Support-for-x86_64-w64-mingw32.patch --]
[-- Type: text/x-patch, Size: 10505 bytes --]
From f0fade08173b97e2b4a68b79b654ad3d30a59286 Mon Sep 17 00:00:00 2001
From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
Date: Wed, 12 Aug 2020 20:54:33 +0200
Subject: [PATCH wip-mingw-guile-2.2] mingw: Support for x86_64-w64-mingw32.
Content-Transfer-Encoding: 8bit
Content-Type: text/plain; charset=UTF-8
Until now, the assumption was made that POINTER and LONG are the same
size. This is not so on x86_64-MinGW, which uses a 4-byte LONG and an
8-byte POINTER. This patch introduces FIXNUM-SIZE, fixing x86_64-MinGW.
* module/system/base/target.scm (%native-word-size): Use sizeof long
instead of '*. Fixes word size on x86_64-w64-mingw32
(%native-fixnum-size, %target-fixnum-size): New variable.
(triplet-pointer-size): Add case for mingw.
(target-fixnum-size): New procedure.
* libguile/bytevectors.c: Use SIZEOF_LONG > 4 instead of SIZEOF_VOID.
* libguile/vm-engine.c (INUM_MAX,INUM_MIN,INUM_STEP): Remove.
(BR_ARITHMETIC): Use scm_t_inum and SCM_I_INUM instead of
scm_t_signed_bits and SCM_UNPACK.
* module/system/vm/assembler.scm (<asm>)[ fixnum-size]: New field.
* module/system/vm/assembler.scm (make-assembler): Add #:fixnum-size
parameter.
(immediate-bits): Use fixnum-size for immediate size.
---
libguile/bytevectors.c | 16 ++++++++--------
libguile/vm-engine.c | 13 ++-----------
module/system/base/target.scm | 22 +++++++++++++++++++++-
module/system/vm/assembler.scm | 13 ++++++++-----
4 files changed, 39 insertions(+), 25 deletions(-)
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 7cd7530095..f08285d770 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -1377,7 +1377,7 @@ SCM_DEFINE (scm_bytevector_u32_ref, "bytevector-u32-ref",
"@var{index}.")
#define FUNC_NAME s_scm_bytevector_u32_ref
{
-#if SIZEOF_VOID_P > 4
+#if SIZEOF_LONG > 4
INTEGER_REF (32, unsigned);
#else
LARGE_INTEGER_REF (32, unsigned);
@@ -1392,7 +1392,7 @@ SCM_DEFINE (scm_bytevector_s32_ref, "bytevector-s32-ref",
"@var{index}.")
#define FUNC_NAME s_scm_bytevector_s32_ref
{
-#if SIZEOF_VOID_P > 4
+#if SIZEOF_LONG > 4
INTEGER_REF (32, signed);
#else
LARGE_INTEGER_REF (32, signed);
@@ -1407,7 +1407,7 @@ SCM_DEFINE (scm_bytevector_u32_native_ref, "bytevector-u32-native-ref",
"@var{index} using the native endianness.")
#define FUNC_NAME s_scm_bytevector_u32_native_ref
{
-#if SIZEOF_VOID_P > 4
+#if SIZEOF_LONG > 4
INTEGER_NATIVE_REF (32, unsigned);
#else
LARGE_INTEGER_NATIVE_REF (32, unsigned);
@@ -1422,7 +1422,7 @@ SCM_DEFINE (scm_bytevector_s32_native_ref, "bytevector-s32-native-ref",
"@var{index} using the native endianness.")
#define FUNC_NAME s_scm_bytevector_s32_native_ref
{
-#if SIZEOF_VOID_P > 4
+#if SIZEOF_LONG > 4
INTEGER_NATIVE_REF (32, signed);
#else
LARGE_INTEGER_NATIVE_REF (32, signed);
@@ -1437,7 +1437,7 @@ SCM_DEFINE (scm_bytevector_u32_set_x, "bytevector-u32-set!",
"@var{endianness}.")
#define FUNC_NAME s_scm_bytevector_u32_set_x
{
-#if SIZEOF_VOID_P > 4
+#if SIZEOF_LONG > 4
INTEGER_SET (32, unsigned);
#else
LARGE_INTEGER_SET (32, unsigned);
@@ -1452,7 +1452,7 @@ SCM_DEFINE (scm_bytevector_s32_set_x, "bytevector-s32-set!",
"@var{endianness}.")
#define FUNC_NAME s_scm_bytevector_s32_set_x
{
-#if SIZEOF_VOID_P > 4
+#if SIZEOF_LONG > 4
INTEGER_SET (32, signed);
#else
LARGE_INTEGER_SET (32, signed);
@@ -1467,7 +1467,7 @@ SCM_DEFINE (scm_bytevector_u32_native_set_x, "bytevector-u32-native-set!",
"of @var{bv} using the native endianness.")
#define FUNC_NAME s_scm_bytevector_u32_native_set_x
{
-#if SIZEOF_VOID_P > 4
+#if SIZEOF_LONG > 4
INTEGER_NATIVE_SET (32, unsigned);
#else
LARGE_INTEGER_NATIVE_SET (32, unsigned);
@@ -1482,7 +1482,7 @@ SCM_DEFINE (scm_bytevector_s32_native_set_x, "bytevector-s32-native-set!",
"of @var{bv} using the native endianness.")
#define FUNC_NAME s_scm_bytevector_s32_native_set_x
{
-#if SIZEOF_VOID_P > 4
+#if SIZEOF_LONG > 4
INTEGER_NATIVE_SET (32, signed);
#else
LARGE_INTEGER_NATIVE_SET (32, signed);
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 9509cd6435..75168daddb 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -315,8 +315,8 @@
y = SP_REF (b); \
if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
{ \
- scm_t_signed_bits x_bits = SCM_UNPACK (x); \
- scm_t_signed_bits y_bits = SCM_UNPACK (y); \
+ scm_t_inum x_bits = SCM_I_INUM (x); \
+ scm_t_inum y_bits = SCM_I_INUM (y); \
if ((ip[2] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \
{ \
scm_t_int32 offset = ip[2]; \
@@ -392,15 +392,6 @@
#define RETURN_EXP(exp) \
do { SCM __x; SYNC_IP (); __x = exp; CACHE_SP (); RETURN (__x); } while (0)
-/* The maximum/minimum tagged integers. */
-#define INUM_MAX \
- ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)))
-#define INUM_MIN \
- ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)))
-#define INUM_STEP \
- ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \
- - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
-
#define BINARY_INTEGER_OP(CFUNC,SFUNC) \
{ \
ARGS2 (x, y); \
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
index 8af1995373..234faf6f93 100644
--- a/module/system/base/target.scm
+++ b/module/system/base/target.scm
@@ -26,7 +26,7 @@
target-cpu target-vendor target-os
- target-endianness target-word-size))
+ target-endianness target-fixnum-size target-word-size))
\f
@@ -34,11 +34,15 @@
;;; Target types
;;;
+(define %native-fixnum-size
+ ((@ (system foreign) sizeof) (@ (system foreign) long)))
+
(define %native-word-size
((@ (system foreign) sizeof) '*))
(define %target-type (make-fluid %host-type))
(define %target-endianness (make-fluid (native-endianness)))
+(define %target-fixnum-size (make-fluid %native-fixnum-size))
(define %target-word-size (make-fluid %native-word-size))
(define (validate-target target)
@@ -53,6 +57,7 @@
(let ((cpu (triplet-cpu target)))
(with-fluids ((%target-type target)
(%target-endianness (cpu-endianness cpu))
+ (%target-fixnum-size (triplet-fixnum-size target))
(%target-word-size (triplet-pointer-size target)))
(thunk))))
@@ -109,6 +114,17 @@
((string-match "^arm.*" cpu) 4)
(else (error "unknown CPU word size" cpu)))))
+(define (triplet-fixnum-size triplet)
+ "Return the size of pointers in bytes for TRIPLET."
+ (let ((cpu (triplet-cpu triplet)))
+ (cond ((and (string=? cpu (triplet-cpu %host-type))
+ (string=? (triplet-os triplet) (triplet-os %host-type)))
+ %native-fixnum-size)
+
+ ((string-match "^x86_64-.*-mingw32" triplet) 4) ; x32
+
+ (else (triplet-pointer-size triplet)))))
+
(define (triplet-cpu t)
(substring t 0 (string-index t #\-)))
@@ -141,6 +157,10 @@
"Return the endianness object of the target platform."
(fluid-ref %target-endianness))
+(define (target-fixnum-size)
+ "Return the fixnum size, in bytes, of the target platform."
+ (fluid-ref %target-fixnum-size))
+
(define (target-word-size)
"Return the word size, in bytes, of the target platform."
(fluid-ref %target-word-size))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 8d71dc5516..4e0cf5f017 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -382,7 +382,7 @@ N-byte unit."
(define-record-type <asm>
(make-asm buf pos start
labels relocs
- word-size endianness
+ fixnum-size word-size endianness
constants inits
shstrtab next-section-number
meta sources
@@ -419,6 +419,7 @@ N-byte unit."
;; Target information.
;;
+ (fixnum-size asm-fixnum-size)
(word-size asm-word-size)
(endianness asm-endianness)
@@ -460,14 +461,15 @@ N-byte unit."
;;
(slot-maps asm-slot-maps set-asm-slot-maps!))
-(define* (make-assembler #:key (word-size (target-word-size))
+(define* (make-assembler #:key (fixnum-size (target-fixnum-size))
+ (word-size (target-word-size))
(endianness (target-endianness)))
"Create an assembler for a given target @var{word-size} and
@var{endianness}, falling back to appropriate values for the configured
target."
(make-asm (make-u32vector 1000) 0 0
(make-hash-table) '()
- word-size endianness
+ fixnum-size word-size endianness
vlist-null '()
(make-string-table) 1
'() '() '()))
@@ -961,12 +963,13 @@ immediate, and @code{#f} otherwise."
(if (exact-integer? x)
;; Object is an immediate if it is a fixnum on the target.
(call-with-values (lambda ()
- (case (asm-word-size asm)
+ (case (asm-fixnum-size asm)
((4) (values (- #x20000000)
#x1fffffff))
((8) (values (- #x2000000000000000)
#x1fffffffFFFFFFFF))
- (else (error "unexpected word size"))))
+ (else (error "unexpected fixnum-size:"
+ (asm-fixnum-size asm)))))
(lambda (fixnum-min fixnum-max)
(and (<= fixnum-min x fixnum-max)
(let ((fixnum-bits (if (negative? x)
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com
[-- Attachment #3: Type: text/plain, Size: 152 bytes --]
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2020-08-14 9:18 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-08-14 9:18 [PATCH wip-mingw-guile-2.2] mingw: Support for x86_64-w64-mingw32 Jan Nieuwenhuizen
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).