summaryrefslogtreecommitdiff
path: root/module/system
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2024-03-17 21:39:16 +0100
committerAndy Wingo <wingo@pobox.com>2024-03-17 21:40:58 +0100
commite15617dc0e1e53a54798d88617f0095801a52f1c (patch)
tree32536ae66367f03145957f1018d99c625f287613 /module/system
parentd7ae468c170454d807bd0dd29ae309ffa4f448ce (diff)
downloadguile-e15617dc0e1e53a54798d88617f0095801a52f1c.tar.gz
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.
Diffstat (limited to 'module/system')
-rw-r--r--module/system/foreign.scm26
1 files changed, 14 insertions, 12 deletions
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))
;;;