;;; bytevector.ss
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(let ()
  (define-syntax signed-value-pred
    (lambda (x)
      (syntax-case x ()
        [(_ ?bits)
         (let ([bits (syntax->datum #'?bits)])
           (unless (and (fixnum? bits)
                        (fx> bits 0)
                        (fx= (* (fxquotient bits 8) 8) bits))
             (syntax-error #'?bits "invalid bits"))
           (cond
             [(fx<= bits (constant fixnum-bits))
              (with-syntax ([limit- (- (expt 2 (- bits 1)))]
                            [limit+ (- (expt 2 (- bits 1)) 1)])
                #'(lambda (k) (and (fixnum? k) (fx<= limit- k limit+))))]
             [(fx= bits (constant fixnum-bits)) #'fixnum?]
             [else
              (with-syntax ([limit- (- (expt 2 (- bits 1)))]
                            [limit+ (- (expt 2 (- bits 1)) 1)])
                #'(lambda (k)
                    (or (fixnum? k)
                        (and (bignum? k) (<= limit- k limit+)))))]))])))

  (define-syntax unsigned-value-pred
    (lambda (x)
      (syntax-case x ()
        [(_ ?bits)
         (let ([bits (syntax->datum #'?bits)])
           (unless (and (fixnum? bits)
                        (fx> bits 0)
                        (fx= (* (fxquotient bits 8) 8) bits))
             (syntax-error #'?bits "invalid bits"))
           (cond
             [(fx< bits (constant fixnum-bits))
              (with-syntax ([limit+ (expt 2 bits)])
                #'(lambda (k) (and (fixnum? k) ($fxu< k limit+))))]
             [(fx= bits (constant fixnum-bits))
              #'(lambda (k) (and (fixnum? k) (fx>= k 0)))]
             [else
              (with-syntax ([limit+ (- (expt 2 bits) 1)])
                #'(lambda (k)
                    (if (fixnum? k)
                        (fx>= k 0)
                        (and (bignum? k) (<= 0 k limit+)))))]))])))

  (define (not-a-bytevector who v)
    ($oops who "~s is not a bytevector" v))

  (define (not-a-mutable-bytevector who v)
    ($oops who "~s is not a mutable bytevector" v))

  (define (invalid-index who v i)
    ($oops who "invalid index ~s for bytevector ~s" i v))

  (define (invalid-fill-value who fill)
    ($oops who "~s is not a valid fill value" fill))

  (define (invalid-value who x)
    ($oops who "invalid value ~s" x))

  (define (size-multiple-error who n size)
    ($oops who "bytevector length ~s is not a multiple of size ~s"
      n size))

  (define (unrecognized-endianness who eness)
    ($oops who "unrecognized endianness ~s" eness))

  (define (invalid-size who size)
    ($oops who "invalid size ~s" size))

  (define (invalid-size-or-index who size v i)
    (if (and (fixnum? i) ($fxu< i (bytevector-length v)))
        (if ($fxu< size (bytevector-length v))
            ($oops who "invalid index ~s for ~s-byte field of bytevector ~s" i size v)
            ($oops who "invalid size ~s for bytevector ~s" size v))
        (invalid-index who v i)))

  (define (fill? x) (and (fixnum? x) (fx<= -128 x 255)))

  (define-syntax unaligned-ref-check
    (syntax-rules ()
      [(_ who ?size v i)
       (let ([size ?size])
         (unless (and (fixnum? i)
                      (fx>= i 0)
                      (fx< i (fx- (bytevector-length v) (fx- size 1))))
           (invalid-size-or-index who size v i)))]))

  (module ($bytevector-sint-little-ref $bytevector-uint-little-ref)
    (define (load-little v i size a)
      (cond
        [(fx>= size 3)
         (load-little v (fx- i 3) (fx- size 3)
           (logor (ash a 24)
             (fxlogor
               (fxsll (bytevector-u8-ref v i) 16)
               (fxsll (bytevector-u8-ref v (fx- i 1)) 8)
               (bytevector-u8-ref v (fx- i 2)))))]
        [(fx= size 0) a]
        [(fx= size 1) (logor (ash a 8) (bytevector-u8-ref v i))]
        [else (logor (ash a 16)
                (fxlogor
                  (fxsll (bytevector-u8-ref v i) 8)
                  (bytevector-u8-ref v (fx- i 1))))]))

    (define ($bytevector-sint-little-ref v i size)
      (let ([i (fx+ i size -1)])
        (load-little v (fx- i 1) (fx- size 1) (bytevector-s8-ref v i))))

    (define ($bytevector-uint-little-ref v i size)
      (let ([i (fx+ i size -1)])
        (load-little v (fx- i 1) (fx- size 1) (bytevector-u8-ref v i)))))

  (module ($bytevector-sint-big-ref $bytevector-uint-big-ref)
    (define (load-big v i size a)
      (cond
        [(fx>= size 3)
         (load-big v (fx+ i 3) (fx- size 3)
           (logor (ash a 24)
             (fxlogor
               (fxsll (bytevector-u8-ref v i) 16)
               (fxsll (bytevector-u8-ref v (fx+ i 1)) 8)
               (bytevector-u8-ref v (fx+ i 2)))))]
        [(fx= size 0) a]
        [(fx= size 1) (logor (ash a 8) (bytevector-u8-ref v i))]
        [else (logor (ash a 16)
                (fxlogor
                  (fxsll (bytevector-u8-ref v i) 8)
                  (bytevector-u8-ref v (fx+ i 1))))]))

    (define ($bytevector-sint-big-ref v i size)
      (load-big v (fx+ i 1) (fx- size 1) (bytevector-s8-ref v i)))

    (define ($bytevector-uint-big-ref v i size)
      (load-big v (fx+ i 1) (fx- size 1) (bytevector-u8-ref v i))))

  (define ($bytevector-int-little-set! v i k size)
    (let store-little! ([i i] [k k] [size size])
      (cond
        [(fx>= size 4)
         (let ([k (logand k #xffffff)])
           (bytevector-u8-set! v i (fxlogand k #xff))
           (bytevector-u8-set! v (fx+ i 1) (fxlogand (fxsra k 8) #xff))
           (bytevector-u8-set! v (fx+ i 2) (fxsra k 16)))
         (store-little! (fx+ i 3) (ash k -24) (fx- size 3))]
        [(fx= size 1) ($bytevector-set! v i k)]
        [(fx= size 2)
         (bytevector-u8-set! v i (fxlogand k #xff))
         ($bytevector-set! v (fx+ i 1) (fxsra k 8))]
        [else
         (bytevector-u8-set! v i (fxlogand k #xff))
         (bytevector-u8-set! v (fx+ i 1) (fxlogand (fxsra k 8) #xff))
         ($bytevector-set! v (fx+ i 2) (fxsra k 16))])))

  (define ($bytevector-int-big-set! v i k size)
    (let store-big! ([i (fx+ i size -1)] [k k] [size size])
      (cond
        [(fx>= size 4)
         (let ([k (logand k #xffffff)])
           (bytevector-u8-set! v (fx- i 2) (fxsra k 16))
           (bytevector-u8-set! v (fx- i 1) (fxlogand (fxsra k 8) #xff))
           (bytevector-u8-set! v i (fxlogand k #xff)))
         (store-big! (fx- i 3) (ash k -24) (fx- size 3))]
        [(fx= size 1) ($bytevector-set! v i k)]
        [(fx= size 2)
         ($bytevector-set! v (fx- i 1) (fxsra k 8))
         (bytevector-u8-set! v i (fxlogand k #xff))]
        [else
         ($bytevector-set! v (fx- i 2) (fxsra k 16))
         (bytevector-u8-set! v (fx- i 1) (fxlogand (fxsra k 8) #xff))
         (bytevector-u8-set! v i (fxlogand k #xff))])))

  (module ($bytevector-s16-ref $bytevector-u16-ref
           $bytevector-s24-ref $bytevector-u24-ref
           $bytevector-s32-ref $bytevector-u32-ref
           $bytevector-s40-ref $bytevector-u40-ref
           $bytevector-s48-ref $bytevector-u48-ref
           $bytevector-s56-ref $bytevector-u56-ref
           $bytevector-s64-ref $bytevector-u64-ref)
    (meta-cond
      [(fx> (constant fixnum-bits) 56)
       (define logor56 fxlogor)
       (define sll56 fxsll)]
      [else
       (define logor56 logor)
       (define sll56 ash)])

    (define (little-ref-s16 v i)
      (fxlogor (fxsll (#3%bytevector-s8-ref v (fx+ i 1)) 8)
               (#3%bytevector-u8-ref v i)))
    (define (big-ref-s16 v i)
      (fxlogor (fxsll (#3%bytevector-s8-ref v i) 8)
               (#3%bytevector-u8-ref v (fx+ i 1))))
    (define (little-ref-u16 v i)
      (fxlogor (fxsll (#3%bytevector-u8-ref v (fx+ i 1)) 8)
               (#3%bytevector-u8-ref v i)))
    (define (big-ref-u16 v i)
      (fxlogor (fxsll (#3%bytevector-u8-ref v i) 8)
               (#3%bytevector-u8-ref v (fx+ i 1))))
    (define (little-ref-s24 v i)
      (fxlogor (fxsll (#3%bytevector-s8-ref v (fx+ i 2)) 16)
               (little-ref-u16 v i)))
    (define (big-ref-s24 v i)
      (fxlogor (fxsll (#3%bytevector-s8-ref v i) 16)
               (big-ref-u16 v (fx+ i 1))))
    (define (little-ref-u24 v i)
      (fxlogor (fxsll (#3%bytevector-u8-ref v (fx+ i 2)) 16)
               (little-ref-u16 v i)))
    (define (big-ref-u24 v i)
      (fxlogor (fxsll (#3%bytevector-u8-ref v i) 16)
               (big-ref-u16 v (fx+ i 1))))
    (define (little-ref-s32 v i)
      (logor56 (sll56 (little-ref-s16 v (fx+ i 2)) 16)
               (little-ref-u16 v i)))
    (define (big-ref-s32 v i)
      (logor56 (sll56 (big-ref-s16 v i) 16)
               (big-ref-u16 v (fx+ i 2))))
    (define (little-ref-u32 v i)
      (logor56 (sll56 (little-ref-u16 v (fx+ i 2)) 16)
               (little-ref-u16 v i)))
    (define (big-ref-u32 v i)
      (logor56 (sll56 (big-ref-u16 v i) 16)
               (big-ref-u16 v (fx+ i 2))))
    (define (little-ref-s40 v i)
      (logor56 (sll56(#3%bytevector-s8-ref v (fx+ i 4)) 32)
               (little-ref-u32 v i)))
    (define (big-ref-s40 v i)
      (logor56 (sll56(#3%bytevector-s8-ref v i) 32)
               (big-ref-u32 v (fx+ i 1))))
    (define (little-ref-u40 v i)
      (logor56 (sll56(#3%bytevector-u8-ref v (fx+ i 4)) 32)
               (little-ref-u32 v i)))
    (define (big-ref-u40 v i)
      (logor56 (sll56(#3%bytevector-u8-ref v i) 32)
               (big-ref-u32 v (fx+ i 1))))
    (define (little-ref-s48 v i)
      (logor56 (sll56(little-ref-s16 v (fx+ i 4)) 32)
               (little-ref-u32 v i)))
    (define (big-ref-s48 v i)
      (logor56 (sll56(big-ref-s16 v i) 32)
               (big-ref-u32 v (fx+ i 2))))
    (define (little-ref-u48 v i)
      (logor56 (sll56(little-ref-u16 v (fx+ i 4)) 32)
               (little-ref-u32 v i)))
    (define (big-ref-u48 v i)
      (logor56 (sll56(big-ref-u16 v i) 32)
               (big-ref-u32 v (fx+ i 2))))
    (define (little-ref-s56 v i)
      (logor56 (sll56(little-ref-s24 v (fx+ i 4)) 32)
               (little-ref-u32 v i)))
    (define (big-ref-s56 v i)
      (logor56 (sll56(big-ref-s24 v i) 32)
               (big-ref-u32 v (fx+ i 3))))
    (define (little-ref-u56 v i)
      (logor56 (sll56(little-ref-u24 v (fx+ i 4)) 32)
               (little-ref-u32 v i)))
    (define (big-ref-u56 v i)
      (logor56 (sll56(big-ref-u24 v i) 32)
               (big-ref-u32 v (fx+ i 3))))
    (define (little-ref-s64 v i)
      (logor (ash (little-ref-s32 v (fx+ i 4)) 32)
             (little-ref-u32 v i)))
    (define (big-ref-s64 v i)
      (logor (ash (big-ref-s32 v i) 32)
             (big-ref-u32 v (fx+ i 4))))
    (define (little-ref-u64 v i)
      (logor (ash (little-ref-u32 v (fx+ i 4)) 32)
             (little-ref-u32 v i)))
    (define (big-ref-u64 v i)
      (logor (ash (big-ref-u32 v i) 32)
             (big-ref-u32 v (fx+ i 4))))

    (define-syntax bytevector-*-ref
      (lambda (x)
        (define p2?
          (lambda (n)
            (let f ([i 1])
              (or (fx= i n)
                  (and (not (fx> i n)) (f (fxsll i 1)))))))
        (syntax-case x ()
          [(kwd s/u bits)
           (with-syntax ([prim-name (construct-name #'kwd "bytevector-" #'s/u #'bits "-ref")]
                         [native-name (construct-name #'kwd "bytevector-" #'s/u #'bits "-native-ref")]
                         [little-ref (construct-name #'kwd "little-ref-" #'s/u #'bits)]
                         [big-ref (construct-name #'kwd "big-ref-" #'s/u #'bits)])
             #`(lambda (v i eness who)
                 (unless (bytevector? v) (not-a-bytevector who v))
                 (unaligned-ref-check who (fxquotient bits 8) v i)
                 (case eness
                   [(big)
                    #,(cond
                        [(constant unaligned-integers) #`(#3%prim-name v i 'big)]
                        [(and (eq? (constant native-endianness) 'big) (p2? (datum bits)))
                         #`(if (fx= (fxlogand i (fx- (fxquotient bits 8) 1)) 0)
                               (#3%native-name v i)
                               (big-ref v i))]
                        [else #`(big-ref v i)])]
                   [(little)
                    #,(cond
                        [(constant unaligned-integers) #`(#3%prim-name v i 'little)]
                        [(and (eq? (constant native-endianness) 'little) (p2? (datum bits)))
                         #`(if (fx= (fxlogand i (fx- (fxquotient bits 8) 1)) 0)
                               (#3%native-name v i)
                               (little-ref v i))]
                        [else #`(little-ref v i)])]
                   [else (unrecognized-endianness who eness)])))])))

    (define $bytevector-s16-ref (bytevector-*-ref s 16))
    (define $bytevector-u16-ref (bytevector-*-ref u 16))
    (define $bytevector-s24-ref (bytevector-*-ref s 24))
    (define $bytevector-u24-ref (bytevector-*-ref u 24))
    (define $bytevector-s32-ref (bytevector-*-ref s 32))
    (define $bytevector-u32-ref (bytevector-*-ref u 32))
    (define $bytevector-s40-ref (bytevector-*-ref s 40))
    (define $bytevector-u40-ref (bytevector-*-ref u 40))
    (define $bytevector-s48-ref (bytevector-*-ref s 48))
    (define $bytevector-u48-ref (bytevector-*-ref u 48))
    (define $bytevector-s56-ref (bytevector-*-ref s 56))
    (define $bytevector-u56-ref (bytevector-*-ref u 56))
    (define $bytevector-s64-ref (bytevector-*-ref s 64))
    (define $bytevector-u64-ref (bytevector-*-ref u 64))
  )

  (module ($bytevector-s16-set! $bytevector-u16-set!
           $bytevector-s24-set! $bytevector-u24-set!
           $bytevector-s32-set! $bytevector-u32-set!
           $bytevector-s40-set! $bytevector-u40-set!
           $bytevector-s48-set! $bytevector-u48-set!
           $bytevector-s56-set! $bytevector-u56-set!
           $bytevector-s64-set! $bytevector-u64-set!)
    (meta-cond
      [(fx> (constant fixnum-bits) 56)
       (define logand56 fxlogand)
       (define sra56 fxsra)]
      [else
       (define logand56 logand)
       (define sra56 (lambda (x y) (ash x (fx- y))))])

    (define (little-set-s16! v i k)
      (#3%bytevector-u8-set! v i (fxlogand k #xff))
      (#3%bytevector-s8-set! v (fx+ i 1) (fxsra k 8)))
    (define (big-set-s16! v i k)
      (#3%bytevector-s8-set! v i (fxsra k 8))
      (#3%bytevector-u8-set! v (fx+ i 1) (fxlogand k #xff)))
    (define (little-set-u16! v i k)
      (#3%bytevector-u8-set! v i (fxlogand k #xff))
      (#3%bytevector-u8-set! v (fx+ i 1) (fxsra k 8)))
    (define (big-set-u16! v i k)
      (#3%bytevector-u8-set! v i (fxsra k 8))
      (#3%bytevector-u8-set! v (fx+ i 1) (fxlogand k #xff)))
    (define (little-set-s24! v i k)
      (little-set-u16! v i (fxlogand k #xffff))
      (#3%bytevector-s8-set! v (fx+ i 2) (fxsra k 16)))
    (define (big-set-s24! v i k)
      (#3%bytevector-s8-set! v i (fxsra k 16))
      (big-set-u16! v (fx+ i 1) (fxlogand k #xffff)))
    (define (little-set-u24! v i k)
      (little-set-u16! v i (fxlogand k #xffff))
      (#3%bytevector-u8-set! v (fx+ i 2) (fxsra k 16)))
    (define (big-set-u24! v i k)
      (#3%bytevector-u8-set! v i (fxsra k 16))
      (big-set-u16! v (fx+ i 1) (fxlogand k #xffff)))
    (define (little-set-s32! v i k)
      (little-set-u16! v i (logand56 k #xffff))
      (little-set-s16! v (fx+ i 2) (sra56 k 16)))
    (define (big-set-s32! v i k)
      (big-set-s16! v i (sra56 k 16))
      (big-set-u16! v (fx+ i 2) (logand56 k #xffff)))
    (define (little-set-u32! v i k)
      (little-set-u16! v i (logand56 k #xffff))
      (little-set-u16! v (fx+ i 2) (sra56 k 16)))
    (define (big-set-u32! v i k)
      (big-set-u16! v i (sra56 k 16))
      (big-set-u16! v (fx+ i 2) (logand56 k #xffff)))
    (define (little-set-s40! v i k)
      (little-set-u32! v i (logand56 k #xffffffff))
      (#3%bytevector-s8-set! v (fx+ i 4) (sra56 k 32)))
    (define (big-set-s40! v i k)
      (#3%bytevector-s8-set! v i (sra56 k 32))
      (big-set-u32! v (fx+ i 1) (logand56 k #xffffffff)))
    (define (little-set-u40! v i k)
      (little-set-u32! v i (logand56 k #xffffffff))
      (#3%bytevector-u8-set! v (fx+ i 4) (sra56 k 32)))
    (define (big-set-u40! v i k)
      (#3%bytevector-u8-set! v i (sra56 k 32))
      (big-set-u32! v (fx+ i 1) (logand56 k #xffffffff)))
    (define (little-set-s48! v i k)
      (little-set-u32! v i (logand56 k #xffffffff))
      (little-set-s16! v (fx+ i 4) (sra56 k 32)))
    (define (big-set-s48! v i k)
      (big-set-s16! v i (sra56 k 32))
      (big-set-u32! v (fx+ i 2) (logand56 k #xffffffff)))
    (define (little-set-u48! v i k)
      (little-set-u32! v i (logand56 k #xffffffff))
      (little-set-u16! v (fx+ i 4) (sra56 k 32)))
    (define (big-set-u48! v i k)
      (big-set-u16! v i (sra56 k 32))
      (big-set-u32! v (fx+ i 2) (logand56 k #xffffffff)))
    (define (little-set-s56! v i k)
      (little-set-u32! v i (logand56 k #xffffffff))
      (little-set-s24! v (fx+ i 4) (sra56 k 32)))
    (define (big-set-s56! v i k)
      (big-set-s24! v i (sra56 k 32))
      (big-set-u32! v (fx+ i 3) (logand56 k #xffffffff)))
    (define (little-set-u56! v i k)
      (little-set-u32! v i (logand56 k #xffffffff))
      (little-set-u24! v (fx+ i 4) (sra56 k 32)))
    (define (big-set-u56! v i k)
      (big-set-u24! v i (sra56 k 32))
      (big-set-u32! v (fx+ i 3) (logand56 k #xffffffff)))
    (define (little-set-s64! v i k)
      (little-set-u32! v i (logand k #xffffffff))
      (little-set-s32! v (fx+ i 4) (ash k -32)))
    (define (big-set-s64! v i k)
      (big-set-s32! v i (ash k -32))
      (big-set-u32! v (fx+ i 4) (logand k #xffffffff)))
    (define (little-set-u64! v i k)
      (little-set-u32! v i (logand k #xffffffff))
      (little-set-u32! v (fx+ i 4) (ash k -32)))
    (define (big-set-u64! v i k)
      (big-set-u32! v i (ash k -32))
      (big-set-u32! v (fx+ i 4) (logand k #xffffffff)))

    (define-syntax bytevector-*-set!
      (lambda (x)
        (define p2?
          (lambda (n)
            (let f ([i 1])
              (or (fx= i n)
                  (and (not (fx> i n)) (f (fxsll i 1)))))))
        (syntax-case x ()
          [(kwd s/u bits)
           (with-syntax ([prim-name (construct-name #'kwd "bytevector-" #'s/u #'bits "-set!")]
                         [native-name (construct-name #'kwd "bytevector-" #'s/u #'bits "-native-set!")]
                         [little-set! (construct-name #'kwd "little-set-" #'s/u #'bits "!")]
                         [big-set! (construct-name #'kwd "big-set-" #'s/u #'bits "!")]
                         [value-pred (if (free-identifier=? #'s/u #'s)
                                         #'signed-value-pred
                                         #'unsigned-value-pred)])
             #`(let ([value-okay? (value-pred bits)])
                 (lambda (v i k eness who)
                   (unless (mutable-bytevector? v) (not-a-mutable-bytevector who v))
                   (unaligned-ref-check who (fxquotient bits 8) v i)
                   (unless (value-okay? k) (invalid-value who k))
                   (case eness
                     [(big)
                      #,(cond
                          [(and (constant unaligned-integers) (>= (constant ptr-bits) (datum bits)))
                           #`(#3%prim-name v i k 'big)]
                          [(and (eq? (constant native-endianness) 'big) (fx>= (constant ptr-bits) (datum bits)) (p2? (datum bits)))
                           #`(if (fx= (fxlogand i (fx- (fxquotient bits 8) 1)) 0)
                                 (#3%native-name v i k)
                                 (big-set! v i k))]
                          [else #`(big-set! v i k)])]
                     [(little)
                      #,(cond
                          [(and (constant unaligned-integers) (>= (constant ptr-bits) (datum bits)))
                           #`(#3%prim-name v i k 'little)]
                          [(and (eq? (constant native-endianness) 'little) (fx>= (constant ptr-bits) (datum bits)) (p2? (datum bits)))
                           #`(if (fx= (fxlogand i (fx- (fxquotient bits 8) 1)) 0)
                                 (#3%native-name v i k)
                                 (little-set! v i k))]
                          [else #`(little-set! v i k)])]
                     [else (unrecognized-endianness who eness)]))))])))

    (define $bytevector-s16-set! (bytevector-*-set! s 16))
    (define $bytevector-u16-set! (bytevector-*-set! u 16))
    (define $bytevector-s24-set! (bytevector-*-set! s 24))
    (define $bytevector-u24-set! (bytevector-*-set! u 24))
    (define $bytevector-s32-set! (bytevector-*-set! s 32))
    (define $bytevector-u32-set! (bytevector-*-set! u 32))
    (define $bytevector-s40-set! (bytevector-*-set! s 40))
    (define $bytevector-u40-set! (bytevector-*-set! u 40))
    (define $bytevector-s48-set! (bytevector-*-set! s 48))
    (define $bytevector-u48-set! (bytevector-*-set! u 48))
    (define $bytevector-s56-set! (bytevector-*-set! s 56))
    (define $bytevector-u56-set! (bytevector-*-set! u 56))
    (define $bytevector-s64-set! (bytevector-*-set! s 64))
    (define $bytevector-u64-set! (bytevector-*-set! u 64))
  )

  (set! native-endianness
    (lambda ()
      (#2%native-endianness)))

  (set-who! make-bytevector
    (case-lambda
      [(n fill)
       (unless (and (fixnum? n) (not ($fxu< (constant maximum-bytevector-length) n)))
         ($oops who "~s is not a valid bytevector length" n))
       (unless (fill? fill) (invalid-fill-value who fill))
       (#3%make-bytevector n fill)]
      [(n)
       (unless (and (fixnum? n) (not ($fxu< (constant maximum-bytevector-length) n)))
         ($oops who "~s is not a valid bytevector length" n))
       (#3%make-bytevector n)]))

  (set! bytevector? (lambda (x) (#2%bytevector? x)))

  (set! bytevector-length
    (lambda (v)
      (#2%bytevector-length v)))

  (set-who! $bytevector-set-immutable!
    (lambda (v)
      (unless (bytevector? v)
        ($oops who "~s is not a bytevector" v))
      (#3%$bytevector-set-immutable! v)))

  (set-who! mutable-bytevector?
    (lambda (v)
      (#3%mutable-bytevector? v)))

  (set-who! immutable-bytevector?
    (lambda (v)
      (#3%immutable-bytevector? v)))

  (set! bytevector-s8-ref
    (lambda (v i)
      (#2%bytevector-s8-ref v i)))

  (set! bytevector-u8-ref
    (lambda (v i)
      (#2%bytevector-u8-ref v i)))

  (set! bytevector-s8-set!
    (lambda (v i byte)
      (#2%bytevector-s8-set! v i byte)))

  (set! bytevector-u8-set!
    (lambda (v i octet)
      (#2%bytevector-u8-set! v i octet)))

  (set-who! $bytevector-set!
    (lambda (v i fill)
      (if ($bytevector-set!-check? 8 v i)
          (begin
            (unless (fill? fill) (invalid-value who fill))
            (#3%$bytevector-set! v i fill))
          (if (mutable-bytevector? v)
              (invalid-index who v i)
              (not-a-mutable-bytevector who v)))))

  (set-who! bytevector-s16-native-ref
    (lambda (v i)
      (if ($bytevector-ref-check? 16 v i)
          (#3%bytevector-s16-native-ref v i)
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v)))))

  (set-who! bytevector-u16-native-ref
    (lambda (v i)
      (if ($bytevector-ref-check? 16 v i)
          (#3%bytevector-u16-native-ref v i)
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v)))))

  (set-who! bytevector-s16-native-set!
    (let ([value-okay? (signed-value-pred 16)])
      (lambda (v i k)
        (if ($bytevector-set!-check? 16 v i)
            (begin
              (unless (value-okay? k) (invalid-value who k))
              (#3%bytevector-s16-native-set! v i k))
            (if (mutable-bytevector? v)
                (invalid-index who v i)
                (not-a-mutable-bytevector who v))))))

  (set-who! bytevector-u16-native-set!
    (let ([value-okay? (unsigned-value-pred 16)])
      (lambda (v i k)
        (if ($bytevector-set!-check? 16 v i)
            (begin
              (unless (value-okay? k) (invalid-value who k))
              (#3%bytevector-u16-native-set! v i k))
            (if (mutable-bytevector? v)
                (invalid-index who v i)
                (not-a-mutable-bytevector who v))))))

  (set-who! bytevector-s32-native-ref
    (lambda (v i)
      (if ($bytevector-ref-check? 32 v i)
          (#3%bytevector-s32-native-ref v i)
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v)))))

  (set-who! bytevector-u32-native-ref
    (lambda (v i)
      (if ($bytevector-ref-check? 32 v i)
          (#3%bytevector-u32-native-ref v i)
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v)))))

  (set-who! bytevector-s32-native-set!
    (let ([value-okay? (signed-value-pred 32)])
      (lambda (v i k)
        (if ($bytevector-set!-check? 32 v i)
            (begin
              (unless (value-okay? k) (invalid-value who k))
              (#3%bytevector-s32-native-set! v i k))
            (if (mutable-bytevector? v)
                (invalid-index who v i)
                (not-a-mutable-bytevector who v))))))

  (set-who! bytevector-u32-native-set!
    (let ([value-okay? (unsigned-value-pred 32)])
      (lambda (v i k)
        (if ($bytevector-set!-check? 32 v i)
            (begin
              (unless (value-okay? k) (invalid-value who k))
              (#3%bytevector-u32-native-set! v i k))
            (if (mutable-bytevector? v)
                (invalid-index who v i)
                (not-a-mutable-bytevector who v))))))

  (set-who! bytevector-s64-native-ref
    (lambda (v i)
      (if ($bytevector-ref-check? 64 v i)
          (constant-case ptr-bits
            [(64) (#3%bytevector-s64-native-ref v i)]
            [(32)
             (constant-case native-endianness
               [(big)
                (logor (ash (#3%bytevector-s32-native-ref v i) 32)
                       (#3%bytevector-u32-native-ref v (fx+ i 4)))]
               [(little)
                (logor (ash (#3%bytevector-s32-native-ref v (fx+ i 4)) 32)
                       (#3%bytevector-u32-native-ref v i))])])
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v)))))

  (set-who! bytevector-u64-native-ref
    (lambda (v i)
      (if ($bytevector-ref-check? 64 v i)
          (constant-case ptr-bits
            [(64) (#3%bytevector-u64-native-ref v i)]
            [(32)
             (constant-case native-endianness
               [(big)
                (logor (ash (#3%bytevector-u32-native-ref v i) 32)
                       (#3%bytevector-u32-native-ref v (fx+ i 4)))]
               [(little)
                (logor (ash (#3%bytevector-u32-native-ref v (fx+ i 4)) 32)
                       (#3%bytevector-u32-native-ref v i))])])
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v)))))

  (set-who! bytevector-s64-native-set!
    (let ([value-okay? (signed-value-pred 64)])
      (lambda (v i k)
        (if ($bytevector-set!-check? 64 v i)
            (begin
              (unless (value-okay? k) (invalid-value who k))
              (constant-case ptr-bits
                [(64) (#3%bytevector-s64-native-set! v i k)]
                [(32)
                 (constant-case native-endianness
                   [(big)
                    (#3%bytevector-s32-native-set! v i (ash k -32))
                    (#3%bytevector-u32-native-set! v (fx+ i 4) (logand k (- (expt 2 32) 1)))]
                   [(little)
                    (#3%bytevector-s32-native-set! v (fx+ i 4) (ash k -32))
                    (#3%bytevector-u32-native-set! v i (logand k (- (expt 2 32) 1)))])]))
            (if (mutable-bytevector? v)
                (invalid-index who v i)
                (not-a-mutable-bytevector who v))))))

  (set-who! bytevector-u64-native-set!
    (let ([value-okay? (unsigned-value-pred 64)])
      (lambda (v i k)
        (if ($bytevector-set!-check? 64 v i)
            (begin
              (unless (value-okay? k) (invalid-value who k))
              (constant-case ptr-bits
                [(64) (#3%bytevector-u64-native-set! v i k)]
                [(32)
                 (constant-case native-endianness
                   [(big)
                    (#3%bytevector-u32-native-set! v i (ash k -32))
                    (#3%bytevector-u32-native-set! v (fx+ i 4) (logand k (- (expt 2 32) 1)))]
                   [(little)
                    (#3%bytevector-u32-native-set! v (fx+ i 4) (ash k -32))
                    (#3%bytevector-u32-native-set! v i (logand k (- (expt 2 32) 1)))])]))
            (if (mutable-bytevector? v)
                (invalid-index who v i)
                (not-a-mutable-bytevector who v))))))

  (set-who! bytevector-ieee-single-native-ref
    (lambda (v i)
      (if ($bytevector-ref-check? 32 v i)
          (#3%bytevector-ieee-single-native-ref v i)
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v)))))

  (set-who! bytevector-ieee-double-native-ref
    (lambda (v i)
      (if ($bytevector-ref-check? 64 v i)
          (#3%bytevector-ieee-double-native-ref v i)
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v)))))

  (set-who! bytevector-ieee-single-native-set!
    (lambda (v i x)
      (if ($bytevector-set!-check? 32 v i)
         ; inline routine checks to make sure x is a real number
          (#3%bytevector-ieee-single-native-set! v i x)
          (if (mutable-bytevector? v)
              (invalid-index who v i)
              (not-a-mutable-bytevector who v)))))

  (set-who! bytevector-ieee-double-native-set!
    (lambda (v i x)
      (if ($bytevector-set!-check? 64 v i)
         ; inline routine checks to make sure x is a real number
          (#3%bytevector-ieee-double-native-set! v i x)
          (if (mutable-bytevector? v)
              (invalid-index who v i)
              (not-a-mutable-bytevector who v)))))

  (set-who! bytevector-copy
    (lambda (v)
      (unless (bytevector? v) (not-a-bytevector who v))
      (let* ([n (bytevector-length v)] [v2 (make-bytevector n)])
        ($ptr-copy! v (constant bytevector-data-disp) v2
          (constant bytevector-data-disp)
          (fxsrl
            (fx+ n (fx- (constant ptr-bytes) 1))
            (constant log2-ptr-bytes)))
        v2)))

  (set-who! bytevector-copy!
    (lambda (v1 i1 v2 i2 k)
      (unless (bytevector? v1) (not-a-bytevector who v1))
      (unless (mutable-bytevector? v2) (not-a-mutable-bytevector who v2))
      (let ([n1 (bytevector-length v1)] [n2 (bytevector-length v2)])
        (unless (and (fixnum? i1) (fx>= i1 0))
          ($oops who "invalid start value ~s" i1))
        (unless (and (fixnum? i2) (fx>= i2 0))
          ($oops who "invalid start value ~s" i2))
        (unless (and (fixnum? k) (fx>= k 0))
          ($oops who "invalid count ~s" k))
        (unless (fx<= k (fx- n1 i1)) ; avoid overflow
          ($oops who "index ~s + count ~s is beyond the end of ~s" i1 k v1))
        (unless (fx<= k (fx- n2 i2)) ; avoid overflow
          ($oops who "index ~s + count ~s is beyond the end of ~s" i2 k v2))
       ; whew!
        (#3%bytevector-copy! v1 i1 v2 i2 k))))

  (set-who! bytevector->immutable-bytevector
    (lambda (v)
      (cond
        [(immutable-bytevector? v) v]
        [(eqv? v '#vu8()) ($tc-field 'null-immutable-bytevector ($tc))]
        [else
         (unless (bytevector? v) ($oops who "~s is not a bytevector" v))
         (let ([v2 (bytevector-copy v)])
           ($bytevector-set-immutable! v2)
           v2)])))

  (set-who! bytevector-fill!
    (lambda (v fill)
      (unless (mutable-bytevector? v) (not-a-mutable-bytevector who v))
      (unless (fill? fill) (invalid-fill-value who fill))
      (#3%bytevector-fill! v fill)))

  (set-who! bytevector=?
    (lambda (v1 v2)
      (unless (bytevector? v1) (not-a-bytevector who v1))
      (unless (bytevector? v2) (not-a-bytevector who v2))
      (#3%bytevector=? v1 v2)))

  (set-who! $bytevector-ref-check?
    (lambda (bits v i)
     ; inlined handles only constant bits argument
      (case bits
        [(8) (#2%$bytevector-ref-check? 8 v i)]
        [(16) (#2%$bytevector-ref-check? 16 v i)]
        [(32) (#2%$bytevector-ref-check? 32 v i)]
        [(64) (#2%$bytevector-ref-check? 64 v i)]
        [else ($oops who "invalid bits argument ~s" bits)])))

  (set-who! $bytevector-set!-check?
    (lambda (bits v i)
     ; inlined handles only constant bits argument
      (case bits
        [(8) (#2%$bytevector-set!-check? 8 v i)]
        [(16) (#2%$bytevector-set!-check? 16 v i)]
        [(32) (#2%$bytevector-set!-check? 32 v i)]
        [(64) (#2%$bytevector-set!-check? 64 v i)]
        [else ($oops who "invalid bits argument ~s" bits)])))

  (set-who! bytevector-s16-ref
    (lambda (v i eness)
      ($bytevector-s16-ref v i eness who)))

  (set-who! bytevector-u16-ref
    (lambda (v i eness)
      ($bytevector-u16-ref v i eness who)))

  (set-who! bytevector-s24-ref
    (lambda (v i eness)
      ($bytevector-s24-ref v i eness who)))

  (set-who! bytevector-u24-ref
    (lambda (v i eness)
      ($bytevector-u24-ref v i eness who)))

  (set-who! bytevector-s32-ref
    (lambda (v i eness)
      ($bytevector-s32-ref v i eness who)))

  (set-who! bytevector-u32-ref
    (lambda (v i eness)
      ($bytevector-u32-ref v i eness who)))

  (set-who! bytevector-s40-ref
    (lambda (v i eness)
      ($bytevector-s40-ref v i eness who)))

  (set-who! bytevector-u40-ref
    (lambda (v i eness)
      ($bytevector-u40-ref v i eness who)))

  (set-who! bytevector-s48-ref
    (lambda (v i eness)
      ($bytevector-s48-ref v i eness who)))

  (set-who! bytevector-u48-ref
    (lambda (v i eness)
      ($bytevector-u48-ref v i eness who)))

  (set-who! bytevector-s56-ref
    (lambda (v i eness)
      ($bytevector-s56-ref v i eness who)))

  (set-who! bytevector-u56-ref
    (lambda (v i eness)
      ($bytevector-u56-ref v i eness who)))

  (set-who! bytevector-s64-ref
    (lambda (v i eness)
      ($bytevector-s64-ref v i eness who)))

  (set-who! bytevector-u64-ref
    (lambda (v i eness)
      ($bytevector-u64-ref v i eness who)))

  (set-who! bytevector-s16-set!
    (lambda (v i k eness)
      ($bytevector-s16-set! v i k eness who)))

  (set-who! bytevector-u16-set!
    (lambda (v i k eness)
      ($bytevector-u16-set! v i k eness who)))

  (set-who! bytevector-s24-set!
    (lambda (v i k eness)
      ($bytevector-s24-set! v i k eness who)))

  (set-who! bytevector-u24-set!
    (lambda (v i k eness)
      ($bytevector-u24-set! v i k eness who)))

  (set-who! bytevector-s32-set!
    (lambda (v i k eness)
      ($bytevector-s32-set! v i k eness who)))

  (set-who! bytevector-u32-set!
    (lambda (v i k eness)
      ($bytevector-u32-set! v i k eness who)))

  (set-who! bytevector-s40-set!
    (lambda (v i k eness)
      ($bytevector-s40-set! v i k eness who)))

  (set-who! bytevector-u40-set!
    (lambda (v i k eness)
      ($bytevector-u40-set! v i k eness who)))

  (set-who! bytevector-s48-set!
    (lambda (v i k eness)
      ($bytevector-s48-set! v i k eness who)))

  (set-who! bytevector-u48-set!
    (lambda (v i k eness)
      ($bytevector-u48-set! v i k eness who)))

  (set-who! bytevector-s56-set!
    (lambda (v i k eness)
      ($bytevector-s56-set! v i k eness who)))

  (set-who! bytevector-u56-set!
    (lambda (v i k eness)
      ($bytevector-u56-set! v i k eness who)))

  (set-who! bytevector-s64-set!
    (lambda (v i k eness)
      ($bytevector-s64-set! v i k eness who)))

  (set-who! bytevector-u64-set!
    (lambda (v i k eness)
      ($bytevector-u64-set! v i k eness who)))

  (set-who! bytevector-ieee-single-ref
    (lambda (v i eness)
      (define (swap-ref v i)
        (bytevector-ieee-single-native-ref
          (bytevector
            (bytevector-u8-ref v (fx+ i 3))
            (bytevector-u8-ref v (fx+ i 2))
            (bytevector-u8-ref v (fx+ i 1))
            (bytevector-u8-ref v i))
          0))
      (define (noswap-ref v i)
        (bytevector-ieee-single-native-ref
          (bytevector
            (bytevector-u8-ref v i)
            (bytevector-u8-ref v (fx+ i 1))
            (bytevector-u8-ref v (fx+ i 2))
            (bytevector-u8-ref v (fx+ i 3)))
          0))
      (unless (bytevector? v) (not-a-bytevector who v))
      (unaligned-ref-check who 4 v i)
      (if (or (constant unaligned-floats) (fx= (fxlogand i 3) 0))
          (if (eq? eness (native-endianness))
              (#3%bytevector-ieee-single-native-ref v i)
              (if (constant-case native-endianness
                    [(little) (eq? eness 'big)]
                    [(big) (eq? eness 'little)])
                  (swap-ref v i)
                  (unrecognized-endianness who eness)))
          (if (eq? eness (native-endianness))
              (noswap-ref v i)
              (if (constant-case native-endianness
                    [(little) (eq? eness 'big)]
                    [(big) (eq? eness 'little)])
                  (swap-ref v i)
                  (unrecognized-endianness who eness))))))

  (set-who! bytevector-ieee-double-ref
    (lambda (v i eness)
      (define (swap-ref v i)
        (bytevector-ieee-double-native-ref
          (bytevector
            (bytevector-u8-ref v (fx+ i 7))
            (bytevector-u8-ref v (fx+ i 6))
            (bytevector-u8-ref v (fx+ i 5))
            (bytevector-u8-ref v (fx+ i 4))
            (bytevector-u8-ref v (fx+ i 3))
            (bytevector-u8-ref v (fx+ i 2))
            (bytevector-u8-ref v (fx+ i 1))
            (bytevector-u8-ref v i))
          0))
      (define (noswap-ref v i)
        (bytevector-ieee-double-native-ref
          (bytevector
            (bytevector-u8-ref v i)
            (bytevector-u8-ref v (fx+ i 1))
            (bytevector-u8-ref v (fx+ i 2))
            (bytevector-u8-ref v (fx+ i 3))
            (bytevector-u8-ref v (fx+ i 4))
            (bytevector-u8-ref v (fx+ i 5))
            (bytevector-u8-ref v (fx+ i 6))
            (bytevector-u8-ref v (fx+ i 7)))
          0))
      (unless (bytevector? v) (not-a-bytevector who v))
      (unaligned-ref-check who 8 v i)
      (if (or (constant unaligned-floats) (fx= (fxlogand i 7) 0))
          (if (eq? eness (native-endianness))
              (#3%bytevector-ieee-double-native-ref v i)
              (if (constant-case native-endianness
                    [(little) (eq? eness 'big)]
                    [(big) (eq? eness 'little)])
                  (swap-ref v i)
                  (unrecognized-endianness who eness)))
          (if (eq? eness (native-endianness))
              (noswap-ref v i)
              (if (constant-case native-endianness
                    [(little) (eq? eness 'big)]
                    [(big) (eq? eness 'little)])
                  (swap-ref v i)
                  (unrecognized-endianness who eness))))))

  (set-who! bytevector-ieee-single-set!
    (lambda (v i x eness)
      (define (swap-set! v i x)
        (let ([v2 (make-bytevector 4)])
          (bytevector-ieee-single-native-set! v2 0 x)
          (bytevector-u8-set! v i (bytevector-u8-ref v2 3))
          (bytevector-u8-set! v (fx+ i 1) (bytevector-u8-ref v2 2))
          (bytevector-u8-set! v (fx+ i 2) (bytevector-u8-ref v2 1))
          (bytevector-u8-set! v (fx+ i 3) (bytevector-u8-ref v2 0))))
      (define (noswap-set! v i x)
        (let ([v2 (make-bytevector 4)])
          (bytevector-ieee-single-native-set! v2 0 x)
          (bytevector-u8-set! v i (bytevector-u8-ref v2 0))
          (bytevector-u8-set! v (fx+ i 1) (bytevector-u8-ref v2 1))
          (bytevector-u8-set! v (fx+ i 2) (bytevector-u8-ref v2 2))
          (bytevector-u8-set! v (fx+ i 3) (bytevector-u8-ref v2 3))))
      (unless (mutable-bytevector? v) (not-a-mutable-bytevector who v))
      (unaligned-ref-check who 4 v i)
      (let ([x ($real->flonum x who)])
        (if (or (constant unaligned-floats) (fx= (fxlogand i 3) 0))
            (if (eq? eness (native-endianness))
                (#3%bytevector-ieee-single-native-set! v i x)
                (if (constant-case native-endianness
                      [(little) (eq? eness 'big)]
                      [(big) (eq? eness 'little)])
                    (swap-set! v i x)
                    (unrecognized-endianness who eness)))
            (if (eq? eness (native-endianness))
                (noswap-set! v i x)
                (if (constant-case native-endianness
                      [(little) (eq? eness 'big)]
                      [(big) (eq? eness 'little)])
                    (swap-set! v i x)
                    (unrecognized-endianness who eness)))))))

  (set-who! bytevector-ieee-double-set!
    (lambda (v i x eness)
      (define (swap-set! v i x)
        (let ([v2 (make-bytevector 8)])
          (bytevector-ieee-double-native-set! v2 0 x)
          (bytevector-u8-set! v i (bytevector-u8-ref v2 7))
          (bytevector-u8-set! v (fx+ i 1) (bytevector-u8-ref v2 6))
          (bytevector-u8-set! v (fx+ i 2) (bytevector-u8-ref v2 5))
          (bytevector-u8-set! v (fx+ i 3) (bytevector-u8-ref v2 4))
          (bytevector-u8-set! v (fx+ i 4) (bytevector-u8-ref v2 3))
          (bytevector-u8-set! v (fx+ i 5) (bytevector-u8-ref v2 2))
          (bytevector-u8-set! v (fx+ i 6) (bytevector-u8-ref v2 1))
          (bytevector-u8-set! v (fx+ i 7) (bytevector-u8-ref v2 0))))
      (define (noswap-set! v i x)
        (let ([v2 (make-bytevector 8)])
          (bytevector-ieee-double-native-set! v2 0 x)
          (bytevector-u8-set! v i (bytevector-u8-ref v2 0))
          (bytevector-u8-set! v (fx+ i 1) (bytevector-u8-ref v2 1))
          (bytevector-u8-set! v (fx+ i 2) (bytevector-u8-ref v2 2))
          (bytevector-u8-set! v (fx+ i 3) (bytevector-u8-ref v2 3))
          (bytevector-u8-set! v (fx+ i 4) (bytevector-u8-ref v2 4))
          (bytevector-u8-set! v (fx+ i 5) (bytevector-u8-ref v2 5))
          (bytevector-u8-set! v (fx+ i 6) (bytevector-u8-ref v2 6))
          (bytevector-u8-set! v (fx+ i 7) (bytevector-u8-ref v2 7))))
      (unless (mutable-bytevector? v) (not-a-mutable-bytevector who v))
      (unaligned-ref-check who 8 v i)
      (let ([x ($real->flonum x who)])
        (if (or (constant unaligned-floats) (fx= (fxlogand i 7) 0))
            (if (eq? eness (native-endianness))
                (#3%bytevector-ieee-double-native-set! v i x)
                (if (constant-case native-endianness
                      [(little) (eq? eness 'big)]
                      [(big) (eq? eness 'little)])
                    (swap-set! v i x)
                    (unrecognized-endianness who eness)))
            (if (eq? eness (native-endianness))
                (noswap-set! v i x)
                (if (constant-case native-endianness
                      [(little) (eq? eness 'big)]
                      [(big) (eq? eness 'little)])
                    (swap-set! v i x)
                    (unrecognized-endianness who eness)))))))

  (let ()
    (define ($bytevector-s8-ref v i eness who)
      (if ($bytevector-ref-check? 8 v i)
          (begin
            (unless (memq eness '(little big)) (unrecognized-endianness who eness))
            (#3%bytevector-s8-ref v i))
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v))))

    (define ($bytevector-u8-ref v i eness who)
      (if ($bytevector-ref-check? 8 v i)
          (begin
            (unless (memq eness '(little big)) (unrecognized-endianness who eness))
            (#3%bytevector-u8-ref v i))
          (if (bytevector? v)
              (invalid-index who v i)
              (not-a-bytevector who v))))

    (set-who! bytevector-sint-ref
      (lambda (v i eness size)
        (case size
          [(1) ($bytevector-s8-ref v i eness who)]
          [(2) ($bytevector-s16-ref v i eness who)]
          [(4) ($bytevector-s32-ref v i eness who)]
          [(8) ($bytevector-s64-ref v i eness who)]
          [else
           (unless (bytevector? v) (not-a-bytevector who v))
           (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
           (unaligned-ref-check who size v i)
           (case eness
             [(big) ($bytevector-sint-big-ref v i size)]
             [(little) ($bytevector-sint-little-ref v i size)]
             [else (unrecognized-endianness who eness)])])))

    (set-who! bytevector-uint-ref
      (lambda (v i eness size)
        (case size
          [(1) ($bytevector-u8-ref v i eness who)]
          [(2) ($bytevector-u16-ref v i eness who)]
          [(4) ($bytevector-u32-ref v i eness who)]
          [(8) ($bytevector-u64-ref v i eness who)]
          [else
           (unless (bytevector? v) (not-a-bytevector who v))
           (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
           (unaligned-ref-check who size v i)
           (case eness
             [(big) ($bytevector-uint-big-ref v i size)]
             [(little) ($bytevector-uint-little-ref v i size)]
             [else (unrecognized-endianness who eness)])]))))

  (let ()
    (define $bytevector-s8-set!
      (let ([value-okay? (signed-value-pred 8)])
        (lambda (v i k eness who)
          (if ($bytevector-set!-check? 8 v i)
              (begin
                (unless (value-okay? k) (invalid-value who k))
                (unless (memq eness '(little big)) (unrecognized-endianness who eness))
                (#3%bytevector-s8-set! v i k))
              (if (mutable-bytevector? v)
                  (invalid-index who v i)
                  (not-a-mutable-bytevector who v))))))

    (define $bytevector-u8-set!
      (let ([value-okay? (unsigned-value-pred 8)])
        (lambda (v i k eness who)
          (if ($bytevector-set!-check? 8 v i)
              (begin
                (unless (value-okay? k) (invalid-value who k))
                (unless (memq eness '(little big)) (unrecognized-endianness who eness))
                (#3%bytevector-u8-set! v i k))
              (if (mutable-bytevector? v)
                  (invalid-index who v i)
                  (not-a-mutable-bytevector who v))))))

    (set-who! bytevector-sint-set!
      (lambda (v i k eness size)
        (case size
          [(1) ($bytevector-s8-set! v i k eness who)]
          [(2) ($bytevector-s16-set! v i k eness who)]
          [(4) ($bytevector-s32-set! v i k eness who)]
          [(8) ($bytevector-s64-set! v i k eness who)]
          [else
           (unless (mutable-bytevector? v) (not-a-mutable-bytevector who v))
           (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
           (unaligned-ref-check who size v i)
           (unless (and (or (fixnum? k) (bignum? k))
                        (let ([k (ash k (fx- 1 (fx* size 8)))])
                          (or (fx= k 0) (fx= k -1))))
             (invalid-value who k))
           (case eness
             [(big) ($bytevector-int-big-set! v i k size)]
             [(little) ($bytevector-int-little-set! v i k size)]
             [else (unrecognized-endianness who eness)])])))

    (set-who! bytevector-uint-set!
      (lambda (v i k eness size)
        (case size
          [(1) ($bytevector-u8-set! v i k eness who)]
          [(2) ($bytevector-u16-set! v i k eness who)]
          [(4) ($bytevector-u32-set! v i k eness who)]
          [(8) ($bytevector-u64-set! v i k eness who)]
          [else
           (unless (mutable-bytevector? v) (not-a-mutable-bytevector who v))
           (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
           (unaligned-ref-check who size v i)
           (unless (and (or (fixnum? k) (bignum? k))
                        (fx= (ash k (fx- (fx* size 8))) 0))
             (invalid-value who k))
           (case eness
             [(big) ($bytevector-int-big-set! v i k size)]
             [(little) ($bytevector-int-little-set! v i k size)]
             [else (unrecognized-endianness who eness)])]))))

  (let ()
    (define-syntax bv->list
      (syntax-rules ()
        [(_ bytes ref)
         (lambda (v who)
           (unless (bytevector? v) (not-a-bytevector who v))
           (let ([n (bytevector-length v)])
             (unless (fx= (fxlogand n (fx- bytes 1)) 0)
               (size-multiple-error who n bytes))
             (let loop ([i (fx- n bytes)] [ls '()])
               (if (fx> i 0)
                   (loop
                     (fx- i (fx* bytes 2))
                     (list* (ref v (fx- i bytes)) (ref v i) ls))
                   (if (fx= i 0) (cons (ref v 0) ls) ls)))))]))

    (define $bytevector->s8-list (bv->list 1 bytevector-s8-ref))
    (define $bytevector->u8-list (bv->list 1 bytevector-u8-ref))
    (define $bytevector->s16-native-list (bv->list 2 bytevector-s16-native-ref))
    (define $bytevector->u16-native-list (bv->list 2 bytevector-u16-native-ref))
    (define $bytevector->s32-native-list (bv->list 4 bytevector-s32-native-ref))
    (define $bytevector->u32-native-list (bv->list 4 bytevector-u32-native-ref))
    (define $bytevector->s64-native-list (bv->list 8 bytevector-s64-native-ref))
    (define $bytevector->u64-native-list (bv->list 8 bytevector-u64-native-ref))

    (set-who! bytevector->s8-list
      (lambda (v)
        ($bytevector->s8-list v who)))

    (set-who! bytevector->u8-list
      (lambda (v)
        ($bytevector->u8-list v who)))

    (set-who! bytevector->sint-list
      (lambda (v eness size)
        (define (big->list v size)
          (unless (bytevector? v) (not-a-bytevector who v))
          (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
          (let ([n (bytevector-length v)])
            (unless (fx= (fxremainder n size) 0) (size-multiple-error who n size))
            (let f ([i 0])
              (if (fx= i n)
                  '()
                  (cons ($bytevector-sint-big-ref v i size)
                        (f (fx+ i size)))))))
        (define (little->list v size)
          (unless (bytevector? v) (not-a-bytevector who v))
          (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
          (let ([n (bytevector-length v)])
            (unless (fx= (fxremainder n size) 0) (size-multiple-error who n size))
            (let f ([i 0])
              (if (fx= i n)
                  '()
                  (cons ($bytevector-sint-little-ref v i size)
                        (f (fx+ i size)))))))
        (if (eq? eness (native-endianness))
            (case size
              [(1) ($bytevector->s8-list v who)]
              [(2) ($bytevector->s16-native-list v who)]
              [(4) ($bytevector->s32-native-list v who)]
              [(8) ($bytevector->s64-native-list v who)]
              [else
               (constant-case native-endianness
                 [(little) (little->list v size)]
                 [(big) (big->list v size)])])
            (constant-case native-endianness
              [(little)
               (if (eq? eness 'big)
                   (big->list v size)
                   (unrecognized-endianness who eness))]
              [(big)
               (if (eq? eness 'little)
                   (little->list v size)
                   (unrecognized-endianness who eness))]))))

    (set-who! bytevector->uint-list
      (lambda (v eness size)
        (define (big->list v size)
          (unless (bytevector? v) (not-a-bytevector who v))
          (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
          (let ([n (bytevector-length v)])
            (unless (fx= (fxremainder n size) 0) (size-multiple-error who n size))
            (let f ([i 0])
              (if (fx= i n)
                  '()
                  (cons ($bytevector-uint-big-ref v i size)
                        (f (fx+ i size)))))))
        (define (little->list v size)
          (unless (bytevector? v) (not-a-bytevector who v))
          (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
          (let ([n (bytevector-length v)])
            (unless (fx= (fxremainder n size) 0) (size-multiple-error who n size))
            (let f ([i 0])
              (if (fx= i n)
                  '()
                  (cons ($bytevector-uint-little-ref v i size)
                        (f (fx+ i size)))))))
        (if (eq? eness (native-endianness))
            (case size
              [(1) ($bytevector->u8-list v who)]
              [(2) ($bytevector->u16-native-list v who)]
              [(4) ($bytevector->u32-native-list v who)]
              [(8) ($bytevector->u64-native-list v who)]
              [else
               (constant-case native-endianness
                 [(little) (little->list v size)]
                 [(big) (big->list v size)])])
            (constant-case native-endianness
              [(little)
               (if (eq? eness 'big)
                   (big->list v size)
                   (unrecognized-endianness who eness))]
              [(big)
               (if (eq? eness 'little)
                   (little->list v size)
                   (unrecognized-endianness who eness))]))))
  )

  (let ()
    (define-syntax list->bv
      (syntax-rules ()
        [(_ bytes set! vokay?)
         (let ([value-okay? vokay?])
           (lambda (ls who)
             (let* ([n ($list-length ls who)]
                    [v (make-bytevector (fx* n bytes))])
               (let loop ([ls ls] [i 0])
                 (unless (null? ls)
                   (let ([k (car ls)])
                     (unless (value-okay? k) (invalid-value who k))
                     (set! v i k))
                   (let ([ls (cdr ls)])
                     (unless (null? ls)
                       (let ([k (car ls)])
                         (unless (value-okay? k) (invalid-value who k))
                         (set! v (fx+ i bytes) k))
                       (loop (cdr ls) (fx+ i (fx* bytes 2)))))))
               v)))]))

    (define $s8-list->bytevector (list->bv 1 bytevector-s8-set! (signed-value-pred 8)))
    (define $u8-list->bytevector (list->bv 1 bytevector-u8-set! (unsigned-value-pred 8)))
    (define $s16-native-list->bytevector (list->bv 2 bytevector-s16-native-set! (signed-value-pred 16)))
    (define $u16-native-list->bytevector (list->bv 2 bytevector-u16-native-set! (unsigned-value-pred 16)))
    (define $s32-native-list->bytevector (list->bv 4 bytevector-s32-native-set! (signed-value-pred 32)))
    (define $u32-native-list->bytevector (list->bv 4 bytevector-u32-native-set! (unsigned-value-pred 32)))
    (define $s64-native-list->bytevector (list->bv 8 bytevector-s64-native-set! (signed-value-pred 64)))
    (define $u64-native-list->bytevector (list->bv 8 bytevector-u64-native-set! (unsigned-value-pred 64)))

    (set-who! s8-list->bytevector
      (lambda (ls)
        ($s8-list->bytevector ls who)))

    (set-who! u8-list->bytevector
      (lambda (ls)
        ($u8-list->bytevector ls who)))

    (set-who! sint-list->bytevector
      (lambda (ls eness size)
        (define (list->big v size)
          (let ([n ($list-length ls who)])
            (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
            (let ([v (make-bytevector (fx* n size))])
              (let f ([ls ls] [i 0])
                (unless (null? ls)
                  (let ([k (car ls)])
                    (unless (and (or (fixnum? k) (bignum? k))
                                 (let ([k (ash k (fx- 1 (fx* size 8)))])
                                   (or (fx= k 0) (fx= k -1))))
                      (invalid-value who k))
                    ($bytevector-int-big-set! v i k size))
                  (f (cdr ls) (fx+ i size))))
              v)))
        (define (list->little v size)
          (let ([n ($list-length ls who)])
            (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
            (let ([v (make-bytevector (fx* n size))])
              (let f ([ls ls] [i 0])
                (unless (null? ls)
                  (let ([k (car ls)])
                    (unless (and (or (fixnum? k) (bignum? k))
                                 (let ([k (ash k (fx- 1 (fx* size 8)))])
                                   (or (fx= k 0) (fx= k -1))))
                      (invalid-value who k))
                    ($bytevector-int-little-set! v i k size))
                  (f (cdr ls) (fx+ i size))))
              v)))
        (if (eq? eness (native-endianness))
            (case size
              [(1) ($s8-list->bytevector ls who)]
              [(2) ($s16-native-list->bytevector ls who)]
              [(4) ($s32-native-list->bytevector ls who)]
              [(8) ($s64-native-list->bytevector ls who)]
              [else
               (constant-case native-endianness
                 [(little) (list->little ls size)]
                 [(big) (list->big ls size)])])
            (constant-case native-endianness
              [(little)
               (if (eq? eness 'big)
                   (list->big ls size)
                   (unrecognized-endianness who eness))]
              [(big)
               (if (eq? eness 'little)
                   (list->little ls size)
                   (unrecognized-endianness who eness))]))))

    (set-who! uint-list->bytevector
      (lambda (ls eness size)
        (define (list->big v size)
          (let ([n ($list-length ls who)])
            (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
            (let ([v (make-bytevector (fx* n size))])
              (let f ([ls ls] [i 0])
                (unless (null? ls)
                  (let ([k (car ls)])
                    (unless (and (or (fixnum? k) (bignum? k))
                                 (fx= (ash k (fx- (fx* size 8))) 0))
                      (invalid-value who k))
                    ($bytevector-int-big-set! v i k size))
                  (f (cdr ls) (fx+ i size))))
              v)))
        (define (list->little v size)
          (let ([n ($list-length ls who)])
            (unless (and (fixnum? size) (fx> size 0)) (invalid-size who size))
            (let ([v (make-bytevector (fx* n size))])
              (let f ([ls ls] [i 0])
                (unless (null? ls)
                  (let ([k (car ls)])
                    (unless (and (or (fixnum? k) (bignum? k))
                                 (fx= (ash k (fx- (fx* size 8))) 0))
                      (invalid-value who k))
                    ($bytevector-int-little-set! v i k size))
                  (f (cdr ls) (fx+ i size))))
              v)))
        (if (eq? eness (native-endianness))
            (case size
              [(1) ($u8-list->bytevector ls who)]
              [(2) ($u16-native-list->bytevector ls who)]
              [(4) ($u32-native-list->bytevector ls who)]
              [(8) ($u64-native-list->bytevector ls who)]
              [else
               (constant-case native-endianness
                 [(little) (list->little ls size)]
                 [(big) (list->big ls size)])])
            (constant-case native-endianness
              [(little)
               (if (eq? eness 'big)
                   (list->big ls size)
                   (unrecognized-endianness who eness))]
              [(big)
               (if (eq? eness 'little)
                   (list->little ls size)
                   (unrecognized-endianness who eness))]))))
  )

  (let ()
    ;; Store uncompressed size as u64, using low bits to indicate compression format:
    (define uncompressed-length-length (ftype-sizeof integer-64))
    ;; Always big-endian, so that compressed data is portable.
    (define uncompressed-length-endianness (endianness big))

    (define fp-bytevector-compress-size
      (foreign-procedure "(cs)bytevector_compress_size" (iptr int) uptr))
    (define fp-bytevector-compress
      (foreign-procedure "(cs)bytevector_compress" (scheme-object iptr iptr scheme-object iptr iptr int) scheme-object))
    (define fp-bytevector-uncompress
      (foreign-procedure "(cs)bytevector_uncompress" (scheme-object iptr iptr scheme-object iptr iptr int) scheme-object))

    (let ()
      (define (compress who bv fmt offset)
        (let* ([dest-max-len (fp-bytevector-compress-size (bytevector-length bv) fmt)]
               [dest-alloc-len (min (+ dest-max-len offset) (constant maximum-bytevector-length))]
               [dest-bv (make-bytevector dest-alloc-len)])
          (let ([r (fp-bytevector-compress dest-bv offset (fx- dest-alloc-len offset) bv 0 (bytevector-length bv) fmt)])
            (if (string? r)
                ($oops who r bv)
                (bytevector-truncate! dest-bv (fx+ r offset))))))

      (set-who! $bytevector-compress
        (lambda (bv fmt)
          (compress who bv fmt 0)))

      (set-who! bytevector-compress
        (lambda (bv)
          (unless (bytevector? bv) (not-a-bytevector who bv))
          (let* ([fmt ($tc-field 'compress-format ($tc))]
                 [dest-bv (compress who bv fmt uncompressed-length-length)])
            (let ([tag (bitwise-ior
                         (bitwise-arithmetic-shift-left (bytevector-length bv) (constant COMPRESS-FORMAT-BITS))
                         fmt)])
              ($bytevector-u64-set! dest-bv 0 tag uncompressed-length-endianness who)
              dest-bv)))))

    (let ()
      (define (uncompress who bv dest-length fmt offset)
        (unless (and (fixnum? dest-length) ($fxu< dest-length (constant maximum-bytevector-length)))
          ($oops who "bytevector ~s claims invalid uncompressed size ~s" bv dest-length))
        (let ([dest-bv (make-bytevector dest-length)])
          (let ([r (fp-bytevector-uncompress dest-bv 0 dest-length bv offset (fx- (bytevector-length bv) offset) fmt)])
            (cond
              [(string? r) ($oops who r bv)]
              [(fx= r dest-length) dest-bv]
              [else ($oops who "uncompressed size ~s for ~s is smaller than expected size ~s" r bv dest-length)]))))

      (set-who! $bytevector-uncompress
        (lambda (bv dest-length fmt)
          (uncompress who bv dest-length fmt 0)))

      (set-who! bytevector-uncompress
        (lambda (bv)
          (unless (bytevector? bv) (not-a-bytevector who bv))
          (unless (>= (bytevector-length bv) uncompressed-length-length) ($oops who "invalid data in source bytevector ~s" bv))
          (let* ([tag ($bytevector-u64-ref bv 0 uncompressed-length-endianness who)]
                 [fmt (logand tag (fx- (fxsll 1 (constant COMPRESS-FORMAT-BITS)) 1))]
                 [dest-length (bitwise-arithmetic-shift-right tag (constant COMPRESS-FORMAT-BITS))])
            (uncompress who bv dest-length fmt uncompressed-length-length))))))
)