From 2b58dea2d24068e2a9dbe002cdceb6fec5a13a82 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 4 Mar 2024 22:14:04 +0100 Subject: [PATCH] (scheme foreign): API is less configuration-dependent * libguile/foreign.h: * libguile/foreign.c: Always define complex-float and complex-double. Fall back to alignof float / 2*sizeof float if no complex numbers. (But with C99 surely it exists everywhere.) * module/system/foreign.scm (*writers*, *readers*): Always include complex-float and complex-double readers and writers. * test-suite/tests/foreign.test: Always run the complex tests. --- libguile/foreign.c | 32 +++++++++++++++------ libguile/foreign.h | 6 +--- module/system/foreign.scm | 52 ++++++++++++++++------------------- test-suite/tests/foreign.test | 45 +++++++++++++++--------------- 4 files changed, 70 insertions(+), 65 deletions(-) diff --git a/libguile/foreign.c b/libguile/foreign.c index 1f594b0e4..b49e1473b 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -1,4 +1,4 @@ -/* Copyright 2010-2016,2018 +/* Copyright 2010-2016,2018,2024 Free Software Foundation, Inc. This file is part of Guile. @@ -29,7 +29,7 @@ #include -#ifdef FFI_TARGET_HAS_COMPLEX_TYPE +#ifdef HAVE_COMPLEX_H #include #endif @@ -67,10 +67,8 @@ SCM_SYMBOL (sym_void, "void"); SCM_SYMBOL (sym_float, "float"); SCM_SYMBOL (sym_double, "double"); -#ifdef FFI_TARGET_HAS_COMPLEX_TYPE SCM_SYMBOL (sym_complex_float, "complex-float"); SCM_SYMBOL (sym_complex_double, "complex-double"); -#endif SCM_SYMBOL (sym_uint8, "uint8"); SCM_SYMBOL (sym_int8, "int8"); SCM_SYMBOL (sym_uint16, "uint16"); @@ -478,11 +476,17 @@ SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type), return scm_from_size_t (alignof_type (float)); case SCM_FOREIGN_TYPE_DOUBLE: return scm_from_size_t (alignof_type (double)); -#ifdef FFI_TARGET_HAS_COMPLEX_TYPE case SCM_FOREIGN_TYPE_COMPLEX_FLOAT: +#ifdef FFI_TARGET_HAS_COMPLEX_TYPE return scm_from_size_t (alignof_type (float _Complex)); +#else + return scm_from_size_t (alignof_type (float)); +#endif case SCM_FOREIGN_TYPE_COMPLEX_DOUBLE: +#ifdef FFI_TARGET_HAS_COMPLEX_TYPE return scm_from_size_t (alignof_type (double _Complex)); +#else + return scm_from_size_t (alignof_type (double)); #endif case SCM_FOREIGN_TYPE_UINT8: return scm_from_size_t (alignof_type (uint8_t)); @@ -548,11 +552,17 @@ SCM_DEFINE (scm_sizeof, "sizeof", 1, 0, 0, (SCM type), return scm_from_size_t (sizeof (float)); case SCM_FOREIGN_TYPE_DOUBLE: return scm_from_size_t (sizeof (double)); -#ifdef FFI_TARGET_HAS_COMPLEX_TYPE case SCM_FOREIGN_TYPE_COMPLEX_FLOAT: +#ifdef FFI_TARGET_HAS_COMPLEX_TYPE return scm_from_size_t (sizeof (float _Complex)); +#else + return scm_from_size_t (2 * sizeof (float)); +#endif case SCM_FOREIGN_TYPE_COMPLEX_DOUBLE: +#ifdef FFI_TARGET_HAS_COMPLEX_TYPE return scm_from_size_t (sizeof (double _Complex)); +#else + return scm_from_size_t (2 * sizeof (double)); #endif case SCM_FOREIGN_TYPE_UINT8: return scm_from_size_t (sizeof (uint8_t)); @@ -607,6 +617,14 @@ parse_ffi_type (SCM type, int return_p, long *n_structs, long *n_struct_elts) return 0; else if (SCM_I_INUM (type) == SCM_FOREIGN_TYPE_VOID && !return_p) return 0; +#ifndef FFI_TARGET_HAS_COMPLEX_TYPE + /* The complex types are always defined so they can be used when + accessing data, but some targets don't support them as + arguments or return values. */ + else if (SCM_I_INUM (type) == SCM_FOREIGN_TYPE_COMPLEX_FLOAT + || SCM_I_INUM (type) == SCM_FOREIGN_TYPE_COMPLEX_DOUBLE) + return 0; +#endif else return 1; } @@ -1239,10 +1257,8 @@ scm_init_foreign (void) scm_define (sym_void, scm_from_uint8 (SCM_FOREIGN_TYPE_VOID)); scm_define (sym_float, scm_from_uint8 (SCM_FOREIGN_TYPE_FLOAT)); scm_define (sym_double, scm_from_uint8 (SCM_FOREIGN_TYPE_DOUBLE)); -#ifdef FFI_TARGET_HAS_COMPLEX_TYPE scm_define (sym_complex_float, scm_from_uint8 (SCM_FOREIGN_TYPE_COMPLEX_FLOAT)); scm_define (sym_complex_double, scm_from_uint8 (SCM_FOREIGN_TYPE_COMPLEX_DOUBLE)); -#endif scm_define (sym_uint8, scm_from_uint8 (SCM_FOREIGN_TYPE_UINT8)); scm_define (sym_int8, scm_from_uint8 (SCM_FOREIGN_TYPE_INT8)); scm_define (sym_uint16, scm_from_uint8 (SCM_FOREIGN_TYPE_UINT16)); diff --git a/libguile/foreign.h b/libguile/foreign.h index 33ce6311a..c1d892f01 100644 --- a/libguile/foreign.h +++ b/libguile/foreign.h @@ -1,7 +1,7 @@ #ifndef SCM_FOREIGN_H #define SCM_FOREIGN_H -/* Copyright 2010-2013,2016,2018 +/* Copyright 2010-2013,2016,2018,2024 Free Software Foundation, Inc. This file is part of Guile. @@ -43,13 +43,9 @@ enum scm_t_foreign_type SCM_FOREIGN_TYPE_INT32, SCM_FOREIGN_TYPE_UINT64, SCM_FOREIGN_TYPE_INT64, -#ifdef FFI_TARGET_HAS_COMPLEX_TYPE SCM_FOREIGN_TYPE_COMPLEX_FLOAT, SCM_FOREIGN_TYPE_COMPLEX_DOUBLE, SCM_FOREIGN_TYPE_LAST = SCM_FOREIGN_TYPE_COMPLEX_DOUBLE -#else - SCM_FOREIGN_TYPE_LAST = SCM_FOREIGN_TYPE_INT64 -#endif }; typedef enum scm_t_foreign_type scm_t_foreign_type; diff --git a/module/system/foreign.scm b/module/system/foreign.scm index 7fdd6dd95..3ddfd204b 100644 --- a/module/system/foreign.scm +++ b/module/system/foreign.scm @@ -1,19 +1,18 @@ -;;;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc. -;;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 2.1 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; +;;; Copyright (C) 2010-2011,2013-2014,2024 Free Software Foundation, Inc. +;;; +;;; This library is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this program. If not, see +;;; . (define-module (system foreign) @@ -108,12 +107,10 @@ (define *writers* `((,float . ,bytevector-ieee-single-native-set!) (,double . ,bytevector-ieee-double-native-set!) - ,@(if (defined? 'complex-float) - `((,complex-float - . ,(writer-complex bytevector-ieee-single-native-set! (sizeof float))) - (,complex-double - . ,(writer-complex bytevector-ieee-double-native-set! (sizeof double)))) - '()) + (,complex-float + . ,(writer-complex bytevector-ieee-single-native-set! (sizeof float))) + (,complex-double + . ,(writer-complex bytevector-ieee-double-native-set! (sizeof double))) (,int8 . ,bytevector-s8-set!) (,uint8 . ,bytevector-u8-set!) (,int16 . ,bytevector-s16-native-set!) @@ -127,12 +124,10 @@ (define *readers* `((,float . ,bytevector-ieee-single-native-ref) (,double . ,bytevector-ieee-double-native-ref) - ,@(if (defined? 'complex-float) - `((,complex-float - . ,(reader-complex bytevector-ieee-single-native-ref (sizeof float))) - (,complex-double - . ,(reader-complex bytevector-ieee-double-native-ref (sizeof double)))) - '()) + (,complex-float + . ,(reader-complex bytevector-ieee-single-native-ref (sizeof float))) + (,complex-double + . ,(reader-complex bytevector-ieee-double-native-ref (sizeof double))) (,int8 . ,bytevector-s8-ref) (,uint8 . ,bytevector-u8-ref) (,int16 . ,bytevector-s16-native-ref) @@ -143,7 +138,6 @@ (,uint64 . ,bytevector-u64-native-ref) (* . ,bytevector-pointer-ref))) - (define (align off alignment) (1+ (logior (1- off) (1- alignment)))) diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index 28d7b5df8..6c3c31024 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -1,20 +1,20 @@ -;;;; foreign.test --- FFI. -*- mode: scheme; coding: utf-8; -*- -;;;; -;;;; Copyright (C) 2010, 2011, 2012, 2013, 2017, 2021 Free Software Foundation, Inc. -;;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +;;; foreign.test --- FFI. -*- mode: scheme; coding: utf-8; -*- +;;; +;;; Copyright (C) 2010-2013,2017,2021,2024 Free Software Foundation, Inc. +;;; +;;; This library is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this program. If not, see +;;; . ;;; ;;; See also ../standalone/test-ffi for FFI tests. @@ -418,12 +418,11 @@ layout) data))) - (when (defined? 'complex-float) - (pass-if "complex types" - (let ((layout (list complex-float int complex-double)) - (data '(1+3i 99 3-1i))) - (equal? data (parse-c-struct (make-c-struct layout data) - layout)))))) + (pass-if "complex types" + (let ((layout (list complex-float int complex-double)) + (data '(1+3i 99 3-1i))) + (equal? data (parse-c-struct (make-c-struct layout data) + layout))))) (with-test-prefix "lib->cyg"