From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Jan Nieuwenhuizen Newsgroups: gmane.lisp.guile.devel Subject: [PATCH wip-mingw-guile-2.2] mingw: Support for x86_64-w64-mingw32. Date: Fri, 14 Aug 2020 11:18:21 +0200 Organization: AvatarAcademy.nl Message-ID: <878sehziua.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="35475"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) Cc: guile-devel@gnu.org To: Mike Gran Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Fri Aug 14 12:23:42 2020 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1k6WsA-00098K-03 for guile-devel@m.gmane-mx.org; Fri, 14 Aug 2020 12:23:42 +0200 Original-Received: from localhost ([::1]:45718 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k6Ws9-0004jY-1q for guile-devel@m.gmane-mx.org; Fri, 14 Aug 2020 06:23:41 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:45330) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1k6Vqz-0004uz-Es for guile-devel@gnu.org; Fri, 14 Aug 2020 05:18:25 -0400 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]:43931) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k6Vqz-0003f6-2j; Fri, 14 Aug 2020 05:18:25 -0400 Original-Received: from [2001:980:1b4f:1:42d2:832d:bb59:862] (port=58146 helo=dundal.peder.onsbrabantnet.nl) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1k6Vqy-00084K-J1; Fri, 14 Aug 2020 05:18:24 -0400 X-Url: http://AvatarAcademy.nl X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: "guile-devel" Xref: news.gmane.io gmane.lisp.guile.devel:20578 Archived-At: --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-mingw-Support-for-x86_64-w64-mingw32.patch Content-Transfer-Encoding: quoted-printable >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=3DUTF-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-r= ef", "@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-r= ef", "@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, "bytevecto= r-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, "bytevecto= r-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, "bytevec= tor-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, "bytevec= tor-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 =3D SP_REF (b); \ if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ { \ - scm_t_signed_bits x_bits =3D SCM_UNPACK (x); \ - scm_t_signed_bits y_bits =3D SCM_UNPACK (y); \ + scm_t_inum x_bits =3D SCM_I_INUM (x); \ + scm_t_inum y_bits =3D SCM_I_INUM (y); \ if ((ip[2] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \ { \ scm_t_int32 offset =3D ip[2]; \ @@ -392,15 +392,6 @@ #define RETURN_EXP(exp) \ do { SCM __x; SYNC_IP (); __x =3D exp; CACHE_SP (); RETURN (__x); } whil= e (0) =20 -/* 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 @@ =20 target-cpu target-vendor target-os =20 - target-endianness target-word-size)) + target-endianness target-fixnum-size target-word-size)) =20 =20 @@ -34,11 +34,15 @@ ;;; Target types ;;; =20 +(define %native-fixnum-size + ((@ (system foreign) sizeof) (@ (system foreign) long))) + (define %native-word-size ((@ (system foreign) sizeof) '*)) =20 (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)) =20 (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)))) =20 @@ -109,6 +114,17 @@ ((string-match "^arm.*" cpu) 4) (else (error "unknown CPU word size" cpu))))) =20 +(define (triplet-fixnum-size triplet) + "Return the size of pointers in bytes for TRIPLET." + (let ((cpu (triplet-cpu triplet))) + (cond ((and (string=3D? cpu (triplet-cpu %host-type)) + (string=3D? (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 #\-))) =20 @@ -141,6 +157,10 @@ "Return the endianness object of the target platform." (fluid-ref %target-endianness)) =20 +(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." =20 ;; Target information. ;; + (fixnum-size asm-fixnum-size) (word-size asm-word-size) (endianness asm-endianness) =20 @@ -460,14 +461,15 @@ N-byte unit." ;; (slot-maps asm-slot-maps set-asm-slot-maps!)) =20 -(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 (<=3D fixnum-min x fixnum-max) (let ((fixnum-bits (if (negative? x) --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.com --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.com --=-=-=--