diff --git a/pkgs/racket-doc/scribblings/foreign/objc.scrbl b/pkgs/racket-doc/scribblings/foreign/objc.scrbl
index 13368d691d..a35b4c72ef 100644
--- a/pkgs/racket-doc/scribblings/foreign/objc.scrbl
+++ b/pkgs/racket-doc/scribblings/foreign/objc.scrbl
@@ -323,6 +323,16 @@ retained as long as the block remains in use.
 @history[#:added "6.3"]}
 
 
+@defform[(with-blocking-tell form ...+)]{
+
+Causes any @racket[tell], @racket[tellv], or @racket[super-tell]
+expression syntactically within the @racket[form]s to be blocking in
+the sense of the @racket[#:blocking?] argument to
+@racket[_cprocedure]. Otherwise, @racket[(with-blocking-tell form
+...+)] is equivalent to @racket[(let () form ...+)].
+
+@history[#:added "7.0.0.19"]}
+
 @; ----------------------------------------------------------------------
 
 @section{Raw Runtime Functions}
@@ -419,7 +429,25 @@ Like @racket[objc_msgSend/typed], but for a super call.}
 
 Constructor and FFI C type use for super calls.}
 
-@table-of-contents[]
+@deftogether[(
+@defproc[((objc_msgSend/typed/blocking [types (vector/c result-ctype arg-ctype ...)])
+          [obj _id]
+          [sel _SEL]
+          [arg any/c])
+         any/c]
+@defproc[((objc_msgSendSuper/typed/blocking [types (vector/c result-ctype arg-ctype ...)])
+          [super _objc_super]
+          [sel _SEL]
+          [arg any/c])
+         any/c]
+)]{
+
+The same as @racket[objc_msgSend/typed] and
+@racket[objc_msgSendSuper/typed], but specifying that the send should
+be blocking in the sense of the @racket[#:blocking?] argument to
+@racket[_cprocedure].
+
+@history[#:added "7.0.0.19"]}
 
 @; ----------------------------------------------------------------------
 
diff --git a/racket/collects/ffi/unsafe/objc.rkt b/racket/collects/ffi/unsafe/objc.rkt
index d1d7259b97..6b75d8efa4 100644
--- a/racket/collects/ffi/unsafe/objc.rkt
+++ b/racket/collects/ffi/unsafe/objc.rkt
@@ -290,7 +290,7 @@
 (define-syntax-rule (as-atomic e)
   (begin (start-atomic) (begin0 e (end-atomic))))
 
-(define (lookup-send types msgSends msgSend msgSend_fpret msgSend_stret first-arg-type)
+(define (lookup-send blocking? types msgSends msgSend msgSend_fpret msgSend_stret first-arg-type)
   ;; First type in `types' vector is the result type
   (or (as-atomic (hash-ref msgSends types #f))
       (let ([ret-layout (ctype->layout (vector-ref types 0))])
@@ -299,6 +299,7 @@
             ;; Structure return type:
             (let* ([pre-m (function-ptr msgSend_stret
                                         (_cprocedure
+                                         #:blocking? blocking?
                                          (list* _pointer first-arg-type _SEL (cdr (vector->list types)))
                                          _void))]
                    [m (lambda args
@@ -313,6 +314,7 @@
                                        msgSend_fpret
                                        msgSend)
                                    (_cprocedure
+                                    #:blocking? blocking?
                                     (list* first-arg-type _SEL (cdr (vector->list types)))
                                     (vector-ref types 0)))])
               (as-atomic (hash-set! msgSends types m))
@@ -320,14 +322,33 @@
 
 (define msgSends (make-weak-hash))
 (define (objc_msgSend/typed types)
-  (lookup-send types msgSends objc_msgSend objc_msgSend_fpret objc_msgSend_stret _id))
+  (lookup-send #f types msgSends objc_msgSend objc_msgSend_fpret objc_msgSend_stret _id))
 (provide objc_msgSend/typed)
 
 (define msgSendSupers (make-weak-hash))
 (define (objc_msgSendSuper/typed types)
-  (lookup-send types msgSendSupers objc_msgSendSuper objc_msgSendSuper_fpret objc_msgSendSuper_stret _pointer))
+  (lookup-send #f types msgSendSupers objc_msgSendSuper objc_msgSendSuper_fpret objc_msgSendSuper_stret _pointer))
 (provide objc_msgSendSuper/typed)
 
+(define msgSends/blocking (make-weak-hash))
+(define (objc_msgSend/typed/blocking types)
+  (lookup-send #t types msgSends/blocking objc_msgSend objc_msgSend_fpret objc_msgSend_stret _id))
+(provide objc_msgSend/typed/blocking)
+
+(define msgSendSupers/blocking (make-weak-hash))
+(define (objc_msgSendSuper/typed/blocking types)
+  (lookup-send #t types msgSendSupers/blocking objc_msgSendSuper objc_msgSendSuper_fpret objc_msgSendSuper_stret _pointer))
+(provide objc_msgSendSuper/typed/blocking)
+
+(define-syntax-parameter objc_msgSend/typed* (make-rename-transformer #'objc_msgSend/typed))
+(define-syntax-parameter objc_msgSendSuper/typed* (make-rename-transformer #'objc_msgSendSuper/typed))
+
+(define-syntax-rule (with-blocking-tell e0 e ...)
+  (syntax-parameterize ([objc_msgSend/typed* (make-rename-transformer #'objc_msgSend/typed/blocking)]
+                        [objc_msgSendSuper/typed* (make-rename-transformer #'objc_msgSendSuper/typed/blocking)])
+    e0 e ...))
+(provide with-blocking-tell)
+
 ;; ----------------------------------------
 
 (provide import-class)
@@ -529,23 +550,26 @@
                          "method identifier missing"
                          stx)]
     [(_ #:type t target method)
+     (and (not (keyword? (syntax-e #'target)))
+          (identifier? #'method))
      (let ([m #'method])
        (check-method-name m stx)
        (quasisyntax/loc stx
-         ((objc_msgSend/typed (type-vector 'method t)) target #,(register-selector (syntax-e m)))))]
+         ((objc_msgSend/typed* (type-vector 'method t)) target #,(register-selector (syntax-e m)))))]
     [(_ target method)
-     (not (keyword? (syntax-e #'target)))
+     (and (not (keyword? (syntax-e #'target)))
+          (identifier? #'method))
      (let ([m #'method])
        (check-method-name m stx)
        (quasisyntax/loc stx
-         ((objc_msgSend/typed (type-vector 'method _id)) target #,(register-selector (syntax-e m)))))]
+         ((objc_msgSend/typed* (type-vector 'method _id)) target #,(register-selector (syntax-e m)))))]
     [(_ #:type result-type target method/arg ...)
      (build-send stx #'result-type 
-                 #'objc_msgSend/typed #'(target)
+                 #'objc_msgSend/typed* #'(target)
                  #'(method/arg ...))]
     [(_ target method/arg ...)
      (build-send stx #'_id 
-                 #'objc_msgSend/typed #'(target)
+                 #'objc_msgSend/typed* #'(target)
                  #'(method/arg ...))]))
 
 (define-syntax-rule (tellv a ...)
@@ -876,10 +900,16 @@
          [(kind result-type (id arg ...) body0 body ...)
           (loop stx 
                 (with-syntax ([async
-                               (if (eq? (syntax-e #'id) 'dealloc)
-                                   ;; so that objects can be destroyed in foreign threads:
-                                   #'apply-directly
-                                   #'#f)])
+                               (cond
+                                 [(eq? (syntax-e #'id) 'dealloc)
+                                  ;; so that objects can be destroyed in foreign threads:
+                                  #'apply-directly]
+                                 [(eq? (system-type 'vm) 'chez-scheme)
+                                  ;; to cooperate with blocking callouts, we need a non-#f
+                                  ;; `async-apply`
+                                  #'complain-apply-foreign-thread]
+                                 [else                                  
+                                  #'#f])])
                   (syntax/loc m 
                     (kind #:async-apply async result-type (id arg ...) body0 body ...))))]
          [else (raise-syntax-error #f
@@ -889,6 +919,13 @@
 
 (define (apply-directly f) (f))
 
+(define (complain-apply-foreign-thread f)
+  ;; We'd like to complain, but we' not in a context where there's a
+  ;; valid way to complain. Try logging an error, and just maybe that
+  ;; will get some information out.
+  (log-error "callback in unexpected thread")
+  (void))
+
 (define methods (make-hasheq))
 (define (save-method! m)
   ;; Methods are never GCed, since classes are never unregistered
@@ -916,7 +953,7 @@
      (let ([m #'method])
        (check-method-name m stx)
        (quasisyntax/loc stx
-         ((objc_msgSendSuper/typed (type-vector 'method t))
+         ((objc_msgSendSuper/typed* (type-vector 'method t))
           (make-objc_super self super-class) 
           #,(register-selector (syntax-e m)))))]
     [(_ method)
@@ -924,17 +961,17 @@
      (let ([m #'method])
        (check-method-name m stx)
        (quasisyntax/loc stx
-         ((objc_msgSendSuper/typed (type-vector 'method _id)) 
+         ((objc_msgSendSuper/typed* (type-vector 'method _id)) 
           (make-objc_super self super-class)
           #,(register-selector (syntax-e m)))))]
     [(_ #:type result-type method/arg ...)
      (build-send stx #'result-type 
-                 #'objc_msgSendSuper/typed
+                 #'objc_msgSendSuper/typed*
                  #'((make-objc_super self super-class))
                  #'(method/arg ...))]
     [(_ method/arg ...)
      (build-send stx #'_id
-                 #'objc_msgSendSuper/typed
+                 #'objc_msgSendSuper/typed*
                  #'((make-objc_super self super-class))
                  #'(method/arg ...))]))