From f0fade08173b97e2b4a68b79b654ad3d30a59286 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" 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 ()[ 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 (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 | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com