wingo pushed a commit to branch main
in repository guile.
commit 2b58dea2d24068e2a9dbe002cdceb6fec5a13a82
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Mon Mar 4 22:14:04 2024 +0100
(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 <ffi.h>
-#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
+#ifdef HAVE_COMPLEX_H
#include <complex.h>
#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
+;;; <http://www.gnu.org/licenses/>.
(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
+;;; <http://www.gnu.org/licenses/>.
;;;
;;; 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"
