corectl

 1(define nullptr #f)
 2(define ifs '(0 1)) ;; TODO
 3
 4(define-record-type <usb-endpoint>
 5  (%make-usb-endpoint usb-device addr)
 6  usb-endpoint?
 7
 8  (usb-device usb-endpoint-device)
 9  (addr usb-endpoint-addr))
10
11(define (make-usb-endpoint vid pid addr)
12  (define (make-usb-device vid pid)
13    (libusb-open nullptr vid pid))
14
15  (let ((device (make-usb-device vid pid)))
16    (if (not device)
17      (error "make-usb-device failed")
18      (begin
19        (libusb-auto-detach device 1)
20        (%make-usb-endpoint device addr)))))
21
22(define (close-usb-endpoint endpoint)
23  (libusb-close (usb-endpoint-device endpoint)))
24
25(define (call-with-usb-endpoint endpoint proc)
26  (define dev (usb-endpoint-device endpoint))
27  (define (conf-if state)
28    (let ((proc (cond
29                  ((eq? state 'claim) libusb-claim)
30                  ((eq? state 'release) libusb-release)
31                  (else (abort "unknown interface state")))))
32      (for-each
33        (lambda (i)
34          (when (not (zero? (proc dev i)))
35            (error "interface state change failed"))) ifs)))
36
37  (let ((r (call-with-current-continuation
38             (lambda (k)
39               (with-exception-handler
40                 (lambda (x)
41                   (conf-if 'release))
42                 (lambda ()
43                   (conf-if 'claim)
44                   (proc endpoint)))))))
45    (if (condition? r)
46      (signal r)
47      (conf-if 'release))))
48
49;; TODO: Swap arguments
50(define (endpoint-transfer data endpoint)
51  (let-location ((t int))
52    (if (not (zero?
53               (libusb-irq-transfer
54                 (usb-endpoint-device endpoint)
55                 (usb-endpoint-addr endpoint)
56                 data
57                 (u8vector-length data)
58                 (location t)
59                 0)))
60      (error "libusb-irq-transfer failed")
61      t)))