Artifact 0bc8220e661bf5d2382cec74f44e8718743c5268:
- File usb.sls — part of check-in [cd7a31d87b] at 2017-05-03 18:01:41 on branch trunk — many fixes to usb.sls (user: aldo size: 11214)
0000: 3b 3b 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 ;;.;; Copyright 0010: 32 30 31 36 20 41 6c 64 6f 20 4e 69 63 6f 6c 61 2016 Aldo Nicola 0020: 73 20 42 72 75 6e 6f 0a 3b 3b 0a 3b 3b 20 4c 69 s Bruno.;;.;; Li 0030: 63 65 6e 73 65 64 20 75 6e 64 65 72 20 74 68 65 censed under the 0040: 20 41 70 61 63 68 65 20 4c 69 63 65 6e 73 65 2c Apache License, 0050: 20 56 65 72 73 69 6f 6e 20 32 2e 30 20 28 74 68 Version 2.0 (th 0060: 65 20 22 4c 69 63 65 6e 73 65 22 29 3b 0a 3b 3b e "License");.;; 0070: 20 79 6f 75 20 6d 61 79 20 6e 6f 74 20 75 73 65 you may not use 0080: 20 74 68 69 73 20 66 69 6c 65 20 65 78 63 65 70 this file excep 0090: 74 20 69 6e 20 63 6f 6d 70 6c 69 61 6e 63 65 20 t in compliance 00a0: 77 69 74 68 20 74 68 65 20 4c 69 63 65 6e 73 65 with the License 00b0: 2e 0a 3b 3b 20 59 6f 75 20 6d 61 79 20 6f 62 74 ..;; You may obt 00c0: 61 69 6e 20 61 20 63 6f 70 79 20 6f 66 20 74 68 ain a copy of th 00d0: 65 20 4c 69 63 65 6e 73 65 20 61 74 0a 3b 3b 0a e License at.;;. 00e0: 3b 3b 20 20 20 20 20 68 74 74 70 3a 2f 2f 77 77 ;; http://ww 00f0: 77 2e 61 70 61 63 68 65 2e 6f 72 67 2f 6c 69 63 w.apache.org/lic 0100: 65 6e 73 65 73 2f 4c 49 43 45 4e 53 45 2d 32 2e enses/LICENSE-2. 0110: 30 0a 3b 3b 0a 3b 3b 20 55 6e 6c 65 73 73 20 72 0.;;.;; Unless r 0120: 65 71 75 69 72 65 64 20 62 79 20 61 70 70 6c 69 equired by appli 0130: 63 61 62 6c 65 20 6c 61 77 20 6f 72 20 61 67 72 cable law or agr 0140: 65 65 64 20 74 6f 20 69 6e 20 77 72 69 74 69 6e eed to in writin 0150: 67 2c 20 73 6f 66 74 77 61 72 65 0a 3b 3b 20 64 g, software.;; d 0160: 69 73 74 72 69 62 75 74 65 64 20 75 6e 64 65 72 istributed under 0170: 20 74 68 65 20 4c 69 63 65 6e 73 65 20 69 73 20 the License is 0180: 64 69 73 74 72 69 62 75 74 65 64 20 6f 6e 20 61 distributed on a 0190: 6e 20 22 41 53 20 49 53 22 20 42 41 53 49 53 2c n "AS IS" BASIS, 01a0: 0a 3b 3b 20 57 49 54 48 4f 55 54 20 57 41 52 52 .;; WITHOUT WARR 01b0: 41 4e 54 49 45 53 20 4f 52 20 43 4f 4e 44 49 54 ANTIES OR CONDIT 01c0: 49 4f 4e 53 20 4f 46 20 41 4e 59 20 4b 49 4e 44 IONS OF ANY KIND 01d0: 2c 20 65 69 74 68 65 72 20 65 78 70 72 65 73 73 , either express 01e0: 20 6f 72 20 69 6d 70 6c 69 65 64 2e 0a 3b 3b 20 or implied..;; 01f0: 53 65 65 20 74 68 65 20 4c 69 63 65 6e 73 65 20 See the License 0200: 66 6f 72 20 74 68 65 20 73 70 65 63 69 66 69 63 for the specific 0210: 20 6c 61 6e 67 75 61 67 65 20 67 6f 76 65 72 6e language govern 0220: 69 6e 67 20 70 65 72 6d 69 73 73 69 6f 6e 73 20 ing permissions 0230: 61 6e 64 0a 3b 3b 20 6c 69 6d 69 74 61 74 69 6f and.;; limitatio 0240: 6e 73 20 75 6e 64 65 72 20 74 68 65 20 4c 69 63 ns under the Lic 0250: 65 6e 73 65 2e 0a 0a 23 21 63 68 65 7a 73 63 68 ense...#!chezsch 0260: 65 6d 65 0a 28 6c 69 62 72 61 72 79 20 28 75 73 eme.(library (us 0270: 62 29 0a 20 28 65 78 70 6f 72 74 20 0a 20 20 63 b). (export . c 0280: 2d 75 73 62 2d 64 65 76 69 63 65 2d 64 65 73 63 -usb-device-desc 0290: 72 69 70 74 6f 72 0a 20 20 63 2d 75 73 62 2d 64 riptor. c-usb-d 02a0: 65 76 69 63 65 0a 20 20 75 73 62 2d 64 65 76 69 evice. usb-devi 02b0: 63 65 0a 20 20 75 73 62 2d 64 65 76 69 63 65 2d ce. usb-device- 02c0: 68 61 6e 64 6c 65 0a 20 20 75 73 62 2d 64 65 76 handle. usb-dev 02d0: 69 63 65 3f 0a 0a 20 20 75 73 62 2d 69 6e 69 74 ice?.. usb-init 02e0: 0a 20 20 75 73 62 2d 65 78 69 74 0a 20 20 75 73 . usb-exit. us 02f0: 62 2d 67 65 74 2d 64 65 76 69 63 65 2d 6c 69 73 b-get-device-lis 0300: 74 0a 20 20 75 73 62 2d 67 65 74 2d 64 65 76 69 t. usb-get-devi 0310: 63 65 2d 64 65 73 63 72 69 70 74 6f 72 0a 20 20 ce-descriptor. 0320: 0a 20 20 75 73 62 2d 67 65 74 2d 70 6f 72 74 2d . usb-get-port- 0330: 6e 75 6d 62 65 72 0a 20 20 75 73 62 2d 67 65 74 number. usb-get 0340: 2d 70 6f 72 74 2d 6e 75 6d 62 65 72 73 0a 20 20 -port-numbers. 0350: 75 73 62 2d 67 65 74 2d 62 75 73 2d 6e 75 6d 62 usb-get-bus-numb 0360: 65 72 0a 20 20 75 73 62 2d 67 65 74 2d 64 65 76 er. usb-get-dev 0370: 69 63 65 0a 20 20 0a 20 20 75 73 62 2d 66 69 6e ice. . usb-fin 0380: 64 2d 76 69 64 2d 70 69 64 0a 20 20 75 73 62 2d d-vid-pid. usb- 0390: 64 69 73 70 6c 61 79 2d 64 65 76 69 63 65 2d 6c display-device-l 03a0: 69 73 74 0a 20 20 75 73 62 2d 73 74 72 65 72 72 ist. usb-strerr 03b0: 6f 72 0a 20 20 75 73 62 2d 6f 70 65 6e 0a 20 20 or. usb-open. 03c0: 75 73 62 2d 63 6c 6f 73 65 0a 20 20 75 73 62 2d usb-close. usb- 03d0: 63 6c 61 69 6d 2d 69 6e 74 65 72 66 61 63 65 0a claim-interface. 03e0: 20 20 75 73 62 2d 72 65 6c 65 61 73 65 2d 69 6e usb-release-in 03f0: 74 65 72 66 61 63 65 0a 20 20 0a 20 20 75 73 62 terface. . usb 0400: 2d 6c 6f 67 2d 6c 65 76 65 6c 2d 65 6e 75 6d 0a -log-level-enum. 0410: 20 20 75 73 62 2d 6c 6f 67 2d 6c 65 76 65 6c 2d usb-log-level- 0420: 69 6e 64 65 78 0a 20 20 75 73 62 2d 6c 6f 67 2d index. usb-log- 0430: 6c 65 76 65 6c 2d 72 65 66 0a 20 20 75 73 62 2d level-ref. usb- 0440: 73 65 74 2d 64 65 62 75 67 0a 0a 20 20 75 73 62 set-debug.. usb 0450: 2d 63 6f 6e 74 72 6f 6c 2d 74 72 61 6e 73 66 65 -control-transfe 0460: 72 0a 20 20 75 73 62 2d 62 75 6c 6b 2d 72 65 61 r. usb-bulk-rea 0470: 64 0a 20 20 75 73 62 2d 62 75 6c 6b 2d 77 72 69 d. usb-bulk-wri 0480: 74 65 0a 20 20 75 73 62 2d 69 6e 74 65 72 72 75 te. usb-interru 0490: 70 74 2d 77 72 69 74 65 0a 20 20 75 73 62 2d 69 pt-write. usb-i 04a0: 6e 74 65 72 72 75 70 74 2d 72 65 61 64 0a 20 20 nterrupt-read. 04b0: 29 20 3b 65 78 70 6f 72 74 0a 0a 20 28 69 6d 70 ) ;export.. (imp 04c0: 6f 72 74 20 28 63 68 65 7a 73 63 68 65 6d 65 29 ort (chezscheme) 04d0: 0a 09 20 28 6f 6e 6c 79 20 28 66 66 69 2d 75 74 .. (only (ffi-ut 04e0: 69 6c 73 29 20 63 61 73 74 20 63 68 61 72 2a 2d ils) cast char*- 04f0: 3e 62 79 74 65 76 65 63 74 6f 72 29 29 0a 0a 20 >bytevector)).. 0500: 28 64 65 66 69 6e 65 20 6c 69 62 72 61 72 79 2d (define library- 0510: 69 6e 69 74 20 0a 20 20 20 28 62 65 67 69 6e 0a init . (begin. 0520: 20 20 20 20 20 28 6c 6f 61 64 2d 73 68 61 72 65 (load-share 0530: 64 2d 6f 62 6a 65 63 74 20 22 6c 69 62 75 73 62 d-object "libusb 0540: 2d 31 2e 30 2e 73 6f 2e 30 22 29 29 29 0a 0a 20 -1.0.so.0"))).. 0550: 28 64 65 66 69 6e 65 2d 66 74 79 70 65 20 63 2d (define-ftype c- 0560: 75 73 62 2d 64 65 76 69 63 65 20 28 73 74 72 75 usb-device (stru 0570: 63 74 29 29 0a 20 28 64 65 66 69 6e 65 2d 66 74 ct)). (define-ft 0580: 79 70 65 20 63 2d 75 73 62 2d 64 65 76 69 63 65 ype c-usb-device 0590: 2a 2d 61 72 72 61 79 20 28 61 72 72 61 79 20 30 *-array (array 0 05a0: 20 28 2a 20 63 2d 75 73 62 2d 64 65 76 69 63 65 (* c-usb-device 05b0: 29 29 29 0a 20 28 64 65 66 69 6e 65 2d 66 74 79 ))). (define-fty 05c0: 70 65 20 63 2d 75 73 62 2d 64 65 76 69 63 65 2a pe c-usb-device* 05d0: 2a 2a 20 28 2a 20 63 2d 75 73 62 2d 64 65 76 69 ** (* c-usb-devi 05e0: 63 65 2a 2d 61 72 72 61 79 29 29 0a 20 28 64 65 ce*-array)). (de 05f0: 66 69 6e 65 2d 66 74 79 70 65 20 75 73 62 2d 64 fine-ftype usb-d 0600: 65 76 69 63 65 2d 68 61 6e 64 6c 65 2a 20 76 6f evice-handle* vo 0610: 69 64 2a 29 0a 20 28 64 65 66 69 6e 65 2d 66 74 id*). (define-ft 0620: 79 70 65 20 75 73 62 2d 64 65 76 69 63 65 2d 68 ype usb-device-h 0630: 61 6e 64 6c 65 2a 2a 20 28 2a 20 75 73 62 2d 64 andle** (* usb-d 0640: 65 76 69 63 65 2d 68 61 6e 64 6c 65 2a 29 29 0a evice-handle*)). 0650: 0a 20 28 64 65 66 69 6e 65 2d 66 74 79 70 65 20 . (define-ftype 0660: 63 2d 75 73 62 2d 64 65 76 69 63 65 2d 64 65 73 c-usb-device-des 0670: 63 72 69 70 74 6f 72 20 0a 20 20 20 28 73 74 72 criptor . (str 0680: 75 63 74 20 0a 20 20 20 20 20 20 20 5b 6c 65 6e uct . [len 0690: 67 74 68 20 75 6e 73 69 67 6e 65 64 2d 38 5d 0a gth unsigned-8]. 06a0: 20 20 20 20 20 20 20 5b 74 79 70 65 20 75 6e 73 [type uns 06b0: 69 67 6e 65 64 2d 38 5d 0a 20 20 20 20 20 20 20 igned-8]. 06c0: 5b 55 53 42 20 75 6e 73 69 67 6e 65 64 2d 31 36 [USB unsigned-16 06d0: 5d 0a 20 20 20 20 20 20 20 5b 63 6c 61 73 73 20 ]. [class 06e0: 75 6e 73 69 67 6e 65 64 2d 38 5d 0a 20 20 20 20 unsigned-8]. 06f0: 20 20 20 5b 73 75 62 63 6c 61 73 73 20 75 6e 73 [subclass uns 0700: 69 67 6e 65 64 2d 38 5d 0a 20 20 20 20 20 20 20 igned-8]. 0710: 5b 70 72 6f 74 6f 63 6f 6c 20 75 6e 73 69 67 6e [protocol unsign 0720: 65 64 2d 38 5d 0a 20 20 20 20 20 20 20 5b 6d 61 ed-8]. [ma 0730: 78 2d 70 61 63 6b 65 74 2d 73 69 7a 65 20 75 6e x-packet-size un 0740: 73 69 67 6e 65 64 2d 38 5d 0a 20 20 20 20 20 20 signed-8]. 0750: 20 5b 76 65 6e 64 6f 72 20 75 6e 73 69 67 6e 65 [vendor unsigne 0760: 64 2d 31 36 5d 0a 20 20 20 20 20 20 20 5b 70 72 d-16]. [pr 0770: 6f 64 75 63 74 20 75 6e 73 69 67 6e 65 64 2d 31 oduct unsigned-1 0780: 36 5d 0a 20 20 20 20 20 20 20 5b 64 65 76 69 63 6]. [devic 0790: 65 20 75 6e 73 69 67 6e 65 64 2d 31 36 5d 0a 20 e unsigned-16]. 07a0: 20 20 20 20 20 20 5b 6d 61 6e 75 66 61 63 74 75 [manufactu 07b0: 72 65 72 20 75 6e 73 69 67 6e 65 64 2d 38 5d 0a rer unsigned-8]. 07c0: 20 20 20 20 20 20 20 5b 70 72 6f 64 75 63 74 2d [product- 07d0: 69 6e 64 65 78 20 75 6e 73 69 67 6e 65 64 2d 38 index unsigned-8 07e0: 5d 0a 20 20 20 20 20 20 20 5b 73 65 72 69 61 6c ]. [serial 07f0: 2d 6e 75 6d 62 65 72 2d 69 6e 64 65 78 20 75 6e -number-index un 0800: 73 69 67 6e 65 64 2d 38 5d 0a 20 20 20 20 20 20 signed-8]. 0810: 20 5b 6e 75 6d 2d 63 6f 6e 66 69 67 75 72 61 74 [num-configurat 0820: 69 6f 6e 73 20 75 6e 73 69 67 6e 65 64 2d 38 5d ions unsigned-8] 0830: 0a 20 20 20 20 20 29 29 0a 0a 20 28 64 65 66 69 . )).. (defi 0840: 6e 65 2d 72 65 63 6f 72 64 2d 74 79 70 65 20 28 ne-record-type ( 0850: 75 73 62 2d 64 65 76 69 63 65 20 6d 61 6b 65 2d usb-device make- 0860: 75 73 62 2d 64 65 76 69 63 65 25 20 75 73 62 2d usb-device% usb- 0870: 64 65 76 69 63 65 3f 29 0a 20 20 20 28 66 69 65 device?). (fie 0880: 6c 64 73 0a 20 20 20 20 28 6d 75 74 61 62 6c 65 lds. (mutable 0890: 20 70 74 72 29 29 29 0a 20 28 64 65 66 69 6e 65 ptr))). (define 08a0: 2d 72 65 63 6f 72 64 2d 74 79 70 65 20 75 73 62 -record-type usb 08b0: 2d 64 65 76 69 63 65 2d 68 61 6e 64 6c 65 0a 20 -device-handle. 08c0: 20 20 28 66 69 65 6c 64 73 0a 20 20 20 20 28 6d (fields. (m 08d0: 75 74 61 62 6c 65 20 70 74 72 29 29 29 0a 0a 20 utable ptr))).. 08e0: 28 64 65 66 69 6e 65 20 75 73 62 2d 67 75 61 72 (define usb-guar 08f0: 64 69 61 6e 20 28 6d 61 6b 65 2d 67 75 61 72 64 dian (make-guard 0900: 69 61 6e 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 ian)).. (define 0910: 28 6d 61 6b 65 2d 75 73 62 2d 64 65 76 69 63 65 (make-usb-device 0920: 20 70 74 72 29 0a 20 20 20 28 75 73 62 2d 67 75 ptr). (usb-gu 0930: 61 72 64 69 61 6e 20 70 74 72 29 0a 20 20 20 28 ardian ptr). ( 0940: 6d 61 6b 65 2d 75 73 62 2d 64 65 76 69 63 65 25 make-usb-device% 0950: 20 70 74 72 29 29 0a 0a 20 28 64 65 66 69 6e 65 ptr)).. (define 0960: 20 28 75 73 62 2d 64 65 76 69 63 65 2d 61 64 64 (usb-device-add 0970: 72 20 64 65 76 29 0a 20 20 20 28 66 74 79 70 65 r dev). (ftype 0980: 2d 70 6f 69 6e 74 65 72 2d 61 64 64 72 65 73 73 -pointer-address 0990: 20 28 75 73 62 2d 64 65 76 69 63 65 2d 70 74 72 (usb-device-ptr 09a0: 20 64 65 76 29 29 29 0a 0a 20 28 64 65 66 69 6e dev))).. (defin 09b0: 65 20 28 75 73 62 2d 64 65 76 69 63 65 2d 68 61 e (usb-device-ha 09c0: 6e 64 6c 65 2d 61 64 64 72 20 64 65 76 29 0a 20 ndle-addr dev). 09d0: 20 20 28 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 (ftype-pointer 09e0: 2d 61 64 64 72 65 73 73 20 28 75 73 62 2d 64 65 -address (usb-de 09f0: 76 69 63 65 2d 68 61 6e 64 6c 65 2d 70 74 72 20 vice-handle-ptr 0a00: 64 65 76 29 29 29 0a 0a 20 28 64 65 66 69 6e 65 dev))).. (define 0a10: 20 28 75 73 62 2d 66 72 65 65 2d 67 61 72 62 61 (usb-free-garba 0a20: 67 65 29 0a 20 20 20 28 6c 65 74 20 6c 6f 6f 70 ge). (let loop 0a30: 20 28 5b 70 20 28 75 73 62 2d 67 75 61 72 64 69 ([p (usb-guardi 0a40: 61 6e 29 5d 29 0a 20 20 20 20 20 28 77 68 65 6e an)]). (when 0a50: 20 70 0a 20 20 20 20 20 20 20 28 77 68 65 6e 20 p. (when 0a60: 28 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 3f 20 (ftype-pointer? 0a70: 70 29 0a 09 20 3b 28 70 72 69 6e 74 66 20 22 66 p).. ;(printf "f 0a80: 72 65 65 69 6e 67 20 6d 65 6d 6f 72 79 20 61 74 reeing memory at 0a90: 20 7e 78 5c 6e 22 20 70 29 0a 09 20 28 63 6f 6e ~x\n" p).. (con 0aa0: 64 20 5b 28 66 74 79 70 65 2d 70 6f 69 6e 74 65 d [(ftype-pointe 0ab0: 72 3f 20 63 2d 75 73 62 2d 64 65 76 69 63 65 2a r? c-usb-device* 0ac0: 2d 61 72 72 61 79 20 70 29 0a 09 09 3b 20 46 49 -array p)...; FI 0ad0: 58 4d 45 20 54 48 49 53 20 48 41 4e 47 53 20 49 XME THIS HANGS I 0ae0: 46 20 45 4e 41 42 4c 45 44 0a 09 09 23 3b 28 28 F ENABLED...#;(( 0af0: 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 foreign-procedur 0b00: 65 20 22 6c 69 62 75 73 62 5f 66 72 65 65 5f 64 e "libusb_free_d 0b10: 65 76 69 63 65 5f 6c 69 73 74 22 20 28 76 6f 69 evice_list" (voi 0b20: 64 2a 20 69 6e 74 29 20 76 6f 69 64 29 0a 09 09 d* int) void)... 0b30: 20 28 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 2d (ftype-pointer- 0b40: 61 64 64 72 65 73 73 20 70 29 20 30 29 5d 0a 09 address p) 0)].. 0b50: 20 20 20 20 20 20 20 5b 28 66 74 79 70 65 2d 70 [(ftype-p 0b60: 6f 69 6e 74 65 72 3f 20 63 2d 75 73 62 2d 64 65 ointer? c-usb-de 0b70: 76 69 63 65 20 70 29 0a 09 09 28 28 66 6f 72 65 vice p)...((fore 0b80: 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 6c ign-procedure "l 0b90: 69 62 75 73 62 5f 75 6e 72 65 66 5f 64 65 76 69 ibusb_unref_devi 0ba0: 63 65 22 20 28 28 2a 20 63 2d 75 73 62 2d 64 65 ce" ((* c-usb-de 0bb0: 76 69 63 65 29 29 20 76 6f 69 64 29 20 70 29 5d vice)) void) p)] 0bc0: 0a 09 20 20 20 20 20 20 20 5b 65 6c 73 65 0a 09 .. [else.. 0bd0: 09 28 66 6f 72 65 69 67 6e 2d 66 72 65 65 20 28 .(foreign-free ( 0be0: 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 2d 61 64 ftype-pointer-ad 0bf0: 64 72 65 73 73 20 70 29 29 5d 29 29 0a 20 20 20 dress p))])). 0c00: 20 20 20 20 28 6c 6f 6f 70 20 28 75 73 62 2d 67 (loop (usb-g 0c10: 75 61 72 64 69 61 6e 29 29 29 29 29 0a 20 20 20 uardian))))). 0c20: 0a 20 28 64 65 66 69 6e 65 20 28 75 73 62 2d 67 . (define (usb-g 0c30: 65 74 2d 64 65 76 69 63 65 2d 6c 69 73 74 29 0a et-device-list). 0c40: 20 20 20 28 75 73 62 2d 66 72 65 65 2d 67 61 72 (usb-free-gar 0c50: 62 61 67 65 29 0a 20 20 20 28 6c 65 74 2a 20 28 bage). (let* ( 0c60: 5b 70 74 72 20 28 6d 61 6b 65 2d 66 74 79 70 65 [ptr (make-ftype 0c70: 2d 70 6f 69 6e 74 65 72 20 63 2d 75 73 62 2d 64 -pointer c-usb-d 0c80: 65 76 69 63 65 2a 2a 2a 20 28 66 6f 72 65 69 67 evice*** (foreig 0c90: 6e 2d 61 6c 6c 6f 63 20 28 66 74 79 70 65 2d 73 n-alloc (ftype-s 0ca0: 69 7a 65 6f 66 20 63 2d 75 73 62 2d 64 65 76 69 izeof c-usb-devi 0cb0: 63 65 2a 2a 2a 29 29 29 5d 0a 09 20 20 5b 66 20 ce***)))].. [f 0cc0: 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 (foreign-procedu 0cd0: 72 65 20 22 6c 69 62 75 73 62 5f 67 65 74 5f 64 re "libusb_get_d 0ce0: 65 76 69 63 65 5f 6c 69 73 74 22 20 28 76 6f 69 evice_list" (voi 0cf0: 64 2a 20 76 6f 69 64 2a 29 20 69 6e 74 29 5d 0a d* void*) int)]. 0d00: 09 20 20 5b 25 67 20 28 75 73 62 2d 67 75 61 72 . [%g (usb-guar 0d10: 64 69 61 6e 20 70 74 72 29 5d 0a 09 20 20 5b 65 dian ptr)].. [e 0d20: 20 28 66 20 30 20 28 66 74 79 70 65 2d 70 6f 69 (f 0 (ftype-poi 0d30: 6e 74 65 72 2d 61 64 64 72 65 73 73 20 70 74 72 nter-address ptr 0d40: 29 29 5d 29 0a 20 20 20 20 20 28 69 66 20 28 3c ))]). (if (< 0d50: 20 65 20 30 29 0a 09 20 28 65 72 72 6f 72 20 27 e 0).. (error ' 0d60: 75 73 62 2d 67 65 74 2d 64 65 76 69 63 65 2d 6c usb-get-device-l 0d70: 69 73 74 20 22 65 72 72 6f 72 22 20 65 29 29 0a ist "error" e)). 0d80: 20 20 20 20 20 28 6c 65 74 20 28 28 64 65 76 69 (let ((devi 0d90: 63 65 73 20 28 66 74 79 70 65 2d 26 72 65 66 20 ces (ftype-&ref 0da0: 63 2d 75 73 62 2d 64 65 76 69 63 65 2a 2a 2a 20 c-usb-device*** 0db0: 28 2a 29 20 70 74 72 29 29 29 0a 20 20 20 20 20 (*) ptr))). 0dc0: 20 20 28 75 73 62 2d 67 75 61 72 64 69 61 6e 20 (usb-guardian 0dd0: 64 65 76 69 63 65 73 29 0a 20 20 20 20 20 20 20 devices). 0de0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 (let loop ((i 0) 0df0: 20 28 6c 20 27 28 29 29 29 0a 09 20 28 69 66 20 (l '())).. (if 0e00: 28 3e 3d 20 69 20 65 29 20 6c 0a 09 20 20 20 20 (>= i e) l.. 0e10: 20 28 6c 6f 6f 70 20 28 66 78 2b 20 69 20 31 29 (loop (fx+ i 1) 0e20: 20 0a 09 09 20 20 20 28 63 6f 6e 73 20 28 6d 61 ... (cons (ma 0e30: 6b 65 2d 75 73 62 2d 64 65 76 69 63 65 0a 09 09 ke-usb-device... 0e40: 09 20 20 20 28 66 74 79 70 65 2d 72 65 66 20 63 . (ftype-ref c 0e50: 2d 75 73 62 2d 64 65 76 69 63 65 2a 2d 61 72 72 -usb-device*-arr 0e60: 61 79 20 28 69 29 20 64 65 76 69 63 65 73 29 29 ay (i) devices)) 0e70: 20 6c 29 29 29 29 29 29 29 0a 0a 20 28 64 65 66 l))))))).. (def 0e80: 69 6e 65 20 28 75 73 62 2d 67 65 74 2d 64 65 76 ine (usb-get-dev 0e90: 69 63 65 2d 64 65 73 63 72 69 70 74 6f 72 20 64 ice-descriptor d 0ea0: 65 76 29 0a 20 20 20 28 75 73 62 2d 66 72 65 65 ev). (usb-free 0eb0: 2d 67 61 72 62 61 67 65 29 0a 20 20 20 28 6c 65 -garbage). (le 0ec0: 74 2a 20 28 5b 70 74 72 20 28 6d 61 6b 65 2d 66 t* ([ptr (make-f 0ed0: 74 79 70 65 2d 70 6f 69 6e 74 65 72 20 63 2d 75 type-pointer c-u 0ee0: 73 62 2d 64 65 76 69 63 65 2d 64 65 73 63 72 69 sb-device-descri 0ef0: 70 74 6f 72 20 0a 09 09 09 09 20 20 20 28 66 6f ptor ..... (fo 0f00: 72 65 69 67 6e 2d 61 6c 6c 6f 63 20 28 66 74 79 reign-alloc (fty 0f10: 70 65 2d 73 69 7a 65 6f 66 20 63 2d 75 73 62 2d pe-sizeof c-usb- 0f20: 64 65 76 69 63 65 2d 64 65 73 63 72 69 70 74 6f device-descripto 0f30: 72 29 29 29 5d 0a 09 20 20 5b 25 67 20 28 75 73 r)))].. [%g (us 0f40: 62 2d 67 75 61 72 64 69 61 6e 20 70 74 72 29 5d b-guardian ptr)] 0f50: 0a 09 20 20 5b 66 20 28 66 6f 72 65 69 67 6e 2d .. [f (foreign- 0f60: 70 72 6f 63 65 64 75 72 65 20 22 6c 69 62 75 73 procedure "libus 0f70: 62 5f 67 65 74 5f 64 65 76 69 63 65 5f 64 65 73 b_get_device_des 0f80: 63 72 69 70 74 6f 72 22 20 28 28 2a 20 63 2d 75 criptor" ((* c-u 0f90: 73 62 2d 64 65 76 69 63 65 29 20 28 2a 20 63 2d sb-device) (* c- 0fa0: 75 73 62 2d 64 65 76 69 63 65 2d 64 65 73 63 72 usb-device-descr 0fb0: 69 70 74 6f 72 29 29 20 69 6e 74 29 5d 0a 09 20 iptor)) int)].. 0fc0: 20 5b 65 20 28 66 20 28 75 73 62 2d 64 65 76 69 [e (f (usb-devi 0fd0: 63 65 2d 70 74 72 20 64 65 76 29 20 70 74 72 20 ce-ptr dev) ptr 0fe0: 29 5d 29 0a 20 20 20 20 20 28 69 66 20 28 3c 20 )]). (if (< 0ff0: 65 20 30 29 0a 09 20 28 65 72 72 6f 72 20 27 75 e 0).. (error 'u 1000: 73 62 2d 67 65 74 2d 64 65 76 69 63 65 2d 64 65 sb-get-device-de 1010: 73 63 72 69 70 74 6f 72 20 22 65 72 72 6f 72 22 scriptor "error" 1020: 20 65 29 0a 09 20 70 74 72 29 29 29 0a 0a 20 20 e).. ptr))).. 1030: 28 64 65 66 69 6e 65 20 28 75 73 62 2d 72 65 66 (define (usb-ref 1040: 2d 64 65 76 69 63 65 20 64 65 76 29 0a 20 20 20 -device dev). 1050: 28 6c 65 74 2a 20 28 5b 66 20 28 66 6f 72 65 69 (let* ([f (forei 1060: 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 6c 69 gn-procedure "li 1070: 62 75 73 62 5f 72 65 66 5f 64 65 76 69 63 65 22 busb_ref_device" 1080: 20 28 28 2a 20 63 2d 75 73 62 2d 64 65 76 69 63 ((* c-usb-devic 1090: 65 29 20 29 20 28 2a 20 63 2d 75 73 62 2d 64 65 e) ) (* c-usb-de 10a0: 76 69 63 65 29 29 5d 0a 09 20 20 5b 70 74 72 20 vice))].. [ptr 10b0: 28 66 20 64 65 76 29 5d 29 0a 20 20 20 20 20 70 (f dev)]). p 10c0: 74 72 29 29 0a 0a 20 20 3b 3b 46 49 58 4d 45 3a tr)).. ;;FIXME: 10d0: 20 74 68 69 73 20 77 6f 75 6c 64 20 63 61 75 73 this would caus 10e0: 65 20 70 72 6f 62 6c 65 6d 73 20 69 66 20 74 68 e problems if th 10f0: 65 20 64 65 76 69 63 65 20 69 73 20 66 72 65 65 e device is free 1100: 64 3f 0a 20 20 28 64 65 66 69 6e 65 20 28 75 73 d?. (define (us 1110: 62 2d 67 65 74 2d 64 65 76 69 63 65 20 64 65 76 b-get-device dev 1120: 29 0a 20 20 20 28 75 73 62 2d 66 72 65 65 2d 67 ). (usb-free-g 1130: 61 72 62 61 67 65 29 0a 20 20 20 28 6c 65 74 2a arbage). (let* 1140: 20 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 ([f (foreign-pr 1150: 6f 63 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f ocedure "libusb_ 1160: 67 65 74 5f 64 65 76 69 63 65 22 20 28 75 73 62 get_device" (usb 1170: 2d 64 65 76 69 63 65 2d 68 61 6e 64 6c 65 2a 29 -device-handle*) 1180: 20 28 2a 20 63 2d 75 73 62 2d 64 65 76 69 63 65 (* c-usb-device 1190: 29 29 5d 0a 09 20 20 5b 70 74 72 20 28 66 20 28 ))].. [ptr (f ( 11a0: 75 73 62 2d 64 65 76 69 63 65 2d 68 61 6e 64 6c usb-device-handl 11b0: 65 2d 61 64 64 72 20 64 65 76 29 20 29 5d 29 0a e-addr dev) )]). 11c0: 20 20 20 20 20 28 6d 61 6b 65 2d 75 73 62 2d 64 (make-usb-d 11d0: 65 76 69 63 65 20 28 75 73 62 2d 72 65 66 2d 64 evice (usb-ref-d 11e0: 65 76 69 63 65 20 70 74 72 29 29 29 29 0a 0a 20 evice ptr)))).. 11f0: 28 64 65 66 69 6e 65 20 28 75 73 62 2d 69 6e 69 (define (usb-ini 1200: 74 29 20 0a 20 20 20 28 6c 65 74 20 28 5b 65 20 t) . (let ([e 1210: 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 ((foreign-proced 1220: 75 72 65 20 22 6c 69 62 75 73 62 5f 69 6e 69 74 ure "libusb_init 1230: 22 20 28 76 6f 69 64 2a 29 20 69 6e 74 29 20 30 " (void*) int) 0 1240: 29 5d 29 0a 20 20 20 20 20 28 77 68 65 6e 20 28 )]). (when ( 1250: 3c 20 65 20 30 29 0a 20 20 20 20 20 20 20 28 65 < e 0). (e 1260: 72 72 6f 72 20 27 75 73 62 2d 69 6e 69 74 20 22 rror 'usb-init " 1270: 65 72 72 6f 72 22 20 65 29 29 0a 20 20 20 20 20 error" e)). 1280: 23 74 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 #t)).. (define ( 1290: 75 73 62 2d 65 78 69 74 29 20 0a 20 20 20 28 75 usb-exit) . (u 12a0: 73 62 2d 66 72 65 65 2d 67 61 72 62 61 67 65 29 sb-free-garbage) 12b0: 0a 20 20 20 28 6c 65 74 20 28 5b 65 20 28 28 66 . (let ([e ((f 12c0: 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 oreign-procedure 12d0: 20 22 6c 69 62 75 73 62 5f 65 78 69 74 22 20 28 "libusb_exit" ( 12e0: 76 6f 69 64 2a 29 20 69 6e 74 29 20 30 29 5d 29 void*) int) 0)]) 12f0: 0a 20 20 20 20 20 28 77 68 65 6e 20 28 3c 20 65 . (when (< e 1300: 20 30 29 0a 20 20 20 20 20 20 20 28 65 72 72 6f 0). (erro 1310: 72 20 27 75 73 62 2d 65 78 69 74 20 22 65 72 72 r 'usb-exit "err 1320: 6f 72 22 20 65 29 29 0a 20 20 20 20 20 23 74 29 or" e)). #t) 1330: 29 0a 0a 20 28 64 65 66 69 6e 65 20 75 73 62 2d ).. (define usb- 1340: 6c 6f 67 2d 6c 65 76 65 6c 2d 65 6e 75 6d 20 28 log-level-enum ( 1350: 6d 61 6b 65 2d 65 6e 75 6d 65 72 61 74 69 6f 6e make-enumeration 1360: 20 27 28 6e 6f 6e 65 20 65 72 72 6f 72 20 77 61 '(none error wa 1370: 72 6e 69 6e 67 20 69 6e 66 6f 20 64 65 62 75 67 rning info debug 1380: 29 29 29 0a 20 28 64 65 66 69 6e 65 20 75 73 62 ))). (define usb 1390: 2d 6c 6f 67 2d 6c 65 76 65 6c 2d 69 6e 64 65 78 -log-level-index 13a0: 20 28 65 6e 75 6d 2d 73 65 74 2d 69 6e 64 65 78 (enum-set-index 13b0: 65 72 20 75 73 62 2d 6c 6f 67 2d 6c 65 76 65 6c er usb-log-level 13c0: 2d 65 6e 75 6d 29 29 0a 20 28 64 65 66 69 6e 65 -enum)). (define 13d0: 20 28 75 73 62 2d 6c 6f 67 2d 6c 65 76 65 6c 2d (usb-log-level- 13e0: 72 65 66 20 69 6e 64 65 78 29 0a 20 20 20 28 6c ref index). (l 13f0: 69 73 74 2d 72 65 66 20 28 65 6e 75 6d 2d 73 65 ist-ref (enum-se 1400: 74 2d 3e 6c 69 73 74 20 75 73 62 2d 6c 6f 67 2d t->list usb-log- 1410: 6c 65 76 65 6c 2d 65 6e 75 6d 29 20 69 6e 64 65 level-enum) inde 1420: 78 29 29 0a 0a 20 28 64 65 66 69 6e 65 20 28 75 x)).. (define (u 1430: 73 62 2d 73 65 74 2d 64 65 62 75 67 20 6c 65 76 sb-set-debug lev 1440: 65 6c 29 20 0a 20 20 20 28 6c 65 74 20 28 5b 65 el) . (let ([e 1450: 20 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 ((foreign-proce 1460: 64 75 72 65 20 22 6c 69 62 75 73 62 5f 73 65 74 dure "libusb_set 1470: 5f 64 65 62 75 67 22 20 28 76 6f 69 64 2a 20 69 _debug" (void* i 1480: 6e 74 29 20 69 6e 74 29 20 0a 09 20 20 20 20 20 nt) int) .. 1490: 30 20 3b 20 46 49 58 4d 45 3a 20 63 74 78 20 4e 0 ; FIXME: ctx N 14a0: 55 4c 4c 2c 20 61 6c 6c 6f 77 20 6d 75 6c 74 69 ULL, allow multi 14b0: 70 6c 65 20 63 6f 6e 74 65 78 74 73 3f 0a 09 20 ple contexts?.. 14c0: 20 20 20 20 28 75 73 62 2d 6c 6f 67 2d 6c 65 76 (usb-log-lev 14d0: 65 6c 2d 69 6e 64 65 78 20 6c 65 76 65 6c 29 29 el-index level)) 14e0: 5d 29 0a 20 20 20 20 20 28 77 68 65 6e 20 28 3c ]). (when (< 14f0: 20 65 20 30 29 0a 20 20 20 20 20 20 20 28 65 72 e 0). (er 1500: 72 6f 72 20 27 75 73 62 2d 65 78 69 74 20 22 65 ror 'usb-exit "e 1510: 72 72 6f 72 22 20 65 29 29 0a 20 20 20 20 20 28 rror" e)). ( 1520: 76 6f 69 64 29 29 29 0a 0a 20 28 64 65 66 69 6e void))).. (defin 1530: 65 20 28 75 73 62 2d 73 74 72 65 72 72 6f 72 20 e (usb-strerror 1540: 63 6f 64 65 29 0a 20 20 20 20 28 28 66 6f 72 65 code). ((fore 1550: 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 6c ign-procedure "l 1560: 69 62 75 73 62 5f 73 74 72 65 72 72 6f 72 22 20 ibusb_strerror" 1570: 28 69 6e 74 29 20 73 74 72 69 6e 67 29 20 63 6f (int) string) co 1580: 64 65 29 29 0a 20 0a 20 28 64 65 66 69 6e 65 20 de)). . (define 1590: 28 75 73 62 2d 66 69 6e 64 2d 76 69 64 2d 70 69 (usb-find-vid-pi 15a0: 64 20 76 69 64 20 70 69 64 29 20 0a 20 20 20 28 d vid pid) . ( 15b0: 66 69 6c 74 65 72 20 0a 20 20 20 20 28 6c 61 6d filter . (lam 15c0: 62 64 61 20 28 64 65 76 29 0a 20 20 20 20 20 20 bda (dev). 15d0: 28 6c 65 74 20 28 5b 64 65 73 63 72 69 70 74 6f (let ([descripto 15e0: 72 20 28 75 73 62 2d 67 65 74 2d 64 65 76 69 63 r (usb-get-devic 15f0: 65 2d 64 65 73 63 72 69 70 74 6f 72 20 64 65 76 e-descriptor dev 1600: 29 5d 29 0a 09 28 61 6e 64 20 28 65 71 75 61 6c )])..(and (equal 1610: 3f 20 28 66 74 79 70 65 2d 72 65 66 20 63 2d 75 ? (ftype-ref c-u 1620: 73 62 2d 64 65 76 69 63 65 2d 64 65 73 63 72 69 sb-device-descri 1630: 70 74 6f 72 20 28 76 65 6e 64 6f 72 29 20 64 65 ptor (vendor) de 1640: 73 63 72 69 70 74 6f 72 29 20 76 69 64 29 0a 09 scriptor) vid).. 1650: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 66 74 (equal? (ft 1660: 79 70 65 2d 72 65 66 20 63 2d 75 73 62 2d 64 65 ype-ref c-usb-de 1670: 76 69 63 65 2d 64 65 73 63 72 69 70 74 6f 72 20 vice-descriptor 1680: 28 70 72 6f 64 75 63 74 29 20 64 65 73 63 72 69 (product) descri 1690: 70 74 6f 72 29 20 70 69 64 29 29 29 29 0a 20 20 ptor) pid)))). 16a0: 20 20 28 75 73 62 2d 67 65 74 2d 64 65 76 69 63 (usb-get-devic 16b0: 65 2d 6c 69 73 74 29 29 29 0a 0a 20 28 64 65 66 e-list))).. (def 16c0: 69 6e 65 20 28 75 73 62 2d 64 69 73 70 6c 61 79 ine (usb-display 16d0: 2d 64 65 76 69 63 65 2d 6c 69 73 74 29 0a 20 20 -device-list). 16e0: 20 28 70 72 65 74 74 79 2d 70 72 69 6e 74 20 0a (pretty-print . 16f0: 20 20 20 20 28 6d 61 70 0a 20 20 20 20 20 28 6c (map. (l 1700: 61 6d 62 64 61 20 28 64 65 76 29 20 0a 20 20 20 ambda (dev) . 1710: 20 20 20 20 28 66 74 79 70 65 2d 70 6f 69 6e 74 (ftype-point 1720: 65 72 2d 3e 73 65 78 70 72 20 28 75 73 62 2d 67 er->sexpr (usb-g 1730: 65 74 2d 64 65 76 69 63 65 2d 64 65 73 63 72 69 et-device-descri 1740: 70 74 6f 72 20 64 65 76 29 29 29 0a 20 20 20 20 ptor dev))). 1750: 20 28 75 73 62 2d 67 65 74 2d 64 65 76 69 63 65 (usb-get-device 1760: 2d 6c 69 73 74 29 29 29 29 0a 0a 20 28 64 65 66 -list)))).. (def 1770: 69 6e 65 20 28 75 73 62 2d 67 65 74 2d 70 6f 72 ine (usb-get-por 1780: 74 2d 6e 75 6d 62 65 72 20 64 65 76 29 0a 20 20 t-number dev). 1790: 20 28 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 ((foreign-proce 17a0: 64 75 72 65 20 22 6c 69 62 75 73 62 5f 67 65 74 dure "libusb_get 17b0: 5f 70 6f 72 74 5f 6e 75 6d 62 65 72 22 20 28 76 _port_number" (v 17c0: 6f 69 64 2a 29 20 75 6e 73 69 67 6e 65 64 2d 38 oid*) unsigned-8 17d0: 29 20 28 75 73 62 2d 64 65 76 69 63 65 2d 61 64 ) (usb-device-ad 17e0: 64 72 20 64 65 76 29 29 29 0a 20 0a 20 28 64 65 dr dev))). . (de 17f0: 66 69 6e 65 20 28 75 73 62 2d 67 65 74 2d 70 6f fine (usb-get-po 1800: 72 74 2d 6e 75 6d 62 65 72 73 20 64 65 76 29 0a rt-numbers dev). 1810: 20 20 20 28 6c 65 74 2a 20 28 5b 6c 20 28 6d 61 (let* ([l (ma 1820: 6b 65 2d 62 79 74 65 76 65 63 74 6f 72 20 31 30 ke-bytevector 10 1830: 29 5d 0a 09 20 20 5b 70 20 28 66 6f 72 65 69 67 )].. [p (foreig 1840: 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 6c 69 62 n-procedure "lib 1850: 75 73 62 5f 67 65 74 5f 70 6f 72 74 5f 6e 75 6d usb_get_port_num 1860: 62 65 72 73 22 20 28 76 6f 69 64 2a 20 75 38 2a bers" (void* u8* 1870: 20 69 6e 74 29 0a 09 09 09 09 75 6e 73 69 67 6e int).....unsign 1880: 65 64 2d 38 29 5d 0a 09 20 20 5b 65 20 28 70 20 ed-8)].. [e (p 1890: 28 75 73 62 2d 64 65 76 69 63 65 2d 61 64 64 72 (usb-device-addr 18a0: 20 64 65 76 29 20 6c 20 28 62 79 74 65 76 65 63 dev) l (bytevec 18b0: 74 6f 72 2d 6c 65 6e 67 74 68 20 6c 29 29 5d 29 tor-length l))]) 18c0: 0a 20 20 20 20 20 20 20 28 77 68 65 6e 20 28 3c . (when (< 18d0: 20 65 20 30 29 0a 09 20 28 65 72 72 6f 72 20 27 e 0).. (error ' 18e0: 75 73 62 2d 6f 70 65 6e 20 28 75 73 62 2d 73 74 usb-open (usb-st 18f0: 72 65 72 72 6f 72 20 65 29 20 65 29 29 0a 20 20 rerror e) e)). 1900: 20 20 20 20 20 28 6c 69 73 74 2d 68 65 61 64 20 (list-head 1910: 28 62 79 74 65 76 65 63 74 6f 72 2d 3e 75 38 2d (bytevector->u8- 1920: 6c 69 73 74 20 6c 29 20 65 29 29 29 0a 0a 20 28 list l) e))).. ( 1930: 64 65 66 69 6e 65 20 28 75 73 62 2d 67 65 74 2d define (usb-get- 1940: 62 75 73 2d 6e 75 6d 62 65 72 20 64 65 76 29 0a bus-number dev). 1950: 20 20 20 20 28 28 66 6f 72 65 69 67 6e 2d 70 72 ((foreign-pr 1960: 6f 63 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f ocedure "libusb_ 1970: 67 65 74 5f 62 75 73 5f 6e 75 6d 62 65 72 22 20 get_bus_number" 1980: 28 76 6f 69 64 2a 29 20 75 6e 73 69 67 6e 65 64 (void*) unsigned 1990: 2d 38 29 20 28 75 73 62 2d 64 65 76 69 63 65 2d -8) (usb-device- 19a0: 61 64 64 72 20 64 65 76 29 29 29 0a 0a 20 28 64 addr dev))).. (d 19b0: 65 66 69 6e 65 20 28 75 73 62 2d 6f 70 65 6e 20 efine (usb-open 19c0: 64 65 76 69 63 65 29 0a 20 20 20 28 61 73 73 65 device). (asse 19d0: 72 74 20 28 61 6e 64 20 27 75 73 62 2d 6f 70 65 rt (and 'usb-ope 19e0: 6e 20 28 75 73 62 2d 64 65 76 69 63 65 3f 20 64 n (usb-device? d 19f0: 65 76 69 63 65 29 29 29 0a 20 20 20 28 75 73 62 evice))). (usb 1a00: 2d 66 72 65 65 2d 67 61 72 62 61 67 65 29 0a 20 -free-garbage). 1a10: 20 20 28 6c 65 74 2a 20 28 5b 70 74 72 20 28 6d (let* ([ptr (m 1a20: 61 6b 65 2d 66 74 79 70 65 2d 70 6f 69 6e 74 65 ake-ftype-pointe 1a30: 72 20 75 73 62 2d 64 65 76 69 63 65 2d 68 61 6e r usb-device-han 1a40: 64 6c 65 2a 2a 20 0a 09 09 09 09 20 20 20 28 66 dle** ..... (f 1a50: 6f 72 65 69 67 6e 2d 61 6c 6c 6f 63 20 28 66 74 oreign-alloc (ft 1a60: 79 70 65 2d 73 69 7a 65 6f 66 20 75 73 62 2d 64 ype-sizeof usb-d 1a70: 65 76 69 63 65 2d 68 61 6e 64 6c 65 2a 29 29 29 evice-handle*))) 1a80: 5d 0a 09 20 20 5b 25 67 20 28 75 73 62 2d 67 75 ].. [%g (usb-gu 1a90: 61 72 64 69 61 6e 20 70 74 72 29 5d 0a 09 20 20 ardian ptr)].. 1aa0: 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 [f (foreign-proc 1ab0: 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f 6f 70 edure "libusb_op 1ac0: 65 6e 22 20 28 28 2a 20 63 2d 75 73 62 2d 64 65 en" ((* c-usb-de 1ad0: 76 69 63 65 29 20 76 6f 69 64 2a 29 20 69 6e 74 vice) void*) int 1ae0: 29 5d 0a 09 20 20 5b 65 20 28 66 20 28 75 73 62 )].. [e (f (usb 1af0: 2d 64 65 76 69 63 65 2d 70 74 72 20 64 65 76 69 -device-ptr devi 1b00: 63 65 29 20 28 66 74 79 70 65 2d 70 6f 69 6e 74 ce) (ftype-point 1b10: 65 72 2d 61 64 64 72 65 73 73 20 70 74 72 29 29 er-address ptr)) 1b20: 5d 29 0a 20 20 20 20 20 28 77 68 65 6e 20 28 3c ]). (when (< 1b30: 20 65 20 30 29 0a 09 20 28 65 72 72 6f 72 20 27 e 0).. (error ' 1b40: 75 73 62 2d 6f 70 65 6e 20 28 75 73 62 2d 73 74 usb-open (usb-st 1b50: 72 65 72 72 6f 72 20 65 29 20 65 29 29 0a 20 20 rerror e) e)). 1b60: 20 20 20 28 6d 61 6b 65 2d 75 73 62 2d 64 65 76 (make-usb-dev 1b70: 69 63 65 2d 68 61 6e 64 6c 65 20 28 66 74 79 70 ice-handle (ftyp 1b80: 65 2d 26 72 65 66 20 75 73 62 2d 64 65 76 69 63 e-&ref usb-devic 1b90: 65 2d 68 61 6e 64 6c 65 2a 2a 20 28 2a 29 20 70 e-handle** (*) p 1ba0: 74 72 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e tr)))).. (defin 1bb0: 65 20 28 75 73 62 2d 63 6c 6f 73 65 20 64 65 76 e (usb-close dev 1bc0: 69 63 65 29 0a 20 20 20 28 61 73 73 65 72 74 20 ice). (assert 1bd0: 28 61 6e 64 20 27 75 73 62 2d 63 6c 6f 73 65 20 (and 'usb-close 1be0: 28 75 73 62 2d 64 65 76 69 63 65 2d 68 61 6e 64 (usb-device-hand 1bf0: 6c 65 3f 20 64 65 76 69 63 65 29 29 29 0a 20 20 le? device))). 1c00: 20 28 75 73 62 2d 66 72 65 65 2d 67 61 72 62 61 (usb-free-garba 1c10: 67 65 29 0a 20 20 20 28 6c 65 74 2a 20 28 5b 66 ge). (let* ([f 1c20: 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 (foreign-proced 1c30: 75 72 65 20 22 6c 69 62 75 73 62 5f 63 6c 6f 73 ure "libusb_clos 1c40: 65 22 20 28 76 6f 69 64 2a 29 20 69 6e 74 29 5d e" (void*) int)] 1c50: 0a 09 20 20 5b 65 20 28 66 20 28 75 73 62 2d 64 .. [e (f (usb-d 1c60: 65 76 69 63 65 2d 68 61 6e 64 6c 65 2d 61 64 64 evice-handle-add 1c70: 72 20 64 65 76 69 63 65 29 29 5d 29 0a 20 20 20 r device))]). 1c80: 20 20 28 77 68 65 6e 20 28 3c 20 65 20 30 29 0a (when (< e 0). 1c90: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 75 (error 'u 1ca0: 73 62 2d 6f 70 65 6e 20 28 75 73 62 2d 73 74 72 sb-open (usb-str 1cb0: 65 72 72 6f 72 20 65 29 20 65 29 29 29 29 0a 0a error e) e)))).. 1cc0: 20 28 64 65 66 69 6e 65 20 28 75 73 62 2d 63 6c (define (usb-cl 1cd0: 61 69 6d 2d 69 6e 74 65 72 66 61 63 65 20 68 20 aim-interface h 1ce0: 69 6e 74 65 72 66 61 63 65 2d 6e 75 6d 62 65 72 interface-number 1cf0: 29 0a 20 20 20 28 61 73 73 65 72 74 20 28 61 6e ). (assert (an 1d00: 64 20 27 75 73 62 2d 63 6c 61 69 6d 2d 69 6e 74 d 'usb-claim-int 1d10: 65 72 66 61 63 65 20 28 75 73 62 2d 64 65 76 69 erface (usb-devi 1d20: 63 65 2d 68 61 6e 64 6c 65 3f 20 68 29 29 29 0a ce-handle? h))). 1d30: 20 20 20 28 75 73 62 2d 66 72 65 65 2d 67 61 72 (usb-free-gar 1d40: 62 61 67 65 29 0a 20 20 20 28 6c 65 74 2a 20 28 bage). (let* ( 1d50: 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 [f (foreign-proc 1d60: 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f 63 6c edure "libusb_cl 1d70: 61 69 6d 5f 69 6e 74 65 72 66 61 63 65 22 20 28 aim_interface" ( 1d80: 76 6f 69 64 2a 20 69 6e 74 29 20 69 6e 74 29 5d void* int) int)] 1d90: 0a 09 20 20 5b 65 20 28 66 20 28 66 74 79 70 65 .. [e (f (ftype 1da0: 2d 70 6f 69 6e 74 65 72 2d 61 64 64 72 65 73 73 -pointer-address 1db0: 20 28 75 73 62 2d 64 65 76 69 63 65 2d 68 61 6e (usb-device-han 1dc0: 64 6c 65 2d 70 74 72 20 68 29 29 20 69 6e 74 65 dle-ptr h)) inte 1dd0: 72 66 61 63 65 2d 6e 75 6d 62 65 72 29 5d 29 0a rface-number)]). 1de0: 20 20 20 20 20 28 77 68 65 6e 20 28 3c 20 65 20 (when (< e 1df0: 30 29 0a 20 20 20 20 20 20 20 28 65 72 72 6f 72 0). (error 1e00: 20 27 75 73 62 2d 63 6c 61 69 6d 2d 69 6e 74 65 'usb-claim-inte 1e10: 72 66 61 63 65 20 28 75 73 62 2d 73 74 72 65 72 rface (usb-strer 1e20: 72 6f 72 20 65 29 20 65 29 29 29 29 0a 0a 20 28 ror e) e)))).. ( 1e30: 64 65 66 69 6e 65 20 28 75 73 62 2d 72 65 6c 65 define (usb-rele 1e40: 61 73 65 2d 69 6e 74 65 72 66 61 63 65 20 68 20 ase-interface h 1e50: 69 6e 74 65 72 66 61 63 65 2d 6e 75 6d 62 65 72 interface-number 1e60: 29 0a 20 20 20 28 61 73 73 65 72 74 20 28 61 6e ). (assert (an 1e70: 64 20 27 75 73 62 2d 72 65 6c 65 61 73 65 2d 69 d 'usb-release-i 1e80: 6e 74 65 72 66 61 63 65 20 28 75 73 62 2d 64 65 nterface (usb-de 1e90: 76 69 63 65 2d 68 61 6e 64 6c 65 3f 20 68 29 29 vice-handle? h)) 1ea0: 29 0a 20 20 20 28 75 73 62 2d 66 72 65 65 2d 67 ). (usb-free-g 1eb0: 61 72 62 61 67 65 29 0a 20 20 20 28 6c 65 74 2a arbage). (let* 1ec0: 20 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 ([f (foreign-pr 1ed0: 6f 63 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f ocedure "libusb_ 1ee0: 72 65 6c 65 61 73 65 5f 69 6e 74 65 72 66 61 63 release_interfac 1ef0: 65 22 20 28 76 6f 69 64 2a 20 69 6e 74 29 20 69 e" (void* int) i 1f00: 6e 74 29 5d 0a 09 20 20 5b 65 20 28 66 20 28 66 nt)].. [e (f (f 1f10: 74 79 70 65 2d 70 6f 69 6e 74 65 72 2d 61 64 64 type-pointer-add 1f20: 72 65 73 73 20 28 75 73 62 2d 64 65 76 69 63 65 ress (usb-device 1f30: 2d 68 61 6e 64 6c 65 2d 70 74 72 20 68 29 29 20 -handle-ptr h)) 1f40: 69 6e 74 65 72 66 61 63 65 2d 6e 75 6d 62 65 72 interface-number 1f50: 29 5d 29 0a 20 20 20 20 20 28 77 68 65 6e 20 28 )]). (when ( 1f60: 3c 20 65 20 30 29 0a 20 20 20 20 20 20 20 28 65 < e 0). (e 1f70: 72 72 6f 72 20 27 75 73 62 2d 72 65 6c 65 61 73 rror 'usb-releas 1f80: 65 2d 69 6e 74 65 72 66 61 63 65 20 28 75 73 62 e-interface (usb 1f90: 2d 73 74 72 65 72 72 6f 72 20 65 29 20 65 29 29 -strerror e) e)) 1fa0: 29 29 0a 20 20 20 20 20 0a 20 28 64 65 66 69 6e )). . (defin 1fb0: 65 20 28 61 6c 6c 6f 63 2d 69 6e 74 29 20 0a 20 e (alloc-int) . 1fc0: 20 20 28 6c 65 74 20 28 5b 70 74 72 20 28 6d 61 (let ([ptr (ma 1fd0: 6b 65 2d 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 ke-ftype-pointer 1fe0: 20 69 6e 74 20 28 66 6f 72 65 69 67 6e 2d 61 6c int (foreign-al 1ff0: 6c 6f 63 20 28 66 74 79 70 65 2d 73 69 7a 65 6f loc (ftype-sizeo 2000: 66 20 69 6e 74 29 29 29 5d 29 0a 20 20 20 20 20 f int)))]). 2010: 28 75 73 62 2d 67 75 61 72 64 69 61 6e 20 70 74 (usb-guardian pt 2020: 72 29 0a 20 20 20 20 20 70 74 72 29 29 0a 20 0a r). ptr)). . 2030: 20 28 64 65 66 69 6e 65 20 28 75 73 62 2d 63 6f (define (usb-co 2040: 6e 74 72 6f 6c 2d 74 72 61 6e 73 66 65 72 20 68 ntrol-transfer h 2050: 61 6e 64 6c 65 20 74 79 70 65 20 72 65 71 75 65 andle type reque 2060: 73 74 20 76 61 6c 75 65 20 69 6e 64 65 78 20 64 st value index d 2070: 61 74 61 20 74 69 6d 65 6f 75 74 29 0a 20 20 20 ata timeout). 2080: 28 61 73 73 65 72 74 20 28 61 6e 64 20 27 75 73 (assert (and 'us 2090: 62 2d 63 6f 6e 74 72 6f 6c 2d 74 72 61 6e 73 66 b-control-transf 20a0: 65 72 20 28 75 73 62 2d 64 65 76 69 63 65 2d 68 er (usb-device-h 20b0: 61 6e 64 6c 65 3f 20 68 61 6e 64 6c 65 29 29 29 andle? handle))) 20c0: 0a 20 20 20 28 61 73 73 65 72 74 20 28 61 6e 64 . (assert (and 20d0: 20 27 75 73 62 2d 63 6f 6e 74 72 6f 6c 2d 74 72 'usb-control-tr 20e0: 61 6e 73 66 65 72 20 28 6e 75 6d 62 65 72 3f 20 ansfer (number? 20f0: 74 79 70 65 29 29 29 0a 20 20 20 28 61 73 73 65 type))). (asse 2100: 72 74 20 28 61 6e 64 20 27 75 73 62 2d 63 6f 6e rt (and 'usb-con 2110: 74 72 6f 6c 2d 74 72 61 6e 73 66 65 72 20 28 6e trol-transfer (n 2120: 75 6d 62 65 72 3f 20 72 65 71 75 65 73 74 29 29 umber? request)) 2130: 29 0a 20 20 20 28 61 73 73 65 72 74 20 28 61 6e ). (assert (an 2140: 64 20 27 75 73 62 2d 63 6f 6e 74 72 6f 6c 2d 74 d 'usb-control-t 2150: 72 61 6e 73 66 65 72 20 28 6e 75 6d 62 65 72 3f ransfer (number? 2160: 20 76 61 6c 75 65 29 29 29 0a 20 20 20 28 61 73 value))). (as 2170: 73 65 72 74 20 28 61 6e 64 20 27 75 73 62 2d 63 sert (and 'usb-c 2180: 6f 6e 74 72 6f 6c 2d 74 72 61 6e 73 66 65 72 20 ontrol-transfer 2190: 28 6e 75 6d 62 65 72 3f 20 69 6e 64 65 78 29 29 (number? index)) 21a0: 29 0a 20 20 20 28 61 73 73 65 72 74 20 28 61 6e ). (assert (an 21b0: 64 20 27 75 73 62 2d 63 6f 6e 74 72 6f 6c 2d 74 d 'usb-control-t 21c0: 72 61 6e 73 66 65 72 20 28 62 79 74 65 76 65 63 ransfer (bytevec 21d0: 74 6f 72 3f 20 64 61 74 61 29 29 29 0a 20 20 20 tor? data))). 21e0: 28 61 73 73 65 72 74 20 28 61 6e 64 20 27 75 73 (assert (and 'us 21f0: 62 2d 63 6f 6e 74 72 6f 6c 2d 74 72 61 6e 73 66 b-control-transf 2200: 65 72 20 28 6e 75 6d 62 65 72 3f 20 74 69 6d 65 er (number? time 2210: 6f 75 74 29 29 29 0a 0a 20 20 20 28 6c 65 74 2a out))).. (let* 2220: 20 28 5b 66 20 28 66 6f 72 65 69 67 6e 2d 70 72 ([f (foreign-pr 2230: 6f 63 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f ocedure "libusb_ 2240: 63 6f 6e 74 72 6f 6c 5f 74 72 61 6e 73 66 65 72 control_transfer 2250: 22 20 0a 09 09 09 09 28 76 6f 69 64 2a 20 75 6e " .....(void* un 2260: 73 69 67 6e 65 64 2d 38 20 75 6e 73 69 67 6e 65 signed-8 unsigne 2270: 64 2d 38 20 75 6e 73 69 67 6e 65 64 2d 31 36 20 d-8 unsigned-16 2280: 75 6e 73 69 67 6e 65 64 2d 31 36 20 0a 09 09 09 unsigned-16 .... 2290: 09 20 20 20 20 20 20 20 75 38 2a 20 75 6e 73 69 . u8* unsi 22a0: 67 6e 65 64 2d 31 36 20 75 6e 73 69 67 6e 65 64 gned-16 unsigned 22b0: 2d 69 6e 74 29 20 69 6e 74 29 5d 0a 09 20 20 5b -int) int)].. [ 22c0: 65 20 28 66 20 28 75 73 62 2d 64 65 76 69 63 65 e (f (usb-device 22d0: 2d 68 61 6e 64 6c 65 2d 61 64 64 72 20 68 61 6e -handle-addr han 22e0: 64 6c 65 29 20 74 79 70 65 20 72 65 71 75 65 73 dle) type reques 22f0: 74 20 76 61 6c 75 65 20 69 6e 64 65 78 20 0a 09 t value index .. 2300: 09 64 61 74 61 20 28 62 79 74 65 76 65 63 74 6f .data (bytevecto 2310: 72 2d 6c 65 6e 67 74 68 20 64 61 74 61 29 20 74 r-length data) t 2320: 69 6d 65 6f 75 74 29 5d 29 0a 20 20 20 20 20 28 imeout)]). ( 2330: 69 66 20 28 3c 20 65 20 30 29 0a 09 20 28 65 72 if (< e 0).. (er 2340: 72 6f 72 20 27 75 73 62 2d 63 6f 6e 74 72 6f 6c ror 'usb-control 2350: 2d 74 72 61 6e 73 66 65 72 20 28 75 73 62 2d 73 -transfer (usb-s 2360: 74 72 65 72 72 6f 72 20 65 29 20 65 29 29 0a 20 trerror e) e)). 2370: 20 20 20 20 28 76 6f 69 64 29 29 29 0a 0a 20 28 (void))).. ( 2380: 64 65 66 69 6e 65 20 28 75 73 62 2d 2a 2d 77 72 define (usb-*-wr 2390: 69 74 65 20 68 61 6e 64 6c 65 20 65 6e 64 70 6f ite handle endpo 23a0: 69 6e 74 20 64 61 74 61 20 74 69 6d 65 6f 75 74 int data timeout 23b0: 20 66 75 6e 63 29 0a 20 20 20 28 61 73 73 65 72 func). (asser 23c0: 74 20 28 61 6e 64 20 27 75 73 62 2d 2a 2d 77 72 t (and 'usb-*-wr 23d0: 69 74 65 20 28 75 73 62 2d 64 65 76 69 63 65 2d ite (usb-device- 23e0: 68 61 6e 64 6c 65 3f 20 68 61 6e 64 6c 65 29 29 handle? handle)) 23f0: 29 0a 20 20 20 28 61 73 73 65 72 74 20 28 61 6e ). (assert (an 2400: 64 20 27 75 73 62 2d 2a 2d 77 72 69 74 65 20 28 d 'usb-*-write ( 2410: 6e 75 6d 62 65 72 3f 20 65 6e 64 70 6f 69 6e 74 number? endpoint 2420: 29 29 29 0a 20 20 20 28 61 73 73 65 72 74 20 28 ))). (assert ( 2430: 61 6e 64 20 27 75 73 62 2d 2a 2d 77 72 69 74 65 and 'usb-*-write 2440: 20 28 62 79 74 65 76 65 63 74 6f 72 3f 20 64 61 (bytevector? da 2450: 74 61 29 29 29 0a 20 20 20 28 61 73 73 65 72 74 ta))). (assert 2460: 20 28 61 6e 64 20 27 75 73 62 2d 2a 2d 77 72 69 (and 'usb-*-wri 2470: 74 65 20 28 6e 75 6d 62 65 72 3f 20 74 69 6d 65 te (number? time 2480: 6f 75 74 29 29 29 0a 20 20 20 28 75 73 62 2d 66 out))). (usb-f 2490: 72 65 65 2d 67 61 72 62 61 67 65 29 0a 20 20 20 ree-garbage). 24a0: 28 6c 65 74 2a 20 28 5b 70 74 72 20 28 61 6c 6c (let* ([ptr (all 24b0: 6f 63 2d 69 6e 74 29 5d 0a 09 20 20 5b 65 20 28 oc-int)].. [e ( 24c0: 66 75 6e 63 20 28 75 73 62 2d 64 65 76 69 63 65 func (usb-device 24d0: 2d 68 61 6e 64 6c 65 2d 61 64 64 72 20 68 61 6e -handle-addr han 24e0: 64 6c 65 29 20 65 6e 64 70 6f 69 6e 74 0a 09 09 dle) endpoint... 24f0: 20 20 20 64 61 74 61 20 28 62 79 74 65 76 65 63 data (bytevec 2500: 74 6f 72 2d 6c 65 6e 67 74 68 20 64 61 74 61 29 tor-length data) 2510: 20 0a 09 09 20 20 20 28 66 74 79 70 65 2d 70 6f ... (ftype-po 2520: 69 6e 74 65 72 2d 61 64 64 72 65 73 73 20 70 74 inter-address pt 2530: 72 29 20 74 69 6d 65 6f 75 74 29 5d 29 0a 20 20 r) timeout)]). 2540: 20 20 20 28 77 68 65 6e 20 28 3c 20 65 20 30 29 (when (< e 0) 2550: 0a 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 . (error ' 2560: 75 73 62 2d 2a 2d 77 72 69 74 65 20 28 75 73 62 usb-*-write (usb 2570: 2d 73 74 72 65 72 72 6f 72 20 65 29 20 65 29 29 -strerror e) e)) 2580: 0a 20 20 20 20 20 3b 3b 28 66 74 79 70 65 2d 70 . ;;(ftype-p 2590: 6f 69 6e 74 65 72 2d 61 64 64 72 65 73 73 20 28 ointer-address ( 25a0: 66 74 79 70 65 2d 72 65 66 20 69 6e 74 2a 20 28 ftype-ref int* ( 25b0: 29 20 70 74 72 29 29 0a 20 20 20 20 20 28 76 6f ) ptr)). (vo 25c0: 69 64 29 29 29 0a 20 0a 20 28 69 6d 70 6f 72 74 id))). . (import 25d0: 20 28 6f 6e 6c 79 20 28 74 68 75 6e 64 65 72 2d (only (thunder- 25e0: 75 74 69 6c 73 29 20 73 75 62 2d 62 79 74 65 76 utils) sub-bytev 25f0: 65 63 74 6f 72 29 29 0a 20 0a 20 28 64 65 66 69 ector)). . (defi 2600: 6e 65 20 28 75 73 62 2d 2a 2d 72 65 61 64 20 68 ne (usb-*-read h 2610: 61 6e 64 6c 65 20 65 6e 64 70 6f 69 6e 74 20 6c andle endpoint l 2620: 65 6e 20 74 69 6d 65 6f 75 74 20 66 75 6e 63 29 en timeout func) 2630: 0a 20 20 20 28 61 73 73 65 72 74 20 28 61 6e 64 . (assert (and 2640: 20 27 75 73 62 2d 2a 2d 72 65 61 64 20 28 75 73 'usb-*-read (us 2650: 62 2d 64 65 76 69 63 65 2d 68 61 6e 64 6c 65 3f b-device-handle? 2660: 20 68 61 6e 64 6c 65 29 29 29 0a 20 20 20 28 61 handle))). (a 2670: 73 73 65 72 74 20 28 61 6e 64 20 27 75 73 62 2d ssert (and 'usb- 2680: 2a 2d 72 65 61 64 20 28 6e 75 6d 62 65 72 3f 20 *-read (number? 2690: 65 6e 64 70 6f 69 6e 74 29 29 29 0a 20 20 20 28 endpoint))). ( 26a0: 61 73 73 65 72 74 20 28 61 6e 64 20 27 75 73 62 assert (and 'usb 26b0: 2d 2a 2d 72 65 61 64 20 28 6e 75 6d 62 65 72 3f -*-read (number? 26c0: 20 6c 65 6e 29 29 29 0a 20 20 20 28 61 73 73 65 len))). (asse 26d0: 72 74 20 28 61 6e 64 20 27 75 73 62 2d 2a 2d 72 rt (and 'usb-*-r 26e0: 65 61 64 20 28 6e 75 6d 62 65 72 3f 20 74 69 6d ead (number? tim 26f0: 65 6f 75 74 29 29 29 0a 20 20 20 28 75 73 62 2d eout))). (usb- 2700: 66 72 65 65 2d 67 61 72 62 61 67 65 29 0a 20 20 free-garbage). 2710: 20 28 6c 65 74 2a 20 28 5b 70 74 72 20 28 61 6c (let* ([ptr (al 2720: 6c 6f 63 2d 69 6e 74 29 5d 0a 09 20 20 5b 64 61 loc-int)].. [da 2730: 74 61 20 28 6d 61 6b 65 2d 62 79 74 65 76 65 63 ta (make-bytevec 2740: 74 6f 72 20 6c 65 6e 29 5d 0a 09 20 20 5b 64 61 tor len)].. [da 2750: 74 61 25 20 28 75 73 62 2d 67 75 61 72 64 69 61 ta% (usb-guardia 2760: 6e 20 64 61 74 61 29 5d 0a 09 20 20 5b 65 20 28 n data)].. [e ( 2770: 66 75 6e 63 20 28 75 73 62 2d 64 65 76 69 63 65 func (usb-device 2780: 2d 68 61 6e 64 6c 65 2d 61 64 64 72 20 68 61 6e -handle-addr han 2790: 64 6c 65 29 20 65 6e 64 70 6f 69 6e 74 0a 09 09 dle) endpoint... 27a0: 20 20 20 64 61 74 61 20 6c 65 6e 20 0a 09 09 20 data len ... 27b0: 20 20 28 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 (ftype-pointer 27c0: 2d 61 64 64 72 65 73 73 20 70 74 72 29 20 74 69 -address ptr) ti 27d0: 6d 65 6f 75 74 29 5d 29 0a 20 20 20 20 20 28 69 meout)]). (i 27e0: 66 20 28 3c 20 65 20 30 29 0a 09 20 28 65 72 72 f (< e 0).. (err 27f0: 6f 72 20 27 75 73 62 2d 2a 2d 72 65 61 64 20 28 or 'usb-*-read ( 2800: 75 73 62 2d 73 74 72 65 72 72 6f 72 20 65 29 20 usb-strerror e) 2810: 65 29 29 0a 20 20 20 20 20 28 6c 65 74 20 28 5b e)). (let ([ 2820: 72 65 61 64 2d 6c 65 6e 20 28 66 74 79 70 65 2d read-len (ftype- 2830: 72 65 66 20 69 6e 74 20 28 29 20 70 74 72 29 5d ref int () ptr)] 2840: 29 0a 20 20 20 20 20 20 20 28 73 75 62 2d 62 79 ). (sub-by 2850: 74 65 76 65 63 74 6f 72 20 64 61 74 61 20 30 20 tevector data 0 2860: 72 65 61 64 2d 6c 65 6e 29 29 29 29 0a 0a 28 64 read-len))))..(d 2870: 65 66 69 6e 65 20 28 75 73 62 2d 62 75 6c 6b 2d efine (usb-bulk- 2880: 72 65 61 64 20 68 61 6e 64 6c 65 20 65 6e 64 70 read handle endp 2890: 6f 69 6e 74 20 6c 65 6e 20 74 69 6d 65 6f 75 74 oint len timeout 28a0: 29 0a 20 20 28 75 73 62 2d 2a 2d 72 65 61 64 20 ). (usb-*-read 28b0: 68 61 6e 64 6c 65 20 65 6e 64 70 6f 69 6e 74 20 handle endpoint 28c0: 6c 65 6e 20 74 69 6d 65 6f 75 74 20 0a 09 20 20 len timeout .. 28d0: 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f (foreign-pro 28e0: 63 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f 62 cedure "libusb_b 28f0: 75 6c 6b 5f 74 72 61 6e 73 66 65 72 22 20 0a 09 ulk_transfer" .. 2900: 09 09 09 20 28 76 6f 69 64 2a 20 75 6e 73 69 67 ... (void* unsig 2910: 6e 65 64 2d 38 20 75 38 2a 20 69 6e 74 20 76 6f ned-8 u8* int vo 2920: 69 64 2a 20 75 6e 73 69 67 6e 65 64 2d 69 6e 74 id* unsigned-int 2930: 29 20 69 6e 74 29 29 29 0a 28 64 65 66 69 6e 65 ) int))).(define 2940: 20 28 75 73 62 2d 62 75 6c 6b 2d 77 72 69 74 65 (usb-bulk-write 2950: 20 68 61 6e 64 6c 65 20 65 6e 64 70 6f 69 6e 74 handle endpoint 2960: 20 64 61 74 61 20 74 69 6d 65 6f 75 74 29 0a 20 data timeout). 2970: 20 28 75 73 62 2d 2a 2d 77 72 69 74 65 20 68 61 (usb-*-write ha 2980: 6e 64 6c 65 20 65 6e 64 70 6f 69 6e 74 20 64 61 ndle endpoint da 2990: 74 61 20 74 69 6d 65 6f 75 74 20 0a 09 20 20 20 ta timeout .. 29a0: 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f (foreign-pro 29b0: 63 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f 62 cedure "libusb_b 29c0: 75 6c 6b 5f 74 72 61 6e 73 66 65 72 22 20 0a 09 ulk_transfer" .. 29d0: 09 09 09 20 20 28 76 6f 69 64 2a 20 75 6e 73 69 ... (void* unsi 29e0: 67 6e 65 64 2d 38 20 75 38 2a 20 69 6e 74 20 76 gned-8 u8* int v 29f0: 6f 69 64 2a 20 75 6e 73 69 67 6e 65 64 2d 69 6e oid* unsigned-in 2a00: 74 29 20 69 6e 74 29 29 29 0a 0a 28 64 65 66 69 t) int)))..(defi 2a10: 6e 65 20 28 75 73 62 2d 69 6e 74 65 72 72 75 70 ne (usb-interrup 2a20: 74 2d 72 65 61 64 20 68 61 6e 64 6c 65 20 65 6e t-read handle en 2a30: 64 70 6f 69 6e 74 20 6c 65 6e 20 74 69 6d 65 6f dpoint len timeo 2a40: 75 74 29 0a 20 20 28 75 73 62 2d 2a 2d 72 65 61 ut). (usb-*-rea 2a50: 64 20 68 61 6e 64 6c 65 20 65 6e 64 70 6f 69 6e d handle endpoin 2a60: 74 20 6c 65 6e 20 74 69 6d 65 6f 75 74 20 0a 09 t len timeout .. 2a70: 09 20 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 . (foreign-proc 2a80: 65 64 75 72 65 20 22 6c 69 62 75 73 62 5f 69 6e edure "libusb_in 2a90: 74 65 72 72 75 70 74 5f 74 72 61 6e 73 66 65 72 terrupt_transfer 2aa0: 22 20 0a 09 09 09 09 20 20 20 20 20 28 76 6f 69 " ..... (voi 2ab0: 64 2a 20 75 6e 73 69 67 6e 65 64 2d 38 20 75 38 d* unsigned-8 u8 2ac0: 2a 20 69 6e 74 20 76 6f 69 64 2a 20 75 6e 73 69 * int void* unsi 2ad0: 67 6e 65 64 2d 69 6e 74 29 20 69 6e 74 29 29 29 gned-int) int))) 2ae0: 0a 28 64 65 66 69 6e 65 20 28 75 73 62 2d 69 6e .(define (usb-in 2af0: 74 65 72 72 75 70 74 2d 77 72 69 74 65 20 68 61 terrupt-write ha 2b00: 6e 64 6c 65 20 65 6e 64 70 6f 69 6e 74 20 64 61 ndle endpoint da 2b10: 74 61 20 74 69 6d 65 6f 75 74 29 0a 20 20 28 75 ta timeout). (u 2b20: 73 62 2d 2a 2d 77 72 69 74 65 20 68 61 6e 64 6c sb-*-write handl 2b30: 65 20 65 6e 64 70 6f 69 6e 74 20 64 61 74 61 20 e endpoint data 2b40: 74 69 6d 65 6f 75 74 20 0a 09 09 20 20 28 66 6f timeout ... (fo 2b50: 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 reign-procedure 2b60: 22 6c 69 62 75 73 62 5f 69 6e 74 65 72 72 75 70 "libusb_interrup 2b70: 74 5f 74 72 61 6e 73 66 65 72 22 20 0a 09 09 09 t_transfer" .... 2b80: 09 20 20 20 20 20 28 76 6f 69 64 2a 20 75 6e 73 . (void* uns 2b90: 69 67 6e 65 64 2d 38 20 75 38 2a 20 69 6e 74 20 igned-8 u8* int 2ba0: 76 6f 69 64 2a 20 75 6e 73 69 67 6e 65 64 2d 69 void* unsigned-i 2bb0: 6e 74 29 20 69 6e 74 29 29 29 0a 0a 0a 29 20 3b nt) int)))...) ; 2bc0: 6c 69 62 72 61 72 79 20 75 73 62 0a 0a 0a library usb...