suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ffi/unsafe: add malloc-mode option to _list and _vector

Browse Source
This commit is contained in:
Matthew Flatt 2020-04-28 16:19:33 -06:00
parent d7f0809490
commit 58371b95d4
4 changed files with 88 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/racket-doc/scribblings/foreign/misc.scrbl
View File

@ -5,7 +5,8 @@
@defproc[(list->cblock [lst list?]
[type ctype?]
[expect-length (or/c exact-nonnegative-integer? #f) #f])
[expect-length (or/c exact-nonnegative-integer? #f) #f]
[#:malloc-mode malloc-mode (or/c #f symbol?) #f])
cpointer?]{
Allocates a memory block of an appropriate size---using
@ -16,16 +17,24 @@ according to the given @racket[type].
If @racket[expect-length] is not @racket[#f] and not the same as
@racket[(length lst)], then an exception is raised instead of
allocating memory.}
allocating memory.
If @racket[malloc-mode] is not @racket[#f], it is provided as an
additional argument to @racket[malloc].
@history[#:changed "7.7.0.2" @elem{Added the @racket[#:malloc-mode] argument.}]}
@defproc[(vector->cblock [vec vector?]
[type ctype?]
[expect-length (or/c exact-nonnegative-integer? #f) #f])
[expect-length (or/c exact-nonnegative-integer? #f) #f]
[#:malloc-mode malloc-mode (or/c #f symbol?) #f])
cpointer?]{
Like @racket[list->cblock], but using values from a vector instead of
a list.}
a list.
@history[#:changed "7.7.0.2" @elem{Added the @racket[#:malloc-mode] argument.}]}
@defproc[(vector->cpointer [vec vector?]) cpointer?]{

24
pkgs/racket-doc/scribblings/foreign/types.scrbl
View File

@ -1077,10 +1077,18 @@ Example:
-> (values res (unbox boxed)))
]}
@defform/subs[(_list mode type maybe-len)
@defform/subs[#:literals (atomic raw atomic nonatomic tagged
atomic-interior interior
stubborn uncollectable eternal)
(_list mode type maybe-len maybe-mode)
([mode i o io]
[maybe-len code:blank
len-expr])]{
len-expr]
[maybe-mode code:blank
atomic
raw atomic nonatomic tagged
atomic-interior interior
stubborn uncollectable eternal])]{
A @tech{custom function type} that is similar to @racket[_ptr], except
that it is used for converting lists to/from C vectors. The optional
@ -1089,6 +1097,8 @@ the post code, and in the pre code of an output mode to allocate the
block. (If the length is 0, then NULL is passed in and an empty list is
returned.) In either case, it can refer to a previous binding for the
length of the list which the C function will most likely require.
The @racket[maybe-mode], if provided, is quoted and passed to @racket[malloc]
as needed to allocate the C representation.
For example, the following type corresponds to a function that takes
a vector argument of type @tt{*float} (from a Racket list input)
@ -1112,9 +1122,11 @@ return two values, the vector and the boolean.
[vec : (_list o _float len)]
-> [res : _bool]
-> (values vec res))
]}
]
@defform[(_vector mode type maybe-len)]{
@history[#:changed "7.7.0.2" @elem{Added @racket[maybe-mode].}]}
@defform[(_vector mode type maybe-len maybe-mode)]{
A @tech{custom function type} like @racket[_list], except that it uses
Racket vectors instead of lists.
@ -1131,7 +1143,9 @@ Examples:
-> (values vec res))
]
See @racket[_list] for more explanation about the examples.}
See @racket[_list] for more explanation about the examples.
@history[#:changed "7.7.0.2" @elem{Added @racket[maybe-mode].}]}
@defform*[#:id _bytes

6
pkgs/racket-test-core/tests/racket/foreign-test.rktl
View File

@ -287,12 +287,8 @@
((ffi 'hoho (_fun _int (_fun _int -> (_fun _int -> _int)) -> _int))
3 (lambda (x) (lambda (y) (+ y (* x x))))))
;; ---
;; FIXME: this test is broken, because the array allocated by `(_list io _int len)`
;; has no reason to stay in place; a GC during the callback may move it.
;; The solution is probably to extend `_list` so that an allocation mode like
;; 'atomic-interior can be supplied.
(let ([qsort (get-ffi-obj 'qsort #f
(_fun (l : (_list io _int len))
(_fun (l : (_list io _int len atomic-interior))
(len : _int = (length l))
(size : _int = (ctype-sizeof _int))
(compare : (_fun _pointer _pointer -> _int))

75
racket/collects/ffi/unsafe.rkt
View File

@ -1091,28 +1091,57 @@
(provide _list)
(define-fun-syntax _list
(syntax-rules (i o io)
[(_ i t ) (type: _pointer
pre: (x => (list->cblock x t)))]
[(_ o t n) (type: _pointer
pre: (malloc n t)
post: (x => (cblock->list x t n)))]
[(_ io t n) (type: _pointer
pre: (x => (list->cblock x t))
post: (x => (cblock->list x t n)))]))
[(_ i t ) (type: _pointer
pre: (x => (list->cblock x t)))]
[(_ i t mode) (type: _pointer
pre: (x => (list->cblock x t #:malloc-mode (check-malloc-mode _list mode))))]
[(_ o t n) (type: _pointer
pre: (malloc n t)
post: (x => (cblock->list x t n)))]
[(_ o t n mode) (type: _pointer
pre: (malloc n t (check-malloc-mode _list mode))
post: (x => (cblock->list x t n)))]
[(_ io t n) (type: _pointer
pre: (x => (list->cblock x t))
post: (x => (cblock->list x t n)))]
[(_ io t n mode) (type: _pointer
pre: (x => (list->cblock x t #:malloc-mode (check-malloc-mode _list mode)))
post: (x => (cblock->list x t n)))]))
;; (_vector <mode> <type> [<len>])
;; Same as _list, except that it uses Scheme vectors.
(provide _vector)
(define-fun-syntax _vector
(syntax-rules (i o io)
[(_ i t ) (type: _pointer
pre: (x => (vector->cblock x t)))]
[(_ o t n) (type: _pointer
pre: (malloc n t)
post: (x => (cblock->vector x t n)))]
[(_ io t n) (type: _pointer
pre: (x => (vector->cblock x t))
post: (x => (cblock->vector x t n)))]))
[(_ i t ) (type: _pointer
pre: (x => (vector->cblock x t)))]
[(_ i t mode) (type: _pointer
pre: (x => (vector->cblock x t #:malloc-mode (check-malloc-mode _vector mode))))]
[(_ o t n) (type: _pointer
pre: (malloc n t)
post: (x => (cblock->vector x t n)))]
[(_ o t n mode) (type: _pointer
pre: (malloc n t (check-malloc-mode _vector mode))
post: (x => (cblock->vector x t n)))]
[(_ io t n) (type: _pointer
pre: (x => (vector->cblock x t))
post: (x => (cblock->vector x t n)))]
[(_ io t n mode) (type: _pointer
pre: (x => (vector->cblock x t #:malloc-mode (check-malloc-mode _vector mode)))
post: (x => (cblock->vector x t n)))]))
(define-syntax (check-malloc-mode stx)
(syntax-case stx ()
[(_ _ mode)
(memq (syntax-e #'mode)
'(raw atomic nonatomic tagged
atomic-interior interior
stubborn uncollectable eternal))
#'(quote mode)]
[(_ who mode)
(raise-syntax-error (syntax-e #'who)
"invalid malloc mode"
#'mode)]))
;; Reflect the difference between 'racket and 'chez-scheme
;; VMs for `_bytes` in `_bytes*`:
@ -2026,14 +2055,17 @@
(values x type))))
;; Converting Scheme lists to/from C vectors (going back requires a length)
(define* (list->cblock l type [need-len #f])
(define* (list->cblock l type [need-len #f]
#:malloc-mode [mode #f])
(define len (length l))
(when need-len
(unless (= len need-len)
(error 'list->cblock "list does not have the expected length: ~e" l)))
(if (null? l)
#f ; null => NULL
(let ([cblock (malloc len type)])
(let ([cblock (if mode
(malloc len type mode)
(malloc len type))])
(let loop ([l l] [i 0])
(unless (null? l)
(ptr-set! cblock type i (car l))
@ -2051,14 +2083,17 @@
"expecting a non-void pointer, got ~s" cblock)]))
;; Converting Scheme vectors to/from C vectors
(define* (vector->cblock v type [need-len #f])
(define* (vector->cblock v type [need-len #f]
#:malloc-mode [mode #f])
(let ([len (vector-length v)])
(when need-len
(unless (= need-len len)
(error 'vector->cblock "vector does not have the expected length: ~e" v)))
(if (zero? len)
#f ; #() => NULL
(let ([cblock (malloc len type)])
(let ([cblock (if mode
(malloc len type mode)
(malloc len type))])
(let loop ([i 0])
(when (< i len)
(ptr-set! cblock type i (vector-ref v i))