diff --git a/pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-doc/scribblings/foreign/types.scrbl index 29547a904a..da71a5c0d7 100644 --- a/pkgs/racket-doc/scribblings/foreign/types.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/types.scrbl @@ -619,7 +619,12 @@ For @tech{callouts} to foreign functions with the generated type: value of @racket[blocking?] affects only the @CS[] implementation of Racket, where it enable activity such as garbage collection in other OS threads while the - @tech{callout} blocks. If the blocking @tech{callout} can + @tech{callout} blocks. Since a garbage collection can happen during + the foreign call, objects passed to the foreign call need to be + immobile if they're managed by the garbage collector; in particular, + any @racket[_ptr] arguments should normally specify @racket['atomic-interior] + allocation mode. + If the blocking @tech{callout} can invoke any @tech{callbacks} back to Racket, those @tech{callbacks} must be constructed with a non-@racket[#f] value of @racket[async-apply], even if they are always applied @@ -1064,8 +1069,11 @@ Examples: @defform/subs[#:literals (i o io) - (_ptr mode type-expr) - ([mode i o io])]{ + (_ptr mode type-expr maybe-malloc-mode) + ([mode i o io] + [maybe-malloc-mode (code:line) #f raw atomic nonatomic tagged + atomic-interior interior + stubborn uncollectable eternal])]{ Creates a C pointer type, where @racket[mode] indicates input or output pointers (or both). The @racket[mode] can be one of the @@ -1083,9 +1091,8 @@ following (matched as a symbol independent of binding): the foreign function expects a pointer to a place where it will save some value, and this value is accessible after the call, to be used by an extra return expression. If @racket[_ptr] is used in this - mode, then the generated wrapper does not expect an argument since - one will be freshly allocated before the call. The argument is - allocated using @racket[(malloc type-expr)].} + mode, then the generated wrapper does not expect an argument, since + one will be freshly allocated before the call.} @item{@racket[io] --- combines the above into an @italic{input/output} pointer argument: the wrapper gets the Racket @@ -1113,17 +1120,24 @@ creates a function that calls the foreign function with a fresh integer pointer, and use the value that is placed there as a second return value. +The pointer argument created by @racket[_ptr] is allocated using +allocated using @racket[(malloc type-expr)] if +@racket[maybe-malloc-mode] is not specified or if it is @racket[#f], +@racket[(malloc type-expr '@#,racket[maybe-malloc-mode])] otherwise. + @history[#:changed "7.7.0.6" @elem{The modes @racket[i], @racket[o], and @racket[io] match as symbols - instead of free identifiers.}]} + instead of free identifiers.} + #:changed "8.0.0.13" @elem{Added @racket[malloc-mode].}]} -@defform[(_box type)]{ +@defform[(_box type maybe-malloc-mode)]{ A @tech{custom function type} similar to a @racket[(_ptr io _type)] argument, where the input is expected to be a box holding an appropriate value, which is unboxed on entry and modified accordingly -on exit. +on exit. The optional @racket[maybe-malloc-mode] is the same as for +@racket[_ptr]. Example: diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index 72451c3317..da60ccefe2 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl @@ -176,6 +176,8 @@ ;; Make sure `_box` at least compiles: (test #t ctype? (_fun (_box _int) -> _void)) +(test #t ctype? (_fun (_box _int #f) -> _void)) +(test #t ctype? (_fun (_box _int atomic-interior) -> _void)) ;; Check error message on bad _fun form (syntax-test #'(_fun (b) :: _bool -> _void) #rx"unnamed argument .without an expression. is not allowed") @@ -812,6 +814,12 @@ (test 67 (get-ffi-obj 'varargs_check test-lib (_varargs (_int = 4) (_ptr i _int) (_int = 1) _int)) 50 8 9) + (test 67 + (get-ffi-obj 'varargs_check test-lib (_varargs (_int = 4) (_ptr i _int #f) (_int = 1) _int)) + 50 8 9) + (test 67 + (get-ffi-obj 'varargs_check test-lib (_varargs (_int = 4) (_ptr i _int atomic-interior) (_int = 1) _int)) + 50 8 9) (test 16 (get-ffi-obj 'varargs_check test-lib (_varargs (_int = 5) (_fun #:varargs-after 2 _int _long _double -> _int))) 10 (lambda (a b c) (inexact->exact (+ a b c)))) diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index db8838553a..22263c8a89 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -1075,21 +1075,31 @@ (syntax-case* stx (lit ...) (lambda (a b) (eq? (syntax-e a) (syntax-e b))) [pat (syntax-protect (syntax/loc stx tmpl))] ...)))) -;; (_ptr ) +(define-syntax malloc/static-mode + (syntax-rules () + [(_ who t #f) (malloc t)] + [(_ who t mode) (begin + (check-malloc-mode _who mode) + (malloc t 'mode))])) + +;; (_ptr []) ;; This is for pointers, where mode indicates input or output pointers (or ;; both). If the mode is `o' (output), then the wrapper will not get an ;; argument for it, instead it generates the matching argument. (provide _ptr) (define-fun-syntax _ptr (syntax-rules/symbol-literals (i o io) - [(_ i t) (type: _pointer - pre: (x => (let ([p (malloc t)]) (ptr-set! p t x) p)))] - [(_ o t) (type: _pointer - pre: (malloc t) - post: (x => (ptr-ref x t)))] - [(_ io t) (type: _pointer - pre: (x => (let ([p (malloc t)]) (ptr-set! p t x) p)) - post: (x => (ptr-ref x t)))])) + [(_ i t) (_ptr i t #f)] + [(_ i t mode) (type: _pointer + pre: (x => (let ([p (malloc/static-mode _ptr t mode)]) (ptr-set! p t x) p)))] + [(_ o t) (_ptr o t #f)] + [(_ o t mode) (type: _pointer + pre: (malloc/static-mode _ptr t mode) + post: (x => (ptr-ref x t)))] + [(_ io t) (_ptr io t #f)] + [(_ io t mode) (type: _pointer + pre: (x => (let ([p (malloc/static-mode _ptr t mode)]) (ptr-set! p t x) p)) + post: (x => (ptr-ref x t)))])) ;; (_box ) ;; This is similar to a (_ptr io ) argument, where the input is expected @@ -1097,10 +1107,11 @@ (provide _box) (define-fun-syntax _box (syntax-rules () - [(_ t) (type: _pointer - bind: tmp ; need to save the box so we can get back to it - pre: (x => (let ([p (malloc t)]) (ptr-set! p t (unbox x)) p)) - post: (x => (begin (set-box! tmp (ptr-ref x t)) tmp)))])) + [(_ t) (_box t #f)] + [(_ t mode) (type: _pointer + bind: tmp ; need to save the box so we can get back to it + pre: (x => (let ([p (malloc/static-mode _box t mode)]) (ptr-set! p t (unbox x)) p)) + post: (x => (begin (set-box! tmp (ptr-ref x t)) tmp)))])) ;; (_list []) ;; Similar to _ptr, except that it is used for converting lists to/from C