mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Support C99 complex types in (system foreign)

Browse source 
* libguile/foreign.h (SCM_FOREIGN_TYPE_COMPLEX_FLOAT,
  SCM_FOREIGN_TYPE_COMPLEX_DOUBLE): New enums.
* module/system/foreign.scm (complex-float, complex-double): Export new types.
  (make-c-struct, parse-c-struct): Support the new types.
* libguile/foreign.c (complex-float, complex-double): Define new types.
  (alignof, sizeof, pack, unpack): Support the new types.
* test-suite/tests/foreign.test: Test.
This commit is contained in:
Daniel Llorens 2021-11-11 15:47:42 +01:00
parent 24116be822
commit 496f69dba2
6 changed files with 110 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

5
NEWS
View file

@ -49,6 +49,11 @@ Bytevectors" in the manual.
Compared to the previous versions, these accept range arguments. See
"Accessing and Modifying Vector Contents" in the manual.
** (system foreign) supports C99 complex types
The types `complex-float' and `complex-double' stand for C99 `float
_Complex' and `double _Complex` respectively.
Changes in 3.0.7 (since 3.0.6)

5
doc/ref/api-foreign.texi
View file

@ -465,8 +465,11 @@ C types.
@defvrx {Scheme Variable} int64
@defvrx {Scheme Variable} float
@defvrx {Scheme Variable} double
@defvrx {Scheme Variable} complex-double
@defvrx {Scheme Variable} complex-float
These values represent the C numeric types of the specified sizes and
signednesses.
signednesses. @code{complex-float} and @code{complex-double} stand for
C99 @code{float _Complex} and @code{double _Complex} respecively.
@end defvr
In addition there are some convenience bindings for indicating types of

71
libguile/foreign.c
View file

@ -29,6 +29,10 @@
#include <ffi.h>
#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
#include <complex.h>
#endif
#include "boolean.h"
#include "bytevectors.h"
#include "dynwind.h"
@ -63,6 +67,10 @@
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");
@ -470,6 +478,12 @@ 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:
return scm_from_size_t (alignof_type (float _Complex));
case SCM_FOREIGN_TYPE_COMPLEX_DOUBLE:
return scm_from_size_t (alignof_type (double _Complex));
#endif
case SCM_FOREIGN_TYPE_UINT8:
return scm_from_size_t (alignof_type (uint8_t));
case SCM_FOREIGN_TYPE_INT8:
@ -534,6 +548,12 @@ 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:
return scm_from_size_t (sizeof (float _Complex));
case SCM_FOREIGN_TYPE_COMPLEX_DOUBLE:
return scm_from_size_t (sizeof (double _Complex));
#endif
case SCM_FOREIGN_TYPE_UINT8:
return scm_from_size_t (sizeof (uint8_t));
case SCM_FOREIGN_TYPE_INT8:
@ -626,6 +646,14 @@ fill_ffi_type (SCM type, ffi_type *ftype, ffi_type ***type_ptrs,
case SCM_FOREIGN_TYPE_DOUBLE:
*ftype = ffi_type_double;
return;
#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
case SCM_FOREIGN_TYPE_COMPLEX_FLOAT:
*ftype = ffi_type_complex_float;
return;
case SCM_FOREIGN_TYPE_COMPLEX_DOUBLE:
*ftype = ffi_type_complex_double;
return;
#endif
case SCM_FOREIGN_TYPE_UINT8:
*ftype = ffi_type_uint8;
return;
@ -882,6 +910,23 @@ unpack (const ffi_type *type, void *loc, SCM x, int return_value_p)
*(double *) loc = scm_to_double (x);
break;
/* no FFI_TYPE_xxx_COMPLEX or (FFI_TYPE_COMPLEX_xxx) :-| */
#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
case FFI_TYPE_COMPLEX:
{
double re = scm_to_double (scm_real_part(x));
double im = scm_to_double (scm_imag_part(x));
if (sizeof (float _Complex) == type->size)
*(float _Complex *) loc = (float)re + _Complex_I * (float)im;
else if (sizeof (double _Complex) == type->size)
*(double _Complex *) loc = re + _Complex_I * im;
else
abort();
}
break;
#endif
/* For integer return values smaller than `int', libffi expects the
result in an `ffi_arg'-long buffer. */
@ -960,6 +1005,28 @@ pack (const ffi_type * type, const void *loc, int return_value_p)
case FFI_TYPE_DOUBLE:
return scm_from_double (*(double *) loc);
/* no FFI_TYPE_xxx_COMPLEX or (FFI_TYPE_COMPLEX_xxx) :-| */
#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
case FFI_TYPE_COMPLEX:
{
double re, im;
if (sizeof (float _Complex) == type->size)
{
re = crealf(*(float _Complex *) loc);
im = cimagf(*(float _Complex *) loc);
}
else if (sizeof (double _Complex) == type->size)
{
re = creal(*(double _Complex *) loc);
im = cimag(*(double _Complex *) loc);
}
else
abort ();
return scm_make_rectangular (scm_from_double (re), scm_from_double (im));
}
#endif
/* For integer return values smaller than `int', libffi stores the
result in an `ffi_arg'-long buffer, of which only the
significant bits must be kept---hence the pair of casts below.
@ -1172,6 +1239,10 @@ 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));

6
libguile/foreign.h
View file

@ -43,7 +43,13 @@ 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;

16
module/system/foreign.scm
View file

@ -23,6 +23,7 @@
#:use-module (srfi srfi-9 gnu)
#:export (void
float double
complex-float complex-double
short
unsigned-short
int unsigned-int long unsigned-long size_t ssize_t ptrdiff_t
@ -93,9 +94,22 @@
(bytevector-u32-native-set! bv offset (pointer-address ptr))))
(else (error "what machine is this?"))))
(define (writer-complex set size)
(lambda (bv i val)
(set bv i (real-part val))
(set bv (+ i size) (imag-part val))))
(define (reader-complex ref size)
(lambda (bv i)
(make-rectangular
(ref bv i)
(ref bv (+ i size)))))
(define *writers*
`((,float . ,bytevector-ieee-single-native-set!)
(,double . ,bytevector-ieee-double-native-set!)
(,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!)
@ -109,6 +123,8 @@
(define *readers*
`((,float . ,bytevector-ieee-single-native-ref)
(,double . ,bytevector-ieee-double-native-ref)
(,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)

9
test-suite/tests/foreign.test
View file

@ -416,7 +416,14 @@
(data (list 77 (list 42 4.2 55) 88)))
(equal? (parse-c-struct (make-c-struct layout data)
layout)
data))))
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))))))
(with-test-prefix "lib->cyg"