ffi/unsafe: add optional malloc mode to _ptr and _box

The optional mode is probably most useful when 'atomic-interior is
needed in combination with a `#:blocking? #t` function.

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)
+              (_ptr mode type-expr maybe-malloc-mode)
-              ([mode i o io])]{
+              ([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
+  mode, then the generated wrapper does not expect an argument, since
-  one will be freshly allocated before the call. The argument is
+  one will be freshly allocated before the call.}
-  allocated using @racket[(malloc type-expr)].}
 
  @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:
 

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))))

racket/collects/ffi/unsafe.rkt

@@ -1075,20 +1075,30 @@
       (syntax-case* stx (lit ...) (lambda (a b) (eq? (syntax-e a) (syntax-e b)))
         [pat (syntax-protect (syntax/loc stx tmpl))] ...))))
 
-;; (_ptr <mode> <type>)
+(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 <mode> <type> [<malloc-mode>])
 ;; 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
+    [(_ i  t) (_ptr i t #f)]
-               pre:  (x => (let ([p (malloc t)]) (ptr-set! p t x) p)))]
+    [(_ i  t mode) (type: _pointer
-    [(_ o  t) (type: _pointer
+                          pre:  (x => (let ([p (malloc/static-mode _ptr t mode)]) (ptr-set! p t x) p)))]
-               pre:  (malloc t)
+    [(_ 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) (type: _pointer
+    [(_ io t) (_ptr io t #f)]
-               pre:  (x => (let ([p (malloc t)]) (ptr-set! p t x) p))
+    [(_ 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 <type>)
@@ -1097,9 +1107,10 @@
 (provide _box)
 (define-fun-syntax _box
   (syntax-rules ()
-    [(_ t) (type: _pointer
+    [(_ 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 t)]) (ptr-set! p t (unbox x)) p))
+                       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 <mode> <type> [<len>])