Check-in [35917dddc4]
Not logged in
Home Timeline Files Branches Tags Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:added more funcs to usb.sls
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 35917dddc4cef98f81b8226eeb096f3bbf883079
User & Date: ovenpasta@pizzahack.eu 2016-07-08 17:14:50
Context
2016-07-08
18:14
some fixes to usb.sls guardians check-in: 97a1a5b4fb user: ovenpasta@pizzahack.eu tags: trunk
17:14
added more funcs to usb.sls check-in: 35917dddc4 user: ovenpasta@pizzahack.eu tags: trunk
2016-07-07
20:53
warning in sqlite3.sls, updated README check-in: 4aff54750f user: ovenpasta@pizzahack.eu tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to usb.sls. 

4
5
6
7
8
9
10

11
12
13
14






15





16
17
18
19
20
21

22
23
24
25
26
27
28
..
44
45
46
47
48
49
50












51

52
53

54
55
56
57
58
59
60
61
62
63

64
65

66
67
68
69
70
71
72
73
74
75
76
77























78
79
80
81
82
83
84
..
89
90
91
92
93
94
95
96



























































97
98
99
100

 (usb)
 (export 
  usb-device-descriptor
  usb-device
  usb-device-handle

  usb-init

  usb-get-device-list
  usb-get-device-descriptor
  usb-find-vid-pid
  usb-display-device-list






  )





 (import (chezscheme))
 
 (define-ftype usb-device* void*)
 (define-ftype usb-device*-array (array 0 usb-device*))
 (define-ftype usb-device*** (* usb-device*-array))
 (define-ftype usb-device-handle* void*)


 (define-ftype usb-device-descriptor 
   (struct 
       [length unsigned-8]
       [type unsigned-8]
       [USB unsigned-16]
       [class unsigned-8]
................................................................................
 (define-record-type usb-device-handle
   (fields
    (mutable ptr)))

 (define (usb-device-addr dev)
   (ftype-pointer-address (usb-device-ptr dev)))













 (define (usb-get-device-list) 

   (let* ([ptr (make-ftype-pointer usb-device*** (foreign-alloc (ftype-sizeof usb-device***)))]
	  [f (foreign-procedure "libusb_get_device_list" (void* void*) int)]

	  [e (f 0 (ftype-pointer-address ptr))])
     (if (< e 0)
	 (error 'usb-get-device-list "error" e))
     (let ((devices (ftype-&ref usb-device*** (*) ptr)))
       (let loop ((i 0) (l '()))
	 (if (>= i e) l
	     (loop (fx+ i 1) 
		   (cons (make-usb-device (make-ftype-pointer usb-device* (ftype-ref usb-device*-array (i) devices))) l)))))))

 (define (usb-get-device-descriptor dev) 

   (let* ([ptr (make-ftype-pointer usb-device-descriptor 
				   (foreign-alloc (ftype-sizeof usb-device-descriptor)))]

	  [f (foreign-procedure "libusb_get_device_descriptor" (void* void*) int)]
	  [e (f (usb-device-addr dev) (ftype-pointer-address ptr))])
     (if (< e 0)
	 (error 'usb-get-device-descriptor "error" e)
	 ptr)))

 (define (usb-init) 
   (let ([e ((foreign-procedure "libusb_init" (void*) int) 0)])
     (when (< e 0)
       (error 'usb-init "error" e))
     #t))
























 (define (usb-find-vid-pid vid pid) 
   (call/cc 
    (lambda (k)
      (for-each 
       (lambda (dev)
	 (let ([descriptor (usb-get-device-descriptor dev)])
	   (if (and (equal? (ftype-ref usb-device-descriptor (vendor) descriptor) vid)
................................................................................

 (define (usb-display-device-list)
   (pretty-print 
    (map
     (lambda (dev) 
       (ftype-pointer->sexpr (usb-get-device-descriptor dev)))
     (usb-get-device-list))))
 



























































) ;library usb

(warning 'usb "remember to load the dynamic library: Example: (load-shared-object \"libusb-1.0.so.0\")")
 








>




>
>
>
>
>
>
|
>
>
>
>
>






>







 







>
>
>
>
>
>
>
>
>
>
>
>
|
>


>









|
>


>












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
..
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
...
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

 (usb)
 (export 
  usb-device-descriptor
  usb-device
  usb-device-handle

  usb-init
  usb-exit
  usb-get-device-list
  usb-get-device-descriptor
  usb-find-vid-pid
  usb-display-device-list
  usb-strerror
  usb-open
  usb-log-level-enum
  usb-log-level-index
  usb-log-level-ref
  usb-set-debug

  usb-control-transfer
  usb-bulk-transfer
  usb-interrupt-transfer
  ) ;export

 (import (chezscheme))
 
 (define-ftype usb-device* void*)
 (define-ftype usb-device*-array (array 0 usb-device*))
 (define-ftype usb-device*** (* usb-device*-array))
 (define-ftype usb-device-handle* void*)
 (define-ftype usb-device-handle** (* usb-device-handle*))

 (define-ftype usb-device-descriptor 
   (struct 
       [length unsigned-8]
       [type unsigned-8]
       [USB unsigned-16]
       [class unsigned-8]
................................................................................
 (define-record-type usb-device-handle
   (fields
    (mutable ptr)))

 (define (usb-device-addr dev)
   (ftype-pointer-address (usb-device-ptr dev)))

 (define (usb-device-handle-addr dev)
   (ftype-pointer-address (usb-device-handle-ptr dev)))

 (define usb-guardian (make-guardian))
 (define (usb-free-garbage)
   (let loop ([p (usb-guardian)])
     (when p
       (when (ftype-pointer? p)
	 ;(printf "freeing memory at ~x\n" p)
	 (foreign-free (ftype-pointer-address p)))
       (loop (usb-guardian)))))
   
 (define (usb-get-device-list)
   (usb-free-garbage)
   (let* ([ptr (make-ftype-pointer usb-device*** (foreign-alloc (ftype-sizeof usb-device***)))]
	  [f (foreign-procedure "libusb_get_device_list" (void* void*) int)]
	  [%g (usb-guardian ptr)]
	  [e (f 0 (ftype-pointer-address ptr))])
     (if (< e 0)
	 (error 'usb-get-device-list "error" e))
     (let ((devices (ftype-&ref usb-device*** (*) ptr)))
       (let loop ((i 0) (l '()))
	 (if (>= i e) l
	     (loop (fx+ i 1) 
		   (cons (make-usb-device (make-ftype-pointer usb-device* (ftype-ref usb-device*-array (i) devices))) l)))))))

 (define (usb-get-device-descriptor dev)
   (usb-free-garbage)
   (let* ([ptr (make-ftype-pointer usb-device-descriptor 
				   (foreign-alloc (ftype-sizeof usb-device-descriptor)))]
	  [%g (usb-guardian ptr)]
	  [f (foreign-procedure "libusb_get_device_descriptor" (void* void*) int)]
	  [e (f (usb-device-addr dev) (ftype-pointer-address ptr))])
     (if (< e 0)
	 (error 'usb-get-device-descriptor "error" e)
	 ptr)))

 (define (usb-init) 
   (let ([e ((foreign-procedure "libusb_init" (void*) int) 0)])
     (when (< e 0)
       (error 'usb-init "error" e))
     #t))

 (define (usb-exit) 
   (usb-free-garbage)
   (let ([e ((foreign-procedure "libusb_exit" (void*) int) 0)])
     (when (< e 0)
       (error 'usb-exit "error" e))
     #t))

 (define usb-log-level-enum (make-enumeration '(none error warning info debug)))
 (define usb-log-level-index (enum-set-indexer usb-log-level-enum))
 (define (usb-log-level-ref index)
   (list-ref (enum-set->list usb-log-level-enum) index))

 (define (usb-set-debug ctx level) 
   (let ([e ((foreign-procedure "libusb_set_debug" (void* int) int) 
	     0 
	     (usb-log-level-index level))])
     (when (< e 0)
       (error 'usb-exit "error" e))
     (void)))

 (define (usb-strerror code)
    ((foreign-procedure "libusb_strerror" (int) string) code))

 (define (usb-find-vid-pid vid pid) 
   (call/cc 
    (lambda (k)
      (for-each 
       (lambda (dev)
	 (let ([descriptor (usb-get-device-descriptor dev)])
	   (if (and (equal? (ftype-ref usb-device-descriptor (vendor) descriptor) vid)
................................................................................

 (define (usb-display-device-list)
   (pretty-print 
    (map
     (lambda (dev) 
       (ftype-pointer->sexpr (usb-get-device-descriptor dev)))
     (usb-get-device-list))))

 (define (usb-open device)
   (assert (and 'usb-open (usb-device? device)))
   (usb-free-garbage)
   (let* ([ptr (make-ftype-pointer usb-device-handle** 
				   (foreign-alloc (ftype-sizeof usb-device-handle*)))]
	  [%g (usb-guardian ptr)]
	  [f (foreign-procedure "libusb_open" (void* void*) int)]
	  [e (f (usb-device-addr device) (ftype-pointer-address ptr))])
     (if (< e 0)
	 (error 'usb-open (usb-strerror e) e))
     (make-usb-device-handle (ftype-&ref usb-device-handle** (*) ptr))))
 
 (define-ftype int* (* int))
 (define (alloc-int*) 
   (define ptr (make-ftype-pointer int* (foreign-alloc (ftype-sizeof int*))))
   (usb-guardian ptr)
   ptr)
 
 (define (usb-control-transfer handle type request value index data timeout)
   (assert (and 'usb-control-transfer (usb-device-handle? handle)))
   (assert (and 'usb-control-transfer (number? type)))
   (assert (and 'usb-control-transfer (number? request)))
   (assert (and 'usb-control-transfer (number? value)))
   (assert (and 'usb-control-transfer (number? index)))
   (assert (and 'usb-control-transfer (bytevector? data)))
   (assert (and 'usb-control-transfer (number? timeout)))

   (let* ([f (foreign-procedure "libusb_control_transfer" 
				(void* unsigned-8 unsigned-8 unsigned-16 unsigned-16 
				       u8* unsigned-16 unsigned-int) int)]
	  [e (f (usb-device-handle-addr handle) type request value index 
		data (bytevector-length data) timeout)])
     (if (< e 0)
	 (error 'usb-control-transfer (usb-strerror e) e))
     (void)))

 (define (usb-*-transfer handle endpoint data timeout func)
   (assert (and 'usb-*-transfer (usb-device-handle? handle)))
   (assert (and 'usb-*-transfer (number? endpoint)))
   (assert (and 'usb-*-transfer (bytevector? data)))
   (assert (and 'usb-*-transfer (number? timeout)))
   (usb-free-garbage)
   (let* ([ptr (alloc-int*)]
	  [e (func (usb-device-handle-addr handle) endpoint data (bytevector-length data) 
		   (ftype-pointer-address ptr) timeout)])
     (if (< e 0)
	 (error 'usb-*-transfer (usb-strerror e) e))
     (ftype-pointer-address (ftype-ref int* () ptr))))

(define (usb-bulk-transfer handle endpoint data timeout)
  (usb-*-transfer handle endpoint data timeout 
		  (foreign-procedure "libusb_bulk_transfer" 
				     (void* unsigned-8 u8* int void* unsigned-int) int)))

(define (usb-interrupt-transfer handle endpoint data timeout)
  (usb-*-transfer handle endpoint data timeout 
		  (foreign-procedure "libusb_interrupt_transfer" 
				     (void* unsigned-8 u8* int void* unsigned-int) int)))

) ;library usb

(warning 'usb "remember to load the dynamic library: Example: (load-shared-object \"libusb-1.0.so.0\")")

Fossil 2.9 [0fd79a3e09] 2019-07-13 13:05:19