;;; ftype.ms
;;; 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.

(mat ftype-sizeof
  (equal?
    (list
      (ftype-sizeof integer-8)
      (ftype-sizeof unsigned-8)
      (ftype-sizeof integer-16)
      (ftype-sizeof unsigned-16)
      (ftype-sizeof integer-24)
      (ftype-sizeof unsigned-24)
      (ftype-sizeof integer-32)
      (ftype-sizeof unsigned-32)
      (ftype-sizeof integer-40)
      (ftype-sizeof unsigned-40)
      (ftype-sizeof integer-48)
      (ftype-sizeof unsigned-48)
      (ftype-sizeof integer-56)
      (ftype-sizeof unsigned-56)
      (ftype-sizeof integer-64)
      (ftype-sizeof unsigned-64)
      (ftype-sizeof single-float)
      (ftype-sizeof double-float))
    '(1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 4 8))
  (eqv? (ftype-sizeof char) (foreign-sizeof 'char))
  (eqv? (ftype-sizeof wchar) (foreign-sizeof 'wchar))
  (eqv? (ftype-sizeof short) (foreign-sizeof 'short))
  (eqv? (ftype-sizeof unsigned-short) (foreign-sizeof 'unsigned-short))
  (eqv? (ftype-sizeof int) (foreign-sizeof 'int))
  (eqv? (ftype-sizeof unsigned) (foreign-sizeof 'unsigned))
  (eqv? (ftype-sizeof unsigned-int) (foreign-sizeof 'unsigned-int))
  (eqv? (ftype-sizeof long) (foreign-sizeof 'long))
  (eqv? (ftype-sizeof unsigned-long) (foreign-sizeof 'unsigned-long))
  (eqv? (ftype-sizeof long-long) (foreign-sizeof 'long-long))
  (eqv? (ftype-sizeof unsigned-long-long) (foreign-sizeof 'unsigned-long-long))
  (eqv? (ftype-sizeof float) (foreign-sizeof 'float))
  (eqv? (ftype-sizeof single-float) (foreign-sizeof 'single-float))
  (eqv? (ftype-sizeof double) (foreign-sizeof 'double))
  (eqv? (ftype-sizeof double-float) (foreign-sizeof 'double-float))
  (eqv? (ftype-sizeof void*) (foreign-sizeof 'void*))
  (eqv? (ftype-sizeof iptr) (foreign-sizeof 'iptr))
  (eqv? (ftype-sizeof uptr) (foreign-sizeof 'uptr))
)

(mat ftype-setup
  (begin
    (define max-integer-alignment
      (if (or (> (fixnum-width) 32)
              (memq (machine-type) '(i3nt ti3nt i3qnx ti3qnx arm32le tarm32le ppc32le tppc32le)))
          8
          4))
    (define max-float-alignment
      (if (or (> (fixnum-width) 32)
              (memq (machine-type) '(i3nt ti3nt arm32le tarm32le ppc32le tppc32le)))
          8
          4))
    (define-syntax fptr-free
      (syntax-rules ()
        [(_ fptr)
         (begin
           (foreign-free (ftype-pointer-address fptr))
           (set! fptr #f))]))
    (define-syntax free-after
      (syntax-rules ()
        [(_ fptr e1 e2 ...)
         (let ([ans (begin e1 e2 ...)])
           (fptr-free fptr)
           ans)]))
    #t)
)

(mat ftype
   (error? ; misplaced function type
     (define-ftype IV1 (struct [i integer-8] [f (function (int) int)])))

   (error? ; misplaced function type
     (define-ftype IV1 (union [i uptr] [f (function (int) int)])))

   (error? ; misplaced function type
     (define-ftype IV1 (array 10 (function (int) int))))

   (error? ; misplaced function type
     (let ()
       (define-ftype F1 (function (int) int))
       (define-ftype IV1 (struct [i integer-8] [f F1]))
       3))

   (error? ; misplaced function type
     (let ()
       (define-ftype F1 (function (int) int))
       (define-ftype IV1 (union [i uptr] [f F1]))
       3))

   (error? ; misplaced function type
     (let ()
       (define-ftype F1 (function (int) int))
       (define-ftype IV1 (array 10 F1))
       3))

   (error? ; misplaced function type
     (let ()
       (define-ftype
         [F1 (function (int) int)]
         [IV1 (struct [i integer-8] [f F1])])
       3))

   (begin
     (define-ftype F1 (function (int) int))
     #t)

   (error? ; function ftypes have unknown size
     (ftype-sizeof F1))

   (error? ; cannot calculate offset for function index 10
     (ftype-ref F1 () (make-ftype-pointer F1 0) 10))

   (error? ; cannot calculate offset for function index 1
     (ftype-&ref F1 () (make-ftype-pointer F1 0) 1))

   (error? ; cannot assign non-scalar type
     (ftype-set! F1 () (make-ftype-pointer F1 0) 0 'foo))

   (begin
     (define-ftype F2 (struct [a1 int] [f (* (function (int) int))]))
     #t)

   (error? ; cannot calculate offset for function index 1
     (ftype-ref F2 (f 1) (make-ftype-pointer F2 0)))

   (error? ; cannot calculate offset for function index 14
     (ftype-&ref F2 (f 14) (make-ftype-pointer F2 0)))

   (error? ; cannot calculate offset for function index 7
     (ftype-set! F2 (f 7) (make-ftype-pointer F2 0) 'foo))


 ; ----------------
  (begin
    (define-ftype Aa (struct [a1 integer-8] [a2 integer-16] [a3 integer-8]))
    (define-ftype Ab (struct [b1 integer-8]))
    (define-ftype Ac (struct [c1 Aa] [c2 Ab] [c3 double]))
    #t)
  
  (equal?
    (let ([x (make-ftype-pointer Ac 0)])
      (list
        (ftype-sizeof Aa)
        (ftype-sizeof Ab)
        (ftype-sizeof Ac)
        (ftype-pointer-address (ftype-&ref Ac (c1 a1) x))
        (ftype-pointer-address (ftype-&ref Ac (c1 a2) x))
        (ftype-pointer-address (ftype-&ref Ac (c1 a3) x))
        (ftype-pointer-address (ftype-&ref Ac (c2 b1) x))
        (ftype-pointer-address (ftype-&ref Ac (c3) x))))
    '(6 1 16 0 2 4 6 8))

  (begin
    (define addr (foreign-alloc (ftype-sizeof Ac)))
    (define x (make-ftype-pointer Ac addr))
    #t)

  (ftype-pointer? x)
  (ftype-pointer? Ac x)
  (not (ftype-pointer? Ab x))
  (eqv? (ftype-pointer-address x) addr)
  (eqv? (ftype-pointer-address (ftype-&ref Ac (c1 a1) x)) (+ addr 0))
  (eqv? (ftype-pointer-address (ftype-&ref Ac (c1 a2) x)) (+ addr 2))
  (eqv? (ftype-pointer-address (ftype-&ref Ac (c1 a3) x)) (+ addr 4))
  (eqv? (ftype-pointer-address (ftype-&ref Ac (c2 b1) x)) (+ addr 6))
  (eqv? (ftype-pointer-address (ftype-&ref Ac (c3) x)) (+ addr 8))

  (error? ; not an ftype pointer
    (ftype-&ref Aa (a1) 75))
  (error? ; ftype mismatch
    (ftype-&ref Ab (b1) x))

  (eqv? (ftype-pointer-address (ftype-&ref Ac (c1) x)) (+ addr 0))

  (error? ; unexpected accessor b1
    (ftype-&ref Ac (b1) x))
  (error? ; unexpected accessor 0
    (ftype-&ref Ac (c1 0) x))

  (begin
    (ftype-set! Ac (c1 a1) x 7)
    (ftype-set! Ac (c1 a2) x 30000)
    (ftype-set! Ac (c1 a3) x -15)
    (ftype-set! Ac (c2 b1) x #xFF)
    (ftype-set! Ac (c3) x 3.25)
    #t)

  (error? ; unexpected accessor b1
    (ftype-set! Ac (b1) x 7))
  (error? ; unexpected accessor 0
    (ftype-set! Ac (c1 0) x 7))
  (error? ; ftype mismatch
    (ftype-set! Ab (b1) x 7))
  (error? ; #\a is not an integer-8
    (ftype-set! Ac (c1 a1) x #\a))
  (error? ; 30000 is not an integer-8
    (ftype-set! Ac (c1 a1) x 30000))

  (eqv? (ftype-ref Ac (c1 a1) x) 7)
  (eqv? (ftype-ref Ac (c1 a2) x) 30000)
  (eqv? (ftype-ref Ac (c1 a3) x) -15)
  (eqv? (ftype-ref Ac (c2 b1) x) -1)
  (eqv? (ftype-ref Ac (c3) x) 3.25)
  (eqv? (ftype-ref Aa (a1) (ftype-&ref Ac (c1) x)) 7)
  (eqv? (ftype-ref Aa (a2) (ftype-&ref Ac (c1) x)) 30000)
  (eqv? (ftype-ref Aa (a3) (ftype-&ref Ac (c1) x)) -15)
  (eqv? (ftype-ref Ab (b1) (ftype-&ref Ac (c2) x)) -1)
  (eqv? (ftype-ref double () (ftype-&ref Ac (c3) x)) 3.25)
  (let ([y (ftype-&ref Ac (c3) x)])
    (= (ftype-pointer-address (ftype-&ref double () y))
       (ftype-pointer-address y)))
  (eqv? (foreign-ref 'double (ftype-pointer-address (ftype-&ref Ac (c3) x)) 0) 3.25)
  (let ()
    (define-syntax cast
      (syntax-rules ()
        [(_ ftype x)
         (make-ftype-pointer ftype (ftype-pointer-address x))]))
    (define-ftype double-array (array 1 double))
    (eqv? (ftype-ref double-array (0)
            (cast double-array (ftype-&ref Ac (c3) x)))
      3.25))
  (let ()
    (define-syntax cast
      (syntax-rules ()
        [(_ ftype x)
         (make-ftype-pointer ftype (ftype-pointer-address x))]))
    (define-ftype double-array (array 1 double))
    (let ([y (cast double-array (ftype-&ref Ac (c3) x))])
      (and (ftype-pointer? y)
           (eqv? (ftype-pointer-address y) (ftype-pointer-address (ftype-&ref Ac (c3) x)))
           (ftype-pointer=? y (ftype-&ref Ac (c3) x))
           (eqv? (ftype-ref double-array (0) y) 3.25))))

  (error? ; unexpected accessor b1
    (ftype-ref Ac (b1) x))
  (error? ; unexpected accessor 0
    (ftype-ref Ac (c1 0) x))
  (error? ; ftype mismatch
    (ftype-ref Ab (b1) x))
  (error? ; ftype mismatch
    (ftype-ref Aa (a1) (ftype-&ref Ac (c2) x)))

  (begin
    (foreign-free addr)
    #t)

 ; ----------------

  (begin
    (define-ftype Ba (struct [a1 integer-8] [a2 integer-32] [a3 integer-8]))
    (define-ftype Bb (struct [b1 integer-8]))
    (define-ftype Bc (struct [c1 Ba] [c2 Bb] [c3 double]))
    #t)
    
  (equal?
    (let ([x (make-ftype-pointer Bc 0)])
      (list
        (ftype-sizeof Ba)
        (ftype-sizeof Bb)
        (ftype-sizeof Bc)
        (ftype-pointer-address (ftype-&ref Bc (c1 a1) x))
        (ftype-pointer-address (ftype-&ref Bc (c1 a2) x))
        (ftype-pointer-address (ftype-&ref Bc (c1 a3) x))
        (ftype-pointer-address (ftype-&ref Bc (c2 b1) x))
        (ftype-pointer-address (ftype-&ref Bc (c3) x))))
    '(12 1 24 0 4 8 12 16))

 ; ----------------

  (begin
    (define-ftype Ca (struct [a1 integer-8] [a2 double] [a3 integer-8]))
    (define-ftype Cb (struct [b1 integer-8]))
    (define-ftype Cc (struct [c1 Ca] [c2 Cb] [c3 double]))
    #t)

  (equal?
    (let ([x (make-ftype-pointer Cc 0)])
      (list
        (ftype-sizeof Ca)
        (ftype-sizeof Cb)
        (ftype-sizeof Cc)
        (ftype-pointer-address (ftype-&ref Cc (c1 a1) x))
        (ftype-pointer-address (ftype-&ref Cc (c1 a2) x))
        (ftype-pointer-address (ftype-&ref Cc (c1 a3) x))
        (ftype-pointer-address (ftype-&ref Cc (c2 b1) x))
        (ftype-pointer-address (ftype-&ref Cc (c3) x))))
    (if (< max-float-alignment 8)
        '(16 1 28 0 4 12 16 20)
        '(24 1 40 0 8 16 24 32)))
    
 ; ----------------

  (begin
    (define-ftype Da (struct [a1 integer-8] [a2 integer-64] [a3 integer-8]))
    (define-ftype Db (struct [b1 integer-8]))
    (define-ftype Dc (struct [c1 Da] [c2 Db] [c3 integer-64]))
    #t)

  (equal?
    (let ([x (make-ftype-pointer Dc 0)])
      (list
        (ftype-sizeof Da)
        (ftype-sizeof Db)
        (ftype-sizeof Dc)
        (ftype-pointer-address (ftype-&ref Dc (c1 a1) x))
        (ftype-pointer-address (ftype-&ref Dc (c1 a2) x))
        (ftype-pointer-address (ftype-&ref Dc (c1 a3) x))
        (ftype-pointer-address (ftype-&ref Dc (c2 b1) x))
        (ftype-pointer-address (ftype-&ref Dc (c3) x))))
    (if (< max-integer-alignment 8)
        '(16 1 28 0 4 12 16 20)
        '(24 1 40 0 8 16 24 32)))
    
 ; ----------------

  (begin
    (define-ftype Ea
      (struct
        [x integer-32]
        [y double-float]
        [z (array 25 (struct [_ integer-16] [b integer-16]))]
        [w (struct
             [a integer-32]
             [b (union
                  [b1 (struct [a integer-32] [b integer-32])]
                  [b2 (struct [a integer-8] [b double])])])]
        [v (* Ac)]))
    #t)

  (equal?
    (let ([x (make-ftype-pointer Ea 0)])
      (list
        (ftype-sizeof Ea)
        (ftype-pointer-address (ftype-&ref Ea (x) x))
        (ftype-pointer-address (ftype-&ref Ea (y) x))
        (ftype-pointer-address (ftype-&ref Ea (z) x))
        (ftype-pointer-address (ftype-&ref Ea (w) x))
        (ftype-pointer-address (ftype-&ref Ea (v) x))
        (ftype-pointer-address (ftype-&ref Ea (z 0) x))
        (ftype-pointer-address (ftype-&ref Ea (z 4 b) x))
        (ftype-pointer-address (ftype-&ref Ea (w a) x))
        (ftype-pointer-address (ftype-&ref Ea (w b) x))
        (ftype-pointer-address (ftype-&ref Ea (w b b1) x))
        (ftype-pointer-address (ftype-&ref Ea (w b b1 a) x))
        (ftype-pointer-address (ftype-&ref Ea (w b b1 b) x))
        (ftype-pointer-address (ftype-&ref Ea (w b b2) x))
        (ftype-pointer-address (ftype-&ref Ea (w b b2 a) x))
        (ftype-pointer-address (ftype-&ref Ea (w b b2 b) x))))
    (if (< max-float-alignment 8)
        '(132 0 4 12 112 128 12 30 112 116 116 116 120 116 116 120)
        '(152 0 8 16 120 144 16 34 120 128 128 128 132 128 128 136)))

  (begin
    (define-ftype Eb
      (packed
        (struct
          [x integer-32]
          [y double-float]
          [z (array 25 (struct [_ integer-16] [b integer-16]))]
          [w (struct
               [a integer-32]
               [b (union
                    [b1 (struct [a integer-32] [b integer-32])]
                    [b2 (struct [a integer-8] [b double])])])]
          [v (* Ac)])))
    #t)

  (equal?
    (let ([x (make-ftype-pointer Eb 0)])
      (list
        (ftype-sizeof Eb)
        (ftype-pointer-address (ftype-&ref Eb (x) x))
        (ftype-pointer-address (ftype-&ref Eb (y) x))
        (ftype-pointer-address (ftype-&ref Eb (z) x))
        (ftype-pointer-address (ftype-&ref Eb (w) x))
        (ftype-pointer-address (ftype-&ref Eb (v) x))
        (ftype-pointer-address (ftype-&ref Eb (z 0) x))
        (ftype-pointer-address (ftype-&ref Eb (z 4 b) x))
        (ftype-pointer-address (ftype-&ref Eb (w a) x))
        (ftype-pointer-address (ftype-&ref Eb (w b) x))
        (ftype-pointer-address (ftype-&ref Eb (w b b1) x))
        (ftype-pointer-address (ftype-&ref Eb (w b b1 a) x))
        (ftype-pointer-address (ftype-&ref Eb (w b b1 b) x))
        (ftype-pointer-address (ftype-&ref Eb (w b b2) x))
        (ftype-pointer-address (ftype-&ref Eb (w b b2 a) x))
        (ftype-pointer-address (ftype-&ref Eb (w b b2 b) x))))
    (if (< (fixnum-width) 32)
        '(129 0 4 12 112 125 12 30 112 116 116 116 120 116 116 117)
        '(133 0 4 12 112 125 12 30 112 116 116 116 120 116 116 117)))

 ; ----------------

  (equal?
    (let ()
      (define-ftype A (struct [a1 integer-32]))
      (define-ftype B (struct [b1 A] [b2 (* A)]))
      (define x (make-ftype-pointer B (foreign-alloc (ftype-sizeof B))))
      (define y (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (ftype-set! B (b2) x y)
      (ftype-set! A (a1) y 72)
      (ftype-set! B (b1 a1) x -35)
      (free-after x
        (free-after y
          (list (ftype-ref A (a1) y) (ftype-ref B (b1 a1) x) (ftype-ref B (b2 * a1) x)))))
    '(72 -35 72))

  (begin
    (define base-ftype*
      `((short . "short")
        (unsigned-short . "unsigned short")
        (int . "int")
        (unsigned . "unsigned")
        (unsigned-int . "unsigned int")
        (long . "long")
        (unsigned-long . "unsigned long")
        (long-long . "int64_t")
        (unsigned-long-long . "uint64_t")
        (char . "char")
        (wchar . "wchar")
        (float . "float")
        (double . "double")
        (void* . "void *")
        (iptr . ,(if (< (fixnum-width) 32) "int32_t" "int64_t"))
        (uptr . ,(if (< (fixnum-width) 32) "uint32_t" "uint64_t"))
        (fixnum . ,(if (< (fixnum-width) 32) "int32_t" "int64_t"))
        (boolean . "int")
        (integer-8 . "int8_t")
        (unsigned-8 . "uint8_t")
        (integer-16 . "int16_t")
        (unsigned-16 . "uint16_t")
        (integer-32 . "int32_t")
        (unsigned-32 . "uint32_t")
        (integer-64 . "int64_t")
        (unsigned-64 . "uint64_t")
        (single-float . "float")
        (double-float . "double")))

    (define ftype-paths
      (lambda (name ftype alist)
        (map reverse
          (let f ([ftype ftype] [path (list name)] [path* '()])
            (if (symbol? ftype)
                (cond
                  [(assq ftype alist) =>
                   (lambda (a) (f (cdr a) path path*))]
                  [else (cons path path*)])
                (cons path
                  (record-case ftype
                    [(struct) field*
                     (fold-right
                       (lambda (field path*)
                         (f (cadr field) (cons (car field) path) path*))
                       path* field*)]
                    [(union) field*
                     (fold-right
                       (lambda (field path*)
                         (f (cadr field) (cons (car field) path) path*))
                       path* field*)]
                    [(array) (length ftype)
                     (if (= length 0)
                         path*
                         (f ftype (cons (- length 1) path) path*))]
                    [(*) (ftype) path*]
                    [else
                     (errorf 'ftype-paths "can't handle ~s" ftype)])))))))

    (define ftype-code
      (lambda (ftype name)
        (if (symbol? ftype)
            (cond
              [(assq ftype base-ftype*) =>
               (lambda (a) (format "~a ~a;" (cdr a) name))]
              [else (format "typedef_~a ~a;" ftype name)])
            (record-case ftype
              [(struct) field*
               (format "struct { ~{~a ~}} ~a;"
                 (map
                   (lambda (field) (ftype-code (cadr field) (car field)))
                   field*)
                 name)]
              [(union) field* 
               (format "union { ~{~a ~}} ~a;"
                 (map
                   (lambda (field) (ftype-code (cadr field) (car field)))
                   field*)
                 name)]
              [(array) (length ftype)
               (ftype-code ftype (format "~a[~d]" name length))]
              [(*) (ftype)
               (ftype-code ftype (format "*~a" name))]
              [else
               (errorf 'ftype-code "can't handle ~s" ftype)]))))

    (define C-test-code
      (lambda (ftype-defn* path* ndefs npaths i* j*)
        (let ([ndefs (length ftype-defn*)])
          (printf "#include \"~a/ftype.h\"\n\
                   #define offset(x, y) (int)((char *)&y - (char *)&x)\n\
                   EXPORT int *foo() {\n\
                     ~{~a\n~}\
                     static int a[~d];\n\
                     ~{~a\n~}\
                     ~{~a\n~}\
                     return a;\
                   }\n"
            *mats-dir*
            (map
              (lambda (ftype-defn)
                (format "typedef ~a typedef_~a ~a;"
                  (ftype-code (cdr ftype-defn) (format "typedef_~a" (car ftype-defn)))
                  (car ftype-defn)
                  (car ftype-defn)))
              ftype-defn*)
            (+ ndefs npaths)
            (map
              (lambda (i ftype-defn)
                (format "a[~a] = sizeof(~a);" i (car ftype-defn)))
              i* ftype-defn*)
            (map
              (lambda (j path)
                (format "a[~d] = offset(~a,~a~{~a~});"
                  j
                  (car path)
                  (car path)
                  (map (lambda (x)
                         (if (and (integer? x) (exact? x))
                             (format "[~d]" x)
                             (format ".~a" x)))
                    (cdr path))))
              j* path*)))))

    (define C-compile&load
      (lambda (testfile thunk)
        (let ([testfile.c (format "testfile-~a.c" testfile)]
              [testfile.so (format "testfile-~a.~:[so~;dll~]" testfile
                             (windows?))])
          (with-output-to-file testfile.c thunk 'replace)
          (unless (= (case (machine-type)
                       [(i3osx ti3osx)
                        (system (format "cc -m32 -dynamiclib -o ~a ~a" testfile.so testfile.c))]
                       [(a6osx a6osx)
                        (system (format "cc -m64 -dynamiclib -o ~a ~a" testfile.so testfile.c))]
                       [(a6nt ta6nt)
                        (system (format "set cl= && ~a\\..\\c\\vs.bat amd64 && cl /DWIN32 /Fe~a /LD /MD /nologo ~a"
                                  (patch-exec-path *mats-dir*) testfile.so testfile.c))]
                       [(i3nt ti3nt)
                        (system (format "set cl= && ~a\\..\\c\\vs.bat x86 && cl /DWIN32 /Fe~a /LD /MD /nologo ~a"
                                  (patch-exec-path *mats-dir*) testfile.so testfile.c))]
                       [(arm32le tarm32le)
                        (system (format "cc -fPIC -shared -o ~a ~a" testfile.so testfile.c))]
                       [else ; this should work for most intel-based systems that use gcc...
                        (if (> (fixnum-width) 32)
                            (system (format "cc -m64 -fPIC -shared -o ~a ~a" testfile.so testfile.c))
                            (system (format "cc -m32 -fPIC -shared -o ~a ~a" testfile.so testfile.c)))])
                     0)
            (errorf 'ftype-test "C compilation failed"))
          (load-shared-object (format "./~a" testfile.so)))))

    (define-syntax ftype-test
      (lambda (x)
        (syntax-case x ()
          [(_ testfile (id ftype) ...)
           (with-syntax ([((path ...) ...)
                          (let ([id* (datum (id ...))]
                                [ftype* (datum (ftype ...))])
                            (let ([alist (map cons id* ftype*)])
                              (map
                                (lambda (id ftype)
                                  (map (lambda (x) (datum->syntax #'* x))
                                    (ftype-paths id ftype alist)))
                                id* ftype*)))])
               (let ([ndefs (length #'(ftype ...))]
                     [npaths (length #'(path ... ...))])
                 (with-syntax ([(i ...) (enumerate #'(ftype ...))]
                               [(j ...) (list-tail (enumerate #'(ftype ... path ... ...)) ndefs)]
                               [((idx . pathx) ...) #'(path ... ...)])
                   #`(begin
                       (define-ftype id ftype) ...
                       (define-ftype result-type (array #,(+ ndefs npaths) int))
                       (C-compile&load testfile
                         (lambda ()
                           (C-test-code
                             '((id . ftype) ...) '(path ... ...)
                             #,ndefs #,npaths
                             '(i ...) '(j ...))))

                       (let ([results (make-ftype-pointer result-type
                                        ((foreign-procedure "foo" () void*)))]
                             [status #t])
                         (let ([Scheme-size (ftype-sizeof id)] [C-size (ftype-ref result-type (i) results)])
                           (unless (= Scheme-size C-size)
                             (printf "sizeof check failed for ~s (C says ~s, Scheme says ~s)\n" 'ftype C-size Scheme-size)
                             (set! status #f)))
                         ...
                         (let ([Scheme-addr (ftype-pointer-address (ftype-&ref idx pathx (make-ftype-pointer idx 0)))]
                               [C-addr (ftype-ref result-type (j) results)])
                           (unless (= Scheme-addr C-addr)
                             (printf "address check failed for ~s (C says ~s, Scheme says ~s)\n"
                               (cons 'idx 'pathx) C-addr Scheme-addr)
                             (set! status #f)))
                         ...
                         status)))))])))

    #t)

 ; can pack as many of these together as we want
 ; should avoid too many ftype-test forms to avoid
 ; excessive number of shared object
 ; NB. choose a different testfile name for each
  (ftype-test "ftype1"
    [Aa (struct [a1 integer-8] [a2 integer-16] [a3 integer-8])]
    [Ab (struct [b1 integer-8])]
    [Ac (struct [c1 Aa] [c2 Ab] [c3 double])]

    [A int]
    [B (struct [a int] [b char])]
    [C (struct [c1 B] [c2 A] [c3 double])]
    [D (struct
         [x integer-32]
         [y double-float]
         [z (array 25 (struct [a integer-16] [b integer-16]))]
         [w (struct
              [a integer-32]
              [b (union
                   [b1 (struct [a integer-32] [b integer-32])]
                   [b2 (struct [a integer-8] [b double])])])]
         [v (* C)])]
    [E (struct
         [z (array 25 (struct [a unsigned-short] [b unsigned]))]
         [x unsigned-long]
         [w (struct
              [a long-long]
              [b (union
                   [b1 (struct [a int] [b int])]
                   [b2 (struct [a char] [b double])])])]
         [y double]
         [u (array 9 float)]
         [v (* C)]
         [t char])]
    [F (struct
         [a integer-32]
         [b double])]
    [G (struct
         [a double]
         [b integer-32])]
    [H (struct
         [a integer-32]
         [b (union
              [b1 double]
              [b2 (struct [b2a integer-32] [b2b integer-32])])])]
    [I (struct
         [a integer-32]
         [b (array 1 double)])]
    [J (struct
         [a (array 1 double)]
         [b integer-32])]
    [K1 (union
          [a double]
          [b (struct
               [a integer-32]
               [b integer-32])])]
    [K2 (struct
          [a K1]
          [b integer-32])]
    [K2x (struct
           [a integer-32]
           [b (union
                [a double]
                [b (struct
                     [a integer-32]
                     [b integer-32])])])]
    [K3 (struct
          [a integer-32]
          [b K1])]
    [K3x (struct
           [a integer-32]
           [b (union
                [a double]
                [b (struct
                     [a integer-32]
                     [b integer-32])])])]
    [M1 (union
          [b (struct
               [a integer-32]
               [b double])]
          [a double])]
    [M2 (struct [a M1] [b integer-32])]
    [M3 (struct [a integer-32] [b M1])]
    [N1 (struct [a integer-32] [b integer-64])]
  )

 ; ----------------

  (equal?
    (let ()
       (define-ftype A
         (struct
           [a1 double]
           [a2 float]
           [a3 long-long]
           [a4 unsigned-long-long]
           [a5 long]
           [a6 unsigned-long]
           [a7 int]
           [a8 unsigned]
           [a9 unsigned-int]
           [a10 short]
           [a11 unsigned-short]
           [a12 wchar]
           [a13 char]
           [a14 boolean]
           [a15 fixnum]
           [a16 iptr]
           [a17 uptr]
           [a18 void*]))
       (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
       (free-after a
         (ftype-set! A (a1) a 3.5)
         (ftype-set! A (a2) a -4.5)
         (ftype-set! A (a3) a -30000)
         (ftype-set! A (a4) a #xabcdef02)
         (ftype-set! A (a5) a -30001)
         (ftype-set! A (a6) a #xabcdef03)
         (ftype-set! A (a7) a -30002)
         (ftype-set! A (a8) a #xabcdef04)
         (ftype-set! A (a9) a #xabcdef05)
         (ftype-set! A (a10) a -30003)
         (ftype-set! A (a11) a #xab06)
         (ftype-set! A (a12) a #\a)
         (ftype-set! A (a13) a #\b)
         (ftype-set! A (a14) a 'hello)
         (ftype-set! A (a15) a (most-positive-fixnum))
         (ftype-set! A (a16) a -30004)
         (ftype-set! A (a17) a #xabcdef07)
         (ftype-set! A (a18) a 25000)
         (list
           (ftype-ref A (a1) a)
           (ftype-ref A (a2) a)
           (ftype-ref A (a3) a)
           (ftype-ref A (a4) a)
           (ftype-ref A (a5) a)
           (ftype-ref A (a6) a)
           (ftype-ref A (a7) a)
           (ftype-ref A (a8) a)
           (ftype-ref A (a9) a)
           (ftype-ref A (a10) a)
           (ftype-ref A (a11) a)
           (ftype-ref A (a12) a)
           (ftype-ref A (a13) a)
           (ftype-ref A (a14) a)
           (ftype-ref A (a15) a)
           (ftype-ref A (a16) a)
           (ftype-ref A (a17) a)
           (ftype-ref A (a18) a))))
    `(3.5
      -4.5
      -30000
      #xabcdef02
      -30001
      #xabcdef03
      -30002
      #xabcdef04
      #xabcdef05
      -30003
      #xab06
      #\a
      #\b
      #t
      ,(most-positive-fixnum)
      -30004
      #xabcdef07
      25000))

  (begin
    (define-ftype A
      (array 3
        (struct
          [a int]
          [b short])))
    (define x (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
    (do ([i 0 (fx+ i 1)])
        ((fx= i 3))
      (ftype-set! A (i a) x (expt 2 i))
      (ftype-set! A (i b) x (- 1 (expt 2 i))))
    #t)

  (eqv? (ftype-ref A (0 a) x) 1)
  (eqv? (ftype-ref A (0 b) x) 0)
  (eqv? (ftype-ref A (1 a) x) 2)
  (eqv? (ftype-ref A (1 b) x) -1)
  (eqv? (ftype-ref A (2 a) x) 4)
  (eqv? (ftype-ref A (2 b) x) -3)

  (error? ; invalid index
    (ftype-ref A (3 a) x))
  (error? ; invalid index
    (ftype-ref A (-1 a) x))
  (error? ; invalid index
    (ftype-ref A (x a) x))
  (error? ; invalid index
    (ftype-ref A (1.0 a) x))
  (error? ; invalid index
    (ftype-&ref A (3) x))
  (error? ; invalid index
    (ftype-&ref A (-1) x))
  (error? ; invalid index
    (ftype-&ref A (x) x))
  (error? ; invalid index
    (ftype-&ref A (1.0) x))
  (error? ; invalid index
    (ftype-&ref A (3 a) x))
  (error? ; invalid index
    (ftype-&ref A (-1 a) x))
  (error? ; invalid index
    (ftype-&ref A (x a) x))
  (error? ; invalid index
    (ftype-&ref A (1.0 a) x))
  (error? ; invalid index
    (ftype-set! A (3 a) x 0))
  (error? ; invalid index
    (ftype-set! A (-1 a) x 0))
  (error? ; invalid index
    (ftype-set! A (x a) x 0))
  (error? ; invalid index
    (ftype-set! A (1.0 a) x 0))
  (error? ; invalid value
    (ftype-set! A (1 a) x 3.2))
  (error? ; invalid index
    (ftype-set! A (1 a) x #\a))
  (error? ; invalid index
    (ftype-set! A (1 a) x (expt 2 1000)))
  (error? ; target cannot be referenced
    (ftype-ref A (1) x))
  (error? ; target cannot be assigned
    (ftype-set! A (1) x 0))

  (begin
    (fptr-free x)
    #t)

 ; ----------------

  (begin
    (define-ftype Q
      (struct
        [x integer-16]
        [y (array 100 integer-32)]))
    (define x (make-ftype-pointer Q (foreign-alloc (- (ftype-sizeof Q) (* (ftype-sizeof integer-32) (- 100 10))))))
    #t)
  (eqv? (ftype-sizeof Q) 404)
  (eqv? (ftype-pointer-address (ftype-&ref Q (y) (make-ftype-pointer Q 0))) 4)
  (begin
    (do ([i 0 (fx+ i 1)])
        ((fx= i 10))
      (ftype-set! Q (y i) x (+ (* i 3) 2)))
    #t)
  (equal?
    (map (lambda (i) (ftype-ref Q (y i) x)) (iota 10))
    (map (lambda (i) (+ (* i 3) 2)) (iota 10)))
  (begin
    (fptr-free x)
    #t)

 ; ----------------
  (begin
    (define-ftype A (struct [x double]))
    (define-ftype B (struct [head int] [tail (* A)]))
    (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
    (define b (make-ftype-pointer B (foreign-alloc (ftype-sizeof B))))
    (ftype-set! B (tail) b a)
    (ftype-set! B (head) b 17)
    (ftype-set! A (x) a 3.25)
    #t)
  (equal?
    (ftype-pointer->sexpr a)
    '(struct [x 3.25]))
  (equal? 
    (ftype-pointer->sexpr b)
    '(struct [head 17] [tail (* (struct [x 3.25]))]))
  (error? ; not a scalar
    (ftype-ref B (tail *) b))
  (ftype-pointer? (ftype-ref B (tail) b))
  (begin
    (ftype-set! A (x) (ftype-ref B (tail) b) -5.5)
    #t)
  (eqv? (ftype-ref B (tail * x) b) -5.5)

  (begin
    (fptr-free a)
    (fptr-free b)
    #t)
 ; ----------------
  (begin
    (define-ftype Qlist
      (struct
        [head int]
        [tail (* Qlist)]))
    (define x (make-ftype-pointer Qlist (foreign-alloc (ftype-sizeof Qlist))))
    (ftype-set! Qlist (head) x 17)
    (ftype-set! Qlist (tail) x x)
    #t)
  (eqv? (ftype-ref Qlist (head) x) 17)
  (eqv? (ftype-ref Qlist (tail * head) x) 17)
  (eqv? (ftype-ref Qlist (tail * tail * tail * tail * head) x) 17)
  (equal?
    (ftype-pointer->sexpr x)
    '#0=(struct [head 17] [tail (* #0#)]))
  (begin
    (fptr-free x)
    #t)

 ; ----------------
  (begin
    (define-ftype
      [Qfrob (struct
               [head int]
               [tail (* Qsnark)])]
      [Qsnark (struct
                [head int]
                [tail (* Qfrob)])])
    (define x (make-ftype-pointer Qfrob (foreign-alloc (ftype-sizeof Qfrob))))
    (ftype-set! Qfrob (head) x 17)
    (define y (make-ftype-pointer Qsnark (foreign-alloc (ftype-sizeof Qsnark))))
    (ftype-set! Qfrob (tail) x y)
    (ftype-set! Qfrob (tail * head) x -57)
    (ftype-set! Qfrob (tail * tail) x x)
    #t)
  (eqv? (ftype-ref Qfrob (head) x) 17)
  (eqv? (ftype-ref Qfrob (tail * head) x) -57)
  (eqv? (ftype-ref Qfrob (tail * tail * tail * tail * head) x) 17)
  (eqv? (ftype-ref Qfrob (tail * tail * tail * tail * tail * head) x) -57)
  (eqv? (ftype-ref Qsnark (head) (ftype-ref Qfrob (tail) x)) -57)
  (equal?
    (ftype-pointer->sexpr x)
    '#1=(struct
          [head 17]
          [tail (* (struct [head -57] [tail (* #1#)]))]))
  (begin
    (fptr-free x)
    (fptr-free y)
    #t)

 ; ----------------
  (error? ; invalid recursive or forward reference
    (define-ftype
      [Qfrob (struct
               [head int]
               [xtra Qfrob]
               [tail (* Qsnark)])]
      [Qsnark (struct
                [head int]
                [tail (* Qfrob)])]))
  (error? ; invalid recursive or forward reference
    (define-ftype
      [Qfrob (struct
               [head int]
               [xtra Qsnark]
               [tail (* Qsnark)])]
      [Qsnark (struct
                [head int]
                [tail (* Qfrob)])]))

 ; ----------------
  (begin
    (define-ftype
      [Qfrob (struct
               [head int]
               [tail (* Qsnark)])]
      [Qsnark (struct
                [head int]
                [xtra Qfrob]
                [tail (* Qfrob)])])
    (define x (make-ftype-pointer Qfrob (foreign-alloc (ftype-sizeof Qfrob))))
    (ftype-set! Qfrob (head) x 17)
    (define y (make-ftype-pointer Qsnark (foreign-alloc (ftype-sizeof Qsnark))))
    (ftype-set! Qfrob (tail) x y)
    (ftype-set! Qfrob (tail * head) x -57)
    (ftype-set! Qfrob (tail * tail) x x)
    (ftype-set! Qfrob (tail * xtra head) x 83)
    (ftype-set! Qfrob (tail * xtra tail) x (ftype-ref Qfrob (tail) x))
    #t)
  (eqv? (ftype-ref Qfrob (head) x) 17)
  (eqv? (ftype-ref Qfrob (tail * head) x) -57)
  (eqv? (ftype-ref Qfrob (tail * tail * tail * tail * head) x) 17)
  (eqv? (ftype-ref Qfrob (tail * tail * tail * tail * tail * head) x) -57)
  (eqv? (ftype-ref Qsnark (head) (ftype-ref Qfrob (tail) x)) -57)
  (eqv? (ftype-ref Qfrob (tail * xtra head) x) 83)
  (eqv? (ftype-ref Qfrob (tail * xtra tail * head) x) -57)
  (equal?
    (ftype-pointer-ftype x)
    '(struct
       [head int]
       [tail (* Qsnark)]))
  (equal?
    (ftype-pointer-ftype (ftype-ref Qfrob (tail) x))
    '(struct
       [head int]
       [xtra Qfrob]
       [tail (* Qfrob)]))
  (equal?
    (ftype-pointer->sexpr x)
    '#2=(struct
          [head 17]
          [tail (* #3=(struct
                        [head -57]
                        [xtra (struct [head 83] [tail (* #3#)])]
                        [tail (* #2#)]))]))
  (begin
    (fptr-free x)
    (fptr-free y)
    #t)

 ; ----------------
  (begin
    (define-ftype A (bits [x unsigned 3] [y unsigned 5]))
    (define-ftype B (* A))
    (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
    (define b (make-ftype-pointer B (foreign-alloc (ftype-sizeof B))))
    (ftype-set! B () b a)
    #t)

  (begin
    (ftype-set! A (x) a 3)
    (ftype-set! A (y) a 31)
    #t)

  (eqv? (ftype-ref A (x) a) 3)
  (eqv? (ftype-ref A (y) a) 31)
  (eqv? (ftype-ref B (* x) b) 3)
  (eqv? (ftype-ref B (* y) b) 31)

  (begin
    (ftype-set! A (x) a 6)
    (ftype-set! A (y) a 21)
    #t)

  (eqv? (ftype-ref A (x) a) 6)
  (eqv? (ftype-ref A (y) a) 21)
  (eqv? (ftype-ref B (* x) b) 6)
  (eqv? (ftype-ref B (* y) b) 21)

  (begin
    (fptr-free a)
    (fptr-free b)
    #t)

 ; ----------------
  (begin
    (define-ftype Q
      (struct
        [x integer-16]
        [y (array 0 iptr)]))
    (define qlen 17)
    (define q (make-ftype-pointer Q (foreign-alloc (+ (ftype-sizeof Q) (* qlen (ftype-sizeof iptr))))))
    (do ([i 0 (fx+ i 1)]) ((fx= i qlen)) (ftype-set! Q (y i) q (* i 7)))
    #t)

  (error? ; invalid index
    (ftype-ref Q (y -1) q))
  (error? ; invalid index
    (ftype-ref Q (y 3.2) q))
  (error? ; invalid index
    (ftype-ref Q (y (+ (most-positive-fixnum) 1)) q))
  (error? ; invalid index
    (ftype-set! Q (y -1) q 7))
  (error? ; invalid index
    (ftype-set! Q (y 3.2) q 7))
  (error? ; invalid index
    (ftype-set! Q (y (+ (most-positive-fixnum) 1)) q 7))
  (error? ; invalid index
    (ftype-&ref Q (y -1) q))
  (error? ; invalid index
    (ftype-&ref Q (y 3.2) q))
  (error? ; invalid index
    (ftype-&ref Q (y (+ (most-positive-fixnum) 1)) q))
  (error? ; invalid index
    (ftype-locked-incr! Q (y -1) q))
  (error? ; invalid index
    (ftype-locked-decr! Q (y 3.2) q))
  (error? ; invalid index
    (ftype-lock! Q (y (+ (most-positive-fixnum) 1)) q))
  (error? ; invalid index
    (ftype-spin-lock! Q (y (+ (most-positive-fixnum) 1)) q))
  (eqv? (ftype-ref Q (y 0) q) 0)
  (eqv? (ftype-ref Q (y 7) q) 49)
  (eqv? (ftype-ref Q (y 16) q) 112)

  (begin
    (fptr-free q)
    #t)

 ; ----------------
  (guard (c [(and (message-condition? c)
                  (equal? (condition-message c) "non-fixnum overall size for ftype"))
             #t])
    (eval
      '(meta-cond
         [(= (fixnum-width) 30)
          (define-ftype Q
            (struct
              [x integer-16]
              [y (array #xFFFFFFF integer-32)]))]
         [(= (fixnum-width) 61)
          (define-ftype Q
            (struct
              [x integer-16]
              [y (array #xFFFFFFFFFFFFFFF integer-32)]))]
         [else (errorf #f "unexpected fixnum-width")]))
    #t)

 ; ----------------
  (begin
    (define-syntax $dfvalerr
      (syntax-rules ()
        [(_ type)
         (let ()
           (define-ftype A (endian big type))
           (define x (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
           (guard (c [#t (fptr-free x) (raise c)])
             (ftype-set! A () x 'oops)))]))
    #t)

  (error? ($dfvalerr (* float)))
  (error? ($dfvalerr integer-8))
  (error? ($dfvalerr unsigned-8))
  (error? ($dfvalerr integer-16))
  (error? ($dfvalerr unsigned-16))
  (error? ($dfvalerr integer-32))
  (error? ($dfvalerr unsigned-32))
  (error? ($dfvalerr integer-64))
  (error? ($dfvalerr unsigned-64))
  (error? ($dfvalerr double-float))
  (error? ($dfvalerr single-float))
  (error? ($dfvalerr char))
  (error? ($dfvalerr wchar))
  (error? ($dfvalerr fixnum))
  (error? ($dfvalerr iptr))
  (error? ($dfvalerr uptr))
  (error? ($dfvalerr void*))
  (error? ($dfvalerr int))
  (error? ($dfvalerr unsigned))
  (error? ($dfvalerr unsigned-int))
  (error? ($dfvalerr short))
  (error? ($dfvalerr unsigned-short))
  (error? ($dfvalerr long))
  (error? ($dfvalerr unsigned-long))
  (error? ($dfvalerr long-long))
  (error? ($dfvalerr unsigned-long-long))
  (error? ($dfvalerr double))
  (error? ($dfvalerr float))

 ; ----------------
  (begin
    (define-syntax $dfvalerr
      (syntax-rules ()
        [(_ type)
         (let ()
           (define-ftype A (endian little type))
           (define x (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
           (guard (c [#t (fptr-free x) (raise c)])
             (ftype-set! A () x 'oops)))]))
    #t)

  (error? ($dfvalerr (* float)))
  (error? ($dfvalerr integer-8))
  (error? ($dfvalerr unsigned-8))
  (error? ($dfvalerr integer-16))
  (error? ($dfvalerr unsigned-16))
  (error? ($dfvalerr integer-32))
  (error? ($dfvalerr unsigned-32))
  (error? ($dfvalerr integer-64))
  (error? ($dfvalerr unsigned-64))
  (error? ($dfvalerr double-float))
  (error? ($dfvalerr single-float))
  (error? ($dfvalerr char))
  (error? ($dfvalerr wchar))
  (error? ($dfvalerr fixnum))
  (error? ($dfvalerr iptr))
  (error? ($dfvalerr uptr))
  (error? ($dfvalerr void*))
  (error? ($dfvalerr int))
  (error? ($dfvalerr unsigned))
  (error? ($dfvalerr unsigned-int))
  (error? ($dfvalerr short))
  (error? ($dfvalerr unsigned-short))
  (error? ($dfvalerr long))
  (error? ($dfvalerr unsigned-long))
  (error? ($dfvalerr long-long))
  (error? ($dfvalerr unsigned-long-long))
  (error? ($dfvalerr double))
  (error? ($dfvalerr float))

 ; ----------------
  (begin
    (define-syntax $dfvalerr
      (syntax-rules ()
        [(_ type)
         (begin
           (with-output-to-file "testfile.ss"
             (lambda ()
               (pretty-print
                 '(let ()
                    (define-ftype A type)
                    (define x (make-ftype-pointer A 0))
                    (ftype-set! A () x 'oops))))
             'replace)
           (load "testfile.ss"))]))
    #t)

  (error? ($dfvalerr (* float)))
  (error? ($dfvalerr integer-8))
  (error? ($dfvalerr unsigned-8))
  (error? ($dfvalerr integer-16))
  (error? ($dfvalerr unsigned-16))
  (error? ($dfvalerr integer-32))
  (error? ($dfvalerr unsigned-32))
  (error? ($dfvalerr integer-64))
  (error? ($dfvalerr unsigned-64))
  (error? ($dfvalerr double-float))
  (error? ($dfvalerr single-float))
  (error? ($dfvalerr char))
  (error? ($dfvalerr wchar))
  (error? ($dfvalerr fixnum))
  (error? ($dfvalerr iptr))
  (error? ($dfvalerr uptr))
  (error? ($dfvalerr void*))
  (error? ($dfvalerr int))
  (error? ($dfvalerr unsigned))
  (error? ($dfvalerr unsigned-int))
  (error? ($dfvalerr short))
  (error? ($dfvalerr unsigned-short))
  (error? ($dfvalerr long))
  (error? ($dfvalerr unsigned-long))
  (error? ($dfvalerr long-long))
  (error? ($dfvalerr unsigned-long-long))
  (error? ($dfvalerr double))
  (error? ($dfvalerr float))

 ; ----------------
  (error? ; invalid syntax
    (ftype-sizeof (struct [a int])))
  (error? ; invalid syntax
    (make-ftype-pointer (struct [a int]) 0))
  (error? ; invalid syntax
    (ftype-pointer? (struct [a int]) 0))
  (error? ; invalid syntax
    (ftype-&ref (struct [a int]) (a) x))
  (error? ; invalid syntax
    (ftype-ref (struct [a int]) (a) x))
  (error? ; invalid syntax
    (ftype-set! (struct [a int]) (a) x 0))

 ; ----------------
  (begin
    (define-ftype A (packed (struct [a char] [b int])))
    (define-ftype B (struct [a A] [b (* A)]))
    (define b (make-ftype-pointer B (foreign-alloc (ftype-sizeof B))))
    #t)

  (ftype-pointer? A (ftype-&ref B (a) b))
  (ftype-pointer? A (ftype-ref B (b) b))

  (begin
    (fptr-free b)
    #t)

 ; ----------------
 (begin
   ;; Bind a native built-in type as a normal ftype (note this fixes the endianness).
   (define-ftype integer-8 integer-8)
   (define-ftype float float)
   (define-ftype S (struct [i integer-8] [f float]))
   #t)
 (let ([int-fptr (make-ftype-pointer integer-8 (foreign-alloc (ftype-sizeof integer-8)))]
       [flo-fptr (make-ftype-pointer float (foreign-alloc (ftype-sizeof float)))]
       [s-fptr (make-ftype-pointer S (foreign-alloc (ftype-sizeof S)))])
   (ftype-set! integer-8 () int-fptr 42)
   (ftype-set! float () flo-fptr 7.125)
   (ftype-set! S (i) s-fptr 75)
   (ftype-set! S (f) s-fptr 8.25)
   (let ([a (ftype-ref integer-8 () int-fptr)]
         [b (ftype-ref float () flo-fptr)]
         [c (ftype-ref S (i) s-fptr)]
         [d (ftype-ref S (f) s-fptr)])
     (foreign-free (ftype-pointer-address int-fptr))
     (foreign-free (ftype-pointer-address flo-fptr))
     (foreign-free (ftype-pointer-address s-fptr))
     (equal? (list a b c d) (list 42 7.125 75 8.25))))

 (begin
   ;; Show that binding does not interfere with native types.
   (define-syntax unsigned-16 (make-compile-time-value "Non-interfering binding"))
   (let ([fptr (make-ftype-pointer unsigned-16 0)])
     (= (ftype-pointer-address fptr) 0)))
)

(mat ftype-pointer-address-optimizations
  (begin
    (define-ftype A (struct (x iptr)))
    (define-ftype B (struct (x uptr)))
    (define a1 (make-ftype-pointer A 0))
    (define a1-also (make-ftype-pointer A 0))
    (define a2 (make-ftype-pointer A (+ (most-positive-fixnum) 1)))
    (define a2-also (make-ftype-pointer A (+ (most-positive-fixnum) 1)))
    #t)

  (error? (ftype-pointer-null? '()))
  (error? (ftype-pointer=? "oops" a1))
  (error? (ftype-pointer=? a1 17))

  (ftype-pointer-null? a1)
  (= (ftype-pointer-address a1) 0)
  (r6rs:= (ftype-pointer-address a1) 0)
  (eqv? (ftype-pointer-address a1) 0)
  (equal? (ftype-pointer-address a1) 0)
  (= 0 (ftype-pointer-address a1))
  (r6rs:= 0 (ftype-pointer-address a1))
  (eqv? 0 (ftype-pointer-address a1))
  (equal? 0 (ftype-pointer-address a1))
  (not (< (ftype-pointer-address a1) 0))

  (not (ftype-pointer-null? a2))
  (not (= (ftype-pointer-address a2) 0))
  (not (r6rs:= (ftype-pointer-address a2) 0))
  (not (eqv? (ftype-pointer-address a2) 0))
  (not (equal? (ftype-pointer-address a2) 0))
  (not (= 0 (ftype-pointer-address a2)))
  (not (r6rs:= 0 (ftype-pointer-address a2)))
  (not (eqv? 0 (ftype-pointer-address a2)))
  (not (equal? 0 (ftype-pointer-address a2)))
  (not (< (ftype-pointer-address a2) 0))

  (ftype-pointer=? a1 a1-also)
  (= (ftype-pointer-address a1) (ftype-pointer-address a1-also))
  (r6rs:= (ftype-pointer-address a1) (ftype-pointer-address a1-also))
  (eqv? (ftype-pointer-address a1) (ftype-pointer-address a1-also))
  (equal? (ftype-pointer-address a1) (ftype-pointer-address a1-also))
  (ftype-pointer=? a2 a2-also)
  (= (ftype-pointer-address a2) (ftype-pointer-address a2-also))
  (r6rs:= (ftype-pointer-address a2) (ftype-pointer-address a2-also))
  (eqv? (ftype-pointer-address a2) (ftype-pointer-address a2-also))
  (equal? (ftype-pointer-address a2) (ftype-pointer-address a2-also))
  (not (ftype-pointer=? a1 a2))
  (not (= (ftype-pointer-address a2) (ftype-pointer-address a1)))
  (not (r6rs:= (ftype-pointer-address a2) (ftype-pointer-address a1)))
  (not (eqv? (ftype-pointer-address a2) (ftype-pointer-address a1)))
  (not (equal? (ftype-pointer-address a2) (ftype-pointer-address a1)))

  (begin
    (define $f1
      (lambda (a)
        (ftype-pointer-null? a)))
    (define $f2a
      (lambda (a)
        (#%= (#3%ftype-pointer-address a1) 0)))
    (define $f2b
      (lambda (a)
        (#%r6rs:= (#3%ftype-pointer-address a1) 0)))
    (define $f3
      (lambda (a)
        (#%eqv? (#3%ftype-pointer-address a) 0)))
    (define $f4
      (lambda (a)
        (#%equal? (#3%ftype-pointer-address a) 0)))
    (define $f5a
      (lambda (a)
        (#%= 0 (#3%ftype-pointer-address a))))
    (define $f5b
      (lambda (a)
        (#%r6rs:= 0 (#3%ftype-pointer-address a))))
    (define $f6
      (lambda (a)
        (#%eqv? 0 (#3%ftype-pointer-address a))))
    (define $f7
      (lambda (a)
        (#%equal? 0 (#3%ftype-pointer-address a))))
    (define $f8
      (lambda (a b)
        (ftype-pointer=? a b)))
    (define $f9a
      (lambda (a b)
        (#%= (#3%ftype-pointer-address b) (#3%ftype-pointer-address a))))
    (define $f9b
      (lambda (a b)
        (#%r6rs:= (#3%ftype-pointer-address b) (#3%ftype-pointer-address a))))
    (define $f10
      (lambda (a b)
        (#%eqv? (#3%ftype-pointer-address b) (#3%ftype-pointer-address a))))
    (define $f11
      (lambda (a b)
        (#%equal? (#3%ftype-pointer-address b) (#3%ftype-pointer-address a))))
    #t)

  ; check to make sure we don't allocate a bignum while checking
  (let ([s0 (statistics)])
    (do ([n 1000 (fx- n 1)])
        ((fx= n 0))
      ($f1 a1)
      ($f2a a1)
      ($f2b a1)
      ($f3 a1)
      ($f4 a1)
      ($f5a a1)
      ($f5b a1)
      ($f6 a1)
      ($f7 a1))
    (let ([s1 (statistics)])
      (<= (- (sstats-bytes s1) (sstats-bytes s0)) 1000)))

  (or (eq? (current-eval) interpret)
      (eq? (compile-profile) 'source)
      (let ([s0 (statistics)])
        (do ([n 1000 (fx- n 1)])
          ((fx= n 0))
          ($f1 a2)
          ($f2a a2)
          ($f2b a2)
          ($f3 a2)
          ($f4 a2)
          ($f5a a2)
          ($f5b a2)
          ($f6 a2)
          ($f7 a2))
        (let ([s1 (statistics)])
          (<= (- (sstats-bytes s1) (sstats-bytes s0)) 1000))))

  (let ([s0 (statistics)])
    (do ([n 1000 (fx- n 1)])
      ((fx= n 0))
      ($f8 a1-also a1)
      ($f9a a1-also a1)
      ($f9b a1-also a1)
      ($f10 a1-also a1)
      ($f11 a1-also a1))
    (let ([s1 (statistics)])
      (<= (- (sstats-bytes s1) (sstats-bytes s0)) 1000)))

  (or (eq? (current-eval) interpret)
      (eq? (compile-profile) 'source)
      (let ([s0 (statistics)])
        (do ([n 1000 (fx- n 1)])
          ((fx= n 0))
          ($f8 a1 a2)
          ($f9a a1 a2)
          ($f9b a1 a2)
          ($f10 a1 a2)
          ($f11 a1 a2))
        (let ([s1 (statistics)])
          (<= (- (sstats-bytes s1) (sstats-bytes s0)) 1000))))

  (or (eq? (current-eval) interpret)
      (eq? (compile-profile) 'source)
      (let ([s0 (statistics)])
        (do ([n 1000 (fx- n 1)])
          ((fx= n 0))
          ($f8 a2-also a2)
          ($f9a a2-also a2)
          ($f9b a2-also a2)
          ($f10 a2-also a2)
          ($f11 a2-also a2))
        (let ([s1 (statistics)])
          (<= (- (sstats-bytes s1) (sstats-bytes s0)) 1000))))

  (begin
    (define x (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
    #t)
  (begin
    (define $not-much-alloc?
      (lambda (require-cp0? p)
        (or (eq? (current-eval) interpret)
            (#%$suppress-primitive-inlining)
            (eq? (compile-profile) 'source)
            (not (= (optimize-level) 3))
            (and require-cp0? (not (enable-cp0)))
            (let ([s0 (statistics)])
              (and (let f ([n 1000])
                     (or (fx= n 0)
                         (begin
                           (let ([x (p n)]) (unless (eq? x #t) (errorf #f "p returned non-#t value ~s for n=~s" x n)))
                           (f (fx- n 1)))))
                   (let ([s1 (statistics)])
                     (<= (- (sstats-bytes s1) (sstats-bytes s0)) 1000)))))))
    #t)

  ; might should also check ftype-&ref, ftype-locked-decr!, ftype-init-lock,
  ; ftype-lock!, ftype-spin-lock!, and ftype-unlock!, plus more flavors of
  ; ftype-ref (including bit-field references) and all the others.
  ($not-much-alloc? #f
    (lambda (n)
      (ftype-set! A (x) x (fx+ n 10))
      (and (fx= (ftype-ref B (x) (make-ftype-pointer B (ftype-pointer-address x))) (fx+ n 10))
           (begin
             (ftype-set! B (x) (make-ftype-pointer B (ftype-pointer-address x)) (fx+ n 19))
             (and (fx= (ftype-ref A (x) x) (fx+ n 19))
                  (begin
                    (ftype-locked-incr! B (x) (make-ftype-pointer B (ftype-pointer-address x)))
                    (fx= (ftype-ref A (x) x) (fx+ n 20))))))))

  (begin
    (define $ftp1 (make-ftype-pointer A 0))
    (define $ftp2 (make-ftype-pointer A (+ (most-positive-fixnum) 1)))
    ; this should cost the same at o=3 whether address is a fixnum or bignum
    (define $mkftp (lambda (x) (make-ftype-pointer B (ftype-pointer-address x))))
    #t)

  (or (eq? (current-eval) interpret)
      (#%$suppress-primitive-inlining)
      (eq? (compile-profile) 'source)
      (not (= (optimize-level) 3))
      (<=
        -100
        (- (let ([s0 (statistics)])
             (ftype-pointer?
               (do ([n 100 (fx- n 1)] [x $ftp1 ($mkftp x)])
                 ((fx= n 0) x)))
             (let ([s1 (statistics)])
               (- (sstats-bytes s1) (sstats-bytes s0))))
           (let ([s0 (statistics)])
             (ftype-pointer?
               (do ([n 100 (fx- n 1)] [x $ftp2 ($mkftp x)])
                 ((fx= n 0) x)))
             (let ([s1 (statistics)])
               (- (sstats-bytes s1) (sstats-bytes s0)))))
        100))

  (begin
    (fptr-free x)
    #t)

  ($not-much-alloc? #t
    (let ()
      (define-ftype A (struct [x (array 10 int)] [y (bits [y1 unsigned 3] [y2 unsigned 12] [y3 signed 17])]))
      (define-ftype B (* A))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (define b (make-ftype-pointer B (foreign-alloc (ftype-sizeof B))))
      (lambda (n)
        (and
          (eqv? (ftype-set! B () b a) (void))
          (eqv? (ftype-set! A (x 3) a 17) (void))
          (eqv? (ftype-set! A (y y1) a 5) (void))
          (eqv? (ftype-set! A (y y2) a 2795) (void))
          (eqv? (ftype-set! A (y y3) a -9493) (void))
          (eqv? (ftype-ref A (x 3) (ftype-ref B () b)) 17)
          (eqv? (ftype-set! A (x 3) (ftype-ref B () b) 37) (void))
          (eqv? (ftype-ref A (x 3) (ftype-ref B () b)) 37)
          (eqv? (ftype-ref A (y y1) (ftype-ref B () b)) 5)
          (eqv? (ftype-ref A (y y2) (ftype-ref B () b)) 2795)
          (eqv? (ftype-ref A (y y3) (ftype-ref B () b)) -9493)
          (eqv? (ftype-set! A (y y1) (ftype-ref B () b) 6) (void))
          (eqv? (ftype-set! A (y y2) (ftype-ref B () b) 1037) (void))
          (eqv? (ftype-set! A (y y3) (ftype-ref B () b) 9493) (void))
          (eqv? (ftype-ref A (y y1) (ftype-ref B () b)) 6)
          (eqv? (ftype-ref A (y y2) (ftype-ref B () b)) 1037)
          (eqv? (ftype-ref A (y y3) (ftype-ref B () b)) 9493)))))

  ($not-much-alloc? #t
    (let ()
      (define-ftype A (struct [x (array 10 int)] [y (bits [y1 unsigned 3] [y2 unsigned 12] [y3 signed 17])]))
      (define-ftype B (* A))
      (define-ftype BB (struct [b1 char] [b2 B]))
      (define-ftype BBB (* BB))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (define bb (make-ftype-pointer BB (foreign-alloc (ftype-sizeof BB))))
      (define bbb (make-ftype-pointer BBB (foreign-alloc (ftype-sizeof BBB))))
      (lambda (n)
        (and
          (eqv? (ftype-set! BB (b2) bb a) (void))
          (eqv? (ftype-set! BBB () bbb bb) (void))
          (eqv? (ftype-set! A (x 3) a 17) (void))
          (eqv? (ftype-set! A (y y1) a 5) (void))
          (eqv? (ftype-set! A (y y2) a 2795) (void))
          (eqv? (ftype-set! A (y y3) a -9493) (void))
          (eqv? (ftype-ref A (x 3) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb)))) 17)
          (eqv? (ftype-set! A (x 3) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb))) 37) (void))
          (eqv? (ftype-ref A (x 3) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb)))) 37)
          (eqv? (ftype-ref A (y y1) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb)))) 5)
          (eqv? (ftype-ref A (y y2) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb)))) 2795)
          (eqv? (ftype-ref A (y y3) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb)))) -9493)
          (eqv? (ftype-set! A (y y1) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb))) 6) (void))
          (eqv? (ftype-set! A (y y2) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb))) 1037) (void))
          (eqv? (ftype-set! A (y y3) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb))) 9493) (void))
          (eqv? (ftype-ref A (y y1) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb)))) 6)
          (eqv? (ftype-ref A (y y2) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb)))) 1037)
          (eqv? (ftype-ref A (y y3) (ftype-ref B () (ftype-&ref BB (b2) (ftype-ref BBB () bbb)))) 9493)))))

  ($not-much-alloc? #t
    (let ()
      (define-ftype A (struct [x (array 10 int)] [y (bits [y1 unsigned 3] [y2 unsigned 12] [y3 signed 17])]))
      (define-ftype C (struct [c1 int] [c2 A]))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (define c (make-ftype-pointer C (foreign-alloc (ftype-sizeof C))))
      (lambda (n)
        (and
          (ftype-set! C (c2 x 7) c 53)
          (eqv? (ftype-ref A (x 7) (ftype-&ref C (c2) c)) 53)
          (eqv? (ftype-set! A (x 7) (ftype-&ref C (c2) c) 71) (void))
          (eqv? (ftype-ref A (x 7) (ftype-&ref C (c2) c)) 71)))))

  ($not-much-alloc? #t
    (let ()
      (define-ftype A (struct [x (array 10 int)] [y (bits [y1 unsigned 3] [y2 unsigned 12] [y3 signed 17])]))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (define a-addr (ftype-pointer-address a))
      (lambda (n)
        (and
          (eqv? (ftype-set! A (x 3) (make-ftype-pointer A (ftype-pointer-address a)) n) (void))
          (eqv? (ftype-ref A (x 3) (make-ftype-pointer A (ftype-pointer-address a))) n)
          (eqv? (ftype-set! A (x 3) (make-ftype-pointer A (ftype-pointer-address a)) (- n 3)) (void))
          (eqv? (ftype-ref A (x 3) (make-ftype-pointer A a-addr)) (- n 3))))))
    
  ($not-much-alloc? #t
    (let ()
      (define-ftype A iptr)
      (define-ftype B (* A))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (define b (make-ftype-pointer B (foreign-alloc (ftype-sizeof B))))
      (ftype-set! A () a 0)
      (ftype-set! B () b a)
      (lambda (n)
        (and
          (not (ftype-locked-incr! A () (ftype-ref B () b)))
          (ftype-locked-decr! A () (ftype-ref B () b))))))

  ($not-much-alloc? #t
    (let ()
      (define-ftype A iptr)
      (define-ftype B (* A))
      (define-ftype BB (* B))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (define b (make-ftype-pointer B (foreign-alloc (ftype-sizeof B))))
      (define bb (make-ftype-pointer BB (foreign-alloc (ftype-sizeof BB))))
      (ftype-set! A () a 0)
      (ftype-set! B () b a)
      (ftype-set! BB () bb b)
      (lambda (n)
        (and
          (eq? (ftype-spin-lock! A () (ftype-ref B () (ftype-ref BB () bb))) (void))
          (eq? (ftype-unlock! A () (ftype-ref B () (ftype-ref BB () bb))) (void))))))
  )

(mat ftype-odd
  (begin
    (define-ftype O
      (struct
        [i (struct
             [i24 integer-24]
             [i40 integer-40]
             [i48 integer-48]
             [i56 integer-56])]
        [u (struct
             [u56 unsigned-56]
             [u48 unsigned-48]
             [u40 unsigned-40]
             [u24 unsigned-24])]))
    #t)
    
  (equal?
    (let ([x (make-ftype-pointer O 0)])
      (list
        (ftype-sizeof O)
        (ftype-pointer-address (ftype-&ref O (i i24) x))
        (ftype-pointer-address (ftype-&ref O (i i40) x))
        (ftype-pointer-address (ftype-&ref O (i i48) x))
        (ftype-pointer-address (ftype-&ref O (i i56) x))
        (ftype-pointer-address (ftype-&ref O (u u56) x))
        (ftype-pointer-address (ftype-&ref O (u u48) x))
        (ftype-pointer-address (ftype-&ref O (u u40) x))
        (ftype-pointer-address (ftype-&ref O (u u24) x))))
    '(44 0 3 8 14 22 30 36 41))

  (begin
    (define o (make-ftype-pointer O (foreign-alloc (ftype-sizeof O))))
    #t)

  (begin
    (ftype-set! O (i i24) o 0)
    (ftype-set! O (i i40) o 0)
    (ftype-set! O (i i48) o 0)
    (ftype-set! O (i i56) o 0)
    (ftype-set! O (u u24) o 0)
    (ftype-set! O (u u40) o 0)
    (ftype-set! O (u u48) o 0)
    (ftype-set! O (u u56) o 0)
    (equal?
      (list 
        (ftype-ref O (i i24) o)
        (ftype-ref O (i i40) o)
        (ftype-ref O (i i48) o)
        (ftype-ref O (i i56) o)
        (ftype-ref O (u u24) o)
        (ftype-ref O (u u40) o)
        (ftype-ref O (u u48) o)
        (ftype-ref O (u u56) o))
      '(0 0 0 0 0 0 0 0)))

  (let ([n24 (- (ash 1 24) 1)]
        [n40  (- (ash 1 40) 1)]
        [n48  (- (ash 1 48) 1)]
        [n56  (- (ash 1 56) 1)])
    (ftype-set! O (i i24) o -1)
    (ftype-set! O (i i40) o -1)
    (ftype-set! O (i i48) o -1)
    (ftype-set! O (i i56) o -1)
    (ftype-set! O (u u24) o -1)
    (ftype-set! O (u u40) o -1)
    (ftype-set! O (u u48) o -1)
    (ftype-set! O (u u56) o -1)
    (equal?
      (list 
        (ftype-ref O (i i24) o)
        (ftype-ref O (i i40) o)
        (ftype-ref O (i i48) o)
        (ftype-ref O (i i56) o)
        (ftype-ref O (u u24) o)
        (ftype-ref O (u u40) o)
        (ftype-ref O (u u48) o)
        (ftype-ref O (u u56) o))
      (list -1 -1 -1 -1 n24 n40 n48 n56)))

  (let ([n24 (- (ash 1 24) 1)]
        [n40  (- (ash 1 40) 1)]
        [n48  (- (ash 1 48) 1)]
        [n56  (- (ash 1 56) 1)])
    (ftype-set! O (i i24) o n24)
    (ftype-set! O (i i40) o n40)
    (ftype-set! O (i i48) o n48)
    (ftype-set! O (i i56) o n56)
    (ftype-set! O (u u24) o n24)
    (ftype-set! O (u u40) o n40)
    (ftype-set! O (u u48) o n48)
    (ftype-set! O (u u56) o n56)
    (equal?
      (list 
        (ftype-ref O (i i24) o)
        (ftype-ref O (i i40) o)
        (ftype-ref O (i i48) o)
        (ftype-ref O (i i56) o)
        (ftype-ref O (u u24) o)
        (ftype-ref O (u u40) o)
        (ftype-ref O (u u48) o)
        (ftype-ref O (u u56) o))
      (list -1 -1 -1 -1 n24 n40 n48 n56)))

  (let ([n24 (- (ash 1 23))]
        [n40  (- (ash 1 39))]
        [n48  (- (ash 1 47))]
        [n56  (- (ash 1 55))])
    (ftype-set! O (i i24) o n24)
    (ftype-set! O (i i40) o n40)
    (ftype-set! O (i i48) o n48)
    (ftype-set! O (i i56) o n56)
    (ftype-set! O (u u24) o n24)
    (ftype-set! O (u u40) o n40)
    (ftype-set! O (u u48) o n48)
    (ftype-set! O (u u56) o n56)
    (equal?
      (list 
        (ftype-ref O (i i24) o)
        (ftype-ref O (i i40) o)
        (ftype-ref O (i i48) o)
        (ftype-ref O (i i56) o)
        (ftype-ref O (u u24) o)
        (ftype-ref O (u u40) o)
        (ftype-ref O (u u48) o)
        (ftype-ref O (u u56) o))
      (list n24 n40 n48 n56 (- n24) (- n40) (- n48) (- n56))))

  (equal?
    (ftype-pointer->sexpr o)
    '(struct
       [i (struct
            [i24 #x-800000]
            [i40 #x-8000000000]
            [i48 #x-800000000000]
            [i56 #x-80000000000000])]
       [u (struct
            [u56 #x80000000000000]
            [u48 #x800000000000]
            [u40 #x8000000000]
            [u24 #x800000])]))

  (do ([i 1000 (fx- i 1)])
      ((fx= i 0) #t)
    (let ([i24 (- (random (ash 1 24)) (ash 1 23))]
          [i40 (- (random (ash 1 40)) (ash 1 39))]
          [i48 (- (random (ash 1 48)) (ash 1 47))]
          [i56 (- (random (ash 1 56)) (ash 1 55))]
          [u24 (- (random (ash #b11 23)) (ash 1 23))]
          [u40 (- (random (ash #b11 39)) (ash 1 39))]
          [u48 (- (random (ash #b11 47)) (ash 1 47))]
          [u56 (- (random (ash #b11 55)) (ash 1 55))])
      (ftype-set! O (i i24) o i24)
      (ftype-set! O (i i40) o i40)
      (ftype-set! O (i i48) o i48)
      (ftype-set! O (i i56) o i56)
      (ftype-set! O (u u24) o u24)
      (ftype-set! O (u u40) o u40)
      (ftype-set! O (u u48) o u48)
      (ftype-set! O (u u56) o u56)
      (and
        (= (ftype-ref O (i i24) o) i24)
        (= (ftype-ref O (i i40) o) i40)
        (= (ftype-ref O (i i48) o) i48)
        (= (ftype-ref O (i i56) o) i56)
        (= (ftype-ref O (u u24) o) u24)
        (= (ftype-ref O (u u40) o) u40)
        (= (ftype-ref O (u u48) o) u48)
        (= (ftype-ref O (u u56) o) u56))))

  (do ([i 1000 (fx- i 1)])
      ((fx= i 0) #t)
    (let ([i24 (- (random (ash 1 24)) (ash 1 23))]
          [i40 (- (random (ash 1 40)) (ash 1 39))]
          [i48 (- (random (ash 1 48)) (ash 1 47))]
          [i56 (- (random (ash 1 56)) (ash 1 55))]
          [u24 (- (random (ash #b11 23)) (ash 1 23))]
          [u40 (- (random (ash #b11 39)) (ash 1 39))]
          [u48 (- (random (ash #b11 47)) (ash 1 47))]
          [u56 (- (random (ash #b11 55)) (ash 1 55))])
      (ftype-set! O (u u56) o u56)
      (ftype-set! O (u u48) o u48)
      (ftype-set! O (u u40) o u40)
      (ftype-set! O (u u24) o u24)
      (ftype-set! O (i i56) o i56)
      (ftype-set! O (i i48) o i48)
      (ftype-set! O (i i40) o i40)
      (ftype-set! O (i i24) o i24)
      (and
        (= (ftype-ref O (i i24) o) i24)
        (= (ftype-ref O (i i40) o) i40)
        (= (ftype-ref O (i i48) o) i48)
        (= (ftype-ref O (i i56) o) i56)
        (= (ftype-ref O (u u24) o) u24)
        (= (ftype-ref O (u u40) o) u40)
        (= (ftype-ref O (u u48) o) u48)
        (= (ftype-ref O (u u56) o) u56))))

  (begin
    (fptr-free o)
    #t)

 ; ----------------

  (begin
    (define-ftype O
      (packed
        ; NB: tests with this version will cause unaligned access errors on
        ; NB: machines that don't support unalinged accesses
        (struct
          [i (struct
               [i24 integer-24]
               [i40 integer-40]
               [i48 integer-48]
               [i56 integer-56])]
          [u (struct
               [u56 unsigned-56]
               [u48 unsigned-48]
               [u40 unsigned-40]
               [u24 unsigned-24])])))
    #t)
    
  (equal?
    (let ([x (make-ftype-pointer O 0)])
      (list
        (ftype-sizeof O)
        (ftype-pointer-address (ftype-&ref O (i i24) x))
        (ftype-pointer-address (ftype-&ref O (i i40) x))
        (ftype-pointer-address (ftype-&ref O (i i48) x))
        (ftype-pointer-address (ftype-&ref O (i i56) x))
        (ftype-pointer-address (ftype-&ref O (u u56) x))
        (ftype-pointer-address (ftype-&ref O (u u48) x))
        (ftype-pointer-address (ftype-&ref O (u u40) x))
        (ftype-pointer-address (ftype-&ref O (u u24) x))))
    '(42 0 3 8 14 21 28 34 39))

  (begin
    (define o (make-ftype-pointer O (foreign-alloc (ftype-sizeof O))))
    #t)

  (do ([i 1000 (fx- i 1)])
      ((fx= i 0) #t)
    (let ([i24 (- (random (ash 1 24)) (ash 1 23))]
          [i40 (- (random (ash 1 40)) (ash 1 39))]
          [i48 (- (random (ash 1 48)) (ash 1 47))]
          [i56 (- (random (ash 1 56)) (ash 1 55))]
          [u24 (- (random (ash #b11 23)) (ash 1 23))]
          [u40 (- (random (ash #b11 39)) (ash 1 39))]
          [u48 (- (random (ash #b11 47)) (ash 1 47))]
          [u56 (- (random (ash #b11 55)) (ash 1 55))])
      (ftype-set! O (i i24) o i24)
      (ftype-set! O (i i40) o i40)
      (ftype-set! O (i i48) o i48)
      (ftype-set! O (i i56) o i56)
      (ftype-set! O (u u24) o u24)
      (ftype-set! O (u u40) o u40)
      (ftype-set! O (u u48) o u48)
      (ftype-set! O (u u56) o u56)
      (and
        (= (ftype-ref O (i i24) o) i24)
        (= (ftype-ref O (i i40) o) i40)
        (= (ftype-ref O (i i48) o) i48)
        (= (ftype-ref O (i i56) o) i56)
        (= (ftype-ref O (u u24) o) u24)
        (= (ftype-ref O (u u40) o) u40)
        (= (ftype-ref O (u u48) o) u48)
        (= (ftype-ref O (u u56) o) u56))))

  (do ([i 1000 (fx- i 1)])
      ((fx= i 0) #t)
    (let ([i24 (- (random (ash 1 24)) (ash 1 23))]
          [i40 (- (random (ash 1 40)) (ash 1 39))]
          [i48 (- (random (ash 1 48)) (ash 1 47))]
          [i56 (- (random (ash 1 56)) (ash 1 55))]
          [u24 (- (random (ash #b11 23)) (ash 1 23))]
          [u40 (- (random (ash #b11 39)) (ash 1 39))]
          [u48 (- (random (ash #b11 47)) (ash 1 47))]
          [u56 (- (random (ash #b11 55)) (ash 1 55))])
      (ftype-set! O (u u56) o u56)
      (ftype-set! O (u u48) o u48)
      (ftype-set! O (u u40) o u40)
      (ftype-set! O (u u24) o u24)
      (ftype-set! O (i i56) o i56)
      (ftype-set! O (i i48) o i48)
      (ftype-set! O (i i40) o i40)
      (ftype-set! O (i i24) o i24)
      (and
        (= (ftype-ref O (i i24) o) i24)
        (= (ftype-ref O (i i40) o) i40)
        (= (ftype-ref O (i i48) o) i48)
        (= (ftype-ref O (i i56) o) i56)
        (= (ftype-ref O (u u24) o) u24)
        (= (ftype-ref O (u u40) o) u40)
        (= (ftype-ref O (u u48) o) u48)
        (= (ftype-ref O (u u56) o) u56))))

  (begin
    (fptr-free o)
    #t)
)

(mat ftype-indexing
  (begin
    (define-ftype pdouble (* double))
    (define ftype-indexing-test
      (lambda (init-array!)
        (define ls '(2.17 3.14 1.85 10.75 18.32))
        (equal?
          (let ([doubles (make-ftype-pointer double (foreign-alloc (* (ftype-sizeof double) 5)))]
                [pdoubles (make-ftype-pointer pdouble (foreign-alloc (ftype-sizeof pdouble)))])
            (ftype-set! pdouble () pdoubles doubles)
            (init-array! doubles ls)
            (let ([v (list
                       (ftype-ref double () doubles)
                       (ftype-ref double () doubles *)
                       (ftype-ref double () doubles 0)
                       (ftype-ref double () doubles 1)
                       (ftype-ref double () doubles 2)
                       (ftype-ref double () doubles 3)
                       (ftype-ref double () doubles 4)
                       (ftype-ref pdouble (*) pdoubles)
                       (ftype-ref pdouble (0) pdoubles)
                       (ftype-ref pdouble (1) pdoubles)
                       (ftype-ref pdouble (2) pdoubles)
                       (ftype-ref pdouble (3) pdoubles)
                       (ftype-ref pdouble (4) pdoubles))])
              (foreign-free (ftype-pointer-address doubles))
              (foreign-free (ftype-pointer-address pdoubles))
              v))
          `(,(car ls) ,(car ls) ,@ls ,(car ls) ,@ls))))
    #t)

  (ftype-indexing-test
    (lambda (d ls)
      (unless (null? ls)
        (let f ([dbl (car ls)] [ls (cdr ls)] [d d])
          (ftype-set! double () d dbl)
          (unless (null? ls)
            (f (car ls) (cdr ls) 
              (make-ftype-pointer double
                (+ (ftype-sizeof double)
                   (ftype-pointer-address d)))))))))
  (ftype-indexing-test
    (lambda (d ls)
      (unless (null? ls)
        (let f ([dbl (car ls)] [ls (cdr ls)] [idx 0])
          (ftype-set! double () d idx dbl)
          (unless (null? ls)
            (f (car ls) (cdr ls) (fx+ idx 1)))))))
  (ftype-indexing-test
    (lambda (d ls)
      (unless (null? ls)
        (let f ([dbl (car ls)] [ls (cdr ls)] [idx 0])
          (ftype-set! double () (ftype-&ref double () d idx) * dbl)
          (unless (null? ls)
            (f (car ls) (cdr ls) (fx+ idx 1)))))))
  (ftype-indexing-test
    (lambda (d ls)
      (unless (null? ls)
        (let ([pdbl (make-ftype-pointer pdouble (foreign-alloc (ftype-sizeof pdouble)))])
          (ftype-set! pdouble () pdbl (ftype-&ref double () d *))
          (let f ([dbl (car ls)] [ls (cdr ls)] [idx 0])
            (ftype-set! pdouble (idx) pdbl * dbl)
            (unless (null? ls)
              (f (car ls) (cdr ls) (fx+ idx 1))))))))
  (ftype-indexing-test
    (lambda (d ls)
      (unless (null? ls)
        (let ([pdbl (make-ftype-pointer pdouble (foreign-alloc (ftype-sizeof pdouble)))])
          (ftype-set! pdouble () pdbl (ftype-&ref double () d (length ls)))
          (let ([ls (reverse ls)])
            (let f ([dbl (car ls)] [ls (cdr ls)] [idx 0])
              (ftype-set! pdouble ((- -1 idx)) pdbl * dbl)
              (unless (null? ls)
                (f (car ls) (cdr ls) (fx+ idx 1)))))))))

  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double 0)])
      (ftype-&ref double () doubles 4.5)))
  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double 0)])
      (ftype-&ref double () doubles (most-positive-fixnum))))
  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double (foreign-alloc (* (ftype-sizeof double) 5)))]
          [pdoubles (make-ftype-pointer pdouble (foreign-alloc (ftype-sizeof pdouble)))])
      (ftype-set! pdouble () pdoubles doubles)
      (guard (c [#t (foreign-free (ftype-pointer-address doubles))
                    (foreign-free (ftype-pointer-address pdoubles))
                    (raise c)])
        (pretty-print (ftype-&ref pdouble ('a) pdoubles)))))
  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double 0)])
      (ftype-ref double () doubles 4.5)))
  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double 0)])
      (ftype-ref double () doubles (most-positive-fixnum))))
  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double (foreign-alloc (* (ftype-sizeof double) 5)))]
          [pdoubles (make-ftype-pointer pdouble (foreign-alloc (ftype-sizeof pdouble)))])
      (ftype-set! pdouble () pdoubles doubles)
      (guard (c [#t (foreign-free (ftype-pointer-address doubles))
                    (foreign-free (ftype-pointer-address pdoubles))
                    (raise c)])
        (pretty-print (ftype-ref pdouble ('a) pdoubles)))))
  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double 0)])
      (ftype-set! double () doubles 4.5 7.0)))
  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double 0)])
      (ftype-set! double () doubles (most-positive-fixnum) 7.0)))
  (error? ; invalid index
    (let ([doubles (make-ftype-pointer double (foreign-alloc (* (ftype-sizeof double) 5)))]
          [pdoubles (make-ftype-pointer pdouble (foreign-alloc (ftype-sizeof pdouble)))])
      (ftype-set! pdouble () pdoubles doubles)
      (guard (c [#t (foreign-free (ftype-pointer-address doubles))
                    (foreign-free (ftype-pointer-address pdoubles))
                    (raise c)])
        (pretty-print (ftype-set! pdouble ('a) pdoubles 7.0)))))

  (begin
    (define-ftype A (struct [x int] [y double]))
    (define-ftype pA (* A))
    (define ftype-indexing-test
      (lambda (init-array!)
        (define int* '(2 3 4 -5 -6))
        (define dbl* '(2.0 3.0 4.0 -5.0 -6.0))
        (let ([array (make-ftype-pointer A (foreign-alloc (* (ftype-sizeof A) (length int*))))]
              [parray (make-ftype-pointer pA (foreign-alloc (ftype-sizeof pA)))])
          (ftype-set! pA () parray array)
          (init-array! array int* dbl*)
          (let ([v (and (eqv? (ftype-ref A (x) array) (car int*))
                        (eqv? (ftype-ref A (y) array) (car dbl*))
                        (eqv? (ftype-ref A (x) array *) (car int*))
                        (eqv? (ftype-ref A (y) array *) (car dbl*))
                        (andmap
                          (lambda (int dbl i)
                            (and
                              (eqv? (ftype-ref A (x) array i) int)
                              (eqv? (ftype-ref A (y) array i) dbl)))
                          int* dbl* (enumerate int*))
                        (eqv? (ftype-ref pA (* x) parray) (car int*))
                        (eqv? (ftype-ref pA (* y) parray) (car dbl*))
                        (andmap
                          (lambda (int dbl i)
                            (and
                              (eqv? (ftype-ref pA (i x) parray) int)
                              (eqv? (ftype-ref pA (i y) parray) dbl)))
                          int* dbl* (enumerate int*)))])
            (foreign-free (ftype-pointer-address array))
            (foreign-free (ftype-pointer-address parray))
            v))))
    #t)

  (ftype-indexing-test
    (lambda (array int* dbl*)
      (unless (null? int*)
        (for-each
          (lambda (int dbl i)
            (ftype-set! A (x)
              (make-ftype-pointer A
                (+ (ftype-pointer-address array)
                   (* (ftype-sizeof A) i)))
              int)
            (ftype-set! A (y)
              (make-ftype-pointer A
                (+ (ftype-pointer-address array)
                   (* (ftype-sizeof A) i)))
              dbl))
          int* dbl* (enumerate int*)))))
  (ftype-indexing-test
    (lambda (array int* dbl*)
      (unless (null? int*)
        (for-each
          (lambda (int dbl i)
            (ftype-set! A (x) array i int)
            (ftype-set! A (y) array i dbl))
          int* dbl* (enumerate int*)))))

  ; test for source info attached to index errors
  ; ...first with invalid value for optional index subform
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A int)
            (define (foo x i) (ftype-&ref A () x i))
            (foo (make-ftype-pointer A 0) 'q))))
      'replace)
    #t)
  (error? ; invalid index q w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A int)
            (define (foo x i) (ftype-ref A () x i))
            (foo (make-ftype-pointer A 0) 'q))))
      'replace)
    #t)
  (error? ; invalid index q w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A int)
            (define (foo x i) (ftype-set! A () x i 55))
            (foo (make-ftype-pointer A 0) 'q))))
      'replace)
    #t)
  (error? ; invalid index q w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A uptr)
            (define (foo x i) (ftype-locked-incr! A () x i))
            (foo (make-ftype-pointer A 0) 'q))))
      'replace)
    #t)
  (error? ; invalid index q w/source info
    (load "testfile.ss"))

  ; now with invalid array accessor
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A (array 17 int))
            (define (foo x i) (ftype-&ref A (i) x))
            (foo (make-ftype-pointer A 0) 25))))
      'replace)
    #t)
  (error? ; invalid index 25 w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A (array 17 int))
            (define (foo x i) (ftype-ref A (i) x))
            (foo (make-ftype-pointer A 0) 25))))
      'replace)
    #t)
  (error? ; invalid index 25 w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A (array 17 int))
            (define (foo x i) (ftype-set! A (i) x 55))
            (foo (make-ftype-pointer A 0) 25))))
      'replace)
    #t)
  (error? ; invalid index 25 w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A (array 17 uptr))
            (define (foo x i) (ftype-locked-incr! A (i) x))
            (foo (make-ftype-pointer A 0) 25))))
      'replace)
    #t)
  (error? ; invalid index 25 w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A (array 17 int))
            (eval '(define (foo x i) (ftype-&ref A (i) x)))
            (foo (make-ftype-pointer A 0) 25))))
      'replace)
    #t)
  (error? ; invalid index 25 w/o source info
    (load "testfile.ss"))

  ; test for source info attached to fptr errors
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A int)
            (define (foo x) (ftype-&ref A () x))
            (foo (make-ftype-pointer double 0)))))
      'replace)
    #t)
  (error? ; ftype mismatch w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A int)
            (define (foo x) (ftype-ref A () x))
            (foo 17))))
      'replace)
    #t)
  (error? ; 17 is not an fptr w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A int)
            (define (foo x) (ftype-set! A () x 55))
            (foo (make-ftype-pointer double 0)))))
      'replace)
    #t)
  (error? ; ftype mismatch w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A int)
            (define (foo x y) (ftype-set! A () x y))
            (foo (make-ftype-pointer A 0) (make-ftype-pointer double 0)))))
      'replace)
    #t)
  (error? ; ftype mismatch w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A uptr)
            (define (foo x) (ftype-locked-incr! A () x))
            (foo 17))))
      'replace)
    #t)
  (error? ; 17 is not an fptr w/source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A uptr)
            (eval '(define (foo x) (ftype-locked-incr! A () x)))
            (foo 17))))
      'replace)
    #t)
  (error? ; 17 is not an fptr w/o source info
    (load "testfile.ss"))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((define-ftype A (* uptr))
            (define (foo x n) (ftype-ref A (n) x))
            (define x (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
            (define y (make-ftype-pointer uptr (foreign-alloc (ftype-sizeof uptr))))
            (ftype-set! A () x y)
            (guard (c [else
                        (foreign-free (ftype-pointer-address x))
                        (foreign-free (ftype-pointer-address y))
                        (raise c)])
              (foo x 'a)))))
      'replace)
    #t)
  (error? ; invalid index a for A
    (load "testfile.ss"))
)

(mat ftype-inheritance
  (begin
    (define-ftype A (struct [a double] [b int]))
    (define-ftype Bl (endian little (struct [a double] [b int])))
    (define-ftype Bb (endian big (struct [a double] [b int])))
    (define-ftype C (union [a int] [b unsigned]))
    (define-ftype D double)
    (define-ftype Dl (endian little double))
    (define-ftype Db (endian big double))
    (define-ftype E (packed (struct [a double] [b int])))
    (define-ftype G (packed (array 5 double)))
    (define-ftype Gu (array 5 double))
    (define-ftype H (struct [a (endian big G)] [b int]))
    (define-ftype I (struct [a Gu] [b int]))
    (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
    (define bl (make-ftype-pointer Bl (foreign-alloc (ftype-sizeof Bl))))
    (define bb (make-ftype-pointer Bb (foreign-alloc (ftype-sizeof Bb))))
    (define c (make-ftype-pointer C (foreign-alloc (ftype-sizeof C))))
    (define d (make-ftype-pointer D (foreign-alloc (ftype-sizeof D))))
    (define e (make-ftype-pointer E (foreign-alloc (ftype-sizeof E))))
    (define f (make-ftype-pointer double (foreign-alloc (ftype-sizeof double))))
    (define g (make-ftype-pointer G (foreign-alloc (ftype-sizeof G))))
    (define h (make-ftype-pointer H (foreign-alloc (ftype-sizeof H))))
    (define i (make-ftype-pointer I (foreign-alloc (ftype-sizeof I))))
    (ftype-set! A (a) a 3.14)
    (ftype-set! A (b) a 75)
    (ftype-set! Bl (a) bl -3.14)
    (ftype-set! Bl (b) bl -75)
    (ftype-set! Bb (a) bb -3.14)
    (ftype-set! Bb (b) bb -75)
    (ftype-set! C (a) c -750)
    (ftype-set! D () d 3.0)
    (ftype-set! E (a) e -3.1415)
    (ftype-set! E (b) e -7755)
    (ftype-set! G (0) g 88.5)
    (ftype-set! H (a 0) h 100.5)
    (ftype-set! I (a 0) i 100.5)
    (ftype-set! double () f -3.0)
    #t)

  (error? ; ftype mismatch
    (ftype-ref A (a) bl))
  (error? ; ftype mismatch
    (ftype-ref A (a) bb))
  (error? ; ftype mismatch
    (ftype-ref A (a) c))
  (error? ; ftype mismatch
    (ftype-ref A (a) d))
  (error? ; ftype mismatch
    (ftype-ref A (a) e))
  (error? ; ftype mismatch
    (ftype-ref A (a) f))

  (error? ; ftype mismatch
    (ftype-ref Bl (b) a))
  (error? ; ftype mismatch
    (ftype-ref Bl (b) c))
  (error? ; ftype mismatch
    (ftype-ref Bl (b) d))
  (error? ; ftype mismatch
    (ftype-ref Bl (b) e))
  (error? ; ftype mismatch
    (ftype-ref Bl (b) f))

  (error? ; ftype mismatch
    (ftype-set! E (a) a 0.0))
  (error? ; ftype mismatch
    (ftype-set! E (a) bl 0.0))
  (error? ; ftype mismatch
    (ftype-set! E (a) bb 0.0))
  (error? ; ftype mismatch
    (ftype-set! E (a) c 0))
  (error? ; ftype mismatch
    (ftype-set! E (a) d 0.0))
  (error? ; ftype mismatch
    (ftype-set! E (a) f 0.0))

  (error? ; ftype mismatch
    (ftype-ref int () c))
  (error? ; ftype mismatch
    (ftype-ref unsigned () c))
  (error? ; ftype mismatch
    (ftype-set! int () c 0))
  (error? ; ftype mismatch
    (ftype-set! unsigned () c 0))

  (eqv? (ftype-ref A (a) a) 3.14)
  (eqv? (ftype-ref D () a) 3.14)
  (eqv? (ftype-ref double () a) 3.14)
  (eqv? (ftype-set! D () a -3.5) (void))
  (eqv? (ftype-ref A (a) a) -3.5)
  (eqv? (ftype-set! double () a 666.6) (void))
  (eqv? (ftype-ref A (a) a) 666.6)

  (error? ; ftype mismatch
    (ftype-ref int () a))

  (eqv? (ftype-ref Bl (a) bl) -3.14)
  (or (not (eq? (native-endianness) 'little))
      (eqv? (ftype-ref D () bl) -3.14))
  (eqv? (ftype-ref Dl () bl) -3.14)
  (or (not (eq? (native-endianness) 'little))
      (eqv? (ftype-ref double () bl) -3.14))
  (error? ; invalid syntax
    (ftype-ref (endian little double) () bl))

  (eqv? (ftype-ref Bb (a) bb) -3.14)
  (or (not (eq? (native-endianness) 'big))
      (eqv? (ftype-ref D () bb) -3.14))
  (eqv? (ftype-ref Db () bb) -3.14)
  (or (not (eq? (native-endianness) 'big))
      (eqv? (ftype-ref double () bb) -3.14))
  (error? ; invalid syntax
    (ftype-ref (endian big double) () bb))

  (eqv? (ftype-ref E (a) e) -3.1415)
  (eqv? (ftype-ref D () e) -3.1415)
  (eqv? (ftype-ref double () e) -3.1415)
  (eqv? (ftype-set! D () e 3.1416) (void))
  (eqv? (ftype-ref E (a) e) 3.1416)
  (eqv? (ftype-set! double () e -3.1416) (void))
  (eqv? (ftype-ref E (a) e) -3.1416)

  (eqv? (ftype-ref G (0) g) 88.5)
  (eqv? (ftype-ref D () g) 88.5)
  (eqv? (ftype-ref double () g) 88.5)
  (eqv? (ftype-set! D () g 3.1416) (void))
  (eqv? (ftype-ref G (0) g) 3.1416)
  (eqv? (ftype-set! double () g -3.1416) (void))
  (eqv? (ftype-ref G (0) g) -3.1416)

  (eqv? (ftype-ref H (a 0) h) 100.5)
  (eqv? (ftype-ref G (0) h) 100.5)
  (eqv? (ftype-ref D () h) 100.5)
  (eqv? (ftype-ref double () h) 100.5)
  (eqv? (ftype-set! D () h 3.1416) (void))
  (eqv? (ftype-ref H (a 0) h) 3.1416)
  (eqv? (ftype-set! double () h -3.1416) (void))
  (eqv? (ftype-ref H (a 0) h) -3.1416)

  (eqv? (ftype-ref I (a 0) i) 100.5)
  (eqv? (ftype-ref Gu (0) i) 100.5)
  (eqv? (ftype-ref D () i) 100.5)
  (eqv? (ftype-ref double () i) 100.5)
  (eqv? (ftype-set! D () i 3.1416) (void))
  (eqv? (ftype-ref I (a 0) i) 3.1416)
  (eqv? (ftype-set! double () i -3.1416) (void))
  (eqv? (ftype-ref I (a 0) i) -3.1416)

  (begin
    (fptr-free a)
    (fptr-free bl)
    (fptr-free bb)
    (fptr-free c)
    (fptr-free d)
    (fptr-free e)
    (fptr-free f)
    (fptr-free g)
    (fptr-free h)
    (fptr-free i)
    #t)
)

(mat ftype-lock-operations ; also tested in thread.ms
  (begin
    (meta-cond
      [(eq? (native-endianness) 'little)
       (define-ftype swapped-iptr (endian big iptr))]
      [else
       (define-ftype swapped-iptr (endian little iptr))])
    (define-ftype A
      (struct
        [a double]
        [b wchar]
        [c uptr]
        [d float]
        [e integer-16]
        [f (struct
             (f1 iptr)
             (f2 (array 3 (union (f3a fixnum) (f3b iptr)))))]
        [g (* iptr)]
        [h swapped-iptr]))
    (define g (make-ftype-pointer iptr (foreign-alloc (ftype-sizeof iptr))))
    (define x (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
    (ftype-set! A (g) x g)
    (define $idx 2)
    #t)

  (error? ; invalid syntax
    (ftype-locked-incr!))
  (error? ; invalid syntax
    (ftype-locked-incr! A))
  (error? ; invalid syntax
    (ftype-locked-incr! A x))
  (error? ; invalid syntax
    (ftype-locked-incr! A (a . b) x))
  (error? ; not an ftype
    (ftype-locked-incr! x () x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-incr! A (a) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-incr! A (b) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-incr! A (d) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-incr! A (e) x))
  (error? ; unsupported non-base
    (ftype-locked-incr! A (f) x))
  (error? ; unsupported non-base
    (ftype-locked-incr! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-locked-incr! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-locked-incr! A (f f2 0) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-incr! A (f f2 0 f3a) x))
  (error? ; unsupported non-base
    (ftype-locked-incr! A (g) x))
  (error? ; unsupported swapped
    (ftype-locked-incr! A (h) x))

  (error? ; invalid syntax
    (ftype-locked-decr!))
  (error? ; invalid syntax
    (ftype-locked-decr! A))
  (error? ; invalid syntax
    (ftype-locked-decr! A x))
  (error? ; invalid syntax
    (ftype-locked-decr! A (a . b) x))
  (error? ; not an ftype
    (ftype-locked-decr! x () x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-decr! A (a) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-decr! A (b) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-decr! A (d) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-decr! A (e) x))
  (error? ; unsupported non-base
    (ftype-locked-decr! A (f) x))
  (error? ; unsupported non-base
    (ftype-locked-decr! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-locked-decr! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-locked-decr! A (f f2 0) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-locked-decr! A (f f2 0 f3a) x))
  (error? ; unsupported non-base
    (ftype-locked-decr! A (g) x))
  (error? ; unsupported swapped
    (ftype-locked-decr! A (h) x))

  (error? ; invalid syntax
    (ftype-init-lock!))
  (error? ; invalid syntax
    (ftype-init-lock! A))
  (error? ; invalid syntax
    (ftype-init-lock! A x))
  (error? ; invalid syntax
    (ftype-init-lock! A (a . b) x))
  (error? ; not an ftype
    (ftype-init-lock! x () x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-init-lock! A (a) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-init-lock! A (b) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-init-lock! A (d) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-init-lock! A (e) x))
  (error? ; unsupported non-base
    (ftype-init-lock! A (f) x))
  (error? ; unsupported non-base
    (ftype-init-lock! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-init-lock! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-init-lock! A (f f2 0) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-init-lock! A (f f2 0 f3a) x))
  (error? ; unsupported non-base
    (ftype-init-lock! A (g) x))
  (error? ; unsupported swapped
    (ftype-init-lock! A (h) x))

  (error? ; invalid syntax
    (ftype-lock!))
  (error? ; invalid syntax
    (ftype-lock! A))
  (error? ; invalid syntax
    (ftype-lock! A x))
  (error? ; invalid syntax
    (ftype-lock! A (a . b) x))
  (error? ; not an ftype
    (ftype-lock! x () x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-lock! A (a) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-lock! A (b) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-lock! A (d) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-lock! A (e) x))
  (error? ; unsupported non-base
    (ftype-lock! A (f) x))
  (error? ; unsupported non-base
    (ftype-lock! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-lock! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-lock! A (f f2 0) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-lock! A (f f2 0 f3a) x))
  (error? ; unsupported non-base
    (ftype-lock! A (g) x))
  (error? ; unsupported swapped
    (ftype-lock! A (h) x))

  (error? ; invalid syntax
    (ftype-spin-lock!))
  (error? ; invalid syntax
    (ftype-spin-lock! A))
  (error? ; invalid syntax
    (ftype-spin-lock! A x))
  (error? ; invalid syntax
    (ftype-spin-lock! A (a . b) x))
  (error? ; not an ftype
    (ftype-spin-lock! x () x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-spin-lock! A (a) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-spin-lock! A (b) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-spin-lock! A (d) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-spin-lock! A (e) x))
  (error? ; unsupported non-base
    (ftype-spin-lock! A (f) x))
  (error? ; unsupported non-base
    (ftype-spin-lock! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-spin-lock! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-spin-lock! A (f f2 0) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-spin-lock! A (f f2 0 f3a) x))
  (error? ; unsupported non-base
    (ftype-spin-lock! A (g) x))
  (error? ; unsupported swapped
    (ftype-spin-lock! A (h) x))

  (error? ; invalid syntax
    (ftype-unlock!))
  (error? ; invalid syntax
    (ftype-unlock! A))
  (error? ; invalid syntax
    (ftype-unlock! A x))
  (error? ; invalid syntax
    (ftype-unlock! A (a . b) x))
  (error? ; not an ftype
    (ftype-unlock! x () x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-unlock! A (a) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-unlock! A (b) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-unlock! A (d) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-unlock! A (e) x))
  (error? ; unsupported non-base
    (ftype-unlock! A (f) x))
  (error? ; unsupported non-base
    (ftype-unlock! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-unlock! A (f f2) x))
  (error? ; unsupported non-base
    (ftype-unlock! A (f f2 0) x))
  (error? ; unsupported non-integer or non-word-size
    (ftype-unlock! A (f f2 0 f3a) x))
  (error? ; unsupported non-base
    (ftype-unlock! A (g) x))
  (error? ; unsupported swapped
    (ftype-unlock! A (h) x))

  (begin
    (ftype-set! A (c) x 0)
    (ftype-set! A (f f1) x 0)
    (ftype-set! A (f f2 1 f3b) x 0)
    (ftype-set! A (f f2 $idx f3b) x 0)
    (ftype-set! A (g *) x 0)
    #t)

  (not (ftype-locked-incr! A (c) x))
  (not (ftype-locked-incr! A (f f1) x))
  (not (ftype-locked-incr! A (f f2 1 f3b) x))
  (not (ftype-locked-incr! A (f f2 $idx f3b) x))
  (not (ftype-locked-incr! A (g *) x))

  (ftype-locked-decr! A (c) x)
  (ftype-locked-decr! A (f f1) x)
  (ftype-locked-decr! A (f f2 1 f3b) x)
  (ftype-locked-decr! A (f f2 $idx f3b) x)
  (ftype-locked-decr! A (g *) x)

  (not (ftype-locked-decr! A (c) x))
  (not (ftype-locked-decr! A (f f1) x))
  (not (ftype-locked-decr! A (f f2 1 f3b) x))
  (not (ftype-locked-decr! A (f f2 $idx f3b) x))
  (not (ftype-locked-decr! A (g *) x))

  (not (ftype-locked-decr! A (c) x))
  (not (ftype-locked-decr! A (f f1) x))
  (not (ftype-locked-decr! A (f f2 1 f3b) x))
  (not (ftype-locked-decr! A (f f2 $idx f3b) x))
  (not (ftype-locked-decr! A (g *) x))

  (not (ftype-locked-incr! A (c) x))
  (not (ftype-locked-incr! A (f f1) x))
  (not (ftype-locked-incr! A (f f2 1 f3b) x))
  (not (ftype-locked-incr! A (f f2 $idx f3b) x))
  (not (ftype-locked-incr! A (g *) x))

  (ftype-locked-incr! A (c) x)
  (ftype-locked-incr! A (f f1) x)
  (ftype-locked-incr! A (f f2 1 f3b) x)
  (ftype-locked-incr! A (f f2 $idx f3b) x)
  (ftype-locked-incr! A (g *) x)

  (equal?
    (list
      (ftype-ref A (c) x)
      (ftype-ref A (f f1) x)
      (ftype-ref A (f f2 1 f3b) x)
      (ftype-ref A (f f2 $idx f3b) x)
      (ftype-ref A (g *) x))
    '(0 0 0 0 0))

  (begin
    (ftype-init-lock! A (c) x)
    (ftype-init-lock! A (f f1) x)
    (ftype-init-lock! A (f f2 1 f3b) x)
    (ftype-init-lock! A (f f2 $idx f3b) x)
    (ftype-init-lock! A (g *) x)
    #t)

  (ftype-lock! A (c) x)
  (ftype-lock! A (f f1) x)
  (ftype-lock! A (f f2 1 f3b) x)
  (ftype-lock! A (f f2 $idx f3b) x)
  (ftype-lock! A (g *) x)

  (not (ftype-lock! A (c) x))
  (not (ftype-lock! A (f f1) x))
  (not (ftype-lock! A (f f2 1 f3b) x))
  (not (ftype-lock! A (f f2 $idx f3b) x))
  (not (ftype-lock! A (g *) x))

  (eq? (ftype-unlock! A (c) x) (void))
  (eq? (ftype-unlock! A (f f1) x) (void))
  (eq? (ftype-unlock! A (f f2 1 f3b) x) (void))
  (eq? (ftype-unlock! A (f f2 $idx f3b) x) (void))
  (eq? (ftype-unlock! A (g *) x) (void))

  (eq? (ftype-spin-lock! A (c) x) (void))
  (eq? (ftype-spin-lock! A (f f1) x) (void))
  (eq? (ftype-spin-lock! A (f f2 1 f3b) x) (void))
  (eq? (ftype-spin-lock! A (f f2 $idx f3b) x) (void))
  (eq? (ftype-spin-lock! A (g *) x) (void))

  (not (ftype-lock! A (c) x))
  (not (ftype-lock! A (f f1) x))
  (not (ftype-lock! A (f f2 1 f3b) x))
  (not (ftype-lock! A (f f2 $idx f3b) x))
  (not (ftype-lock! A (g *) x))

  (begin
    (fptr-free x)
    (fptr-free g)
    #t)
)

(mat ftype-compile-file
 ; first, load from source
  (begin
    (with-output-to-file "testfile-ftype1.ss"
      (lambda ()
        (pretty-print
          '(define-ftype fcf-A (struct [a double] [b wchar])))
        (pretty-print
          '(define a (make-ftype-pointer fcf-A (foreign-alloc (ftype-sizeof fcf-A))))))
      'replace)
    (load "testfile-ftype1.ss")
    #t)

  (begin
    (ftype-set! fcf-A (a) a 3.4)
    (ftype-set! fcf-A (b) a #\$)
    #t)

  (eqv? (ftype-ref fcf-A (a) a) 3.4)
  (eqv? (ftype-ref fcf-A (b) a) #\$)
  (eqv? (ftype-ref double () a) 3.4)

 ; now try compile-file and load the object file
  (begin
    (with-output-to-file "testfile-ftype1.ss"
      (lambda ()
        (pretty-print
          '(define-ftype fcf-A (struct [a double] [b wchar])))
        (pretty-print
          '(define a (make-ftype-pointer fcf-A (foreign-alloc (ftype-sizeof fcf-A))))))
      'replace)
    (for-each separate-compile '(ftype1))
    (load "testfile-ftype1.so")
    #t)

  (begin
    (ftype-set! fcf-A (a) a 3.4)
    (ftype-set! fcf-A (b) a #\$)
    #t)

  (eqv? (ftype-ref fcf-A (a) a) 3.4)
  (eqv? (ftype-ref fcf-A (b) a) #\$)
  (eqv? (ftype-ref double () a) 3.4)

  (begin
    (define old-a a)
    (load "testfile-ftype1.so")
    #t)

  (begin
    (ftype-set! fcf-A (a) old-a 3.4)
    (ftype-set! fcf-A (b) old-a #\$)
    #t)

  (eqv? (ftype-ref fcf-A (a) old-a) 3.4)
  (eqv? (ftype-ref fcf-A (b) old-a) #\$)
  (eqv? (ftype-ref double () old-a) 3.4)

  ; check fasling of recursive ftype definitions
  (begin
    (with-output-to-file "testfile-ftype2.ss"
      (lambda ()
        (pretty-print
          '(define-ftype fcf-B
             (struct
               [data double]
               [next (* fcf-B)]))))
      'replace)
    (separate-compile "testfile-ftype2")
    (load "testfile-ftype2.so")
    #t)
  (equal?
    (ftype-pointer-ftype (make-ftype-pointer fcf-B 0))
    '(struct
       [data double]
       [next (* fcf-B)]))
  ; directly check that cyclic rtd fasl'd in okay
  (let ([ftd (record-rtd (make-ftype-pointer fcf-B 0))])
    (let ([ftd2 (caddr (cadr ((record-accessor (record-rtd ftd) 0) ftd)))])
      (eq? ((record-accessor (record-rtd ftd2) 0) ftd2) ftd)))
  ; indirectly check
  (let* ([addr (foreign-alloc (ftype-sizeof fcf-B))]
         [x (make-ftype-pointer fcf-B addr)])
    (dynamic-wind
      void
      (lambda ()
        (ftype-set! fcf-B (next) x (make-ftype-pointer fcf-B 0))
        (ftype-pointer? (ftype-ref fcf-B (next) x)))
      (lambda () (foreign-free addr))))
  ; regression test: verify that we can fasl in a cyclic ftd that's already registered on its uid
  (begin
    (mkfile "testfile-ftype3.ss"
      '(define-ftype
         [ftype3-A (* ftype3-B)]
         [ftype3-B (struct [h ftype3-A])]))
    (compile-file "testfile-ftype3")
    #t)
  (begin ; once should prove it
    (load "testfile-ftype3.so")
    (ftype-pointer? ftype3-A (make-ftype-pointer ftype3-B 0)))
  (begin ; twice for that warm fuzzy feeling
    (load "testfile-ftype3.so")
    (ftype-pointer? ftype3-A (make-ftype-pointer ftype3-B 0)))
  (begin
    (mkfile "testfile-ftype4.ss"
      '(define-ftype
         [ftype4-A (struct [q (* ftype4-B)])]
         [ftype4-B (struct [h (* ftype4-A)])]))
    (compile-file "testfile-ftype4")
    #t)
  (begin ; once should prove it
    (load "testfile-ftype4.so")
      (ftype-pointer? ftype4-A (make-ftype-pointer ftype4-A 0)))
  (begin ; twice for that warm fuzzy feeling
    (load "testfile-ftype4.so")
    (ftype-pointer? ftype4-B (make-ftype-pointer ftype4-B 0)))
  (begin
    (mkfile "testfile-ftype5.ss"
      '(define-ftype
         [ftype5-A (struct [q (* ftype4-A)])]))
    (compile-file "testfile-ftype5")
    #t)
  (begin
    (load "testfile-ftype5.so")
    (ftype-pointer? ftype5-A (make-ftype-pointer ftype5-A 0)))
)

(mat ftype-bits
  (begin
    (define z (make-ftype-pointer unsigned-32 (foreign-alloc (ftype-sizeof unsigned-32))))
    (ftype-set! unsigned-32 () z #b101101011010111010)
    #t)

  (equal?
    (list 
      (#%$fptr-ref-bits 'unsigned-32 #f #f z 0 0 4)
      (#%$fptr-ref-bits 'unsigned-32 #f #f z 0 0 5)
      (#%$fptr-ref-bits 'unsigned-32 #f #f z 0 0 6)
      (#%$fptr-ref-bits 'unsigned-32 #f #f z 0 0 7)
      (#%$fptr-ref-bits 'unsigned-32 #f #f z 0 1 7)
      (#%$fptr-ref-bits 'unsigned-32 #f #f z 0 1 6))
    '(10 26 58 58 29 29))

  (equal?
    (list 
      (#%$fptr-ref-bits 'unsigned-32 #f #t z 0 0 4)
      (#%$fptr-ref-bits 'unsigned-32 #f #t z 0 0 5)
      (#%$fptr-ref-bits 'unsigned-32 #f #t z 0 0 6)
      (#%$fptr-ref-bits 'unsigned-32 #f #t z 0 0 7)
      (#%$fptr-ref-bits 'unsigned-32 #f #t z 0 1 7)
      (#%$fptr-ref-bits 'unsigned-32 #f #t z 0 1 6))
    '(-6 -6 -6 58 29 -3))

  (begin
    (#%$fptr-set-bits! 'unsigned-32 #f z 0 1 6 5)
    (#%$fptr-set-bits! 'unsigned-32 #f z 0 6 10 -3)
    (#%$fptr-set-bits! 'unsigned-32 #f z 0 10 15 10)
    #t)

  (equal?
    (list
      (#%$fptr-ref-bits 'unsigned-32 #f #f z 0 1 6)
      (#%$fptr-ref-bits 'unsigned-32 #f #t z 0 6 10)
      (#%$fptr-ref-bits 'unsigned-32 #f #t z 0 10 15))
    '(5 -3 10))

  (begin
    (fptr-free z)
    #t)

 ; ----------------
  (begin
    (define-ftype Bbits
      (endian little
        (union
          [a1 (struct
                [a1 unsigned-16]
                [a2 unsigned-8]
                [a3 unsigned-64]
                [a4 unsigned-32])]
          [a2 (struct
                [a1 (bits
                      [a1 signed 1]
                      [a2 signed 15])]
                [a2 (bits
                      [a1 signed 3]
                      [a2 signed 5])]
                [a3 (bits
                      [a1 signed 50]
                      [a2 signed 14])]
                [a4 (bits
                      [a1 signed 19]
                      [a2 signed 13])])]
          [a3 (struct
                [a1 (bits
                      [a1 unsigned 1]
                      [a2 unsigned 15])]
                [a2 (bits
                      [a1 unsigned 3]
                      [a2 unsigned 5])]
                [a3 (bits
                      [a1 unsigned 50]
                      [a2 unsigned 14])]
                [a4 (bits
                      [a1 unsigned 19]
                      [a2 unsigned 13])])])))
    (define x (make-ftype-pointer Bbits (foreign-alloc (ftype-sizeof Bbits))))
    #t)

  (error? ;; invalid value 113886 for bit field of size 1
    (ftype-set! Bbits (a2 a1 a1) x #x1bcde))

  (error? ;; invalid value #\a for bit field of size 3
    (ftype-set! Bbits (a2 a2 a1) x #\a))

  (error? ;; invalid value oops for bit field of size 14
    (ftype-set! Bbits (a3 a3 a2) x 'oops))

  (begin
    (ftype-set! Bbits (a1 a1) x #xabce)
    (ftype-set! Bbits (a1 a2) x #xde)
    (ftype-set! Bbits (a1 a3) x #xf9357c18d679e35b)
    (ftype-set! Bbits (a1 a4) x #x7c18d679)
    #t)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) #x0)
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (- #x55e7 (expt 2 15)))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (- #x6 (expt 2 3)))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (- #x1b (expt 2 5)))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) #x17c18d679e35b)
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (- #x3e4d (expt 2 14)))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) #xd679)
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) #xf83)

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) #x0)
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) #x55e7)
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) #x6)
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) #x1b)
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) #x17c18d679e35b)
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) #x3e4d)
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) #xd679)
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) #xf83)

  (begin
    (ftype-set! Bbits (a1 a1) x #x7c7c)
    (ftype-set! Bbits (a1 a2) x #xa8)
    (ftype-set! Bbits (a1 a3) x #x3b3b3b3b3b3b3b3b)
    (ftype-set! Bbits (a1 a4) x #x91919191)
    #t)

  (begin
    (ftype-set! Bbits (a2 a1 a1) x #x-1)
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) #x7c7d)

  (begin
    (ftype-set! Bbits (a2 a1 a1) x #x0)
    (ftype-set! Bbits (a2 a1 a2) x (- #x55e7 (expt 2 15)))
    (ftype-set! Bbits (a2 a2 a1) x (- #x6 (expt 2 3)))
    (ftype-set! Bbits (a2 a2 a2) x (- #x1b (expt 2 5)))
    (ftype-set! Bbits (a2 a3 a1) x #x17c18d679e35b)
    (ftype-set! Bbits (a2 a3 a2) x (- #x3e4d (expt 2 14)))
    (ftype-set! Bbits (a2 a4 a1) x #xd679)
    (ftype-set! Bbits (a2 a4 a2) x #xf83)
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) #xabce)
  (eqv? (ftype-ref Bbits (a1 a2) x) #xde)
  (eqv? (ftype-ref Bbits (a1 a3) x) #xf9357c18d679e35b)
  (eqv? (ftype-ref Bbits (a1 a4) x) #x7c18d679)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) #x0)
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (- #x55e7 (expt 2 15)))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (- #x6 (expt 2 3)))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (- #x1b (expt 2 5)))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) #x17c18d679e35b)
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (- #x3e4d (expt 2 14)))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) #xd679)
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) #xf83)

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) #x0)
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) #x55e7)
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) #x6)
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) #x1b)
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) #x17c18d679e35b)
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) #x3e4d)
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) #xd679)
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) #xf83)

  (begin
    (ftype-set! Bbits (a1 a1) x #xc7c7)
    (ftype-set! Bbits (a1 a2) x #xa8)
    (ftype-set! Bbits (a1 a3) x #x3b3b3b3b3b3b3b3b)
    (ftype-set! Bbits (a1 a4) x #x91919191)
    #t)

  (begin
    (ftype-set! Bbits (a3 a1 a1) x #x0)
    (ftype-set! Bbits (a3 a1 a2) x #x55e7)
    (ftype-set! Bbits (a3 a2 a1) x #x6)
    (ftype-set! Bbits (a3 a2 a2) x #x1b)
    (ftype-set! Bbits (a3 a3 a1) x #x17c18d679e35b)
    (ftype-set! Bbits (a3 a3 a2) x #x3e4d)
    (ftype-set! Bbits (a3 a4 a1) x #xd679)
    (ftype-set! Bbits (a3 a4 a2) x #xf83)
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) #xabce)
  (eqv? (ftype-ref Bbits (a1 a2) x) #xde)
  (eqv? (ftype-ref Bbits (a1 a3) x) #xf9357c18d679e35b)
  (eqv? (ftype-ref Bbits (a1 a4) x) #x7c18d679)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) #x0)
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (- #x55e7 (expt 2 15)))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (- #x6 (expt 2 3)))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (- #x1b (expt 2 5)))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) #x17c18d679e35b)
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (- #x3e4d (expt 2 14)))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) #xd679)
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) #xf83)

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) #x0)
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) #x55e7)
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) #x6)
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) #x1b)
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) #x17c18d679e35b)
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) #x3e4d)
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) #xd679)
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) #xf83)

  (begin
    (fptr-free x)
    #t)

 ; ----------------

  (begin
    (define-ftype Ebits (bits [x signed 32]))
    (define ebits (make-ftype-pointer Ebits 0))
    #t)

  (error? ;; invalid value oops for type bit-field
    (ftype-set! Ebits (x) ebits 'oops))

  (error? ;; invalid value <int> for type bit-field
    (ftype-set! Ebits (x) ebits (expt 2 32)))

 ; ----------------
  (begin
    (define-ftype Bbits
      (endian big
        (union
          [a1 (struct
                [a1 unsigned-16]
                [a2 unsigned-8]
                [a3 unsigned-64]
                [a4 unsigned-32])]
          [a2 (struct
                [a1 (bits
                      [a1 signed 1]
                      [a2 signed 15])]
                [a2 (bits
                      [a1 signed 3]
                      [a2 signed 5])]
                [a3 (bits
                      [a1 signed 50]
                      [a2 signed 14])]
                [a4 (bits
                      [a1 signed 19]
                      [a2 signed 13])])]
          [a3 (struct
                [a1 (bits
                      [a1 unsigned 1]
                      [a2 unsigned 15])]
                [a2 (bits
                      [a1 unsigned 3]
                      [a2 unsigned 5])]
                [a3 (bits
                      [a1 unsigned 50]
                      [a2 unsigned 14])]
                [a4 (bits
                      [a1 unsigned 19]
                      [a2 unsigned 13])])])))
    (define x (make-ftype-pointer Bbits (foreign-alloc (ftype-sizeof Bbits))))
    #t)

  (begin
    (ftype-set! Bbits (a1 a1) x #xabce)
    (ftype-set! Bbits (a1 a2) x #xde)
    (ftype-set! Bbits (a1 a3) x #xf9357c18d679e35b)
    (ftype-set! Bbits (a1 a4) x #x7c18d679)
    #t)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) -1)
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) #x2bce)
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (- #x6 (expt 2 3)))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (- #x1e (expt 2 5)))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (- #x3e4d5f06359e7 (expt 2 50)))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (- #x235b (expt 2 14)))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) #x3e0c6)
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (- #x1679 (expt 2 13)))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) 1)
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) #x2bce)
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) #x6)
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) #x1e)
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) #x3e4d5f06359e7)
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) #x235b)
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) #x3e0c6)
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) #x1679)

  (begin
    (ftype-set! Bbits (a1 a1) x #x7c7c)
    (ftype-set! Bbits (a1 a2) x #xa8)
    (ftype-set! Bbits (a1 a3) x #x3b3b3b3b3b3b3b3b)
    (ftype-set! Bbits (a1 a4) x #x91919191)
    #t)

  (begin
    (ftype-set! Bbits (a2 a1 a1) x -1)
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) #xfc7c)

  (begin
    (ftype-set! Bbits (a2 a1 a1) x -1)
    (ftype-set! Bbits (a2 a1 a2) x #x2bce)
    (ftype-set! Bbits (a2 a2 a1) x (- #x6 (expt 2 3)))
    (ftype-set! Bbits (a2 a2 a2) x (- #x1e (expt 2 5)))
    (ftype-set! Bbits (a2 a3 a1) x (- #x3e4d5f06359e7 (expt 2 50)))
    (ftype-set! Bbits (a2 a3 a2) x (- #x235b (expt 2 14)))
    (ftype-set! Bbits (a2 a4 a1) x #x3e0c6)
    (ftype-set! Bbits (a2 a4 a2) x (- #x1679 (expt 2 13)))
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) #xabce)
  (eqv? (ftype-ref Bbits (a1 a2) x) #xde)
  (eqv? (ftype-ref Bbits (a1 a3) x) #xf9357c18d679e35b)
  (eqv? (ftype-ref Bbits (a1 a4) x) #x7c18d679)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) -1)
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) #x2bce)
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (- #x6 (expt 2 3)))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (- #x1e (expt 2 5)))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (- #x3e4d5f06359e7 (expt 2 50)))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (- #x235b (expt 2 14)))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) #x3e0c6)
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (- #x1679 (expt 2 13)))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) 1)
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) #x2bce)
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) #x6)
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) #x1e)
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) #x3e4d5f06359e7)
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) #x235b)
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) #x3e0c6)
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) #x1679)

  (begin
    (ftype-set! Bbits (a1 a1) x #xc7c7)
    (ftype-set! Bbits (a1 a2) x #xa8)
    (ftype-set! Bbits (a1 a3) x #x3b3b3b3b3b3b3b3b)
    (ftype-set! Bbits (a1 a4) x #x91919191)
    #t)

  (begin
    (ftype-set! Bbits (a3 a1 a1) x 1)
    (ftype-set! Bbits (a3 a1 a2) x #x2bce)
    (ftype-set! Bbits (a3 a2 a1) x #x6)
    (ftype-set! Bbits (a3 a2 a2) x #x1e)
    (ftype-set! Bbits (a3 a3 a1) x #x3e4d5f06359e7)
    (ftype-set! Bbits (a3 a3 a2) x #x235b)
    (ftype-set! Bbits (a3 a4 a1) x #x3e0c6)
    (ftype-set! Bbits (a3 a4 a2) x #x1679)
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) #xabce)
  (eqv? (ftype-ref Bbits (a1 a2) x) #xde)
  (eqv? (ftype-ref Bbits (a1 a3) x) #xf9357c18d679e35b)
  (eqv? (ftype-ref Bbits (a1 a4) x) #x7c18d679)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) -1)
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) #x2bce)
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (- #x6 (expt 2 3)))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (- #x1e (expt 2 5)))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (- #x3e4d5f06359e7 (expt 2 50)))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (- #x235b (expt 2 14)))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) #x3e0c6)
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (- #x1679 (expt 2 13)))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) 1)
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) #x2bce)
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) #x6)
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) #x1e)
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) #x3e4d5f06359e7)
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) #x235b)
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) #x3e0c6)
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) #x1679)

  (begin
    (fptr-free x)
    #t)

 ; ----------------
  (begin
    (define-ftype Cbits
      (endian little
        (union
          [a1 (struct
                [a1 unsigned-64]
                [a2 unsigned-64]
                [a3 unsigned-64]
                [a4 unsigned-64]
                [a5 unsigned-64]
                [a6 unsigned-64]
                [a7 unsigned-64])]
          [a2 (struct
                [a1 (bits
                      [a1 signed 64])]
                [a2 (bits
                      [a1 unsigned 64])]
                [a3 (bits
                      [a1 unsigned 63]
                      [a2 signed 1])]
                [a4 (bits
                      [a1 unsigned 1]
                      [a2 signed 63])]
                [a5 (bits
                      [a1 signed 32]
                      [a2 unsigned 16]
                      [a3 signed 8]
                      [a4 unsigned 5]
                      [a5 signed 3])]
                [a6 (bits
                      [a1 unsigned 5]
                      [a2 signed 8]
                      [a3 unsigned 16]
                      [a4 signed 32]
                      [a5 signed 3])]
                [a7 (bits
                      [a1 unsigned 32]
                      [a2 signed 16]
                      [a3 unsigned 8]
                      [a4 signed 5]
                      [a5 unsigned 3])])])))
    (define x (make-ftype-pointer Cbits (foreign-alloc (ftype-sizeof Cbits))))
    #t)

  (begin
    (ftype-set! Cbits (a1 a1) x #x923456789abcdef9)
    (ftype-set! Cbits (a1 a2) x #xda3c2d784b69f01e)
    (ftype-set! Cbits (a1 a3) x #x923456789abcdef9)
    (ftype-set! Cbits (a1 a4) x #xda3c2d784b69f01e)
    (ftype-set! Cbits (a1 a5) x #x923456789abcdef9)
    (ftype-set! Cbits (a1 a6) x #xda3c2d784b69f01e)
    (ftype-set! Cbits (a1 a7) x #x923456789abcdef9)
    #t)

  (eqv? (ftype-ref Cbits (a2 a1 a1) x) (- #x923456789abcdef9 (expt 2 64)))
  (eqv? (ftype-ref Cbits (a2 a2 a1) x) #xda3c2d784b69f01e)
  (eqv? (ftype-ref Cbits (a2 a3 a1) x) #x123456789abcdef9)
  (eqv? (ftype-ref Cbits (a2 a3 a2) x) -1)
  (eqv? (ftype-ref Cbits (a2 a4 a1) x) 0)
  (eqv? (ftype-ref Cbits (a2 a4 a2) x) (- (ash #xda3c2d784b69f01e -1) (expt 2 63)))
  (eqv? (ftype-ref Cbits (a2 a5 a1) x) (- #x9abcdef9 (expt 2 32)))
  (eqv? (ftype-ref Cbits (a2 a5 a2) x) #x5678)
  (eqv? (ftype-ref Cbits (a2 a5 a3) x) #x34)
  (eqv? (ftype-ref Cbits (a2 a5 a4) x) #x12)
  (eqv? (ftype-ref Cbits (a2 a5 a5) x) #x-4)
  (eqv? (ftype-ref Cbits (a2 a6 a1) x) #x1e)
  (eqv? (ftype-ref Cbits (a2 a6 a2) x) #x-80)
  (eqv? (ftype-ref Cbits (a2 a6 a3) x) #x5b4f)
  (eqv? (ftype-ref Cbits (a2 a6 a4) x) (- #xD1E16BC2 (expt 2 32)))
  (eqv? (ftype-ref Cbits (a2 a6 a5) x) #x-2)
  (eqv? (ftype-ref Cbits (a2 a7 a1) x) #x9abcdef9)
  (eqv? (ftype-ref Cbits (a2 a7 a2) x) #x5678)
  (eqv? (ftype-ref Cbits (a2 a7 a3) x) #x34)
  (eqv? (ftype-ref Cbits (a2 a7 a4) x) (- #x12 (expt 2 5)))
  (eqv? (ftype-ref Cbits (a2 a7 a5) x) #x4)

  (begin
    (ftype-set! Cbits (a1 a1) x 0)
    (ftype-set! Cbits (a1 a2) x 0)
    (ftype-set! Cbits (a1 a3) x 0)
    (ftype-set! Cbits (a1 a4) x 0)
    (ftype-set! Cbits (a1 a5) x 0)
    (ftype-set! Cbits (a1 a6) x 0)
    (ftype-set! Cbits (a1 a7) x 0)
    #t)

  (begin
    (ftype-set! Cbits (a2 a1 a1) x (- #x923456789abcdef9 (expt 2 64)))
    (ftype-set! Cbits (a2 a2 a1) x #xda3c2d784b69f01e)
    (ftype-set! Cbits (a2 a3 a1) x #x123456789abcdef9)
    (ftype-set! Cbits (a2 a3 a2) x -1)
    (ftype-set! Cbits (a2 a4 a1) x 0)
    (ftype-set! Cbits (a2 a4 a2) x (- (ash #xda3c2d784b69f01e -1) (expt 2 63)))
    (ftype-set! Cbits (a2 a5 a1) x (- #x9abcdef9 (expt 2 32)))
    (ftype-set! Cbits (a2 a5 a2) x #x5678)
    (ftype-set! Cbits (a2 a5 a3) x #x34)
    (ftype-set! Cbits (a2 a5 a4) x #x12)
    (ftype-set! Cbits (a2 a5 a5) x #x-4)
    (ftype-set! Cbits (a2 a6 a1) x #x1e)
    (ftype-set! Cbits (a2 a6 a2) x #x-80)
    (ftype-set! Cbits (a2 a6 a3) x #x5b4f)
    (ftype-set! Cbits (a2 a6 a4) x (- #xD1E16BC2 (expt 2 32)))
    (ftype-set! Cbits (a2 a6 a5) x #x-2)
    (ftype-set! Cbits (a2 a7 a1) x #x9abcdef9)
    (ftype-set! Cbits (a2 a7 a2) x #x5678)
    (ftype-set! Cbits (a2 a7 a3) x #x34)
    (ftype-set! Cbits (a2 a7 a4) x #x12)
    (ftype-set! Cbits (a2 a7 a5) x #x4)
    #t)

  (eqv? (ftype-ref Cbits (a1 a1) x) #x923456789abcdef9)
  (eqv? (ftype-ref Cbits (a1 a2) x) #xda3c2d784b69f01e)
  (eqv? (ftype-ref Cbits (a1 a3) x) #x923456789abcdef9)
  (eqv? (ftype-ref Cbits (a1 a4) x) #xda3c2d784b69f01e)
  (eqv? (ftype-ref Cbits (a1 a5) x) #x923456789abcdef9)
  (eqv? (ftype-ref Cbits (a1 a6) x) #xda3c2d784b69f01e)
  (eqv? (ftype-ref Cbits (a1 a7) x) #x923456789abcdef9)

  (begin
    (fptr-free x)
    #t)

 ; ----------------
  (begin
    (define-ftype Cbits
      (endian big
        (union
          [a1 (struct
                [a1 unsigned-64]
                [a2 unsigned-64]
                [a3 unsigned-64]
                [a4 unsigned-64]
                [a5 unsigned-64]
                [a6 unsigned-64]
                [a7 unsigned-64])]
          [a2 (struct
                [a1 (bits
                      [a1 signed 64])]
                [a2 (bits
                      [a1 unsigned 64])]
                [a3 (bits
                      [a1 unsigned 63]
                      [a2 signed 1])]
                [a4 (bits
                      [a1 unsigned 1]
                      [a2 signed 63])]
                [a5 (bits
                      [a1 signed 32]
                      [a2 unsigned 16]
                      [a3 signed 8]
                      [a4 unsigned 5]
                      [a5 signed 3])]
                [a6 (bits
                      [a1 unsigned 5]
                      [a2 signed 8]
                      [a3 unsigned 16]
                      [a4 signed 32]
                      [a5 signed 3])]
                [a7 (bits
                      [a1 unsigned 32]
                      [a2 signed 16]
                      [a3 unsigned 8]
                      [a4 signed 5]
                      [a5 unsigned 3])])])))
    (define x (make-ftype-pointer Cbits (foreign-alloc (ftype-sizeof Cbits))))
    #t)

  (begin
    (ftype-set! Cbits (a1 a1) x #x923456789abcdef9)
    (ftype-set! Cbits (a1 a2) x #xda3c2d784b69f01e)
    (ftype-set! Cbits (a1 a3) x #x923456789abcdef9)
    (ftype-set! Cbits (a1 a4) x #xda3c2d784b69f01e)
    (ftype-set! Cbits (a1 a5) x #x923456789abcdefe)
    (ftype-set! Cbits (a1 a6) x #xda3c2d784b69f01e)
    (ftype-set! Cbits (a1 a7) x #x923456789abcdefe)
    #t)

  (eqv? (ftype-ref Cbits (a2 a1 a1) x) (- #x923456789abcdef9 (expt 2 64)))
  (eqv? (ftype-ref Cbits (a2 a2 a1) x) #xda3c2d784b69f01e)
  (eqv? (ftype-ref Cbits (a2 a3 a1) x) #x491A2B3C4D5E6F7C)
  (eqv? (ftype-ref Cbits (a2 a3 a2) x) -1)
  (eqv? (ftype-ref Cbits (a2 a4 a1) x) 1)
  (eqv? (ftype-ref Cbits (a2 a4 a2) x) (- #x5A3C2D784B69F01E (expt 2 63)))
  (eqv? (ftype-ref Cbits (a2 a5 a1) x) (- #x92345678 (expt 2 32)))
  (eqv? (ftype-ref Cbits (a2 a5 a2) x) #x9abc)
  (eqv? (ftype-ref Cbits (a2 a5 a3) x) (- #xde (expt 2 8)))
  (eqv? (ftype-ref Cbits (a2 a5 a4) x) #x1f)
  (eqv? (ftype-ref Cbits (a2 a5 a5) x) (- 6 (expt 2 3)))
  (eqv? (ftype-ref Cbits (a2 a6 a1) x) #x1b)
  (eqv? (ftype-ref Cbits (a2 a6 a2) x) #x47)
  (eqv? (ftype-ref Cbits (a2 a6 a3) x) #x85af)
  (eqv? (ftype-ref Cbits (a2 a6 a4) x) #x96d3e03)
  (eqv? (ftype-ref Cbits (a2 a6 a5) x) (- #x6 (expt 2 3)))
  (eqv? (ftype-ref Cbits (a2 a7 a1) x) #x92345678)
  (eqv? (ftype-ref Cbits (a2 a7 a2) x) (- #x9abc (expt 2 16)))
  (eqv? (ftype-ref Cbits (a2 a7 a3) x) #xde)
  (eqv? (ftype-ref Cbits (a2 a7 a4) x) (- #x1f (expt 2 5)))
  (eqv? (ftype-ref Cbits (a2 a7 a5) x) 6)

  (begin
    (ftype-set! Cbits (a1 a1) x 0)
    (ftype-set! Cbits (a1 a2) x 0)
    (ftype-set! Cbits (a1 a3) x 0)
    (ftype-set! Cbits (a1 a4) x 0)
    (ftype-set! Cbits (a1 a5) x 0)
    (ftype-set! Cbits (a1 a6) x 0)
    (ftype-set! Cbits (a1 a7) x 0)
    #t)

  (begin
    (ftype-set! Cbits (a2 a1 a1) x (- #x923456789abcdef9 (expt 2 64)))
    (ftype-set! Cbits (a2 a2 a1) x #xda3c2d784b69f01e)
    (ftype-set! Cbits (a2 a3 a1) x #x491A2B3C4D5E6F7C)
    (ftype-set! Cbits (a2 a3 a2) x -1)
    (ftype-set! Cbits (a2 a4 a1) x 1)
    (ftype-set! Cbits (a2 a4 a2) x (- #x5A3C2D784B69F01E (expt 2 63)))
    (ftype-set! Cbits (a2 a5 a1) x (- #x92345678 (expt 2 32)))
    (ftype-set! Cbits (a2 a5 a2) x #x9abc)
    (ftype-set! Cbits (a2 a5 a3) x (- #xde (expt 2 8)))
    (ftype-set! Cbits (a2 a5 a4) x #x1f)
    (ftype-set! Cbits (a2 a5 a5) x (- 6 (expt 2 3)))
    (ftype-set! Cbits (a2 a6 a1) x #x1b)
    (ftype-set! Cbits (a2 a6 a2) x #x47)
    (ftype-set! Cbits (a2 a6 a3) x #x85af)
    (ftype-set! Cbits (a2 a6 a4) x #x96d3e03)
    (ftype-set! Cbits (a2 a6 a5) x (- #x6 (expt 2 3)))
    (ftype-set! Cbits (a2 a7 a1) x #x92345678)
    (ftype-set! Cbits (a2 a7 a2) x (- #x9abc (expt 2 16)))
    (ftype-set! Cbits (a2 a7 a3) x #xde)
    (ftype-set! Cbits (a2 a7 a4) x (- #x1f (expt 2 5)))
    (ftype-set! Cbits (a2 a7 a5) x 6)
  #t)

  (eqv? (ftype-ref Cbits (a1 a1) x) #x923456789abcdef9)
  (eqv? (ftype-ref Cbits (a1 a2) x) #xda3c2d784b69f01e)
  (eqv? (ftype-ref Cbits (a1 a3) x) #x923456789abcdef9)
  (eqv? (ftype-ref Cbits (a1 a4) x) #xda3c2d784b69f01e)
  (eqv? (ftype-ref Cbits (a1 a5) x) #x923456789abcdefe)
  (eqv? (ftype-ref Cbits (a1 a6) x) #xda3c2d784b69f01e)
  (eqv? (ftype-ref Cbits (a1 a7) x) #x923456789abcdefe)

  (begin
    (fptr-free x)
    #t)
)

(mat ftype-odd-bits
  (begin
    (define-ftype Bbits
      (endian little
        (union
          [a1 (struct
                [a1 unsigned-24]
                [a2 unsigned-40]
                [a3 unsigned-56]
                [a4 unsigned-48])]
          [a2 (struct
                [a1 (bits
                      [a1 signed 1]
                      [a2 signed 23])]
                [a2 (bits
                      [a1 signed 3]
                      [a2 signed 37])]
                [a3 (bits
                      [a1 signed 42]
                      [a2 signed 14])]
                [a4 (bits
                      [a1 signed 19]
                      [a2 signed 29])])]
          [a3 (struct
                [a1 (bits
                      [a1 unsigned 1]
                      [a2 unsigned 23])]
                [a2 (bits
                      [a1 unsigned 3]
                      [a2 unsigned 37])]
                [a3 (bits
                      [a1 unsigned 42]
                      [a2 unsigned 14])]
                [a4 (bits
                      [a1 unsigned 19]
                      [a2 unsigned 29])])])))
    (define x (make-ftype-pointer Bbits (foreign-alloc (ftype-sizeof Bbits))))
    (define unsigned-bit-field
      (lambda (n start end)
        (bitwise-bit-field n start end)))
    (define signed-bit-field
      (lambda (n start end)
        (let ([n (bitwise-bit-field n start end)])
          (if (fx= (bitwise-arithmetic-shift-right n (fx- end start 1)) 0)
              n
              (- n (bitwise-arithmetic-shift-left 1 (fx- end start)))))))
    #t)

  (error? ;; invalid value 113886 for bit field of size 1
    (ftype-set! Bbits (a2 a1 a1) x #x1bcde))

  (error? ;; invalid value #\a for bit field of size 3
    (ftype-set! Bbits (a2 a2 a1) x #\a))

  (error? ;; invalid value oops for bit field of size 14
    (ftype-set! Bbits (a3 a3 a2) x 'oops))

  (begin
    (define A1 #xabcfde) 
    (define A2 #xde13752b) 
    (define A3 #xf93578d679e35b) 
    (define A4 #x7c18d679)
    #t)

  (begin
    (ftype-set! Bbits (a1 a1) x A1)
    (ftype-set! Bbits (a1 a2) x A2)
    (ftype-set! Bbits (a1 a3) x A3)
    (ftype-set! Bbits (a1 a4) x A4)
    #t)

  (equal?
    (list
      (ftype-ref Bbits (a1 a1) x)
      (ftype-ref Bbits (a1 a2) x)
      (ftype-ref Bbits (a1 a3) x)
      (ftype-ref Bbits (a1 a4) x))
    (list A1 A2 A3 A4))

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) (signed-bit-field A1 0 1))
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (signed-bit-field A1 1 24))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (signed-bit-field A2 0 3))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (signed-bit-field A2 3 40))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (signed-bit-field A3 0 42))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (signed-bit-field A3 42 56))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) (signed-bit-field A4 0 19))
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (signed-bit-field A4 19 48))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) (unsigned-bit-field A1 0 1))
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) (unsigned-bit-field A1 1 24))
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) (unsigned-bit-field A2 0 3))
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) (unsigned-bit-field A2 3 40))
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) (unsigned-bit-field A3 0 42))
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) (unsigned-bit-field A3 42 56))
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) (unsigned-bit-field A4 0 19))
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) (unsigned-bit-field A4 19 48))

  (begin
    (ftype-set! Bbits (a1 a1) x #x7c7c7c)
    (ftype-set! Bbits (a1 a2) x #xa8a8a8a8a8)
    (ftype-set! Bbits (a1 a3) x #x3b3b3b3b3b3b3b)
    (ftype-set! Bbits (a1 a4) x #x919191919191)
    #t)

  (begin
    (ftype-set! Bbits (a2 a1 a1) x #x-1)
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) #x7c7c7d)

  (begin
    (ftype-set! Bbits (a2 a1 a1) x (signed-bit-field A1 0 1))
    (ftype-set! Bbits (a2 a1 a2) x (signed-bit-field A1 1 24))
    (ftype-set! Bbits (a2 a2 a1) x (signed-bit-field A2 0 3))
    (ftype-set! Bbits (a2 a2 a2) x (signed-bit-field A2 3 40))
    (ftype-set! Bbits (a2 a3 a1) x (signed-bit-field A3 0 42))
    (ftype-set! Bbits (a2 a3 a2) x (signed-bit-field A3 42 56))
    (ftype-set! Bbits (a2 a4 a1) x (signed-bit-field A4 0 19))
    (ftype-set! Bbits (a2 a4 a2) x (signed-bit-field A4 19 48))
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) A1)
  (eqv? (ftype-ref Bbits (a1 a2) x) A2)
  (eqv? (ftype-ref Bbits (a1 a3) x) A3)
  (eqv? (ftype-ref Bbits (a1 a4) x) A4)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) (signed-bit-field A1 0 1))
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (signed-bit-field A1 1 24))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (signed-bit-field A2 0 3))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (signed-bit-field A2 3 40))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (signed-bit-field A3 0 42))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (signed-bit-field A3 42 56))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) (signed-bit-field A4 0 19))
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (signed-bit-field A4 19 48))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) (unsigned-bit-field A1 0 1))
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) (unsigned-bit-field A1 1 24))
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) (unsigned-bit-field A2 0 3))
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) (unsigned-bit-field A2 3 40))
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) (unsigned-bit-field A3 0 42))
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) (unsigned-bit-field A3 42 56))
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) (unsigned-bit-field A4 0 19))
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) (unsigned-bit-field A4 19 48))

  (begin
    (ftype-set! Bbits (a1 a1) x #x7c7c7c)
    (ftype-set! Bbits (a1 a2) x #xa8a8a8a8a8)
    (ftype-set! Bbits (a1 a3) x #x3b3b3b3b3b3b3b)
    (ftype-set! Bbits (a1 a4) x #x919191919191)
    #t)

  (begin
    (ftype-set! Bbits (a3 a1 a1) x (unsigned-bit-field A1 0 1))
    (ftype-set! Bbits (a3 a1 a2) x (unsigned-bit-field A1 1 24))
    (ftype-set! Bbits (a3 a2 a1) x (unsigned-bit-field A2 0 3))
    (ftype-set! Bbits (a3 a2 a2) x (unsigned-bit-field A2 3 40))
    (ftype-set! Bbits (a3 a3 a1) x (unsigned-bit-field A3 0 42))
    (ftype-set! Bbits (a3 a3 a2) x (unsigned-bit-field A3 42 56))
    (ftype-set! Bbits (a3 a4 a1) x (unsigned-bit-field A4 0 19))
    (ftype-set! Bbits (a3 a4 a2) x (unsigned-bit-field A4 19 48))
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) A1)
  (eqv? (ftype-ref Bbits (a1 a2) x) A2)
  (eqv? (ftype-ref Bbits (a1 a3) x) A3)
  (eqv? (ftype-ref Bbits (a1 a4) x) A4)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) (signed-bit-field A1 0 1))
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (signed-bit-field A1 1 24))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (signed-bit-field A2 0 3))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (signed-bit-field A2 3 40))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (signed-bit-field A3 0 42))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (signed-bit-field A3 42 56))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) (signed-bit-field A4 0 19))
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (signed-bit-field A4 19 48))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) (unsigned-bit-field A1 0 1))
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) (unsigned-bit-field A1 1 24))
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) (unsigned-bit-field A2 0 3))
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) (unsigned-bit-field A2 3 40))
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) (unsigned-bit-field A3 0 42))
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) (unsigned-bit-field A3 42 56))
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) (unsigned-bit-field A4 0 19))
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) (unsigned-bit-field A4 19 48))

  (begin
    (fptr-free x)
    #t)

 ; ----------------
  (begin
    (define-ftype Bbits
      (endian big
        (union
          [a1 (struct
                [a1 unsigned-24]
                [a2 unsigned-40]
                [a3 unsigned-56]
                [a4 unsigned-48])]
          [a2 (struct
                [a1 (bits
                      [a1 signed 1]
                      [a2 signed 23])]
                [a2 (bits
                      [a1 signed 3]
                      [a2 signed 37])]
                [a3 (bits
                      [a1 signed 42]
                      [a2 signed 14])]
                [a4 (bits
                      [a1 signed 19]
                      [a2 signed 29])])]
          [a3 (struct
                [a1 (bits
                      [a1 unsigned 1]
                      [a2 unsigned 23])]
                [a2 (bits
                      [a1 unsigned 3]
                      [a2 unsigned 37])]
                [a3 (bits
                      [a1 unsigned 42]
                      [a2 unsigned 14])]
                [a4 (bits
                      [a1 unsigned 19]
                      [a2 unsigned 29])])])))
    (define x (make-ftype-pointer Bbits (foreign-alloc (ftype-sizeof Bbits))))
    (define unsigned-bit-field
      (lambda (n start end)
        (bitwise-bit-field n start end)))
    (define signed-bit-field
      (lambda (n start end)
        (let ([n (bitwise-bit-field n start end)])
          (if (fx= (bitwise-arithmetic-shift-right n (fx- end start 1)) 0)
              n
              (- n (bitwise-arithmetic-shift-left 1 (fx- end start)))))))
    #t)

  (error? ;; invalid value 113886 for bit field of size 1
    (ftype-set! Bbits (a2 a1 a1) x #x1bcde))

  (error? ;; invalid value #\a for bit field of size 3
    (ftype-set! Bbits (a2 a2 a1) x #\a))

  (error? ;; invalid value oops for bit field of size 14
    (ftype-set! Bbits (a3 a3 a2) x 'oops))

  (begin
    (define A1 #xabcfde) 
    (define A2 #xde13752b) 
    (define A3 #xf93578d679e35b) 
    (define A4 #x7c18d679)
    #t)

  (begin
    (ftype-set! Bbits (a1 a1) x A1)
    (ftype-set! Bbits (a1 a2) x A2)
    (ftype-set! Bbits (a1 a3) x A3)
    (ftype-set! Bbits (a1 a4) x A4)
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) A1)
  (eqv? (ftype-ref Bbits (a1 a2) x) A2)
  (eqv? (ftype-ref Bbits (a1 a3) x) A3)
  (eqv? (ftype-ref Bbits (a1 a4) x) A4)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) (signed-bit-field A1 23 24))
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (signed-bit-field A1 0 23))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (signed-bit-field A2 37 40))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (signed-bit-field A2 0 37))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (signed-bit-field A3 14 56))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (signed-bit-field A3 0 14))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) (signed-bit-field A4 29 48))
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (signed-bit-field A4 0 29))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) (unsigned-bit-field A1 23 24))
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) (unsigned-bit-field A1 0 23))
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) (unsigned-bit-field A2 37 40))
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) (unsigned-bit-field A2 0 37))
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) (unsigned-bit-field A3 14 56))
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) (unsigned-bit-field A3 0 14))
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) (unsigned-bit-field A4 29 48))
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) (unsigned-bit-field A4 0 29))

  (begin
    (ftype-set! Bbits (a1 a1) x #x7c7c7c)
    (ftype-set! Bbits (a1 a2) x #xa8a8a8a8a8)
    (ftype-set! Bbits (a1 a3) x #x3b3b3b3b3b3b3b)
    (ftype-set! Bbits (a1 a4) x #x919191919191)
    #t)

  (begin
    (ftype-set! Bbits (a2 a1 a1) x #x-1)
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) #xfc7c7c)

  (begin
    (ftype-set! Bbits (a2 a1 a1) x (signed-bit-field A1 23 24))
    (ftype-set! Bbits (a2 a1 a2) x (signed-bit-field A1 0 23))
    (ftype-set! Bbits (a2 a2 a1) x (signed-bit-field A2 37 40))
    (ftype-set! Bbits (a2 a2 a2) x (signed-bit-field A2 0 37))
    (ftype-set! Bbits (a2 a3 a1) x (signed-bit-field A3 14 56))
    (ftype-set! Bbits (a2 a3 a2) x (signed-bit-field A3 0 14))
    (ftype-set! Bbits (a2 a4 a1) x (signed-bit-field A4 29 48))
    (ftype-set! Bbits (a2 a4 a2) x (signed-bit-field A4 0 29))
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) A1)
  (eqv? (ftype-ref Bbits (a1 a2) x) A2)
  (eqv? (ftype-ref Bbits (a1 a3) x) A3)
  (eqv? (ftype-ref Bbits (a1 a4) x) A4)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) (signed-bit-field A1 23 24))
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (signed-bit-field A1 0 23))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (signed-bit-field A2 37 40))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (signed-bit-field A2 0 37))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (signed-bit-field A3 14 56))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (signed-bit-field A3 0 14))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) (signed-bit-field A4 29 48))
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (signed-bit-field A4 0 29))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) (unsigned-bit-field A1 23 24))
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) (unsigned-bit-field A1 0 23))
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) (unsigned-bit-field A2 37 40))
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) (unsigned-bit-field A2 0 37))
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) (unsigned-bit-field A3 14 56))
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) (unsigned-bit-field A3 0 14))
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) (unsigned-bit-field A4 29 48))
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) (unsigned-bit-field A4 0 29))

  (begin
    (ftype-set! Bbits (a1 a1) x #x7c7c7c)
    (ftype-set! Bbits (a1 a2) x #xa8a8a8a8a8)
    (ftype-set! Bbits (a1 a3) x #x3b3b3b3b3b3b3b)
    (ftype-set! Bbits (a1 a4) x #x919191919191)
    #t)

  (begin
    (ftype-set! Bbits (a3 a1 a1) x (unsigned-bit-field A1 23 24))
    (ftype-set! Bbits (a3 a1 a2) x (unsigned-bit-field A1 0 23))
    (ftype-set! Bbits (a3 a2 a1) x (unsigned-bit-field A2 37 40))
    (ftype-set! Bbits (a3 a2 a2) x (unsigned-bit-field A2 0 37))
    (ftype-set! Bbits (a3 a3 a1) x (unsigned-bit-field A3 14 56))
    (ftype-set! Bbits (a3 a3 a2) x (unsigned-bit-field A3 0 14))
    (ftype-set! Bbits (a3 a4 a1) x (unsigned-bit-field A4 29 48))
    (ftype-set! Bbits (a3 a4 a2) x (unsigned-bit-field A4 0 29))
    #t)

  (eqv? (ftype-ref Bbits (a1 a1) x) A1)
  (eqv? (ftype-ref Bbits (a1 a2) x) A2)
  (eqv? (ftype-ref Bbits (a1 a3) x) A3)
  (eqv? (ftype-ref Bbits (a1 a4) x) A4)

  (eqv? (ftype-ref Bbits (a2 a1 a1) x) (signed-bit-field A1 23 24))
  (eqv? (ftype-ref Bbits (a2 a1 a2) x) (signed-bit-field A1 0 23))
  (eqv? (ftype-ref Bbits (a2 a2 a1) x) (signed-bit-field A2 37 40))
  (eqv? (ftype-ref Bbits (a2 a2 a2) x) (signed-bit-field A2 0 37))
  (eqv? (ftype-ref Bbits (a2 a3 a1) x) (signed-bit-field A3 14 56))
  (eqv? (ftype-ref Bbits (a2 a3 a2) x) (signed-bit-field A3 0 14))
  (eqv? (ftype-ref Bbits (a2 a4 a1) x) (signed-bit-field A4 29 48))
  (eqv? (ftype-ref Bbits (a2 a4 a2) x) (signed-bit-field A4 0 29))

  (eqv? (ftype-ref Bbits (a3 a1 a1) x) (unsigned-bit-field A1 23 24))
  (eqv? (ftype-ref Bbits (a3 a1 a2) x) (unsigned-bit-field A1 0 23))
  (eqv? (ftype-ref Bbits (a3 a2 a1) x) (unsigned-bit-field A2 37 40))
  (eqv? (ftype-ref Bbits (a3 a2 a2) x) (unsigned-bit-field A2 0 37))
  (eqv? (ftype-ref Bbits (a3 a3 a1) x) (unsigned-bit-field A3 14 56))
  (eqv? (ftype-ref Bbits (a3 a3 a2) x) (unsigned-bit-field A3 0 14))
  (eqv? (ftype-ref Bbits (a3 a4 a1) x) (unsigned-bit-field A4 29 48))
  (eqv? (ftype-ref Bbits (a3 a4 a2) x) (unsigned-bit-field A4 0 29))

  (begin
    (fptr-free x)
    #t)

)

(mat ftype-endian
  (equal?
    (let ()
      (define-ftype A (endian native double))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (free-after a
        (ftype-set! A () a 3.5)
        (ftype-ref A () a)))
    3.5)
  (equal?
    (let ()
      (define-ftype A (endian big double))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (free-after a
        (ftype-set! A () a 3.5)
        (ftype-ref A () a)))
    3.5)
  (equal?
    (let ()
      (define-ftype A (endian little double))
      (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
      (free-after a
        (ftype-set! A () a 3.5)
        (ftype-ref A () a)))
    3.5)
  (equal?
    (let ()
       (define-ftype A
         (endian big
           (struct
             [a1 double]
             [a2 float]
             [a3 long-long]
             [a4 unsigned-long-long]
             [a5 long]
             [a6 unsigned-long]
             [a7 int]
             [a8 unsigned]
             [a9 unsigned-int]
             [a10 short]
             [a11 unsigned-short]
             [a12 wchar]
             [a13 char]
             [a14 boolean]
             [a15 fixnum]
             [a16 iptr]
             [a17 uptr]
             [a18 void*])))
       (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
       (free-after a
         (ftype-set! A (a1) a 3.5)
         (ftype-set! A (a2) a -4.5)
         (ftype-set! A (a3) a -30000)
         (ftype-set! A (a4) a #xabcdef02)
         (ftype-set! A (a5) a -30001)
         (ftype-set! A (a6) a #xabcdef03)
         (ftype-set! A (a7) a -30002)
         (ftype-set! A (a8) a #xabcdef04)
         (ftype-set! A (a9) a #xabcdef05)
         (ftype-set! A (a10) a -30003)
         (ftype-set! A (a11) a #xab06)
         (ftype-set! A (a12) a #\a)
         (ftype-set! A (a13) a #\b)
         (ftype-set! A (a14) a 'hello)
         (ftype-set! A (a15) a (most-positive-fixnum))
         (ftype-set! A (a16) a -30004)
         (ftype-set! A (a17) a #xabcdef07)
         (ftype-set! A (a18) a 25000)
         (list
           (ftype-ref A (a1) a)
           (ftype-ref A (a2) a)
           (ftype-ref A (a3) a)
           (ftype-ref A (a4) a)
           (ftype-ref A (a5) a)
           (ftype-ref A (a6) a)
           (ftype-ref A (a7) a)
           (ftype-ref A (a8) a)
           (ftype-ref A (a9) a)
           (ftype-ref A (a10) a)
           (ftype-ref A (a11) a)
           (ftype-ref A (a12) a)
           (ftype-ref A (a13) a)
           (ftype-ref A (a14) a)
           (ftype-ref A (a15) a)
           (ftype-ref A (a16) a)
           (ftype-ref A (a17) a)
           (ftype-ref A (a18) a))))
    `(3.5
      -4.5
      -30000
      #xabcdef02
      -30001
      #xabcdef03
      -30002
      #xabcdef04
      #xabcdef05
      -30003
      #xab06
      #\a
      #\b
      #t
      ,(most-positive-fixnum)
      -30004
      #xabcdef07
      25000))
  (equal?
    (let ()
       (define-ftype A
         (endian little
           (struct
             [a1 double]
             [a2 float]
             [a3 long-long]
             [a4 unsigned-long-long]
             [a5 long]
             [a6 unsigned-long]
             [a7 int]
             [a8 unsigned]
             [a9 unsigned-int]
             [a10 short]
             [a11 unsigned-short]
             [a12 wchar]
             [a13 char]
             [a14 boolean]
             [a15 fixnum]
             [a16 iptr]
             [a17 uptr]
             [a18 void*])))
       (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
       (free-after a
         (ftype-set! A (a1) a 3.5)
         (ftype-set! A (a2) a -4.5)
         (ftype-set! A (a3) a -30000)
         (ftype-set! A (a4) a #xabcdef02)
         (ftype-set! A (a5) a -30001)
         (ftype-set! A (a6) a #xabcdef03)
         (ftype-set! A (a7) a -30002)
         (ftype-set! A (a8) a #xabcdef04)
         (ftype-set! A (a9) a #xabcdef05)
         (ftype-set! A (a10) a -30003)
         (ftype-set! A (a11) a #xab06)
         (ftype-set! A (a12) a #\a)
         (ftype-set! A (a13) a #\b)
         (ftype-set! A (a14) a 'hello)
         (ftype-set! A (a15) a (most-positive-fixnum))
         (ftype-set! A (a16) a -30004)
         (ftype-set! A (a17) a #xabcdef07)
         (ftype-set! A (a18) a 25000)
         (list
           (ftype-ref A (a1) a)
           (ftype-ref A (a2) a)
           (ftype-ref A (a3) a)
           (ftype-ref A (a4) a)
           (ftype-ref A (a5) a)
           (ftype-ref A (a6) a)
           (ftype-ref A (a7) a)
           (ftype-ref A (a8) a)
           (ftype-ref A (a9) a)
           (ftype-ref A (a10) a)
           (ftype-ref A (a11) a)
           (ftype-ref A (a12) a)
           (ftype-ref A (a13) a)
           (ftype-ref A (a14) a)
           (ftype-ref A (a15) a)
           (ftype-ref A (a16) a)
           (ftype-ref A (a17) a)
           (ftype-ref A (a18) a))))
    `(3.5
      -4.5
      -30000
      #xabcdef02
      -30001
      #xabcdef03
      -30002
      #xabcdef04
      #xabcdef05
      -30003
      #xab06
      #\a
      #\b
      #t
      ,(most-positive-fixnum)
      -30004
      #xabcdef07
      25000))
  (equal?
    (let ()
       (define-ftype A
         (endian native
           (struct
             [a1 double]
             [a2 float]
             [a3 long-long]
             [a4 unsigned-long-long]
             [a5 long]
             [a6 unsigned-long]
             [a7 int]
             [a8 unsigned]
             [a9 unsigned-int]
             [a10 short]
             [a11 unsigned-short]
             [a12 wchar]
             [a13 char]
             [a14 boolean]
             [a15 fixnum]
             [a16 iptr]
             [a17 uptr]
             [a18 void*])))
       (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
       (free-after a
         (ftype-set! A (a1) a 3.5)
         (ftype-set! A (a2) a -4.5)
         (ftype-set! A (a3) a -30000)
         (ftype-set! A (a4) a #xabcdef02)
         (ftype-set! A (a5) a -30001)
         (ftype-set! A (a6) a #xabcdef03)
         (ftype-set! A (a7) a -30002)
         (ftype-set! A (a8) a #xabcdef04)
         (ftype-set! A (a9) a #xabcdef05)
         (ftype-set! A (a10) a -30003)
         (ftype-set! A (a11) a #xab06)
         (ftype-set! A (a12) a #\a)
         (ftype-set! A (a13) a #\b)
         (ftype-set! A (a14) a 'hello)
         (ftype-set! A (a15) a (most-positive-fixnum))
         (ftype-set! A (a16) a -30004)
         (ftype-set! A (a17) a #xabcdef07)
         (ftype-set! A (a18) a 25000)
         (list
           (ftype-ref A (a1) a)
           (ftype-ref A (a2) a)
           (ftype-ref A (a3) a)
           (ftype-ref A (a4) a)
           (ftype-ref A (a5) a)
           (ftype-ref A (a6) a)
           (ftype-ref A (a7) a)
           (ftype-ref A (a8) a)
           (ftype-ref A (a9) a)
           (ftype-ref A (a10) a)
           (ftype-ref A (a11) a)
           (ftype-ref A (a12) a)
           (ftype-ref A (a13) a)
           (ftype-ref A (a14) a)
           (ftype-ref A (a15) a)
           (ftype-ref A (a16) a)
           (ftype-ref A (a17) a)
           (ftype-ref A (a18) a))))
    `(3.5
      -4.5
      -30000
      #xabcdef02
      -30001
      #xabcdef03
      -30002
      #xabcdef04
      #xabcdef05
      -30003
      #xab06
      #\a
      #\b
      #t
      ,(most-positive-fixnum)
      -30004
      #xabcdef07
      25000))

 ; ----------------
  (begin
    (define-ftype Aendian
      (union
        [a1 (endian native
              (struct
                [a1 integer-64]
                [a2 integer-32]
                [a3 integer-16]))]
        [a2 (endian big
              (struct
                [a1 integer-64]
                [a2 integer-32]
                [a3 integer-16]))]
        [a3 (endian little
              (struct
                [a1 integer-64]
                [a2 integer-32]
                [a3 integer-16]))]))
    (define x (make-ftype-pointer Aendian (foreign-alloc (ftype-sizeof Aendian))))
    (define xcheck
      (lambda (x1 x2 x3)
        (define iswap
          (lambda (k n)
            (let ([n (if (< n 0) (+ (expt 2 k) n) n)])
              (do ([i 0 (fx+ i 8)]
                   [m 0 (logor (ash m 8) (bitwise-bit-field n i (+ i 8)))])
                ((fx= i k) (if (>= m (expt 2 (- k 1))) (- m (expt 2 k)) m))))))
        (define okay?
          (let ([s1 (iswap 64 x1)] [s2 (iswap 32 x2)] [s3 (iswap 16 x3)])
            (lambda (eness)
              (and
                (equal? (ftype-ref Aendian (a1 a1) x)
                        (if (eq? eness (native-endianness)) x1 s1))
                (equal? (ftype-ref Aendian (a1 a2) x)
                        (if (eq? eness (native-endianness)) x2 s2))
                (equal? (ftype-ref Aendian (a1 a3) x)
                        (if (eq? eness (native-endianness)) x3 s3))
                (equal? (ftype-ref Aendian (a2 a1) x)
                        (if (eq? eness 'big) x1 s1))
                (equal? (ftype-ref Aendian (a2 a2) x)
                        (if (eq? eness 'big) x2 s2))
                (equal? (ftype-ref Aendian (a2 a3) x)
                        (if (eq? eness 'big) x3 s3))
                (equal? (ftype-ref Aendian (a3 a1) x)
                        (if (eq? eness 'little) x1 s1))
                (equal? (ftype-ref Aendian (a3 a2) x)
                        (if (eq? eness 'little) x2 s2))
                (equal? (ftype-ref Aendian (a3 a3) x)
                        (if (eq? eness 'little) x3 s3))))))
        (and
          (begin
            (ftype-set! Aendian (a1 a1) x x1)
            (ftype-set! Aendian (a1 a2) x x2)
            (ftype-set! Aendian (a1 a3) x x3)
            (okay? (native-endianness)))
          (begin
            (ftype-set! Aendian (a2 a1) x x1)
            (ftype-set! Aendian (a2 a2) x x2)
            (ftype-set! Aendian (a2 a3) x x3)
            (okay? 'big))
          (begin
            (ftype-set! Aendian (a3 a1) x x1)
            (ftype-set! Aendian (a3 a2) x x2)
            (ftype-set! Aendian (a3 a3) x x3)
            (okay? 'little)))))
    #t)

  (xcheck 0 0 0)
  (xcheck -1 -1 -1)
  (xcheck 15 25 35)
  (xcheck -15 -25 -35)
  (xcheck #x123456780fedcba9 #x4ca97531 #x3efa)
  (xcheck #x-123456780fedcba9 #x-4ca97531 #x-3efa)

  (begin
    (fptr-free x)
    #t)

 ; ----------------
  (begin
    (define-ftype Bendian
      (union
        [a1 (endian native
              (struct
                [a1 unsigned-64]
                [a2 unsigned-32]
                [a3 unsigned-16]))]
        [a2 (endian big
              (struct
                [a1 unsigned-64]
                [a2 unsigned-32]
                [a3 unsigned-16]))]
        [a3 (endian little
              (struct
                [a1 unsigned-64]
                [a2 unsigned-32]
                [a3 unsigned-16]))]))
    (define x (make-ftype-pointer Bendian (foreign-alloc (ftype-sizeof Bendian))))
    (define xcheck
      (lambda (x1 x2 x3)
        (define uswap
          (lambda (k n)
            (do ([i 0 (fx+ i 8)]
                 [m 0 (logor (ash m 8) (bitwise-bit-field n i (+ i 8)))])
              ((fx= i k) m))))
        (define okay?
          (let ([s1 (uswap 64 x1)] [s2 (uswap 32 x2)] [s3 (uswap 16 x3)])
            (lambda (eness)
              (and
                (equal? (ftype-ref Bendian (a1 a1) x)
                        (if (eq? eness (native-endianness)) x1 s1))
                (equal? (ftype-ref Bendian (a1 a2) x)
                        (if (eq? eness (native-endianness)) x2 s2))
                (equal? (ftype-ref Bendian (a1 a3) x)
                        (if (eq? eness (native-endianness)) x3 s3))
                (equal? (ftype-ref Bendian (a2 a1) x)
                        (if (eq? eness 'big) x1 s1))
                (equal? (ftype-ref Bendian (a2 a2) x)
                        (if (eq? eness 'big) x2 s2))
                (equal? (ftype-ref Bendian (a2 a3) x)
                        (if (eq? eness 'big) x3 s3))
                (equal? (ftype-ref Bendian (a3 a1) x)
                        (if (eq? eness 'little) x1 s1))
                (equal? (ftype-ref Bendian (a3 a2) x)
                        (if (eq? eness 'little) x2 s2))
                (equal? (ftype-ref Bendian (a3 a3) x)
                        (if (eq? eness 'little) x3 s3))))))
        (and
          (begin
            (ftype-set! Bendian (a1 a1) x x1)
            (ftype-set! Bendian (a1 a2) x x2)
            (ftype-set! Bendian (a1 a3) x x3)
            (okay? (native-endianness)))
          (begin
            (ftype-set! Bendian (a2 a1) x x1)
            (ftype-set! Bendian (a2 a2) x x2)
            (ftype-set! Bendian (a2 a3) x x3)
            (okay? 'big))
          (begin
            (ftype-set! Bendian (a3 a1) x x1)
            (ftype-set! Bendian (a3 a2) x x2)
            (ftype-set! Bendian (a3 a3) x x3)
            (okay? 'little)))))
    #t)

  (xcheck 0 0 0)
  (xcheck #xffffffffffffffff #xffffffff #xffff)
  (xcheck #x8000000000000015 #x80000025 #x8035)
  (xcheck #x123456780fedcba9 #x4ca97531 #x3efa)
  (xcheck #xf23456780fedcba9 #xdca97531 #x9efa)

  (begin
    (fptr-free x)
    #t)

 ; ----------------
  (begin
    (define-ftype Abits
      (endian little
        (union
          [a1 (struct
                [a1 unsigned-32]
                [a2 unsigned-32]
                [a3 unsigned-32]
                [a4 unsigned-32]
                [a5 unsigned-32]
                [a6 unsigned-32]
                [a7 unsigned-32]
                [a8 unsigned-32]
                [a9 unsigned-32]
                [a10 unsigned-32]
                [a11 unsigned-32]
                [a12 unsigned-32]
                [a13 unsigned-32]
                [a14 unsigned-32]
                [a15 unsigned-32]
                [a16 unsigned-32]
                [a17 unsigned-32]
                [a18 unsigned-32]
                [a19 unsigned-32]
                [a20 unsigned-32]
                [a21 unsigned-32])]
          [a2 (struct
                [a1 (bits
                      [_ signed 4]
                      [a1 signed 1]
                      [a2 signed 2]
                      [a3 signed 3]
                      [a4 signed 4]
                      [a5 signed 5]
                      [a6 signed 6]
                      [a7 signed 7])]
                [a2 (bits
                      [_ signed 5]
                      [a8 signed 8]
                      [a9 signed 9]
                      [a10 signed 10])]
                [a3 (bits
                      [a11 signed 11]
                      [a12 signed 12]
                      [_ signed 9])]
                [a4 (bits
                      [a13 signed 13]
                      [_ signed 5]
                      [a14 signed 14])]
                [a5 (bits
                      [_ signed 1]
                      [a15 signed 15]
                      [a16 signed 16])]
                [a6 (bits [a17 signed 17] [_ signed 15])]
                [a7 (bits [_ signed 14] [a18 signed 18])]
                [a8 (bits [a19 signed 19] [_ signed 13])]
                [a9 (bits [_ signed 12] [a20 signed 20])]
                [a10 (bits [a21 signed 21] [_ signed 11])]
                [a11 (bits [_ signed 10] [a22 signed 22])]
                [a12 (bits [a23 signed 23] [_ signed 9])]
                [a13 (bits [_ signed 8] [a24 signed 24])]
                [a14 (bits [a25 signed 25] [_ signed 7])]
                [a15 (bits [_ signed 6] [a26 signed 26])]
                [a16 (bits [a27 signed 27] [_ signed 5])]
                [a17 (bits [_ signed 4] [a28 signed 28])]
                [a18 (bits [a29 signed 29] [_ signed 3])]
                [a19 (bits [_ signed 2] [a30 signed 30])]
                [a20 (bits [a31 signed 31] [_ signed 1])]
                [a21 (bits [a32 signed 32])])]
          [a3 (struct
                [a1 (bits
                      [_ unsigned 4]
                      [a1 unsigned 1]
                      [a2 unsigned 2]
                      [a3 unsigned 3]
                      [a4 unsigned 4]
                      [a5 unsigned 5]
                      [a6 unsigned 6]
                      [a7 unsigned 7])]
                [a2 (bits
                      [_ unsigned 5]
                      [a8 unsigned 8]
                      [a9 unsigned 9]
                      [a10 unsigned 10])]
                [a3 (bits
                      [a11 unsigned 11]
                      [a12 unsigned 12]
                      [_ unsigned 9])]
                [a4 (bits
                      [a13 unsigned 13]
                      [_ unsigned 5]
                      [a14 unsigned 14])]
                [a5 (bits
                      [_ unsigned 1]
                      [a15 unsigned 15]
                      [a16 unsigned 16])]
                [a6 (bits [a17 unsigned 17] [_ unsigned 15])]
                [a7 (bits [_ unsigned 14] [a18 unsigned 18])]
                [a8 (bits [a19 unsigned 19] [_ unsigned 13])]
                [a9 (bits [_ unsigned 12] [a20 unsigned 20])]
                [a10 (bits [a21 unsigned 21] [_ unsigned 11])]
                [a11 (bits [_ unsigned 10] [a22 unsigned 22])]
                [a12 (bits [a23 unsigned 23] [_ unsigned 9])]
                [a13 (bits [_ unsigned 8] [a24 unsigned 24])]
                [a14 (bits [a25 unsigned 25] [_ unsigned 7])]
                [a15 (bits [_ unsigned 6] [a26 unsigned 26])]
                [a16 (bits [a27 unsigned 27] [_ unsigned 5])]
                [a17 (bits [_ unsigned 4] [a28 unsigned 28])]
                [a18 (bits [a29 unsigned 29] [_ unsigned 3])]
                [a19 (bits [_ unsigned 2] [a30 unsigned 30])]
                [a20 (bits [a31 unsigned 31] [_ unsigned 1])]
                [a21 (bits [a32 unsigned 32])])])))
    (define x (make-ftype-pointer Abits (foreign-alloc (ftype-sizeof Abits))))
    (define (get-a1)
      (list
        (ftype-ref Abits (a1 a1) x)
        (ftype-ref Abits (a1 a2) x)
        (ftype-ref Abits (a1 a3) x)
        (ftype-ref Abits (a1 a4) x)
        (ftype-ref Abits (a1 a5) x)
        (ftype-ref Abits (a1 a6) x)
        (ftype-ref Abits (a1 a7) x)
        (ftype-ref Abits (a1 a8) x)
        (ftype-ref Abits (a1 a9) x)
        (ftype-ref Abits (a1 a10) x)
        (ftype-ref Abits (a1 a11) x)
        (ftype-ref Abits (a1 a12) x)
        (ftype-ref Abits (a1 a13) x)
        (ftype-ref Abits (a1 a14) x)
        (ftype-ref Abits (a1 a15) x)
        (ftype-ref Abits (a1 a16) x)
        (ftype-ref Abits (a1 a17) x)
        (ftype-ref Abits (a1 a18) x)
        (ftype-ref Abits (a1 a19) x)
        (ftype-ref Abits (a1 a20) x)
        (ftype-ref Abits (a1 a21) x)))
    (define (get-a2)
      (list
        (ftype-ref Abits (a2 a1 a1) x)
        (ftype-ref Abits (a2 a1 a2) x)
        (ftype-ref Abits (a2 a1 a3) x)
        (ftype-ref Abits (a2 a1 a4) x)
        (ftype-ref Abits (a2 a1 a5) x)
        (ftype-ref Abits (a2 a1 a6) x)
        (ftype-ref Abits (a2 a1 a7) x)
        (ftype-ref Abits (a2 a2 a8) x)
        (ftype-ref Abits (a2 a2 a9) x)
        (ftype-ref Abits (a2 a2 a10) x)
        (ftype-ref Abits (a2 a3 a11) x)
        (ftype-ref Abits (a2 a3 a12) x)
        (ftype-ref Abits (a2 a4 a13) x)
        (ftype-ref Abits (a2 a4 a14) x)
        (ftype-ref Abits (a2 a5 a15) x)
        (ftype-ref Abits (a2 a5 a16) x)
        (ftype-ref Abits (a2 a6 a17) x)
        (ftype-ref Abits (a2 a7 a18) x)
        (ftype-ref Abits (a2 a8 a19) x)
        (ftype-ref Abits (a2 a9 a20) x)
        (ftype-ref Abits (a2 a10 a21) x)
        (ftype-ref Abits (a2 a11 a22) x)
        (ftype-ref Abits (a2 a12 a23) x)
        (ftype-ref Abits (a2 a13 a24) x)
        (ftype-ref Abits (a2 a14 a25) x)
        (ftype-ref Abits (a2 a15 a26) x)
        (ftype-ref Abits (a2 a16 a27) x)
        (ftype-ref Abits (a2 a17 a28) x)
        (ftype-ref Abits (a2 a18 a29) x)
        (ftype-ref Abits (a2 a19 a30) x)
        (ftype-ref Abits (a2 a20 a31) x)
        (ftype-ref Abits (a2 a21 a32) x)))
    (define (get-a3)
      (list
        (ftype-ref Abits (a3 a1 a1) x)
        (ftype-ref Abits (a3 a1 a2) x)
        (ftype-ref Abits (a3 a1 a3) x)
        (ftype-ref Abits (a3 a1 a4) x)
        (ftype-ref Abits (a3 a1 a5) x)
        (ftype-ref Abits (a3 a1 a6) x)
        (ftype-ref Abits (a3 a1 a7) x)
        (ftype-ref Abits (a3 a2 a8) x)
        (ftype-ref Abits (a3 a2 a9) x)
        (ftype-ref Abits (a3 a2 a10) x)
        (ftype-ref Abits (a3 a3 a11) x)
        (ftype-ref Abits (a3 a3 a12) x)
        (ftype-ref Abits (a3 a4 a13) x)
        (ftype-ref Abits (a3 a4 a14) x)
        (ftype-ref Abits (a3 a5 a15) x)
        (ftype-ref Abits (a3 a5 a16) x)
        (ftype-ref Abits (a3 a6 a17) x)
        (ftype-ref Abits (a3 a7 a18) x)
        (ftype-ref Abits (a3 a8 a19) x)
        (ftype-ref Abits (a3 a9 a20) x)
        (ftype-ref Abits (a3 a10 a21) x)
        (ftype-ref Abits (a3 a11 a22) x)
        (ftype-ref Abits (a3 a12 a23) x)
        (ftype-ref Abits (a3 a13 a24) x)
        (ftype-ref Abits (a3 a14 a25) x)
        (ftype-ref Abits (a3 a15 a26) x)
        (ftype-ref Abits (a3 a16 a27) x)
        (ftype-ref Abits (a3 a17 a28) x)
        (ftype-ref Abits (a3 a18 a29) x)
        (ftype-ref Abits (a3 a19 a30) x)
        (ftype-ref Abits (a3 a20 a31) x)
        (ftype-ref Abits (a3 a21 a32) x)))
    (define (set-a1! ls)
      (map
        (lambda (f v) (f v))
        (list
          (lambda (v) (ftype-set! Abits (a1 a1) x v))
          (lambda (v) (ftype-set! Abits (a1 a2) x v))
          (lambda (v) (ftype-set! Abits (a1 a3) x v))
          (lambda (v) (ftype-set! Abits (a1 a4) x v))
          (lambda (v) (ftype-set! Abits (a1 a5) x v))
          (lambda (v) (ftype-set! Abits (a1 a6) x v))
          (lambda (v) (ftype-set! Abits (a1 a7) x v))
          (lambda (v) (ftype-set! Abits (a1 a8) x v))
          (lambda (v) (ftype-set! Abits (a1 a9) x v))
          (lambda (v) (ftype-set! Abits (a1 a10) x v))
          (lambda (v) (ftype-set! Abits (a1 a11) x v))
          (lambda (v) (ftype-set! Abits (a1 a12) x v))
          (lambda (v) (ftype-set! Abits (a1 a13) x v))
          (lambda (v) (ftype-set! Abits (a1 a14) x v))
          (lambda (v) (ftype-set! Abits (a1 a15) x v))
          (lambda (v) (ftype-set! Abits (a1 a16) x v))
          (lambda (v) (ftype-set! Abits (a1 a17) x v))
          (lambda (v) (ftype-set! Abits (a1 a18) x v))
          (lambda (v) (ftype-set! Abits (a1 a19) x v))
          (lambda (v) (ftype-set! Abits (a1 a20) x v))
          (lambda (v) (ftype-set! Abits (a1 a21) x v)))
        ls))
    (define (set-a2! ls)
      (map
        (lambda (f v) (f v))
        (list
          (lambda (v) (ftype-set! Abits (a2 a1 a1) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a2) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a3) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a4) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a5) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a6) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a7) x v))
          (lambda (v) (ftype-set! Abits (a2 a2 a8) x v))
          (lambda (v) (ftype-set! Abits (a2 a2 a9) x v))
          (lambda (v) (ftype-set! Abits (a2 a2 a10) x v))
          (lambda (v) (ftype-set! Abits (a2 a3 a11) x v))
          (lambda (v) (ftype-set! Abits (a2 a3 a12) x v))
          (lambda (v) (ftype-set! Abits (a2 a4 a13) x v))
          (lambda (v) (ftype-set! Abits (a2 a4 a14) x v))
          (lambda (v) (ftype-set! Abits (a2 a5 a15) x v))
          (lambda (v) (ftype-set! Abits (a2 a5 a16) x v))
          (lambda (v) (ftype-set! Abits (a2 a6 a17) x v))
          (lambda (v) (ftype-set! Abits (a2 a7 a18) x v))
          (lambda (v) (ftype-set! Abits (a2 a8 a19) x v))
          (lambda (v) (ftype-set! Abits (a2 a9 a20) x v))
          (lambda (v) (ftype-set! Abits (a2 a10 a21) x v))
          (lambda (v) (ftype-set! Abits (a2 a11 a22) x v))
          (lambda (v) (ftype-set! Abits (a2 a12 a23) x v))
          (lambda (v) (ftype-set! Abits (a2 a13 a24) x v))
          (lambda (v) (ftype-set! Abits (a2 a14 a25) x v))
          (lambda (v) (ftype-set! Abits (a2 a15 a26) x v))
          (lambda (v) (ftype-set! Abits (a2 a16 a27) x v))
          (lambda (v) (ftype-set! Abits (a2 a17 a28) x v))
          (lambda (v) (ftype-set! Abits (a2 a18 a29) x v))
          (lambda (v) (ftype-set! Abits (a2 a19 a30) x v))
          (lambda (v) (ftype-set! Abits (a2 a20 a31) x v))
          (lambda (v) (ftype-set! Abits (a2 a21 a32) x v)))
        ls))
    (define (set-a3! ls)
      (map
        (lambda (f v) (f v))
        (list
          (lambda (v) (ftype-set! Abits (a3 a1 a1) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a2) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a3) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a4) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a5) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a6) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a7) x v))
          (lambda (v) (ftype-set! Abits (a3 a2 a8) x v))
          (lambda (v) (ftype-set! Abits (a3 a2 a9) x v))
          (lambda (v) (ftype-set! Abits (a3 a2 a10) x v))
          (lambda (v) (ftype-set! Abits (a3 a3 a11) x v))
          (lambda (v) (ftype-set! Abits (a3 a3 a12) x v))
          (lambda (v) (ftype-set! Abits (a3 a4 a13) x v))
          (lambda (v) (ftype-set! Abits (a3 a4 a14) x v))
          (lambda (v) (ftype-set! Abits (a3 a5 a15) x v))
          (lambda (v) (ftype-set! Abits (a3 a5 a16) x v))
          (lambda (v) (ftype-set! Abits (a3 a6 a17) x v))
          (lambda (v) (ftype-set! Abits (a3 a7 a18) x v))
          (lambda (v) (ftype-set! Abits (a3 a8 a19) x v))
          (lambda (v) (ftype-set! Abits (a3 a9 a20) x v))
          (lambda (v) (ftype-set! Abits (a3 a10 a21) x v))
          (lambda (v) (ftype-set! Abits (a3 a11 a22) x v))
          (lambda (v) (ftype-set! Abits (a3 a12 a23) x v))
          (lambda (v) (ftype-set! Abits (a3 a13 a24) x v))
          (lambda (v) (ftype-set! Abits (a3 a14 a25) x v))
          (lambda (v) (ftype-set! Abits (a3 a15 a26) x v))
          (lambda (v) (ftype-set! Abits (a3 a16 a27) x v))
          (lambda (v) (ftype-set! Abits (a3 a17 a28) x v))
          (lambda (v) (ftype-set! Abits (a3 a18 a29) x v))
          (lambda (v) (ftype-set! Abits (a3 a19 a30) x v))
          (lambda (v) (ftype-set! Abits (a3 a20 a31) x v))
          (lambda (v) (ftype-set! Abits (a3 a21 a32) x v)))
        ls))
    (define a3-c7c7c7c7
      '(#b0
        #b10
        #b111
        #b0001
        #b11111
        #b111000
        #b1100011
        #b00111110
        #b000111110
        #b1100011111
        #b11111000111
        #b100011111000
        #b0011111000111
        #b11000111110001
        #b110001111100011
        #b1100011111000111
        #b11100011111000111
        #b110001111100011111
        #b1111100011111000111
        #b11000111110001111100
        #b001111100011111000111
        #b1100011111000111110001
        #b10001111100011111000111
        #b110001111100011111000111
        #b1110001111100011111000111
        #b11000111110001111100011111
        #b111110001111100011111000111
        #b1100011111000111110001111100
        #b00111110001111100011111000111
        #b110001111100011111000111110001
        #b1000111110001111100011111000111
        #b11000111110001111100011111000111))
    (define a3-13579bdf
      '(#b1
        #b10
        #b111
        #b0110
        #b11110
        #b101010
        #b0001001
        #b11011110
        #b010111100
        #b0001001101
        #b01111011111
        #b101011110011
        #b1101111011111
        #b00010011010101
        #b100110111101111
        #b0001001101010111
        #b11001101111011111
        #b000100110101011110
        #b1111001101111011111
        #b00010011010101111001
        #b101111001101111011111
        #b0001001101010111100110
        #b10101111001101111011111
        #b000100110101011110011011
        #b1010101111001101111011111
        #b00010011010101111001101111
        #b011010101111001101111011111
        #b0001001101010111100110111101
        #b10011010101111001101111011111
        #b000100110101011110011011110111
        #b0010011010101111001101111011111
        #b00010011010101111001101111011111))
    (define a2-from-a3
      (lambda (ls)
        (map (lambda (i n)
               (let* ([radix/2 (expt 2 i)])
                 (if (>= n radix/2)
                     (- n (ash radix/2 1))
                     n)))
          (enumerate ls) ls)))
    #t)
  (begin
    (set-a1! (make-list 21 0))
    #t)
  (equal?
    (get-a2)
    (make-list 32 0))
  (equal?
    (get-a3)
    (make-list 32 0))
  (begin
    (set-a1! (make-list 21 #xffffffff))
    #t)
  (equal?
    (get-a2)
    (make-list 32 -1))
  (equal?
    (get-a3)
    (do ([n 32 (fx- n 1)]
         [ls '() (cons (- (expt 2 n) 1) ls)])
      ((= n 0) ls)))
  (begin
    (set-a1! (make-list 21 #xc7c7c7c7))
    #t)
  (equal?
    (get-a3)
    a3-c7c7c7c7)
  (equal?
    (get-a2)
    (a2-from-a3 a3-c7c7c7c7))
  (begin
    (ftype-set! Abits (a1 a1) x #x13579bdf)
    (ftype-set! Abits (a1 a2) x #x13579bdf)
    (ftype-set! Abits (a1 a3) x #x13579bdf)
    (ftype-set! Abits (a1 a4) x #x13579bdf)
    (ftype-set! Abits (a1 a5) x #x13579bdf)
    (ftype-set! Abits (a1 a6) x #x13579bdf)
    (ftype-set! Abits (a1 a7) x #x13579bdf)
    (ftype-set! Abits (a1 a8) x #x13579bdf)
    (ftype-set! Abits (a1 a9) x #x13579bdf)
    (ftype-set! Abits (a1 a10) x #x13579bdf)
    (ftype-set! Abits (a1 a11) x #x13579bdf)
    (ftype-set! Abits (a1 a12) x #x13579bdf)
    (ftype-set! Abits (a1 a13) x #x13579bdf)
    (ftype-set! Abits (a1 a14) x #x13579bdf)
    (ftype-set! Abits (a1 a15) x #x13579bdf)
    (ftype-set! Abits (a1 a16) x #x13579bdf)
    (ftype-set! Abits (a1 a17) x #x13579bdf)
    (ftype-set! Abits (a1 a18) x #x13579bdf)
    (ftype-set! Abits (a1 a19) x #x13579bdf)
    (ftype-set! Abits (a1 a20) x #x13579bdf)
    (ftype-set! Abits (a1 a21) x #x13579bdf)
    #t)
  (equal?
    (get-a3)
    a3-13579bdf)
  (equal?
    (get-a2)
    (a2-from-a3 a3-13579bdf))
  (begin
    (set-a1! (make-list 21 0))
    (set-a3! a3-c7c7c7c7)
    #t)
  (equal?
    (get-a3)
    a3-c7c7c7c7)
  (equal?
    (get-a2)
    (a2-from-a3 a3-c7c7c7c7))
  (equal?
    (get-a1)
    '(#xc7c7c7c0
      #xc7c7c7c0
      #x0047c7c7
      #xc7c407c7
      #xc7c7c7c6
      #x0001c7c7
      #xc7c7c000
      #x0007c7c7
      #xc7c7c000
      #x0007c7c7
      #xc7c7c400
      #x0047c7c7
      #xc7c7c700
      #x01c7c7c7
      #xc7c7c7c0
      #x07c7c7c7
      #xc7c7c7c0
      #x07c7c7c7
      #xc7c7c7c4
      #x47c7c7c7
      #xc7c7c7c7))
  (begin
    (set-a1! (make-list 21 0))
    (set-a2! (a2-from-a3 a3-13579bdf))
    #t)
  (equal?
    (get-a3)
    a3-13579bdf)
  (equal?
    (get-a2)
    (a2-from-a3 a3-13579bdf))
  (equal?
    (get-a1)
    '(#x13579bd0
      #x13579bc0
      #x00579bdf
      #x13541bdf
      #x13579bde
      #x00019bdf
      #x13578000
      #x00079bdf
      #x13579000
      #x00179bdf
      #x13579800
      #x00579bdf
      #x13579b00
      #x01579bdf
      #x13579bc0
      #x03579bdf
      #x13579bd0
      #x13579bdf
      #x13579bdc
      #x13579bdf
      #x13579bdf))

  (begin
    (fptr-free x)
    #t)

 ; ----------------
  (begin
    (define-ftype Abits
      (endian big
        (union
          [a1 (struct
                [a1 unsigned-32]
                [a2 unsigned-32]
                [a3 unsigned-32]
                [a4 unsigned-32]
                [a5 unsigned-32]
                [a6 unsigned-32]
                [a7 unsigned-32]
                [a8 unsigned-32]
                [a9 unsigned-32]
                [a10 unsigned-32]
                [a11 unsigned-32]
                [a12 unsigned-32]
                [a13 unsigned-32]
                [a14 unsigned-32]
                [a15 unsigned-32]
                [a16 unsigned-32]
                [a17 unsigned-32]
                [a18 unsigned-32]
                [a19 unsigned-32]
                [a20 unsigned-32]
                [a21 unsigned-32])]
          [a2 (struct
                [a1 (bits
                      [_ signed 4]
                      [a1 signed 1]
                      [a2 signed 2]
                      [a3 signed 3]
                      [a4 signed 4]
                      [a5 signed 5]
                      [a6 signed 6]
                      [a7 signed 7])]
                [a2 (bits
                      [_ signed 5]
                      [a8 signed 8]
                      [a9 signed 9]
                      [a10 signed 10])]
                [a3 (bits
                      [a11 signed 11]
                      [a12 signed 12]
                      [_ signed 9])]
                [a4 (bits
                      [a13 signed 13]
                      [_ signed 5]
                      [a14 signed 14])]
                [a5 (bits
                      [_ signed 1]
                      [a15 signed 15]
                      [a16 signed 16])]
                [a6 (bits [a17 signed 17] [_ signed 15])]
                [a7 (bits [_ signed 14] [a18 signed 18])]
                [a8 (bits [a19 signed 19] [_ signed 13])]
                [a9 (bits [_ signed 12] [a20 signed 20])]
                [a10 (bits [a21 signed 21] [_ signed 11])]
                [a11 (bits [_ signed 10] [a22 signed 22])]
                [a12 (bits [a23 signed 23] [_ signed 9])]
                [a13 (bits [_ signed 8] [a24 signed 24])]
                [a14 (bits [a25 signed 25] [_ signed 7])]
                [a15 (bits [_ signed 6] [a26 signed 26])]
                [a16 (bits [a27 signed 27] [_ signed 5])]
                [a17 (bits [_ signed 4] [a28 signed 28])]
                [a18 (bits [a29 signed 29] [_ signed 3])]
                [a19 (bits [_ signed 2] [a30 signed 30])]
                [a20 (bits [a31 signed 31] [_ signed 1])]
                [a21 (bits [a32 signed 32])])]
          [a3 (struct
                [a1 (bits
                      [_ unsigned 4]
                      [a1 unsigned 1]
                      [a2 unsigned 2]
                      [a3 unsigned 3]
                      [a4 unsigned 4]
                      [a5 unsigned 5]
                      [a6 unsigned 6]
                      [a7 unsigned 7])]
                [a2 (bits
                      [_ unsigned 5]
                      [a8 unsigned 8]
                      [a9 unsigned 9]
                      [a10 unsigned 10])]
                [a3 (bits
                      [a11 unsigned 11]
                      [a12 unsigned 12]
                      [_ unsigned 9])]
                [a4 (bits
                      [a13 unsigned 13]
                      [_ unsigned 5]
                      [a14 unsigned 14])]
                [a5 (bits
                      [_ unsigned 1]
                      [a15 unsigned 15]
                      [a16 unsigned 16])]
                [a6 (bits [a17 unsigned 17] [_ unsigned 15])]
                [a7 (bits [_ unsigned 14] [a18 unsigned 18])]
                [a8 (bits [a19 unsigned 19] [_ unsigned 13])]
                [a9 (bits [_ unsigned 12] [a20 unsigned 20])]
                [a10 (bits [a21 unsigned 21] [_ unsigned 11])]
                [a11 (bits [_ unsigned 10] [a22 unsigned 22])]
                [a12 (bits [a23 unsigned 23] [_ unsigned 9])]
                [a13 (bits [_ unsigned 8] [a24 unsigned 24])]
                [a14 (bits [a25 unsigned 25] [_ unsigned 7])]
                [a15 (bits [_ unsigned 6] [a26 unsigned 26])]
                [a16 (bits [a27 unsigned 27] [_ unsigned 5])]
                [a17 (bits [_ unsigned 4] [a28 unsigned 28])]
                [a18 (bits [a29 unsigned 29] [_ unsigned 3])]
                [a19 (bits [_ unsigned 2] [a30 unsigned 30])]
                [a20 (bits [a31 unsigned 31] [_ unsigned 1])]
                [a21 (bits [a32 unsigned 32])])])))
    (define x (make-ftype-pointer Abits (foreign-alloc (ftype-sizeof Abits))))
    (define (get-a1)
      (list
        (ftype-ref Abits (a1 a1) x)
        (ftype-ref Abits (a1 a2) x)
        (ftype-ref Abits (a1 a3) x)
        (ftype-ref Abits (a1 a4) x)
        (ftype-ref Abits (a1 a5) x)
        (ftype-ref Abits (a1 a6) x)
        (ftype-ref Abits (a1 a7) x)
        (ftype-ref Abits (a1 a8) x)
        (ftype-ref Abits (a1 a9) x)
        (ftype-ref Abits (a1 a10) x)
        (ftype-ref Abits (a1 a11) x)
        (ftype-ref Abits (a1 a12) x)
        (ftype-ref Abits (a1 a13) x)
        (ftype-ref Abits (a1 a14) x)
        (ftype-ref Abits (a1 a15) x)
        (ftype-ref Abits (a1 a16) x)
        (ftype-ref Abits (a1 a17) x)
        (ftype-ref Abits (a1 a18) x)
        (ftype-ref Abits (a1 a19) x)
        (ftype-ref Abits (a1 a20) x)
        (ftype-ref Abits (a1 a21) x)))
    (define (get-a2)
      (list
        (ftype-ref Abits (a2 a1 a1) x)
        (ftype-ref Abits (a2 a1 a2) x)
        (ftype-ref Abits (a2 a1 a3) x)
        (ftype-ref Abits (a2 a1 a4) x)
        (ftype-ref Abits (a2 a1 a5) x)
        (ftype-ref Abits (a2 a1 a6) x)
        (ftype-ref Abits (a2 a1 a7) x)
        (ftype-ref Abits (a2 a2 a8) x)
        (ftype-ref Abits (a2 a2 a9) x)
        (ftype-ref Abits (a2 a2 a10) x)
        (ftype-ref Abits (a2 a3 a11) x)
        (ftype-ref Abits (a2 a3 a12) x)
        (ftype-ref Abits (a2 a4 a13) x)
        (ftype-ref Abits (a2 a4 a14) x)
        (ftype-ref Abits (a2 a5 a15) x)
        (ftype-ref Abits (a2 a5 a16) x)
        (ftype-ref Abits (a2 a6 a17) x)
        (ftype-ref Abits (a2 a7 a18) x)
        (ftype-ref Abits (a2 a8 a19) x)
        (ftype-ref Abits (a2 a9 a20) x)
        (ftype-ref Abits (a2 a10 a21) x)
        (ftype-ref Abits (a2 a11 a22) x)
        (ftype-ref Abits (a2 a12 a23) x)
        (ftype-ref Abits (a2 a13 a24) x)
        (ftype-ref Abits (a2 a14 a25) x)
        (ftype-ref Abits (a2 a15 a26) x)
        (ftype-ref Abits (a2 a16 a27) x)
        (ftype-ref Abits (a2 a17 a28) x)
        (ftype-ref Abits (a2 a18 a29) x)
        (ftype-ref Abits (a2 a19 a30) x)
        (ftype-ref Abits (a2 a20 a31) x)
        (ftype-ref Abits (a2 a21 a32) x)))
    (define (get-a3)
      (list
        (ftype-ref Abits (a3 a1 a1) x)
        (ftype-ref Abits (a3 a1 a2) x)
        (ftype-ref Abits (a3 a1 a3) x)
        (ftype-ref Abits (a3 a1 a4) x)
        (ftype-ref Abits (a3 a1 a5) x)
        (ftype-ref Abits (a3 a1 a6) x)
        (ftype-ref Abits (a3 a1 a7) x)
        (ftype-ref Abits (a3 a2 a8) x)
        (ftype-ref Abits (a3 a2 a9) x)
        (ftype-ref Abits (a3 a2 a10) x)
        (ftype-ref Abits (a3 a3 a11) x)
        (ftype-ref Abits (a3 a3 a12) x)
        (ftype-ref Abits (a3 a4 a13) x)
        (ftype-ref Abits (a3 a4 a14) x)
        (ftype-ref Abits (a3 a5 a15) x)
        (ftype-ref Abits (a3 a5 a16) x)
        (ftype-ref Abits (a3 a6 a17) x)
        (ftype-ref Abits (a3 a7 a18) x)
        (ftype-ref Abits (a3 a8 a19) x)
        (ftype-ref Abits (a3 a9 a20) x)
        (ftype-ref Abits (a3 a10 a21) x)
        (ftype-ref Abits (a3 a11 a22) x)
        (ftype-ref Abits (a3 a12 a23) x)
        (ftype-ref Abits (a3 a13 a24) x)
        (ftype-ref Abits (a3 a14 a25) x)
        (ftype-ref Abits (a3 a15 a26) x)
        (ftype-ref Abits (a3 a16 a27) x)
        (ftype-ref Abits (a3 a17 a28) x)
        (ftype-ref Abits (a3 a18 a29) x)
        (ftype-ref Abits (a3 a19 a30) x)
        (ftype-ref Abits (a3 a20 a31) x)
        (ftype-ref Abits (a3 a21 a32) x)))
    (define (set-a1! ls)
      (map
        (lambda (f v) (f v))
        (list
          (lambda (v) (ftype-set! Abits (a1 a1) x v))
          (lambda (v) (ftype-set! Abits (a1 a2) x v))
          (lambda (v) (ftype-set! Abits (a1 a3) x v))
          (lambda (v) (ftype-set! Abits (a1 a4) x v))
          (lambda (v) (ftype-set! Abits (a1 a5) x v))
          (lambda (v) (ftype-set! Abits (a1 a6) x v))
          (lambda (v) (ftype-set! Abits (a1 a7) x v))
          (lambda (v) (ftype-set! Abits (a1 a8) x v))
          (lambda (v) (ftype-set! Abits (a1 a9) x v))
          (lambda (v) (ftype-set! Abits (a1 a10) x v))
          (lambda (v) (ftype-set! Abits (a1 a11) x v))
          (lambda (v) (ftype-set! Abits (a1 a12) x v))
          (lambda (v) (ftype-set! Abits (a1 a13) x v))
          (lambda (v) (ftype-set! Abits (a1 a14) x v))
          (lambda (v) (ftype-set! Abits (a1 a15) x v))
          (lambda (v) (ftype-set! Abits (a1 a16) x v))
          (lambda (v) (ftype-set! Abits (a1 a17) x v))
          (lambda (v) (ftype-set! Abits (a1 a18) x v))
          (lambda (v) (ftype-set! Abits (a1 a19) x v))
          (lambda (v) (ftype-set! Abits (a1 a20) x v))
          (lambda (v) (ftype-set! Abits (a1 a21) x v)))
        ls))
    (define (set-a2! ls)
      (map
        (lambda (f v) (f v))
        (list
          (lambda (v) (ftype-set! Abits (a2 a1 a1) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a2) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a3) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a4) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a5) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a6) x v))
          (lambda (v) (ftype-set! Abits (a2 a1 a7) x v))
          (lambda (v) (ftype-set! Abits (a2 a2 a8) x v))
          (lambda (v) (ftype-set! Abits (a2 a2 a9) x v))
          (lambda (v) (ftype-set! Abits (a2 a2 a10) x v))
          (lambda (v) (ftype-set! Abits (a2 a3 a11) x v))
          (lambda (v) (ftype-set! Abits (a2 a3 a12) x v))
          (lambda (v) (ftype-set! Abits (a2 a4 a13) x v))
          (lambda (v) (ftype-set! Abits (a2 a4 a14) x v))
          (lambda (v) (ftype-set! Abits (a2 a5 a15) x v))
          (lambda (v) (ftype-set! Abits (a2 a5 a16) x v))
          (lambda (v) (ftype-set! Abits (a2 a6 a17) x v))
          (lambda (v) (ftype-set! Abits (a2 a7 a18) x v))
          (lambda (v) (ftype-set! Abits (a2 a8 a19) x v))
          (lambda (v) (ftype-set! Abits (a2 a9 a20) x v))
          (lambda (v) (ftype-set! Abits (a2 a10 a21) x v))
          (lambda (v) (ftype-set! Abits (a2 a11 a22) x v))
          (lambda (v) (ftype-set! Abits (a2 a12 a23) x v))
          (lambda (v) (ftype-set! Abits (a2 a13 a24) x v))
          (lambda (v) (ftype-set! Abits (a2 a14 a25) x v))
          (lambda (v) (ftype-set! Abits (a2 a15 a26) x v))
          (lambda (v) (ftype-set! Abits (a2 a16 a27) x v))
          (lambda (v) (ftype-set! Abits (a2 a17 a28) x v))
          (lambda (v) (ftype-set! Abits (a2 a18 a29) x v))
          (lambda (v) (ftype-set! Abits (a2 a19 a30) x v))
          (lambda (v) (ftype-set! Abits (a2 a20 a31) x v))
          (lambda (v) (ftype-set! Abits (a2 a21 a32) x v)))
        ls))
    (define (set-a3! ls)
      (map
        (lambda (f v) (f v))
        (list
          (lambda (v) (ftype-set! Abits (a3 a1 a1) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a2) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a3) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a4) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a5) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a6) x v))
          (lambda (v) (ftype-set! Abits (a3 a1 a7) x v))
          (lambda (v) (ftype-set! Abits (a3 a2 a8) x v))
          (lambda (v) (ftype-set! Abits (a3 a2 a9) x v))
          (lambda (v) (ftype-set! Abits (a3 a2 a10) x v))
          (lambda (v) (ftype-set! Abits (a3 a3 a11) x v))
          (lambda (v) (ftype-set! Abits (a3 a3 a12) x v))
          (lambda (v) (ftype-set! Abits (a3 a4 a13) x v))
          (lambda (v) (ftype-set! Abits (a3 a4 a14) x v))
          (lambda (v) (ftype-set! Abits (a3 a5 a15) x v))
          (lambda (v) (ftype-set! Abits (a3 a5 a16) x v))
          (lambda (v) (ftype-set! Abits (a3 a6 a17) x v))
          (lambda (v) (ftype-set! Abits (a3 a7 a18) x v))
          (lambda (v) (ftype-set! Abits (a3 a8 a19) x v))
          (lambda (v) (ftype-set! Abits (a3 a9 a20) x v))
          (lambda (v) (ftype-set! Abits (a3 a10 a21) x v))
          (lambda (v) (ftype-set! Abits (a3 a11 a22) x v))
          (lambda (v) (ftype-set! Abits (a3 a12 a23) x v))
          (lambda (v) (ftype-set! Abits (a3 a13 a24) x v))
          (lambda (v) (ftype-set! Abits (a3 a14 a25) x v))
          (lambda (v) (ftype-set! Abits (a3 a15 a26) x v))
          (lambda (v) (ftype-set! Abits (a3 a16 a27) x v))
          (lambda (v) (ftype-set! Abits (a3 a17 a28) x v))
          (lambda (v) (ftype-set! Abits (a3 a18 a29) x v))
          (lambda (v) (ftype-set! Abits (a3 a19 a30) x v))
          (lambda (v) (ftype-set! Abits (a3 a20 a31) x v))
          (lambda (v) (ftype-set! Abits (a3 a21 a32) x v)))
        ls))
    (define a3-c7c7c7c7
      '(#b0
        #b11
        #b111
        #b0001
        #b11110
        #b001111
        #b1000111
        #b11111000
        #b111110001
        #b1111000111
        #b11000111110
        #b001111100011
        #b1100011111000
        #b00011111000111
        #b100011111000111
        #b1100011111000111
        #b11000111110001111
        #b111100011111000111
        #b1100011111000111110
        #b01111100011111000111
        #b110001111100011111000
        #b0001111100011111000111
        #b11000111110001111100011
        #b110001111100011111000111
        #b1100011111000111110001111
        #b11110001111100011111000111
        #b110001111100011111000111110
        #b0111110001111100011111000111
        #b11000111110001111100011111000
        #b000111110001111100011111000111
        #b1100011111000111110001111100011
        #b11000111110001111100011111000111))
    (define a3-13579bdf
      '(#b0
        #b01
        #b101
        #b0101
        #b11100
        #b110111
        #b1011111
        #b01101010
        #b111100110
        #b1111011111
        #b00010011010
        #b101111001101
        #b0001001101010
        #b01101111011111
        #b001001101010111
        #b1001101111011111
        #b00010011010101111
        #b111001101111011111
        #b0001001101010111100
        #b01111001101111011111
        #b000100110101011110011
        #b0101111001101111011111
        #b00010011010101111001101
        #b010101111001101111011111
        #b0001001101010111100110111
        #b11010101111001101111011111
        #b000100110101011110011011110
        #b0011010101111001101111011111
        #b00010011010101111001101111011
        #b010011010101111001101111011111
        #b0001001101010111100110111101111
        #b00010011010101111001101111011111))
    (define a2-from-a3
      (lambda (ls)
        (map (lambda (i n)
               (let* ([radix/2 (expt 2 i)])
                 (if (>= n radix/2)
                     (- n (ash radix/2 1))
                     n)))
          (enumerate ls) ls)))
    #t)
  (begin
    (set-a1! (make-list 21 0))
    #t)
  (equal?
    (get-a2)
    (make-list 32 0))
  (equal?
    (get-a3)
    (make-list 32 0))
  (begin
    (set-a1! (make-list 21 #xffffffff))
    #t)
  (equal?
    (get-a2)
    (make-list 32 -1))
  (equal?
    (get-a3)
    (do ([n 32 (fx- n 1)]
         [ls '() (cons (- (expt 2 n) 1) ls)])
      ((= n 0) ls)))
  (begin
    (set-a1! (make-list 21 #xc7c7c7c7))
    #t)
  (equal?
    (get-a3)
    a3-c7c7c7c7)
  (equal?
    (get-a2)
    (a2-from-a3 a3-c7c7c7c7))
  (begin
    (ftype-set! Abits (a1 a1) x #x13579bdf)
    (ftype-set! Abits (a1 a2) x #x13579bdf)
    (ftype-set! Abits (a1 a3) x #x13579bdf)
    (ftype-set! Abits (a1 a4) x #x13579bdf)
    (ftype-set! Abits (a1 a5) x #x13579bdf)
    (ftype-set! Abits (a1 a6) x #x13579bdf)
    (ftype-set! Abits (a1 a7) x #x13579bdf)
    (ftype-set! Abits (a1 a8) x #x13579bdf)
    (ftype-set! Abits (a1 a9) x #x13579bdf)
    (ftype-set! Abits (a1 a10) x #x13579bdf)
    (ftype-set! Abits (a1 a11) x #x13579bdf)
    (ftype-set! Abits (a1 a12) x #x13579bdf)
    (ftype-set! Abits (a1 a13) x #x13579bdf)
    (ftype-set! Abits (a1 a14) x #x13579bdf)
    (ftype-set! Abits (a1 a15) x #x13579bdf)
    (ftype-set! Abits (a1 a16) x #x13579bdf)
    (ftype-set! Abits (a1 a17) x #x13579bdf)
    (ftype-set! Abits (a1 a18) x #x13579bdf)
    (ftype-set! Abits (a1 a19) x #x13579bdf)
    (ftype-set! Abits (a1 a20) x #x13579bdf)
    (ftype-set! Abits (a1 a21) x #x13579bdf)
    #t)
  (equal?
    (get-a3)
    a3-13579bdf)
  (equal?
    (get-a2)
    (a2-from-a3 a3-13579bdf))
  (begin
    (set-a1! (make-list 21 0))
    (set-a3! a3-c7c7c7c7)
    #t)
  (equal?
    (get-a3)
    a3-c7c7c7c7)
  (equal?
    (get-a2)
    (a2-from-a3 a3-c7c7c7c7))
  (equal?
    (get-a1)
    '(#x07c7c7c7
      #x07c7c7c7
      #xc7c7c600
      #xc7c007c7
      #x47c7c7c7
      #xc7c78000
      #x0003c7c7
      #xc7c7c000
      #x0007c7c7
      #xc7c7c000
      #x0007c7c7
      #xc7c7c600
      #x00c7c7c7
      #xc7c7c780
      #x03c7c7c7
      #xc7c7c7c0
      #x07c7c7c7
      #xc7c7c7c0
      #x07c7c7c7
      #xc7c7c7c6
      #xc7c7c7c7))
  (begin
    (set-a1! (make-list 21 0))
    (set-a2! (a2-from-a3 a3-13579bdf))
    #t)
  (equal?
    (get-a3)
    a3-13579bdf)
  (equal?
    (get-a2)
    (a2-from-a3 a3-13579bdf))
  (equal?
    (get-a1)
    '(#x03579bdf
      #x03579bdf
      #x13579a00
      #x13501bdf
      #x13579bdf
      #x13578000
      #x00039bdf
      #x13578000
      #x00079bdf
      #x13579800
      #x00179bdf
      #x13579a00
      #x00579bdf
      #x13579b80
      #x03579bdf
      #x13579bc0
      #x03579bdf
      #x13579bd8
      #x13579bdf
      #x13579bde
      #x13579bdf))

  (begin
    (fptr-free x)
    #t)
)

(mat ftype-inspection
  (begin
    (define-ftype Qa
      (struct
        [x short]
        [y long]))
    (define-ftype Q
      (struct
        [x (packed integer-32)]
        [y double-float]
        [z (array 4 (struct [_ integer-16] [b integer-16]))]
        [w (endian big
             (union
               [a integer-32]
               [b unsigned-32]))]
        [v (* Qa)]
        [u (array 3 float)]
        [t char]
        [s (endian little
             (array 2
               (bits
                 [x unsigned 3]
                 [y signed 4]
                 [_ unsigned 17]
                 [z unsigned 8])))]))
    (define q (make-ftype-pointer Q (foreign-alloc (ftype-sizeof Q))))
    (ftype-set! Q (x) q -73)
    (ftype-set! Q (y) q 3.25)
    (ftype-set! Q (z 0 b) q 11)
    (ftype-set! Q (z 1 b) q -15)
    (ftype-set! Q (z 2 b) q 53)
    (ftype-set! Q (z 3 b) q -71)
    (ftype-set! Q (w a) q -1)
    (ftype-set! Q (v) q (make-ftype-pointer Qa (foreign-alloc (ftype-sizeof Qa))))
    (ftype-set! Q (v * x) q 7)
    (ftype-set! Q (v * y) q -503)
    (ftype-set! Q (u 0) q 1.0)
    (ftype-set! Q (u 1) q 2.0)
    (ftype-set! Q (u 2) q 3.0)
    (ftype-set! Q (t) q #\$)
    (ftype-set! Q (s 0 x) q 5)
    (ftype-set! Q (s 0 y) q -2)
    (ftype-set! Q (s 0 z) q 225)
    (ftype-set! Q (s 1 x) q 2)
    (ftype-set! Q (s 1 y) q 7)
    (ftype-set! Q (s 1 z) q 47)
    #t)

  (equal?
    (ftype-pointer-ftype q)
    '(struct
       [x (packed integer-32)]
       [y double-float]
       [z (array 4 (struct [_ integer-16] [b integer-16]))]
       [w (endian big
            (union
              [a integer-32]
              [b unsigned-32]))]
       [v (* Qa)]
       [u (array 3 float)]
       [t char]
       [s (endian little
            (array 2
              (bits
                [x unsigned 3]
                [y signed 4]
                [_ unsigned 17]
                [z unsigned 8])))]))

  (eq? ; verify sharing in internal type field
    (ftype-pointer-ftype (ftype-&ref Q (s) q))
    (cadr (list-ref (ftype-pointer-ftype q) 8)))

  (equal?
    (ftype-pointer->sexpr q)
    '(struct
       [x -73]
       [y 3.25]
       [z (array 4
            (struct [_ _] [b 11])
            (struct [_ _] [b -15])
            (struct [_ _] [b 53])
            (struct [_ _] [b -71]))]
       [w (union [a -1] [b #xffffffff])]
       [v (* (struct [x 7] [y -503]))]
       [u (array 3 1.0 2.0 3.0)]
       [t #\$]
       [s (array 2
            (bits [x 5] [y -2] [_ _] [z 225])
            (bits [x 2] [y 7] [_ _] [z 47]))]))

  (begin
    (fptr-free q)
    #t)

 ; ----------------

  (begin
    (define-ftype big-wchar (endian big wchar))
    (define-ftype little-wchar (endian little wchar))
    (define-ftype Q
      (struct
        [a (array 10 char)]
        [b (array 10 wchar)]
        [c (endian big (array 10 wchar))]
        [d (endian little (array 10 wchar))]
        [e (* char)]
        [f (* wchar)]
        [g (* big-wchar)]
        [h (* little-wchar)]
        [i (* char)]
        [j (* wchar)]))
    (define q (make-ftype-pointer Q (foreign-alloc (ftype-sizeof Q))))

    (define-syntax ftype-set-char-array!
      (syntax-rules ()
        [(_ maxlen ftype (a ...) fptr str)
         (let ([len (min (string-length str) maxlen)])
           (do ([i 0 (fx+ i 1)])
               ((fx= i len))
             (ftype-set! ftype (a ... i) fptr (string-ref str i)))
           (when (< len maxlen) (ftype-set! ftype (a ... len) fptr #\nul)))]))

    (ftype-set-char-array! 10 Q (a) q "abcd")
    (ftype-set-char-array! 10 Q (b) q "abcdefghijklmnop")
    (ftype-set-char-array! 10 Q (c) q "ABCDEFGHIJKLMNOP")
    (ftype-set-char-array! 10 Q (d) q "ABCDEFG")
    
    (define-syntax ftype-set-string!
      (syntax-rules ()
        [(_ char ftype (a ...) fptr str p)
         (let ([len (string-length str)])
           (set! p (make-ftype-pointer char (foreign-alloc (fx* (ftype-sizeof char) (fx+ len 1)))))
           (do ([i 0 (fx+ i 1)])
             ((fx= i len))
             (ftype-set! char () p i (string-ref str i)))
           (ftype-set! char () p len #\nul)
           (ftype-set! ftype (a ...) fptr p))]))

    (ftype-set-string! char Q (e) q "hello!" q-e)
    (ftype-set-string! wchar Q (f) q "Hello!" q-f)
    (ftype-set-string! big-wchar Q (g) q "HELLO!" q-g)
    (ftype-set-string! little-wchar Q (h) q "GoodBye" q-h)

    (ftype-set! Q (i) q (make-ftype-pointer char 0))
    (ftype-set! Q (j) q (make-ftype-pointer wchar 1))

    #t)

  (if (memq (machine-type) '(ti3ob ta6ob)) ; avoid openbsd/pthreads signal bugs
      (error #f "openbsd pthreads + signals is fubar")
      (equal?
        (ftype-pointer->sexpr q)
        '(struct
           [a "abcd"]
           [b "abcdefghij"]
           [c "ABCDEFGHIJ"]
           [d "ABCDEFG"]
           [e "hello!"]
           [f "Hello!"]
           [g "HELLO!"]
           [h "GoodBye"]
           [i null]
           [j (* invalid)])))

  (if (memq (machine-type) '(ti3ob ta6ob)) ; avoid openbsd/pthreads signal bugs
      (error #f "openbsd pthreads + signals is fubar")
      (equal?
        (ftype-pointer->sexpr (make-ftype-pointer Q 0))
        '(struct
           [a (array 10 invalid)]
           [b (array 10 invalid)]
           [c (array 10 invalid)]
           [d (array 10 invalid)]
           [e invalid]
           [f invalid]
           [g invalid]
           [h invalid]
           [i invalid]
           [j invalid])))

  (begin
    (fptr-free q-e)
    (fptr-free q-f)
    (fptr-free q-g)
    (fptr-free q-h)
    (fptr-free q)
    #t)

 ; ----------------

  (begin
    (define-ftype A (endian little double))
    (define-ftype B (endian big double))
    #t)

  (equal?
    (ftype-pointer-ftype (make-ftype-pointer A 0))
    (case (native-endianness)
      [(big) '(endian little double)]
      [(little) 'double]
      [else (errorf #f "unexpected native endianness")]))

  (equal?
    (ftype-pointer-ftype (make-ftype-pointer B 0))
    (case (native-endianness)
      [(big) 'double]
      [(little) '(endian big double)]
      [else (errorf #f "unexpected native endianness")]))

  (begin
    (define-ftype A (endian little char))
    (define-ftype B (endian big char))
    #t)

  (eq? (ftype-pointer-ftype (make-ftype-pointer A 0)) 'char)
  (eq? (ftype-pointer-ftype (make-ftype-pointer B 0)) 'char)
)

(mat discarded-refs
  (begin
    (define-ftype A
      (endian big
        (struct
          [a1 double]
          [a2 float]
          [a3 long-long]
          [a4 unsigned-long-long]
          [a5 long]
          [a6 unsigned-long]
          [a7 int]
          [a8 unsigned]
          [a9 unsigned-int]
          [a10 short]
          [a11 unsigned-short]
          [a12 wchar]
          [a13 char]
          [a14 boolean]
          [a15 fixnum]
          [a16 iptr]
          [a17 uptr]
          [a18 void*])))
    #t)
  (equivalent-expansion?
    (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(lambda (x)
           (ftype-ref A (a1) x)
           (ftype-ref A (a2) x)
           (ftype-ref A (a3) x)
           (ftype-ref A (a4) x)
           (ftype-ref A (a5) x)
           (ftype-ref A (a6) x)
           (ftype-ref A (a7) x)
           (ftype-ref A (a8) x)
           (ftype-ref A (a9) x)
           (ftype-ref A (a10) x)
           (ftype-ref A (a11) x)
           (ftype-ref A (a12) x)
           (ftype-ref A (a13) x)
           (ftype-ref A (a14) x)
           (ftype-ref A (a15) x)
           (ftype-ref A (a16) x)
           (ftype-ref A (a17) x)
           (ftype-ref A (a18) x)
           x)))
    '(lambda (x) x))
  (equivalent-expansion?
    (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(lambda (x)
           (ftype-&ref A (a1) x)
           (ftype-&ref A (a2) x)
           (ftype-&ref A (a3) x)
           (ftype-&ref A (a4) x)
           (ftype-&ref A (a5) x)
           (ftype-&ref A (a6) x)
           (ftype-&ref A (a7) x)
           (ftype-&ref A (a8) x)
           (ftype-&ref A (a9) x)
           (ftype-&ref A (a10) x)
           (ftype-&ref A (a11) x)
           (ftype-&ref A (a12) x)
           (ftype-&ref A (a13) x)
           (ftype-&ref A (a14) x)
           (ftype-&ref A (a15) x)
           (ftype-&ref A (a16) x)
           (ftype-&ref A (a17) x)
           (ftype-&ref A (a18) x)
           x)))
    '(lambda (x) x))
  (begin
    (define-ftype A
      (endian little
        (struct
          [a1 double]
          [a2 float]
          [a3 long-long]
          [a4 unsigned-long-long]
          [a5 long]
          [a6 unsigned-long]
          [a7 int]
          [a8 unsigned]
          [a9 unsigned-int]
          [a10 short]
          [a11 unsigned-short]
          [a12 wchar]
          [a13 char]
          [a14 boolean]
          [a15 fixnum]
          [a16 iptr]
          [a17 uptr]
          [a18 void*])))
    #t)
  (equivalent-expansion?
    (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(lambda (x)
           (ftype-ref A (a1) x)
           (ftype-ref A (a2) x)
           (ftype-ref A (a3) x)
           (ftype-ref A (a4) x)
           (ftype-ref A (a5) x)
           (ftype-ref A (a6) x)
           (ftype-ref A (a7) x)
           (ftype-ref A (a8) x)
           (ftype-ref A (a9) x)
           (ftype-ref A (a10) x)
           (ftype-ref A (a11) x)
           (ftype-ref A (a12) x)
           (ftype-ref A (a13) x)
           (ftype-ref A (a14) x)
           (ftype-ref A (a15) x)
           (ftype-ref A (a16) x)
           (ftype-ref A (a17) x)
           (ftype-ref A (a18) x)
           x)))
    '(lambda (x) x))
  (equivalent-expansion?
    (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(lambda (x)
           (ftype-&ref A (a1) x)
           (ftype-&ref A (a2) x)
           (ftype-&ref A (a3) x)
           (ftype-&ref A (a4) x)
           (ftype-&ref A (a5) x)
           (ftype-&ref A (a6) x)
           (ftype-&ref A (a7) x)
           (ftype-&ref A (a8) x)
           (ftype-&ref A (a9) x)
           (ftype-&ref A (a10) x)
           (ftype-&ref A (a11) x)
           (ftype-&ref A (a12) x)
           (ftype-&ref A (a13) x)
           (ftype-&ref A (a14) x)
           (ftype-&ref A (a15) x)
           (ftype-&ref A (a16) x)
           (ftype-&ref A (a17) x)
           (ftype-&ref A (a18) x)
           x)))
    '(lambda (x) x))
  (begin
    (define-ftype A
      (endian big
        (union
          [a1 (struct
                [a1 unsigned-16]
                [a2 unsigned-8]
                [a3 unsigned-64]
                [a4 unsigned-32])]
          [a2 (struct
                [a1 (bits
                      [a1 signed 1]
                      [a2 signed 15])]
                [a2 (bits
                      [a1 signed 3]
                      [a2 signed 5])]
                [a3 (bits
                      [a1 signed 50]
                      [a2 signed 14])]
                [a4 (bits
                      [a1 signed 19]
                      [a2 signed 13])])]
          [a3 (struct
                [a1 (bits
                      [a1 unsigned 1]
                      [a2 unsigned 15])]
                [a2 (bits
                      [a1 unsigned 3]
                      [a2 unsigned 5])]
                [a3 (bits
                      [a1 unsigned 50]
                      [a2 unsigned 14])]
                [a4 (bits
                      [a1 unsigned 19]
                      [a2 unsigned 13])])])))
    #t)
  (equivalent-expansion?
    (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(lambda (x)
           (ftype-ref A (a1 a1) x)
           (ftype-ref A (a1 a2) x)
           (ftype-ref A (a1 a3) x)
           (ftype-ref A (a1 a4) x)
           (ftype-ref A (a2 a1 a1) x)
           (ftype-ref A (a2 a1 a2) x)
           (ftype-ref A (a2 a2 a1) x)
           (ftype-ref A (a2 a2 a2) x)
           (ftype-ref A (a2 a3 a1) x)
           (ftype-ref A (a2 a3 a2) x)
           (ftype-ref A (a2 a4 a1) x)
           (ftype-ref A (a2 a4 a2) x)
           (ftype-ref A (a3 a1 a1) x)
           (ftype-ref A (a3 a1 a2) x)
           (ftype-ref A (a3 a2 a1) x)
           (ftype-ref A (a3 a2 a2) x)
           (ftype-ref A (a3 a3 a1) x)
           (ftype-ref A (a3 a3 a2) x)
           (ftype-ref A (a3 a4 a1) x)
           (ftype-ref A (a3 a4 a2) x)
           x)))
    '(lambda (x) x))
  (begin
    (define-ftype A
      (endian little
        (union
          [a1 (struct
                [a1 unsigned-16]
                [a2 unsigned-8]
                [a3 unsigned-64]
                [a4 unsigned-32])]
          [a2 (struct
                [a1 (bits
                      [a1 signed 1]
                      [a2 signed 15])]
                [a2 (bits
                      [a1 signed 3]
                      [a2 signed 5])]
                [a3 (bits
                      [a1 signed 50]
                      [a2 signed 14])]
                [a4 (bits
                      [a1 signed 19]
                      [a2 signed 13])])]
          [a3 (struct
                [a1 (bits
                      [a1 unsigned 1]
                      [a2 unsigned 15])]
                [a2 (bits
                      [a1 unsigned 3]
                      [a2 unsigned 5])]
                [a3 (bits
                      [a1 unsigned 50]
                      [a2 unsigned 14])]
                [a4 (bits
                      [a1 unsigned 19]
                      [a2 unsigned 13])])])))
    #t)
  (equivalent-expansion?
    (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(lambda (x)
           (ftype-ref A (a1 a1) x)
           (ftype-ref A (a1 a2) x)
           (ftype-ref A (a1 a3) x)
           (ftype-ref A (a1 a4) x)
           (ftype-ref A (a2 a1 a1) x)
           (ftype-ref A (a2 a1 a2) x)
           (ftype-ref A (a2 a2 a1) x)
           (ftype-ref A (a2 a2 a2) x)
           (ftype-ref A (a2 a3 a1) x)
           (ftype-ref A (a2 a3 a2) x)
           (ftype-ref A (a2 a4 a1) x)
           (ftype-ref A (a2 a4 a2) x)
           (ftype-ref A (a3 a1 a1) x)
           (ftype-ref A (a3 a1 a2) x)
           (ftype-ref A (a3 a2 a1) x)
           (ftype-ref A (a3 a2 a2) x)
           (ftype-ref A (a3 a3 a1) x)
           (ftype-ref A (a3 a3 a2) x)
           (ftype-ref A (a3 a4 a1) x)
           (ftype-ref A (a3 a4 a2) x)
           x)))
    '(lambda (x) x))
)