diff options
author | Andy Wingo <wingo@pobox.com> | 2024-03-17 20:56:21 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2024-03-17 21:40:58 +0100 |
commit | d7ae468c170454d807bd0dd29ae309ffa4f448ce (patch) | |
tree | 6e346f81267ec112ef4c6db503d6c5d31b64d7f7 /module/system | |
parent | 7fef214f6e0df4004020fec530e808c476f2d2bf (diff) | |
download | guile-d7ae468c170454d807bd0dd29ae309ffa4f448ce.tar.gz |
Rework read-fields, write-fields to not return offset
* module/system/foreign.scm (read-fields, write-fields): Don't return
the final offset, as the offset after the final field is not necessarily
the end of the struct, because of padding.
Diffstat (limited to 'module/system')
-rw-r--r-- | module/system/foreign.scm | 34 |
1 files changed, 20 insertions, 14 deletions
diff --git a/module/system/foreign.scm b/module/system/foreign.scm index 438ecd5ed..043d34409 100644 --- a/module/system/foreign.scm +++ b/module/system/foreign.scm @@ -21,6 +21,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-11) #:use-module (system base target) #:export (void float double @@ -177,14 +178,16 @@ not cross-compiling; otherwise leave it to be evaluated at run-time." (complex-double bytevector-complex-double-native-ref) ('* bytevector-pointer-ref)))) -(define-syntax read-fields - (syntax-rules () - ((read-fields () bv offset k) (k offset)) - ((read-fields ((field type) . rest) bv offset k) - (call-with-values (lambda () - (read-field bv offset (compile-time-eval type))) - (lambda (field offset) - (read-fields rest bv offset k)))))) +(define-syntax-rule (read-fields %bv %offset ((field type) ...) k) + (let ((bv %bv) + (offset %offset) + (size (compile-time-eval (sizeof '(type ...))))) + (unless (<= (bytevector-length bv) (+ offset size)) + (error "destination bytevector too small")) + (let*-values (((field offset) + (read-field bv offset (compile-time-eval type))) + ...) + (k field ...)))) (define-syntax-rule (write-field %bv %offset %type %value) (let ((bv %bv) @@ -220,12 +223,15 @@ not cross-compiling; otherwise leave it to be evaluated at run-time." (complex-double bytevector-complex-double-native-set!) ('* bytevector-pointer-set!)))) -(define-syntax write-fields - (syntax-rules () - ((write-fields () bv offset k) (k offset)) - ((write-fields ((field type) . rest) bv offset k) - (let ((offset (write-field bv offset (compile-time-eval type) field))) - (write-fields rest bv offset k))))) +(define-syntax-rule (write-fields %bv %offset ((field type) ...)) + (let ((bv %bv) + (offset %offset) + (size (compile-time-eval (sizeof '(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) |