[PATCH wip-mingw-guile-2.2] mingw: Support for x86_64-w64-mingw32.

[Jan Nieuwenhuizen]

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

>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))
 
 

@@ -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

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com