aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-07-25 12:41:08 +0200
committerLudovic Courtès <ludo@gnu.org>2015-07-25 14:43:45 +0200
commit573b4c1ff3409fb4417ec676091f6bbc09219f19 (patch)
treeeb4d7adfc12ff49c968e9c86fbfb10224cd8ecc3
parent3ca337699a2feb2a42f3661b7321a5e7d5fec594 (diff)
downloadpatches-573b4c1ff3409fb4417ec676091f6bbc09219f19.tar
patches-573b4c1ff3409fb4417ec676091f6bbc09219f19.tar.gz
syscalls: 'define-c-struct' properly align reads.
* guix/build/syscalls.scm (alignof*, align): New macros. (write-types, read-types): Use 'align' to compute the actual offset to read/write a value of TYPE0.
-rw-r--r--guix/build/syscalls.scm33
1 files changed, 29 insertions, 4 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 69abea1ef6..ca26824dc5 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -363,6 +363,26 @@ system to PUT-OLD."
(_ val))))))
v))))
+(define-syntax alignof*
+ ;; XXX: This duplicates 'compile-time-value'.
+ (syntax-rules (int128)
+ ((_ int128)
+ 16)
+ ((_ type)
+ (let-syntax ((v (lambda (s)
+ (let ((val (alignof type)))
+ (syntax-case s ()
+ (_ val))))))
+ v))))
+
+(define-syntax align ;as found in (system foreign)
+ (syntax-rules (~)
+ "Add to OFFSET whatever it takes to get proper alignment for TYPE."
+ ((_ offset (type ~ endianness))
+ (align offset type))
+ ((_ offset type)
+ (1+ (logior (1- offset) (1- (alignof* type)))))))
+
(define-syntax type-size
(syntax-rules (~)
((_ (type ~ order))
@@ -385,8 +405,9 @@ system to PUT-OLD."
#t)
((_ bv offset (type0 types ...) (field0 fields ...))
(begin
- (write-type bv offset type0 field0)
- (write-types bv (+ offset (type-size type0))
+ (write-type bv (align offset type0) type0 field0)
+ (write-types bv
+ (+ (align offset type0) (type-size type0))
(types ...) (fields ...))))))
(define-syntax read-type
@@ -408,8 +429,12 @@ system to PUT-OLD."
(return values ...))
((_ return bv offset (type0 types ...) (values ...))
(read-types return
- bv (+ offset (type-size type0)) (types ...)
- (values ... (read-type bv offset type0))))))
+ bv
+ (+ (align offset type0) (type-size type0))
+ (types ...)
+ (values ... (read-type bv
+ (align offset type0)
+ type0))))))
(define-syntax define-c-struct
(syntax-rules ()