Add bit fields.

2 files changed, 303 insertions, 135 deletions

diff --git a/bstruct.scm b/bstruct.scm
index 2755303..df5163a 100644
--- a/bstruct.scm
+++ b/bstruct.scm
@@ -83,6 +83,22 @@
   (native? scalar-native?)              ; native endianness?
   (type scalar-type))
 
+(define-record-type <bit-field>
+  (make-bit-field name offset length signed?)
+  bit-field?
+  (name bit-field-name)
+  (offset bit-field-offset)
+  (length bit-field-length)
+  (signed? bit-field-signed?))
+
+(define-record-type <bits>
+  (make-bits size align native? fields)
+  bits?
+  (size bits-size)
+  (align bits-align)
+  (native? bits-native?)
+  (fields bits-fields))
+
 (define-record-type <struct-field>
   (make-struct-field name offset type)
   struct-field?
@@ -126,8 +142,6 @@
   ;; Mutable for setting up recursive types.
   (type pointer-type set-pointer-type!))
 
-;; TODO: bitfields
-
 (define (struct-field-ref struct name)
   (and=> (find (match-lambda
                  (($ <struct-field> name*)
@@ -144,6 +158,7 @@
 
 (define (bstruct-type? obj)
   (or (scalar? obj)
+      (bits? obj)
       (%struct? obj)
       (union? obj)
       (array? obj)
@@ -152,6 +167,7 @@
 (define (sizeof type)
   (match type
     ((or ($ <scalar> size)
+         ($ <bits> size)
          ($ <struct> size)
          ($ <union> size)
          ($ <array> size)
@@ -161,6 +177,7 @@
 (define (alignof type)
   (match type
     ((or ($ <scalar> _ align)
+         ($ <bits> _ align)
          ($ <struct> _ align)
          ($ <union> _ align)
          ($ <array> _ align)
@@ -354,6 +371,20 @@
              ('ptrdiff_t (bytevector-sint-ref bv offset e (ffi:sizeof ffi:ptrdiff_t)))
              ('intptr_t (bytevector-sint-ref bv offset e (ffi:sizeof ffi:intptr_t)))
              ('uintptr_t (bytevector-uint-ref bv offset e (ffi:sizeof ffi:uintptr_t))))))
+        (($ <bits> size _ native? fields)
+         (let ((e (if native? (target-endianness) (non-target-endianness))))
+           `(bits
+             ,@(map (match-lambda
+                      (($ <bit-field> name start len signed?)
+                       (list name
+                             (let ((x (ash (logand (bytevector-uint-ref bv offset
+                                                                        e size)
+                                                   (ash (1- (ash 1 len)) start))
+                                           (- start))))
+                               (if signed?
+                                   (centered-remainder x (ash 1 len))
+                                   x)))))
+                    fields))))
         (($ <struct> _ _ fields)
          `(struct ,@(map (match-lambda
                            (($ <struct-field> name offset* type)
@@ -617,6 +648,10 @@
 
 (define-syntax define-bstruct-descriptor
   (lambda (stx)
+    (define (build-bit-field stx)
+      (syntax-case stx ()
+        ((name offset len signed?)
+         #`(make-bit-field 'name offset len signed?))))
     (define (build-struct-field stx)
       (syntax-case stx ()
         ((name offset type)
@@ -633,6 +668,10 @@
         ((scalar size align native? type)
          (symbolic-match? scalar)
          #'(make-scalar size align native? 'type))
+        ((bits size align native? (field ...))
+         (symbolic-match? bits)
+         (with-syntax (((field ...) (map build-bit-field #'(field ...))))
+           #'(make-bits size align native? (list field ...))))
         ((struct size align (field ...))
          (symbolic-match? struct)
          (with-syntax (((field ...) (map build-struct-field #'(field ...))))
@@ -663,6 +702,9 @@
     ((scalar size _ _ _)
      (symbolic-match? scalar)
      (syntax->datum #'size))
+    ((bits size _ _ _)
+     (symbolic-match? bits)
+     (syntax->datum #'size))
     ((struct size _ _)
      (symbolic-match? struct)
      (syntax->datum #'size))
@@ -686,6 +728,9 @@
     ((scalar _ align _ _)
      (symbolic-match? scalar)
      (syntax->datum #'align))
+    ((bits _ align _ _)
+     (symbolic-match? bits)
+     (syntax->datum #'align))
     ((struct _ align _)
      (symbolic-match? struct)
      (syntax->datum #'align))
@@ -722,6 +767,18 @@
           (symbolic-match? scalar)
           (syntax-case stx ()
             (() (proc type offset))))
+         ((bits size _ native? (field ...))
+          (symbolic-match? bits)
+          (syntax-case stx ()
+            ((e)
+             (identifier? #'e)
+             (let ((name (syntax->datum #'e)))
+               (let field-lp ((fields #'(field ...)))
+                 (syntax-case fields ()
+                   (((name* offset* len signed?) . rest)
+                    (if (identifier-eq? #'name* name)
+                        (proc #`(bit-field size offset* len signed? native?) offset)
+                        (field-lp #'rest)))))))))
          ((struct _ _ (field ...))
           (symbolic-match? struct)
           (syntax-case stx ()
@@ -730,9 +787,8 @@
              (let ((name (syntax->datum #'e)))
                (let field-lp ((fields #'(field ...)))
                  (syntax-case fields ()
-                   (() (error "no such struct field" name))
                    (((name* offset* type*) . rest)
-                    (if (eq? name (syntax->datum #'name*))
+                    (if (identifier-eq? #'name* name)
                         (loop #'(elem ...) #'type* #`(+ #,offset offset*))
                         (field-lp #'rest)))))))))
          ((union _ _ (field ...))
@@ -743,9 +799,8 @@
              (let ((name (syntax->datum #'e)))
                (let field-lp ((fields #'(field ...)))
                  (syntax-case fields ()
-                   (() (error "no such union field" name))
                    (((name* type) . rest)
-                    (if (eq? name (syntax->datum #'name*))
+                    (if (identifier-eq? #'name* name)
                         (loop #'(elem ...) #'type offset)
                         (field-lp #'rest)))))))))
          ((array _ _ length type)
@@ -828,66 +883,71 @@
                ((scalar size align native? type)
                 (symbolic-match? scalar)
                 #'(values bv offset))
+               ((bit-field size start len signed? native?)
+                (symbolic-match? bit-field)
+                (syntax-violation 'bstruct->pointer
+                                  "cannot create pointer to bit field"
+                                  id elems))
                (sub-offset
                 #'(sub-offset bv (+ i offset))))))
          elems id 'offset type)))
-(define (expand-getter elems id type)
     ;; Primitive getter/setter helpers
-    (define (ref/endianness proc endianness)
-      #`(lambda (bv i)
-          (#,proc bv i #,endianness)))
-    (define (uint-ref size endianness)
-      #`(lambda (bv i)
-          (bytevector-uint-ref bv i '#,(datum->syntax #f endianness) #,size)))
-    (define (sint-ref size endianness)
-      #`(lambda (bv i)
-          (bytevector-sint-ref bv i '#,(datum->syntax #f endianness) #,size)))
-    ;; Scalar types are divided into two categories: machine
-    ;; indepenent and machine dependent.  The machine independent
-    ;; types (i32, f32, etc.) have a known size and alignment on all
-    ;; platforms.  The machine dependent types have a size and
-    ;; alignment that can vary depending on the ABI of the system that
-    ;; is compiling the code.
-    (define (abi-ref type e)            ; e for endianness
+(define (ref/endianness proc endianness)
+  #`(lambda (bv i)
+      (#,proc bv i #,endianness)))
+(define (uint-ref size endianness)
+  #`(lambda (bv i)
+      (bytevector-uint-ref bv i '#,(datum->syntax #f endianness) #,size)))
+(define (sint-ref size endianness)
+  #`(lambda (bv i)
+      (bytevector-sint-ref bv i '#,(datum->syntax #f endianness) #,size)))
+;; Scalar types are divided into two categories: machine
+;; indepenent and machine dependent.  The machine independent
+;; types (i32, f32, etc.) have a known size and alignment on all
+;; platforms.  The machine dependent types have a size and
+;; alignment that can vary depending on the ABI of the system that
+;; is compiling the code.
+(define (abi-ref type e)            ; e for endianness
+  (match type
+    ('uint (uint-ref (sizeof* 'uint) e))
+    ('int (sint-ref (sizeof* 'int) e))
+    ('ulong (uint-ref (sizeof* 'ulong) e))
+    ('long (sint-ref (sizeof* 'long) e))
+    ('ushort (uint-ref (sizeof* 'ushort) e))
+    ('short (sint-ref (sizeof* 'short) e))
+    ('size_t (uint-ref (sizeof* 'size_t) e))
+    ('ssize_t (sint-ref (sizeof* 'ssize_t) e))
+    ('ptrdiff_t (sint-ref (sizeof* 'ptrdiff_t) e))
+    ('intptr_t (sint-ref (sizeof* 'intptr_t) e))
+    ('uintptr_t (uint-ref (sizeof* 'uintptr_t) e))))
+(define (primitive-getter native? type)
+  (if native?
       (match type
-        ('uint (uint-ref (sizeof* 'uint) e))
-        ('int (sint-ref (sizeof* 'int) e))
-        ('ulong (uint-ref (sizeof* 'ulong) e))
-        ('long (sint-ref (sizeof* 'long) e))
-        ('ushort (uint-ref (sizeof* 'ushort) e))
-        ('short (sint-ref (sizeof* 'short) e))
-        ('size_t (uint-ref (sizeof* 'size_t) e))
-        ('ssize_t (sint-ref (sizeof* 'ssize_t) e))
-        ('ptrdiff_t (sint-ref (sizeof* 'ptrdiff_t) e))
-        ('intptr_t (sint-ref (sizeof* 'intptr_t) e))
-        ('uintptr_t (uint-ref (sizeof* 'uintptr_t) e))))
-  (define (primitive-getter size native? type)
-    (if native?
+        ('u8 #'bytevector-u8-ref)
+        ('s8 #'bytevector-s8-ref)
+        ('u16 #'bytevector-u16-native-ref)
+        ('s16 #'bytevector-s16-native-ref)
+        ('u32 #'bytevector-u32-native-ref)
+        ('s32 #'bytevector-s32-native-ref)
+        ('u64 #'bytevector-u64-native-ref)
+        ('s64 #'bytevector-s64-native-ref)
+        ('f32 #'bytevector-ieee-single-native-ref)
+        ('f64 #'bytevector-ieee-double-native-ref)
+        (_ (abi-ref type (target-endianness))))
+      (let ((e (non-target-endianness)))
         (match type
           ('u8 #'bytevector-u8-ref)
           ('s8 #'bytevector-s8-ref)
-          ('u16 #'bytevector-u16-native-ref)
-          ('s16 #'bytevector-s16-native-ref)
-          ('u32 #'bytevector-u32-native-ref)
-          ('s32 #'bytevector-s32-native-ref)
-          ('u64 #'bytevector-u64-native-ref)
-          ('s64 #'bytevector-s64-native-ref)
-          ('f32 #'bytevector-ieee-single-native-ref)
-          ('f64 #'bytevector-ieee-double-native-ref)
-          (_ (abi-ref type (target-endianness))))
-        (let ((e (non-target-endianness)))
-          (match type
-            ('u8 #'bytevector-u8-ref)
-            ('s8 #'bytevector-s8-ref)
-            ('u16 (ref/endianness #'bytevector-u16-ref e))
-            ('s16 (ref/endianness #'bytevector-s16-ref e))
-            ('u32 (ref/endianness #'bytevector-u32-ref e))
-            ('s32 (ref/endianness #'bytevector-s32-ref e))
-            ('u64 (ref/endianness #'bytevector-u64-ref e))
-            ('s64 (ref/endianness #'bytevector-s64-ref e))
-            ('f32 (ref/endianness #'bytevector-ieee-single-ref e))
-            ('f64 (ref/endianness #'bytevector-ieee-double-ref e))
-            (_ (abi-ref type e))))))
+          ('u16 (ref/endianness #'bytevector-u16-ref e))
+          ('s16 (ref/endianness #'bytevector-s16-ref e))
+          ('u32 (ref/endianness #'bytevector-u32-ref e))
+          ('s32 (ref/endianness #'bytevector-s32-ref e))
+          ('u64 (ref/endianness #'bytevector-u64-ref e))
+          ('s64 (ref/endianness #'bytevector-s64-ref e))
+          ('f32 (ref/endianness #'bytevector-ieee-single-ref e))
+          ('f64 (ref/endianness #'bytevector-ieee-double-ref e))
+          (_ (abi-ref type e))))))
+(define (expand-getter elems id type)
   #`(lambda (bv i)
       #,(expand-accessor
          (lambda (type offset)
@@ -904,63 +964,83 @@
                                         #,(target-word-size))))
                ((scalar size align native? type)
                 (symbolic-match? scalar)
-                (with-syntax ((getter (primitive-getter (syntax->datum #'size)
-                                                        (syntax->datum #'native?)
+                (with-syntax ((getter (primitive-getter (syntax->datum #'native?)
                                                         (syntax->datum #'type))))
                   #'(getter bv (+ i offset))))
+               ((bit-field size start len signed? native?)
+                (symbolic-match? bit-field)
+                (let ((type (if (syntax->datum #'signed?)
+                                (match (syntax->datum #'size)
+                                  (1 's8)
+                                  (2 's16)
+                                  (4 's32)
+                                  (8 's64))
+                                (match (syntax->datum #'size)
+                                  (1 'u8)
+                                  (2 'u16)
+                                  (4 'u32)
+                                  (8 'u64)))))
+                  (with-syntax ((getter (primitive-getter (syntax->datum #'native?)
+                                                          type)))
+                    #'(let ((x (ash (logand (getter bv (+ i offset))
+                                            (ash (1- (ash 1 len)) start))
+                                    (- start))))
+                        (if signed?
+                            (centered-remainder x (ash 1 len))
+                            x)))))
                (sub-get
                 #'(sub-get bv (+ i offset))))))
          elems id 'getter type)))
-(define (expand-setter elems id type size)
-  (define (set!/endianness proc endianness)
-    #`(lambda (bv i x)
-        (#,proc bv i x #,endianness)))
-  (define (uint-set! size endianness)
-    #`(lambda (bv i x)
-        (bytevector-uint-set! bv i x '#,(datum->syntax #f endianness) #,size)))
-  (define (sint-set! size endianness)
-    #`(lambda (bv i x)
-        (bytevector-sint-set! bv i x '#,(datum->syntax #f endianness) #,size)))
-  (define (abi-set! type e)
-    (match type
-      ('uint (uint-set! (sizeof* 'uint) e))
-      ('int (sint-set! (sizeof* 'int) e))
-      ('ulong (uint-set! (sizeof* 'ulong) e))
-      ('long (sint-set! (sizeof* 'long) e))
-      ('ushort (uint-set! (sizeof* 'ushort) e))
-      ('short (sint-set! (sizeof* 'short) e))
-      ('size_t (uint-set! (sizeof* 'size_t) e))
-      ('ssize_t (sint-set! (sizeof* 'ssize_t) e))
-      ('ptrdiff_t (sint-set! (sizeof* 'ptrdiff_t) e))
-      ('intptr_t (sint-set! (sizeof* 'intptr_t) e))
-      ('uintptr_t (uint-set! (sizeof* 'uintptr_t) e))))
-  (define (primitive-setter size native? type)
-    (if native?
+(define (set!/endianness proc endianness)
+  #`(lambda (bv i x)
+      (#,proc bv i x #,endianness)))
+(define (uint-set! size endianness)
+  #`(lambda (bv i x)
+      (bytevector-uint-set! bv i x '#,(datum->syntax #f endianness) #,size)))
+(define (sint-set! size endianness)
+  #`(lambda (bv i x)
+      (bytevector-sint-set! bv i x '#,(datum->syntax #f endianness) #,size)))
+(define (abi-set! type e)
+  (match type
+    ('uint (uint-set! (sizeof* 'uint) e))
+    ('int (sint-set! (sizeof* 'int) e))
+    ('ulong (uint-set! (sizeof* 'ulong) e))
+    ('long (sint-set! (sizeof* 'long) e))
+    ('ushort (uint-set! (sizeof* 'ushort) e))
+    ('short (sint-set! (sizeof* 'short) e))
+    ('size_t (uint-set! (sizeof* 'size_t) e))
+    ('ssize_t (sint-set! (sizeof* 'ssize_t) e))
+    ('ptrdiff_t (sint-set! (sizeof* 'ptrdiff_t) e))
+    ('intptr_t (sint-set! (sizeof* 'intptr_t) e))
+    ('uintptr_t (uint-set! (sizeof* 'uintptr_t) e))))
+(define (primitive-setter native? type)
+  (if native?
+      (match type
+        ('u8 #'bytevector-u8-set!)
+        ('s8 #'bytevector-s8-set!)
+        ('u16 #'bytevector-u16-native-set!)
+        ('s16 #'bytevector-s16-native-set!)
+        ('u32 #'bytevector-u32-native-set!)
+        ('s32 #'bytevector-s32-native-set!)
+        ('u64 #'bytevector-u64-native-set!)
+        ('s64 #'bytevector-s64-native-set!)
+        ('f32 #'bytevector-ieee-single-native-set!)
+        ('f64 #'bytevector-ieee-double-native-set!)
+        (_ (abi-set! type (target-endianness))))
+      (let ((e (non-target-endianness)))
         (match type
           ('u8 #'bytevector-u8-set!)
           ('s8 #'bytevector-s8-set!)
-          ('u16 #'bytevector-u16-native-set!)
-          ('s16 #'bytevector-s16-native-set!)
-          ('u32 #'bytevector-u32-native-set!)
-          ('s32 #'bytevector-s32-native-set!)
-          ('u64 #'bytevector-u64-native-set!)
-          ('s64 #'bytevector-s64-native-set!)
-          ('f32 #'bytevector-ieee-single-native-set!)
-          ('f64 #'bytevector-ieee-double-native-set!)
-          (_ (abi-set! type (target-endianness))))
-        (let ((e (non-target-endianness)))
-          (match type
-            ('u8 #'bytevector-u8-set!)
-            ('s8 #'bytevector-s8-set!)
-            ('u16 (set!/endianness #'bytevector-u16-set! e))
-            ('s16 (set!/endianness #'bytevector-s16-set! e))
-            ('u32 (set!/endianness #'bytevector-u32-set! e))
-            ('s32 (set!/endianness #'bytevector-s32-set! e))
-            ('u64 (set!/endianness #'bytevector-u64-set! e))
-            ('s64 (set!/endianness #'bytevector-s64-set! e))
-            ('f32 (set!/endianness #'bytevector-ieee-single-set! e))
-            ('f64 (set!/endianness #'bytevector-ieee-double-set! e))
-            (_ (abi-set! type e))))))
+          ('u16 (set!/endianness #'bytevector-u16-set! e))
+          ('s16 (set!/endianness #'bytevector-s16-set! e))
+          ('u32 (set!/endianness #'bytevector-u32-set! e))
+          ('s32 (set!/endianness #'bytevector-s32-set! e))
+          ('u64 (set!/endianness #'bytevector-u64-set! e))
+          ('s64 (set!/endianness #'bytevector-s64-set! e))
+          ('f32 (set!/endianness #'bytevector-ieee-single-set! e))
+          ('f64 (set!/endianness #'bytevector-ieee-double-set! e))
+          (_ (abi-set! type e))))))
+(define (expand-setter elems id type size)
   #`(lambda (bv i x)
       #,(expand-accessor
          (lambda (type offset)
@@ -980,13 +1060,46 @@
                                         #,(target-word-size)))
                ((scalar size align native? type)
                 (symbolic-match? scalar)
-                (with-syntax ((setter (primitive-setter (syntax->datum #'size)
-                                                        (syntax->datum #'native?)
+                (with-syntax ((setter (primitive-setter (syntax->datum #'native?)
                                                         (syntax->datum #'type))))
                   #'(setter bv (+ i offset) x)))
+               ((bit-field size start len signed? native?)
+                (symbolic-match? bit-field)
+                (let ((type (if (syntax->datum #'signed?)
+                                (match (syntax->datum #'size)
+                                  (1 's8)
+                                  (2 's16)
+                                  (4 's32)
+                                  (8 's64))
+                                (match (syntax->datum #'size)
+                                  (1 'u8)
+                                  (2 'u16)
+                                  (4 'u32)
+                                  (8 'u64))))
+                      (native? (syntax->datum #'native?)))
+                  (with-syntax ((getter (primitive-getter native? type))
+                                (setter (primitive-setter native? type)))
+                    ;; The mask keeps the bits that are *not* part of
+                    ;; the bit field for the existing value.
+                    #'(let* ((mask (lognot (ash (1- (ash 1 len)) start)))
+                             (rest (logand (getter bv (+ i offset)) mask)))
+                        (define (fail)
+                          (error "bit field value out of range" x))
+                        (if signed?
+                            (if (<= (ash -1 (1- len)) x (1- (ash 1 (1- len))))
+                                ;; Convert to unsigned representation.
+                                (let ((u (logand (1- (ash 1 len)) x)))
+                                  (setter bv (+ i offset)
+                                          (logior rest (ash u start))))
+                                (fail))
+                            (if (<= 0 x (1- (ash 1 len)))
+                                (setter bv (+ i offset)
+                                        (logior rest (ash x start)))
+                                (fail)))))))
                (sub-set!
                 #'(sub-set! bv (+ i offset) x)))))
          elems id 'setter type)))
+
 (define-syntax define-bstruct-macro
   (lambda (stx)
     (syntax-case stx ()
@@ -1036,6 +1149,8 @@
       '(u8 s8 u16 s16 u32 s32 u64 s64 f32 f64
            int uint long ulong short ushort
            size_t ssize_t ptrdiff_t intptr_t uintptr_t))
+    (define bit-field-primitives
+      (remove (lambda (t) (memq t '(f32 f64))) primitives))
     (define (target-endianness? e)
       (eq? e (target-endianness)))
     (define (resolve-endianness e)
@@ -1068,23 +1183,49 @@
                      #,(alignof* type)
                      #,(target-endianness? endianness)
                      primitive)))
+        ((bits field ...)
+         (symbolic-match? bits)
+         (let lp ((field-stx #'(field ...)) (fields '()) (bits 0))
+           (syntax-case field-stx ()
+             (()
+              (let ()
+                (define (finish size)
+                  #`(bits #,size #,size
+                          #,(target-endianness? endianness)
+                          #,(reverse fields)))
+                (cond
+                 ((<= bits 8)  (finish 1))
+                 ((<= bits 16) (finish 2))
+                 ((<= bits 32) (finish 4))
+                 ((<= bits 64) (finish 8))
+                 (else
+                  (syntax-violation 'define-bstruct
+                                    "bit fields exceed maximum of 64 bits"
+                                    stx)))))
+             (((underscore len) . rest)
+              (and (identifier-eq? #'underscore '_)
+                   (exact-integer? (syntax->datum #'len))
+                   (positive? (syntax->datum #'len)))
+              (lp #'rest fields (+ bits (syntax->datum #'len))))
+             (((name len sign) . rest)
+              (and (identifier? #'name)
+                   (identifier-memq?  #'sign '(u s))
+                   (exact-integer? (syntax->datum #'len))
+                   (positive? (syntax->datum #'len)))
+              (let ((signed? (identifier-eq? #'sign 's)))
+                (lp #'rest
+                    (cons #`(name #,bits len #,signed?) fields)
+                    (+ bits (syntax->datum #'len))))))))
         ((struct field ...)
          (and (symbolic-match? struct)
               (not (null? #'(field ...))))
-         (let loop ((stx #'(field ...)) (fields '()) (offset 0) (align 0))
+         (let lp ((stx #'(field ...)) (fields '()) (offset 0) (align 0))
            (syntax-case stx ()
              (()
               ;; Round up to a multiple of align to get final
               ;; size.
               (let ((size (* (ceiling (/ offset align)) align)))
                 #`(struct #,size #,align #,(reverse fields))))
-             ;; An underscore indicates a padding pseudo-field.  It is
-             ;; not included in the struct field list and just adds to
-             ;; the offset.
-             (((underscore expr) . rest)
-              (identifier-eq? #'underscore '_)
-              (let ((type (compute-layout #'expr #f group-ids packed? endianness)))
-                (loop #'rest fields (+ offset (sizeof/syntax type)) align)))
              (((name expr) . rest)
               (identifier? #'name)
               (let* ((type (compute-layout #'expr
@@ -1098,10 +1239,14 @@
                                           field-align)))
                      (offset (+ offset padding))
                      (align (max align field-align)))
-                (loop #'rest
-                      (cons #`(name #,offset #,type) fields)
-                      (+ offset (sizeof/syntax type))
-                      align))))))
+                (lp #'rest
+                    (syntax-case #'name ()
+                      (underscore
+                       (identifier-eq? #'underscore '_)
+                       fields)
+                      (_ (cons #`(name #,offset #,type) fields)))
+                    (+ offset (sizeof/syntax type))
+                    align))))))
         ((union field ...)
          (and (symbolic-match? union)
               (not (null? #'(field ...))))
diff --git a/tests/test-bstruct.scm b/tests/test-bstruct.scm
index 1bd54fb..c0e3aaa 100644
--- a/tests/test-bstruct.scm
+++ b/tests/test-bstruct.scm
@@ -15,6 +15,7 @@
 
 (define-module (tests test-bstruct)
   #:use-module (bstruct)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-64)
   #:use-module (system foreign)
   #:use-module (tests utils))
@@ -26,6 +27,13 @@
 (define-bstruct <vertex>
   (struct (xy <vec2>) (uv <vec2>)))
 
+;; For testing bit fields.
+(define-bstruct <date>
+  (bits
+   (year 32 s)
+   (month 4 u)
+   (day 5 u)))
+
 ;; For testing arrays.
 (define-bstruct <matrix4>
   (array 16 f32))
@@ -95,7 +103,9 @@
                                  (y 0))))
       (bstruct->sexp (bstruct-alloc <event> (type 1))))
     (test-equal '(struct (item 42) (next (* 0)))
-      (bstruct->sexp (bstruct-alloc <node> (item 42)))))
+      (bstruct->sexp (bstruct-alloc <node> (item 42))))
+    (test-equal '(bits (year -2024) (month 9) (day 5))
+      (bstruct->sexp (bstruct-alloc <date> (year -2024) (month 9) (day 5)))))
 
   (test-group "bstruct->pointer"
     (test-equal #vu8(0 0 40 66 0 0 138 66)
@@ -127,12 +137,10 @@
         list)))
 
   (test-group "bstruct-alignof"
-    (test-equal (alignof (list float float))
-      (bstruct-alignof <vec2>))
+    (test-equal (alignof (list float float)) (bstruct-alignof <vec2>))
     (test-equal (alignof (list (list float float) (list float float)))
       (bstruct-alignof <vertex>))
-    (test-equal (alignof (make-list 16 float))
-      (bstruct-alignof <matrix4>))
+    (test-equal (alignof (make-list 16 float)) (bstruct-alignof <matrix4>))
     (test-equal (alignof (list uint8 int32 int32))
       (bstruct-alignof <mouse-move-event>))
     (test-equal (alignof (list uint8 uint8 uint8 int32 int32))
@@ -140,15 +148,14 @@
     (test-equal (max (alignof (list uint8))
                      (alignof (list uint8 int32 int32))
                      (alignof (list uint8 uint8 uint8 int32 int32)))
-      (bstruct-alignof <event>)))
+      (bstruct-alignof <event>))
+    (test-equal (alignof uint64) (bstruct-alignof <date>)))
 
   (test-group "bstruct-sizeof"
-    (test-equal (sizeof (list float float))
-      (bstruct-sizeof <vec2>))
+    (test-equal (sizeof (list float float)) (bstruct-sizeof <vec2>))
     (test-equal (sizeof (list (list float float) (list float float)))
       (bstruct-sizeof <vertex>))
-    (test-equal (sizeof (make-list 16 float))
-      (bstruct-sizeof <matrix4>))
+    (test-equal (sizeof (make-list 16 float)) (bstruct-sizeof <matrix4>))
     (test-equal (sizeof (list uint8 int32 int32))
       (bstruct-sizeof <mouse-move-event>))
     (test-equal (sizeof (list uint8 uint8 uint8 int32 int32))
@@ -158,7 +165,8 @@
                      (sizeof (list uint8 uint8 uint8 int32 int32)))
       (bstruct-sizeof <event>))
     (test-equal (sizeof (list uint64 uint32 uint64 uint32))
-      (bstruct-sizeof <right-sized>)))
+      (bstruct-sizeof <right-sized>))
+    (test-equal (sizeof uint64) (bstruct-sizeof <date>)))
 
   (test-group "bstruct-ref"
     (test-equal 69.0
@@ -172,7 +180,9 @@
                                     (items (bytevector->pointer bv)))
                      (items (* 3)))))
     (test-equal %null-pointer
-      (bstruct-ref <node> (bstruct-alloc <node>) next)))
+      (bstruct-ref <node> (bstruct-alloc <node>) next))
+    (test-equal -2024
+      (bstruct-ref <date> (bstruct-alloc <date> (year -2024)) year)))
 
   (test-group "bstruct-set!"
     (test-equal 42.0
@@ -197,7 +207,11 @@
       (let* ((a (bstruct-alloc <node> (item 42)))
              (b (bstruct-alloc <node> (item 69))))
         (bstruct-set! <node> a (next (bstruct->pointer <node> b)))
-        (bstruct-ref <node> a (next * item)))))
+        (bstruct-ref <node> a (next * item))))
+    (test-equal 12
+      (let ((date (bstruct-alloc <date> (month 11))))
+        (bstruct-set! <date> date (month 12))
+        (bstruct-ref <date> date month))))
 
   (test-group "bstruct-pack!"
     (test-equal (f32vector 42 69)
@@ -222,13 +236,17 @@
         (bstruct-pack! <matrix4> bv 0 (0 1) (5 1) (10 1) (15 1))
         bv))
     (test-equal (u8vector 1 2 0 0 3 0 0 0 4 0 0 0)
-      (let ((bv (make-u8vector (bstruct-sizeof <event>) 0)))
+      (let ((bv (make-bytevector (bstruct-sizeof <event>))))
         (bstruct-pack! <event> bv 0
                        ((mouse-button type) 1)
                        ((mouse-button button) 2)
                        ((mouse-button state) 0)
                        ((mouse-button x) 3)
                        ((mouse-button y) 4))
+        bv))
+    (test-equal (u8vector 232 7 0 0 123 1 0 0)
+      (let ((bv (make-bytevector (bstruct-sizeof <date>))))
+        (bstruct-pack! <date> bv 0 (year 2024) (month 11) (day 23))
         bv)))
 
   (test-group "bstruct-unpack"
@@ -260,6 +278,11 @@
                                             (mouse-button state)
                                             (mouse-button x)
                                             (mouse-button y)))
+          list)))
+    (test-equal '(2024 11 23)
+      (let ((bv (u8vector 232 7 0 0 123 1 0 0)))
+        (call-with-values (lambda ()
+                            (bstruct-unpack <date> bv 0 year month day))
           list))))
 
   (test-group "bstruct-copy"