* [PATCH] Support C99 complex types in (system foreign)
@ 2021-11-11 17:15 lloda
2021-11-15 18:18 ` lloda
0 siblings, 1 reply; 2+ messages in thread
From: lloda @ 2021-11-11 17:15 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 1 bytes --]
[-- Attachment #2: 0001-Support-C99-complex-types-in-system-foreign.patch --]
[-- Type: application/octet-stream, Size: 9476 bytes --]
From 2a95a47be9d431fbcb3fe65c1d02a9926441bbaf Mon Sep 17 00:00:00 2001
From: Daniel Llorens <lloda@sarc.name>
Date: Thu, 11 Nov 2021 15:47:42 +0100
Subject: [PATCH] Support C99 complex types in (system foreign)
* 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.
---
NEWS | 5 +++
doc/ref/api-foreign.texi | 5 ++-
libguile/foreign.c | 66 +++++++++++++++++++++++++++++++++++++++
libguile/foreign.h | 6 ++++
module/system/foreign.scm | 16 ++++++++++
5 files changed, 97 insertions(+), 1 deletion(-)
diff --git a/NEWS b/NEWS
index f41e772ad..710b8ddda 100644
--- a/NEWS
+++ b/NEWS
@@ -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.
+
\f
Changes in 3.0.7 (since 3.0.6)
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index a1a1016b0..540fbbaf5 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -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
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 1368cc9da..fdf1001dc 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -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,22 @@ 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 +1004,24 @@ 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 +1234,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));
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 41f26b335..33ce6311a 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -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;
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index d1c2ceb96..24e14a0cd 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -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)
--
2.30.2
^ permalink raw reply related [flat|nested] 2+ messages in thread
* Re: [PATCH] Support C99 complex types in (system foreign)
2021-11-11 17:15 [PATCH] Support C99 complex types in (system foreign) lloda
@ 2021-11-15 18:18 ` lloda
0 siblings, 0 replies; 2+ messages in thread
From: lloda @ 2021-11-15 18:18 UTC (permalink / raw)
To: guile-devel
Applied with some style changes in 496f69dba2fdf1720b40349932fcdecd444107c3.
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2021-11-15 18:18 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-11-11 17:15 [PATCH] Support C99 complex types in (system foreign) lloda
2021-11-15 18:18 ` lloda
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).