mask) (let ((x* (logand x mask))) (unless (= x x*) (error "out of range" x)) x*)) (define-inline (check-srange x mask) (let ((x* (logand x mask))) (unless (if (negative? x) (= (+ x mask 1) x*) (= x x*)) (error "out of range" x)) x*)) (define-inline (pack-u8-u24 x y) (let ((x (check-urange x #xff)) (y (check-urange y #xffffff))) (logior x (ash y 8)))) (define-inline (pack-u8-s24 x y) (let ((x (check-urange x #xff)) (y (check-srange y #xffffff))) (logior x (ash y 8)))) (define-inline (pack-u1-u7-u24 x y z) (let ((x (check-urange x #x1)) (y (check-urange y #x7f)) (z (check-urange z #xffffff))) (logior x (ash y 1) (ash z 8)))) (define-inline (pack-u8-u12-u12 x y z) (let ((x (check-urange x #xff)) (y (check-urange y #xfff)) (z (check-urange z #xfff))) (logior x (ash y 8) (ash z 20)))) (define-inline (pack-u8-u8-u16 x y z) (let ((x (check-urange x #xff)) (y (check-urange y #xff)) (z (check-urange z #xffff))) (logior x (ash y 8) (ash z 16)))) (define-inline (pack-u8-u8-u8-u8 x y z w) (let ((x (check-urange x #xff)) (y (check-urange y #xff)) (z (check-urange z #xff)) (w (check-urange w #xff))) (logior x (ash y 8) (ash z 16) (ash w 24)))) (eval-when (expand) (define-syntax pack-flags (syntax-rules () ;; Add clauses as needed. ((pack-flags f1 f2) (logior (if f1 (ash 1 0) 0) (if f2 (ash 1 1) 0)))))) (define-syntax-rule (define-byte-order-swapper name size ref set) (define* (name buf #:optional (start 0) (end (bytevector-length buf))) "Patch up the text buffer @var{buf}, swapping the endianness of each N-byte unit." (unless (zero? (modulo (- end start) size)) (error "unexpected length")) (let lp ((pos start)) (when (< pos end) (set buf pos (ref buf pos (endianness big)) (endianness little)) (lp (+ pos size)))))) (define-byte-order-swapper byte-swap/2! 2 bytevector-u16-ref bytevector-u16-set!) (define-byte-order-swapper byte-swap/4! 4 bytevector-u32-ref bytevector-u32-set!) (define-byte-order-swapper byte-swap/8! 8 bytevector-u64-ref bytevector-u64-set!)