diff options
-rw-r--r-- | doc/ref/api-foreign.texi | 58 | ||||
-rw-r--r-- | 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)) ;;; |