wingo pushed a commit to branch main
in repository guile.
commit e15617dc0e1e53a54798d88617f0095801a52f1c
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Sun Mar 17 21:39:16 2024 +0100
Expose read-c-struct, write-c-struct syntax
* module/system/foreign.scm (read-c-struct): Rename from read-fields.
Export.
(write-c-struct): Rename from write-fields. Export.
(%write-c-struct, %read-c-struct): Add % prefix to these private
bindings.
---
doc/ref/api-foreign.texi | 58 +++++++++++++++++++++++++++++++++++++++--------
module/system/foreign.scm | 26 +++++++++++----------
2 files changed, 63 insertions(+), 21 deletions(-)
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index 540fbbaf5..bd250f069 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
-@c Copyright (C) 1996, 1997, 2000-2004, 2007-2014, 2016-2017, 2021
+@c Copyright (C) 1996, 1997, 2000-2004, 2007-2014, 2016-2017, 2021, 2024
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -761,24 +761,64 @@ also be a list of types, in which case the alignment of a
@code{struct} with ABI-conventional packing is returned.
@end deffn
-Guile also provides some convenience methods to pack and unpack foreign
-pointers wrapping C structs.
+Guile also provides some convenience syntax to efficiently read and
+write C structs to and from bytevectors.
-@deffn {Scheme Procedure} make-c-struct types vals
-Create a foreign pointer to a C struct containing @var{vals} with types
-@code{types}.
+@deffn {Scheme Syntax} read-c-struct bv offset @* ((field type) @dots{}) k
+Read a C struct with fields of type @var{type}... from the bytevector
+@var{bv}, at offset @var{offset}. Bind the fields to the identifiers
+@var{field}..., and return @code{(@var{k} @var{field} ...)}.
-@var{vals} and @code{types} should be lists of the same length.
+Unless cross-compiling, the field types are evaluated at macro-expansion
+time. This allows the resulting bytevector accessors and size/alignment
+computations to be completely inlined.
@end deffn
+@deffn {Scheme Syntax} write-c-struct bv offset @* ((field type) @dots{})
+Write a C struct with fields @var{field}... of type @var{type}... to the
bytevector
+@var{bv}, at offset @var{offset}. Return zero values.
+
+Like @code{write-c-struct} above, unless cross-compiling, the field
+types are evaluated at macro-expansion time.
+@end deffn
+
+For example, to define a parser and serializer for the equivalent of a
+@code{struct @{ int64_t a; uint8_t b; @}}, one might do this:
+
+@example
+(use-modules (system foreign) (rnrs bytevectors))
+
+(define-syntax-rule
+ (define-serialization (reader writer) (field type) ...)
+ (begin
+ (define (reader bv offset)
+ (read-c-struct bv offset ((field type) ...) values))
+ (define (writer bv offset field ...)
+ (write-c-struct bv offset ((field type) ...)))))
+
+(define-serialization (read-struct write-struct)
+ (a int64) (b uint8))
+
+(define bv (make-bytevector (sizeof (list int64 uint8))))
+
+(write-struct bv 0 300 43)
+(call-with-values (lambda () (read-struct bv 0))
+ list)
+@result{} (300 43)
+@end example
+
+There is also an older interface that is mostly equivalent to
+@code{read-c-struct} and @code{write-c-struct}, but which uses run-time
+dispatch, and operates on foreign pointers instead of bytevectors.
+
@deffn {Scheme Procedure} parse-c-struct foreign types
Parse a foreign pointer to a C struct, returning a list of values.
@code{types} should be a list of C types.
@end deffn
-For example, to create and parse the equivalent of a @code{struct @{
-int64_t a; uint8_t b; @}}:
+Our parser and serializer example for @code{struct @{ int64_t a; uint8_t
+b; @}} looks more like this:
@example
(parse-c-struct (make-c-struct (list int64 uint8)
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 043d34409..a75c37da1 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -55,6 +55,8 @@
pointer->procedure
;; procedure->pointer (see below)
+
+ read-c-struct write-c-struct
make-c-struct parse-c-struct
define-wrapped-pointer-type))
@@ -160,7 +162,7 @@ not cross-compiling; otherwise leave it to be evaluated at
run-time."
(... ...)
(else
(let ((offset (align offset (alignof type))))
- (values (read-c-struct bv offset type)
+ (values (%read-c-struct bv offset type)
(+ offset (sizeof type)))))))
(dispatch-read
type
@@ -178,10 +180,10 @@ not cross-compiling; otherwise leave it to be evaluated
at run-time."
(complex-double bytevector-complex-double-native-ref)
('* bytevector-pointer-ref))))
-(define-syntax-rule (read-fields %bv %offset ((field type) ...) k)
+(define-syntax-rule (read-c-struct %bv %offset ((field type) ...) k)
(let ((bv %bv)
(offset %offset)
- (size (compile-time-eval (sizeof '(type ...)))))
+ (size (compile-time-eval (sizeof (list type ...)))))
(unless (<= (bytevector-length bv) (+ offset size))
(error "destination bytevector too small"))
(let*-values (((field offset)
@@ -205,7 +207,7 @@ not cross-compiling; otherwise leave it to be evaluated at
run-time."
(... ...)
(else
(let ((offset (align offset (alignof type))))
- (write-c-struct bv offset type value)
+ (%write-c-struct bv offset type value)
(+ offset (sizeof type))))))
(dispatch-write
type
@@ -223,18 +225,18 @@ not cross-compiling; otherwise leave it to be evaluated
at run-time."
(complex-double bytevector-complex-double-native-set!)
('* bytevector-pointer-set!))))
-(define-syntax-rule (write-fields %bv %offset ((field type) ...))
+(define-syntax-rule (write-c-struct %bv %offset ((field type) ...))
(let ((bv %bv)
(offset %offset)
- (size (compile-time-eval (sizeof '(type ...)))))
+ (size (compile-time-eval (sizeof (list type ...)))))
(unless (<= (bytevector-length bv) (+ offset size))
(error "destination bytevector too small"))
(let* ((offset (write-field bv offset (compile-time-eval type) field))
...)
(values))))
-;; Same as write-fields, but with run-time dispatch.
-(define (write-c-struct bv offset types vals)
+;; Same as write-c-struct, but with run-time dispatch.
+(define (%write-c-struct bv offset types vals)
(let lp ((offset offset) (types types) (vals vals))
(match types
(() (match vals
@@ -246,8 +248,8 @@ not cross-compiling; otherwise leave it to be evaluated at
run-time."
(lp (write-field bv offset type val) types vals))
(() (error "too few values" vals)))))))
-;; Same as read-fields, but with run-time dispatch.
-(define (read-c-struct bv offset types)
+;; Same as read-c-struct, but with run-time dispatch.
+(define (%read-c-struct bv offset types)
(let lp ((offset offset) (types types))
(match types
(() '())
@@ -258,11 +260,11 @@ not cross-compiling; otherwise leave it to be evaluated
at run-time."
(define (make-c-struct types vals)
(let ((bv (make-bytevector (sizeof types) 0)))
- (write-c-struct bv 0 types vals)
+ (%write-c-struct bv 0 types vals)
(bytevector->pointer bv)))
(define (parse-c-struct foreign types)
- (read-c-struct (pointer->bytevector foreign (sizeof types)) 0 types))
+ (%read-c-struct (pointer->bytevector foreign (sizeof types)) 0 types))
;;;
