mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
(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.
This commit is contained in:
Andy Wingo
parent
137b0e85b9
commit
2b58dea2d2
4 changed files with 70 additions and 65 deletions
|
|
@ -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));
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue