Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | moved cast and char*->bytevector to ffi-utils |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
6cf5622d3081cc731479c5f40d135d88 |
| User & Date: | aldo 2016-12-08 00:41:28 |
Context
|
2016-12-08
| ||
| 00:42 | added binary-port->string check-in: 3373c30b1e user: aldo tags: trunk | |
| 00:41 | moved cast and char*->bytevector to ffi-utils check-in: 6cf5622d30 user: aldo tags: trunk | |
| 00:39 | minor fixes on cairo check-in: 35fd13c928 user: aldo tags: trunk | |
Changes
Changes to ffi-utils.sls.
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 ... 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 ... 202 203 204 205 206 207 208 209 210 |
#!r6rs (library (ffi-utils) (export define-enumeration* define-function define-flags make-flags flags flags-name flags-alist flags-indexer flags-ref-maker flags-decode-maker let-struct) (import (chezscheme)) ;; TODO: maybe we should support multiple structs? ;; and maybe also normal let entries? let-struct* also? (define-syntax let-struct (lambda (x) ................................................................................ ;> (flags-name color-flags) -> color ;; TODO, what to do for value 0? (define-record flags (name alist)) (define (flags-indexer flags) (lambda (name . more-names) (let ([names (append (list name) more-names)]) (let loop ([f names] [result 0]) (if (null? f) result (let ([r (assq (car f) (flags-alist flags))]) ;(printf "r: ~d flags: ~d f: ~d\n" r flags f) (if (not r) (assertion-violation (flags-name flags) "symbol not found" f) (loop (cdr f) (logor result (cdr r)))))))))) (define (flags-ref-maker flags) (lambda (index) (let ([p (find (lambda (x) (equal? index (cdr x))) (flags-alist flags))]) (if p (car p) p)))) ;; FIXME: WHAT TO DO IF VALUES OVERLAP? ;; AT THE MOMENT RESULT MAYBE NOT WHAT EXPECTED (define (flags-decode-maker flags) ................................................................................ (define flags-name (make-flags 'name (list (cons 'k v) ...))) (define base-name (flags-indexer flags-name)) (define ref-name (flags-ref-maker flags-name)) (define decode-name (flags-decode-maker flags-name)) (define-ftype name-t type) ;(indirect-export base-name flags-name ref-name decode-name name-t ) ))]))) ); library ffi-utils |
| > > | < | | | < | | | > > > > > > > > > > > > > > > > > > > |
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ... 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 ... 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 |
#!r6rs (library (ffi-utils) (export define-enumeration* define-function define-flags make-flags flags flags-name flags-alist flags-indexer flags-ref-maker flags-decode-maker let-struct char*->bytevector cast ) (import (chezscheme)) ;; TODO: maybe we should support multiple structs? ;; and maybe also normal let entries? let-struct* also? (define-syntax let-struct (lambda (x) ................................................................................ ;> (flags-name color-flags) -> color ;; TODO, what to do for value 0? (define-record flags (name alist)) (define (flags-indexer flags) (lambda names (let loop ([f names] [result 0]) (if (null? f) result (let ([r (assq (car f) (flags-alist flags))]) (if (not r) (assertion-violation (flags-name flags) "symbol not found" f) (loop (cdr f) (logor result (cdr r))))))))) (define (flags-ref-maker flags) (lambda (index) (let ([p (find (lambda (x) (equal? index (cdr x))) (flags-alist flags))]) (if p (car p) p)))) ;; FIXME: WHAT TO DO IF VALUES OVERLAP? ;; AT THE MOMENT RESULT MAYBE NOT WHAT EXPECTED (define (flags-decode-maker flags) ................................................................................ (define flags-name (make-flags 'name (list (cons 'k v) ...))) (define base-name (flags-indexer flags-name)) (define ref-name (flags-ref-maker flags-name)) (define decode-name (flags-decode-maker flags-name)) (define-ftype name-t type) ;(indirect-export base-name flags-name ref-name decode-name name-t ) ))]))) (define (char*->bytevector fptr bytes) (define bb (make-bytevector bytes)) (let f ([i 0]) (if (< i bytes) (let ([c (ftype-ref char () fptr i)]) (bytevector-u8-set! bb i (char->integer c)) (f (fx+ i 1))))) bb) (define-syntax cast (syntax-rules () [(_ ftype fptr) (make-ftype-pointer ftype (ftype-pointer-address fptr))])) ); library ffi-utils |
Changes to nanomsg.sls.
343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 |
;; (let ([c (ftype-ref char () fptr i)]) ;; (if (or (char=? c #\nul) (and bytes (>= (+ 1 i) (car bytes)))) ;; (make-string i) ;; (let ([str (f (fx+ i 1))]) ;; (string-set! str i c) ;; str))))) (define (char*->bytevector fptr bytes) (let f ([i 0]) (let ([c (ftype-ref char () fptr i)]) (if (>= i bytes) (make-bytevector i) (let ([bb (f (fx+ i 1))]) (bytevector-u8-set! bb i (char->integer c)) bb))))) (define-syntax cast (syntax-rules () [(_ ftype fptr) (make-ftype-pointer ftype (ftype-pointer-address fptr))])) (define (nn-recv s buf len flags) (define b #f) (define r #f) (dynamic-wind (lambda () (set! b (make-ftype-pointer void* (foreign-alloc (ftype-sizeof void*)))) (set! r (nn-recv% s (ftype-pointer-address b) len flags))) |
< < < < < < < < < < < < < < < |
343 344 345 346 347 348 349 350 351 352 353 354 355 356 |
;; (let ([c (ftype-ref char () fptr i)])
;; (if (or (char=? c #\nul) (and bytes (>= (+ 1 i) (car bytes))))
;; (make-string i)
;; (let ([str (f (fx+ i 1))])
;; (string-set! str i c)
;; str)))))
(define (nn-recv s buf len flags)
(define b #f)
(define r #f)
(dynamic-wind
(lambda ()
(set! b (make-ftype-pointer void* (foreign-alloc (ftype-sizeof void*))))
(set! r (nn-recv% s (ftype-pointer-address b) len flags)))
|