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

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.
This commit is contained in:
Andy Wingo 2024-03-17 21:39:16 +01:00
parent d7ae468c17
commit e15617dc0e
2 changed files with 63 additions and 21 deletions

View file

@ -1,6 +1,6 @@
@c -*-texinfo-*- @c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual. @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 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions. @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. @code{struct} with ABI-conventional packing is returned.
@end deffn @end deffn
Guile also provides some convenience methods to pack and unpack foreign Guile also provides some convenience syntax to efficiently read and
pointers wrapping C structs. write C structs to and from bytevectors.
@deffn {Scheme Procedure} make-c-struct types vals @deffn {Scheme Syntax} read-c-struct bv offset @* ((field type) @dots{}) k
Create a foreign pointer to a C struct containing @var{vals} with types Read a C struct with fields of type @var{type}... from the bytevector
@code{types}. @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 @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 @deffn {Scheme Procedure} parse-c-struct foreign types
Parse a foreign pointer to a C struct, returning a list of values. Parse a foreign pointer to a C struct, returning a list of values.
@code{types} should be a list of C types. @code{types} should be a list of C types.
@end deffn @end deffn
For example, to create and parse the equivalent of a @code{struct @{ Our parser and serializer example for @code{struct @{ int64_t a; uint8_t
int64_t a; uint8_t b; @}}: b; @}} looks more like this:
@example @example
(parse-c-struct (make-c-struct (list int64 uint8) (parse-c-struct (make-c-struct (list int64 uint8)

View file

@ -55,6 +55,8 @@
pointer->procedure pointer->procedure
;; procedure->pointer (see below) ;; procedure->pointer (see below)
read-c-struct write-c-struct
make-c-struct parse-c-struct make-c-struct parse-c-struct
define-wrapped-pointer-type)) define-wrapped-pointer-type))
@ -160,7 +162,7 @@ not cross-compiling; otherwise leave it to be evaluated at run-time."
(... ...) (... ...)
(else (else
(let ((offset (align offset (alignof type)))) (let ((offset (align offset (alignof type))))
(values (read-c-struct bv offset type) (values (%read-c-struct bv offset type)
(+ offset (sizeof type))))))) (+ offset (sizeof type)))))))
(dispatch-read (dispatch-read
type type
@ -178,10 +180,10 @@ not cross-compiling; otherwise leave it to be evaluated at run-time."
(complex-double bytevector-complex-double-native-ref) (complex-double bytevector-complex-double-native-ref)
('* bytevector-pointer-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) (let ((bv %bv)
(offset %offset) (offset %offset)
(size (compile-time-eval (sizeof '(type ...))))) (size (compile-time-eval (sizeof (list type ...)))))
(unless (<= (bytevector-length bv) (+ offset size)) (unless (<= (bytevector-length bv) (+ offset size))
(error "destination bytevector too small")) (error "destination bytevector too small"))
(let*-values (((field offset) (let*-values (((field offset)
@ -205,7 +207,7 @@ not cross-compiling; otherwise leave it to be evaluated at run-time."
(... ...) (... ...)
(else (else
(let ((offset (align offset (alignof type)))) (let ((offset (align offset (alignof type))))
(write-c-struct bv offset type value) (%write-c-struct bv offset type value)
(+ offset (sizeof type)))))) (+ offset (sizeof type))))))
(dispatch-write (dispatch-write
type type
@ -223,18 +225,18 @@ not cross-compiling; otherwise leave it to be evaluated at run-time."
(complex-double bytevector-complex-double-native-set!) (complex-double bytevector-complex-double-native-set!)
('* bytevector-pointer-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) (let ((bv %bv)
(offset %offset) (offset %offset)
(size (compile-time-eval (sizeof '(type ...))))) (size (compile-time-eval (sizeof (list type ...)))))
(unless (<= (bytevector-length bv) (+ offset size)) (unless (<= (bytevector-length bv) (+ offset size))
(error "destination bytevector too small")) (error "destination bytevector too small"))
(let* ((offset (write-field bv offset (compile-time-eval type) field)) (let* ((offset (write-field bv offset (compile-time-eval type) field))
...) ...)
(values)))) (values))))
;; Same as write-fields, but with run-time dispatch. ;; Same as write-c-struct, but with run-time dispatch.
(define (write-c-struct bv offset types vals) (define (%write-c-struct bv offset types vals)
(let lp ((offset offset) (types types) (vals vals)) (let lp ((offset offset) (types types) (vals vals))
(match types (match types
(() (match vals (() (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)) (lp (write-field bv offset type val) types vals))
(() (error "too few values" vals))))))) (() (error "too few values" vals)))))))
;; Same as read-fields, but with run-time dispatch. ;; Same as read-c-struct, but with run-time dispatch.
(define (read-c-struct bv offset types) (define (%read-c-struct bv offset types)
(let lp ((offset offset) (types types)) (let lp ((offset offset) (types types))
(match 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) (define (make-c-struct types vals)
(let ((bv (make-bytevector (sizeof types) 0))) (let ((bv (make-bytevector (sizeof types) 0)))
(write-c-struct bv 0 types vals) (%write-c-struct bv 0 types vals)
(bytevector->pointer bv))) (bytevector->pointer bv)))
(define (parse-c-struct foreign types) (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))
;;; ;;;