diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt
index 02dde77f4a..38e189d6db 100644
--- a/pkgs/base/info.rkt
+++ b/pkgs/base/info.rkt
@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "6.2.0.4")
+(define version "6.2.0.5")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))
diff --git a/pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-doc/scribblings/foreign/types.scrbl
index 79029455e5..8f5be26795 100644
--- a/pkgs/racket-doc/scribblings/foreign/types.scrbl
+++ b/pkgs/racket-doc/scribblings/foreign/types.scrbl
@@ -474,6 +474,7 @@ the later case, the result is the @racket[ctype]).}
                       [#:abi abi (or/c #f 'default 'stdcall 'sysv) #f]
                       [#:atomic? atomic? any/c #f]
                       [#:async-apply async-apply (or/c #f ((-> any/c) . -> . any/c) box?) #f]
+                      [#:lock-name lock-name (or/c string? #f) #f]
                       [#:in-original-place? in-original-place? any/c #f]
                       [#:save-errno save-errno (or/c #f 'posix 'windows) #f]
                       [#:wrapper wrapper (or/c #f (procedure? . -> . procedure?))
@@ -536,6 +537,12 @@ For @tech{callouts} to foreign functions with the generated type:
        (for example, grabbing a value stored in an ``output'' pointer
        and returning multiple values).}
 
+ @item{If @racket[lock-name] is not @racket[#f], then a process-wide
+       lock with the given name is held during the foreign call. In a
+       build that supports parallel places, @racket[lock-name] is
+       registered via @cpp{scheme_register_process_global}, so choose
+       names that are suitably distinct.}
+
  @item{If @racket[in-original-place?] is true, then when a foreign
        @tech{callout} procedure with the generated type is called in
        any Racket @tech-place[], the procedure
@@ -692,7 +699,8 @@ For @tech{callbacks} to Racket functions with the generated type:
        is not used.}
 
 ]
-}
+
+@history[#:changed "6.2.0.5" @elem{Added the @racket[#:lock-name] argument.}]}
 
 @defform/subs[#:literals (->> :: :)
               (_fun fun-option ... maybe-args type-spec ... ->> type-spec
@@ -702,6 +710,7 @@ For @tech{callbacks} to Racket functions with the generated type:
                            (code:line #:keep keep-expr)
                            (code:line #:atomic? atomic?-expr)
                            (code:line #:async-apply async-apply-expr)
+                           (code:line #:lock-name lock-name-expr)
                            (code:line #:in-original-place? in-original-place?-expr)
                            (code:line #:retry (retry-id [arg-id init-expr]))]
                [maybe-args code:blank
@@ -821,7 +830,8 @@ specifications:
 
 ]
 
-@history[#:changed "6.2" @elem{Added the @racket[#:retry] option.}]}
+@history[#:changed "6.2" @elem{Added the @racket[#:retry] option.}
+         #:changed "6.2.0.5" @elem{Added the @racket[#:lock-name] option.}]}
 
 @defproc[(function-ptr [ptr-or-proc (or cpointer? procedure?)]
                        [fun-type ctype?])
diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt
index 04e4f612f9..b033b3d287 100644
--- a/racket/collects/ffi/unsafe.rkt
+++ b/racket/collects/ffi/unsafe.rkt
@@ -452,13 +452,14 @@
                       #:keep        [keep    #t]
                       #:atomic?     [atomic? #f]
                       #:in-original-place? [orig-place? #f]
+                      #:lock-name   [lock-name #f]
                       #:async-apply [async-apply #f]
                       #:save-errno  [errno   #f])
-  (_cprocedure* itypes otype abi wrapper keep atomic? orig-place? async-apply errno))
+  (_cprocedure* itypes otype abi wrapper keep atomic? orig-place? async-apply errno lock-name))
 
 ;; for internal use
 (define held-callbacks (make-weak-hasheq))
-(define (_cprocedure* itypes otype abi wrapper keep atomic? orig-place? async-apply errno)
+(define (_cprocedure* itypes otype abi wrapper keep atomic? orig-place? async-apply errno lock-name)
   (define-syntax-rule (make-it wrap)
     (make-ctype _fpointer
       (lambda (x)
@@ -471,7 +472,7 @@
                                   (if (or (null? x) (pair? x)) (cons cb x) cb)))]
                      [(procedure? keep) (keep cb)])
                cb)))
-      (lambda (x) (and x (wrap (ffi-call x itypes otype abi errno orig-place?))))))
+      (lambda (x) (and x (wrap (ffi-call x itypes otype abi errno orig-place? lock-name))))))
   (if wrapper (make-it wrapper) (make-it begin)))
 
 ;; Syntax for the special _fun type:
@@ -494,7 +495,8 @@
 
 (provide _fun)
 (define-for-syntax _fun-keywords
-  `([#:abi ,#'#f] [#:keep ,#'#t] [#:atomic? ,#'#f] [#:in-original-place? ,#'#f]
+  `([#:abi ,#'#f] [#:keep ,#'#t] [#:atomic? ,#'#f]
+    [#:in-original-place? ,#'#f] [#:lock-name ,#'#f]
     [#:async-apply ,#'#f] [#:save-errno ,#'#f]
     [#:retry #f]))
 (define-syntax (_fun stx)
@@ -658,7 +660,8 @@
                              #,(kwd-ref '#:atomic?)
                              #,(kwd-ref '#:in-original-place?)
                              #,(kwd-ref '#:async-apply)
-                             #,(kwd-ref '#:save-errno)))])
+                             #,(kwd-ref '#:save-errno)
+                             #,(kwd-ref '#:lock-name)))])
       (if (or (caddr output) input-names (ormap caddr inputs)
               (ormap (lambda (x) (not (car x))) inputs)
               (pair? bind) (pair? pre) (pair? post))
diff --git a/racket/src/foreign/foreign.c b/racket/src/foreign/foreign.c
index 5babfa216a..f1960f6b96 100644
--- a/racket/src/foreign/foreign.c
+++ b/racket/src/foreign/foreign.c
@@ -3207,6 +3207,132 @@ void do_ptr_finalizer(void *p, void *finalizer)
   ptr = NULL;
 }
 
+/*****************************************************************************/
+/* FFI named locks */
+
+THREAD_LOCAL_DECL(static Scheme_Hash_Table *ffi_lock_ht);
+
+#ifdef MZ_PRECISE_GC
+static Scheme_Object *make_vector_in_master(int count, Scheme_Object *val) {
+  Scheme_Object *vec;
+  void *original_gc;
+  original_gc = GC_switch_to_master_gc();
+  vec = scheme_make_vector(count, val);
+  GC_switch_back_from_master(original_gc);
+  return vec;
+}
+#endif
+
+static void *name_to_ffi_lock(Scheme_Object *bstr)
+{
+  Scheme_Object *lock;
+
+  if (!ffi_lock_ht) {
+    REGISTER_SO(ffi_lock_ht);
+    ffi_lock_ht = scheme_make_hash_table_equal();
+  }
+
+  lock = scheme_hash_get(ffi_lock_ht, bstr);
+  if (!lock) {
+#   ifdef MZ_USE_PLACES
+    /* implement the lock with a compare-and-swap with fallback (on
+       contention) to a place channel; this strategy has minimal
+       overhead when there's no contention, which is good for avoiding
+       a penalty in the common case of a single place (but it's probably
+       not the best strategy for a contended lock) */
+    void *lock_box, *old_lock_box;
+
+    lock_box = scheme_register_process_global(SCHEME_BYTE_STR_VAL(bstr), NULL);
+    if (!lock_box) {
+      lock = scheme_place_make_async_channel();
+      lock = make_vector_in_master(2, lock);
+      SCHEME_VEC_ELS(lock)[1] = scheme_make_integer(-1);
+      lock_box = scheme_malloc_immobile_box(lock);
+      old_lock_box = scheme_register_process_global(SCHEME_BYTE_STR_VAL(bstr), lock_box);
+      if (old_lock_box) {
+        scheme_free_immobile_box(lock_box);
+        lock_box = old_lock_box;
+      }
+    }
+    lock = *(Scheme_Object **)lock_box;
+#   else /* MZ_USE_PLACES undefined */
+    lock = scheme_make_sema(1);
+#   endif /* MZ_USE_PLACES */
+    scheme_hash_set(ffi_lock_ht, bstr, lock);
+  }
+
+  return lock;
+}
+
+static void wait_ffi_lock(Scheme_Object *lock)
+{
+# ifdef MZ_USE_PLACES
+  while (1) {
+    if (mzrt_cas((uintptr_t*)&(SCHEME_VEC_ELS(lock)[1]),
+                 (uintptr_t)scheme_make_integer(-1),
+                 (uintptr_t)scheme_make_integer(scheme_current_place_id))) {
+      /* obtained lock the fast way */
+      break;
+    } else {
+      Scheme_Object *owner, *new_val;
+      owner = SCHEME_VEC_ELS(lock)[1];
+      if (SCHEME_INT_VAL(owner) != -1) {
+        if (SCHEME_INT_VAL(owner) < -1) {
+          /* other processes waiting, and now there's one more: */
+          new_val = scheme_make_integer(SCHEME_INT_VAL(owner)-1);
+        } else {
+          /* notify owner that another process is now waiting: */
+          new_val = scheme_make_integer(-2);
+        }
+        if (mzrt_cas((uintptr_t*)&(SCHEME_VEC_ELS(lock)[1]),
+                     (uintptr_t)owner,
+                     (uintptr_t)new_val)) {
+          /* wait for lock the slow way - without blocking other Racket threads */
+          (void)scheme_place_async_channel_receive(SCHEME_VEC_ELS(lock)[0]);
+
+          /* not waiting anymore: */
+          while (1) {
+            owner = SCHEME_VEC_ELS(lock)[1];
+            if (SCHEME_INT_VAL(owner) == -2) {
+              /* no other processes waiting */
+              new_val = scheme_make_integer(scheme_current_place_id);
+            } else {
+              /* one less process waiting */
+              new_val = scheme_make_integer(SCHEME_INT_VAL(owner)+1);
+            }
+            if (mzrt_cas((uintptr_t*)&(SCHEME_VEC_ELS(lock)[1]),
+                         (uintptr_t)owner,
+                         (uintptr_t)new_val)) {
+              break;
+            }
+          }
+          break;
+        }
+      }
+    }
+  }
+# else /* MZ_USE_PLACES undefined */
+  scheme_wait_sema(lock, 0);
+# endif /* MZ_USE_PLACES */
+}
+
+static void release_ffi_lock(void *lock)
+{
+# ifdef MZ_USE_PLACES
+  if (mzrt_cas((uintptr_t *)&(SCHEME_VEC_ELS(lock)[1]),
+               (uintptr_t)scheme_make_integer(scheme_current_place_id),
+               (uintptr_t)scheme_make_integer(-1))) {
+    /* released lock with no other process waiting */
+  } else {
+    /* assert: SCHEME_VEC_ELS(lock)[1] holds a negative
+       number corresponding to the number of waiting processes */
+    scheme_place_async_channel_send(SCHEME_VEC_ELS(lock)[0], scheme_false);
+  }
+# else /* MZ_USE_PLACES undefined */
+  scheme_post_sema(lock);
+# endif /* MZ_USE_PLACES */
+}
+
 /*****************************************************************************/
 /* Calling foreign function objects */
 
@@ -3385,8 +3511,9 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
   ffi_cif       *cif    = (ffi_cif*)(SCHEME_VEC_ELS(data)[4]);
   intptr_t      cfoff   = SCHEME_INT_VAL(SCHEME_VEC_ELS(data)[5]);
   int           save_errno = SCHEME_INT_VAL(SCHEME_VEC_ELS(data)[6]);
+  Scheme_Object *lock = SCHEME_VEC_ELS(data)[7];
 #ifdef MZ_USE_PLACES
-  int           orig_place = SCHEME_TRUEP(SCHEME_VEC_ELS(data)[7]);
+  int           orig_place = SCHEME_TRUEP(SCHEME_VEC_ELS(data)[8]);
 #endif
   int           nargs /* = cif->nargs, after checking cif */;
   /* When the foreign function is called, we need an array (ivals) of nargs
@@ -3459,6 +3586,9 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
     newp = NULL;
   }
 
+  if (SCHEME_TRUEP(lock))
+    wait_ffi_lock(lock);
+
 #ifdef MZ_USE_PLACES
   if (orig_place)
     ffi_call_in_orig_place(cif, c_func, cfoff,
@@ -3470,6 +3600,9 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
                     nargs, ivals, avalues,
                     offsets, p);
 
+  if (SCHEME_TRUEP(lock))
+    release_ffi_lock(lock);
+
   /* Use `data' to make sure it's kept alive (as far as the GC is concerned)
      until the foreign call returns: */
   if ((void*)data == (void*)scheme_true)
@@ -3546,11 +3679,12 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
   GC_CAN_IGNORE ffi_type *rtype, **atypes;
   GC_CAN_IGNORE ffi_cif *cif;
   int i, nargs, save_errno;
+  Scheme_Object *lock = scheme_false;
 # ifdef MZ_USE_PLACES
   int orig_place;
-# define FFI_CALL_VEC_SIZE 8
+# define FFI_CALL_VEC_SIZE 9
 # else /* MZ_USE_PLACES undefined */
-# define FFI_CALL_VEC_SIZE 7
+# define FFI_CALL_VEC_SIZE 8
 # endif /* MZ_USE_PLACES */
   cp = unwrap_cpointer_property(argv[0]);
   if (!SCHEME_FFIANYPTRP(cp))
@@ -3586,6 +3720,13 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
   if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
   else orig_place = 0;
 # endif /* MZ_USE_PLACES */
+  if (argc > 6) {
+    if (!SCHEME_FALSEP(argv[6])) {
+      if (!SCHEME_CHAR_STRINGP(argv[6]))
+        scheme_wrong_contract(MYNAME, "(or/c string? #f)", 4, argc, argv);
+      lock = name_to_ffi_lock(scheme_char_string_to_byte_string(argv[6]));
+    }
+  }
   if (SCHEME_FFIOBJP(cp))
     name = scheme_make_byte_string(((ffi_obj_struct*)(cp))->name);
   else
@@ -3609,8 +3750,9 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
   SCHEME_VEC_ELS(data)[4] = (Scheme_Object*)cif;
   SCHEME_VEC_ELS(data)[5] = scheme_make_integer(ooff);
   SCHEME_VEC_ELS(data)[6] = scheme_make_integer(save_errno);
+  SCHEME_VEC_ELS(data)[7] = lock;
 # ifdef MZ_USE_PLACES
-  SCHEME_VEC_ELS(data)[7] = (orig_place ? scheme_true : scheme_false);
+  SCHEME_VEC_ELS(data)[8] = (orig_place ? scheme_true : scheme_false);
 # endif /* MZ_USE_PLACES */
   scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL);
   a[0] = data;
@@ -4305,7 +4447,7 @@ void scheme_init_foreign(Scheme_Env *env)
   scheme_add_global_constant("make-sized-byte-string",
     scheme_make_noncm_prim(foreign_make_sized_byte_string, "make-sized-byte-string", 2, 2), menv);
   scheme_add_global_constant("ffi-call",
-    scheme_make_noncm_prim(foreign_ffi_call, "ffi-call", 3, 6), menv);
+    scheme_make_noncm_prim(foreign_ffi_call, "ffi-call", 3, 7), menv);
   scheme_add_global_constant("ffi-callback",
     scheme_make_noncm_prim(foreign_ffi_callback, "ffi-callback", 3, 6), menv);
   scheme_add_global_constant("saved-errno",
@@ -4654,7 +4796,7 @@ void scheme_init_foreign(Scheme_Env *env)
   scheme_add_global_constant("make-sized-byte-string",
    scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "make-sized-byte-string", 2, 2), menv);
   scheme_add_global_constant("ffi-call",
-   scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ffi-call", 3, 6), menv);
+   scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ffi-call", 3, 7), menv);
   scheme_add_global_constant("ffi-callback",
    scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ffi-callback", 3, 6), menv);
   scheme_add_global_constant("saved-errno",
diff --git a/racket/src/foreign/foreign.rktc b/racket/src/foreign/foreign.rktc
index e67332c168..ae5aa63868 100755
--- a/racket/src/foreign/foreign.rktc
+++ b/racket/src/foreign/foreign.rktc
@@ -2372,6 +2372,132 @@ void do_ptr_finalizer(void *p, void *finalizer)
   ptr = NULL;
 }
 
+/*****************************************************************************/
+/* FFI named locks */
+
+THREAD_LOCAL_DECL(static Scheme_Hash_Table *ffi_lock_ht);
+
+#ifdef MZ_PRECISE_GC
+static Scheme_Object *make_vector_in_master(int count, Scheme_Object *val) {
+  Scheme_Object *vec;
+  void *original_gc;
+  original_gc = GC_switch_to_master_gc();
+  vec = scheme_make_vector(count, val);
+  GC_switch_back_from_master(original_gc);
+  return vec;
+}
+#endif
+
+static void *name_to_ffi_lock(Scheme_Object *bstr)
+{
+  Scheme_Object *lock;
+  
+  if (!ffi_lock_ht) {
+    REGISTER_SO(ffi_lock_ht);
+    ffi_lock_ht = scheme_make_hash_table_equal();
+  }
+  
+  lock = scheme_hash_get(ffi_lock_ht, bstr);
+  if (!lock) {
+    @@@IFDEF{MZ_USE_PLACES}{
+      /* implement the lock with a compare-and-swap with fallback (on
+         contention) to a place channel; this strategy has minimal
+         overhead when there's no contention, which is good for avoiding
+         a penalty in the common case of a single place (but it's probably
+         not the best strategy for a contended lock) */
+      void *lock_box, *old_lock_box;
+
+      lock_box = scheme_register_process_global(SCHEME_BYTE_STR_VAL(bstr), NULL);
+      if (!lock_box) {
+        lock = scheme_place_make_async_channel();
+        lock = make_vector_in_master(2, lock);
+        SCHEME_VEC_ELS(lock)[1] = scheme_make_integer(-1);
+        lock_box = scheme_malloc_immobile_box(lock);
+        old_lock_box = scheme_register_process_global(SCHEME_BYTE_STR_VAL(bstr), lock_box);
+        if (old_lock_box) {
+          scheme_free_immobile_box(lock_box);
+          lock_box = old_lock_box;
+        }
+      }
+      lock = *(Scheme_Object **)lock_box;
+    }{
+      lock = scheme_make_sema(1);
+    }
+    scheme_hash_set(ffi_lock_ht, bstr, lock);
+  }
+  
+  return lock;
+}
+
+static void wait_ffi_lock(Scheme_Object *lock)
+{
+  @@@IFDEF{MZ_USE_PLACES}{
+    while (1) {
+      if (mzrt_cas((uintptr_t*)&(SCHEME_VEC_ELS(lock)[1]),
+                   (uintptr_t)scheme_make_integer(-1),
+                   (uintptr_t)scheme_make_integer(scheme_current_place_id))) {
+        /* obtained lock the fast way */
+        break;
+      } else {
+        Scheme_Object *owner, *new_val;
+        owner = SCHEME_VEC_ELS(lock)[1];
+        if (SCHEME_INT_VAL(owner) != -1) {
+          if (SCHEME_INT_VAL(owner) < -1) {
+            /* other processes waiting, and now there's one more: */
+            new_val = scheme_make_integer(SCHEME_INT_VAL(owner)-1);
+          } else {
+            /* notify owner that another process is now waiting: */
+            new_val = scheme_make_integer(-2);
+          }
+          if (mzrt_cas((uintptr_t*)&(SCHEME_VEC_ELS(lock)[1]),
+                       (uintptr_t)owner,
+                       (uintptr_t)new_val)) {
+            /* wait for lock the slow way - without blocking other Racket threads */
+            (void)scheme_place_async_channel_receive(SCHEME_VEC_ELS(lock)[0]);
+
+            /* not waiting anymore: */
+            while (1) {
+              owner = SCHEME_VEC_ELS(lock)[1];
+              if (SCHEME_INT_VAL(owner) == -2) {
+                /* no other processes waiting */
+                new_val = scheme_make_integer(scheme_current_place_id);
+              } else {
+                /* one less process waiting */
+                new_val = scheme_make_integer(SCHEME_INT_VAL(owner)+1);
+              }
+              if (mzrt_cas((uintptr_t*)&(SCHEME_VEC_ELS(lock)[1]),
+                           (uintptr_t)owner,
+                           (uintptr_t)new_val)) {
+                break;
+              }
+            }
+            break;
+          }
+        }
+      }
+    }
+  }{
+    scheme_wait_sema(lock, 0);
+  }
+}
+
+static void release_ffi_lock(void *lock)
+{
+  @@@IFDEF{MZ_USE_PLACES}{
+    if (mzrt_cas((uintptr_t *)&(SCHEME_VEC_ELS(lock)[1]),
+                 (uintptr_t)scheme_make_integer(scheme_current_place_id),
+                 (uintptr_t)scheme_make_integer(-1))) {
+      /* released lock with no other process waiting */
+    } else {
+      /* assert: SCHEME_VEC_ELS(lock)[1] holds a negative
+         number corresponding to the number of waiting processes */
+      scheme_place_async_channel_send(SCHEME_VEC_ELS(lock)[0], scheme_false);
+    }
+  }{
+    scheme_post_sema(lock);
+  }
+}
+
 /*****************************************************************************/
 /* Calling foreign function objects */
 
@@ -2550,8 +2676,9 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
   ffi_cif       *cif    = (ffi_cif*)(SCHEME_VEC_ELS(data)[4]);
   intptr_t      cfoff   = SCHEME_INT_VAL(SCHEME_VEC_ELS(data)[5]);
   int           save_errno = SCHEME_INT_VAL(SCHEME_VEC_ELS(data)[6]);
+  Scheme_Object *lock = SCHEME_VEC_ELS(data)[7];
 #ifdef MZ_USE_PLACES
-  int           orig_place = SCHEME_TRUEP(SCHEME_VEC_ELS(data)[7]);
+  int           orig_place = SCHEME_TRUEP(SCHEME_VEC_ELS(data)[8]);
 #endif
   int           nargs /* = cif->nargs, after checking cif */;
   /* When the foreign function is called, we need an array (ivals) of nargs
@@ -2624,6 +2751,9 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
     newp = NULL;
   }
 
+  if (SCHEME_TRUEP(lock))
+    wait_ffi_lock(lock);
+
 #ifdef MZ_USE_PLACES
   if (orig_place)
     ffi_call_in_orig_place(cif, c_func, cfoff,
@@ -2635,6 +2765,9 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
                     nargs, ivals, avalues, 
                     offsets, p);
 
+  if (SCHEME_TRUEP(lock))
+    release_ffi_lock(lock);
+
   /* Use `data' to make sure it's kept alive (as far as the GC is concerned)
      until the foreign call returns: */
   if ((void*)data == (void*)scheme_true)
@@ -2700,7 +2833,7 @@ static Scheme_Object *ffi_name = NULL;
 
 /* (ffi-call ffi-obj in-types out-type [abi save-errno? orig-place?]) -> (in-types -> out-value) */
 /* the real work is done by ffi_do_call above */
-@cdefine[ffi-call 3 6]{
+@cdefine[ffi-call 3 7]{
   Scheme_Object *itypes = argv[1];
   Scheme_Object *otype  = argv[2];
   Scheme_Object *obj, *data, *p, *base, *cp, *name, *a[1];
@@ -2709,11 +2842,12 @@ static Scheme_Object *ffi_name = NULL;
   GC_CAN_IGNORE ffi_type *rtype, **atypes;
   GC_CAN_IGNORE ffi_cif *cif;
   int i, nargs, save_errno;
+  Scheme_Object *lock = scheme_false;
   @@@IFDEF{MZ_USE_PLACES}{
     int orig_place;
-    @DEFINE{FFI_CALL_VEC_SIZE 8}
+    @DEFINE{FFI_CALL_VEC_SIZE 9}
   }{
-    @DEFINE{FFI_CALL_VEC_SIZE 7}
+    @DEFINE{FFI_CALL_VEC_SIZE 8}
   }
   cp = unwrap_cpointer_property(argv[0]);
   if (!SCHEME_FFIANYPTRP(cp))
@@ -2749,6 +2883,13 @@ static Scheme_Object *ffi_name = NULL;
     if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
     else orig_place = 0;
   }
+  if (argc > 6) {
+    if (!SCHEME_FALSEP(argv[6])) {
+      if (!SCHEME_CHAR_STRINGP(argv[6]))
+        scheme_wrong_contract(MYNAME, "(or/c string? #f)", 4, argc, argv);
+      lock = name_to_ffi_lock(scheme_char_string_to_byte_string(argv[6]));
+    }
+  }
   if (SCHEME_FFIOBJP(cp))
     name = scheme_make_byte_string(((ffi_obj_struct*)(cp))->name);
   else
@@ -2772,8 +2913,9 @@ static Scheme_Object *ffi_name = NULL;
   SCHEME_VEC_ELS(data)[4] = (Scheme_Object*)cif;
   SCHEME_VEC_ELS(data)[5] = scheme_make_integer(ooff);
   SCHEME_VEC_ELS(data)[6] = scheme_make_integer(save_errno);
+  SCHEME_VEC_ELS(data)[7] = lock;
   @@IFDEF{MZ_USE_PLACES}{
-    SCHEME_VEC_ELS(data)[7] = (orig_place ? scheme_true : scheme_false);
+    SCHEME_VEC_ELS(data)[8] = (orig_place ? scheme_true : scheme_false);
   }
   scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL);
   a[0] = data;
diff --git a/racket/src/racket/include/schthread.h b/racket/src/racket/include/schthread.h
index 475b664405..6ed170c8e4 100644
--- a/racket/src/racket/include/schthread.h
+++ b/racket/src/racket/include/schthread.h
@@ -369,6 +369,7 @@ typedef struct Thread_Local_Variables {
   void *scheme_inotify_server_;
   struct Scheme_Object *configuration_callback_cache_[2];
   struct FFI_Orig_Place_Call *cached_orig_place_todo_;
+  struct Scheme_Hash_Table *ffi_lock_ht_;
 } Thread_Local_Variables;
 
 #if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS)
@@ -755,6 +756,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define scheme_inotify_server XOA (scheme_get_thread_local_variables()->scheme_inotify_server_)
 #define configuration_callback_cache XOA (scheme_get_thread_local_variables()->configuration_callback_cache_)
 #define cached_orig_place_todo XOA (scheme_get_thread_local_variables()->cached_orig_place_todo_)
+#define ffi_lock_ht XOA (scheme_get_thread_local_variables()->ffi_lock_ht_)
 
 /* **************************************** */
 
diff --git a/racket/src/racket/src/place.c b/racket/src/racket/src/place.c
index c392bb8311..623985f877 100644
--- a/racket/src/racket/src/place.c
+++ b/racket/src/racket/src/place.c
@@ -3078,6 +3078,18 @@ static void async_channel_refcount(Scheme_Place_Async_Channel *ch, int for_send,
   mzrt_mutex_unlock(ch->lock);
 }
 
+Scheme_Object *scheme_place_make_async_channel()
+{
+  Scheme_Place_Async_Channel *ch;
+  ch = place_async_channel_create();
+
+  /* we don't allocate a bi channel, so claim an implicit sender and receiver: */
+  async_channel_refcount(ch, 0, 1);
+  async_channel_refcount(ch, 1, 1);
+
+  return (Scheme_Object *)ch;
+}
+
 static void bi_channel_refcount(Scheme_Place_Bi_Channel *ch, int delta)
 {
   async_channel_refcount(ch->link->sendch, 1, delta);
@@ -3369,6 +3381,10 @@ static void place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *uo)
   mzrt_mutex_unlock(ch->lock);
 }
 
+void scheme_place_async_channel_send(Scheme_Object *ch, Scheme_Object *uo) {
+  place_async_send((Scheme_Place_Async_Channel *)ch, uo);
+}
+
 static void place_object_inc_refcount(Scheme_Object *o) {
   Scheme_Place_Object *place_obj;
   place_obj = (Scheme_Place_Object *) o;
@@ -3399,6 +3415,9 @@ static void lock_and_register_place_object_with_channel(Scheme_Place_Async_Chann
 
   mzrt_mutex_lock(ch->lock);
 
+  if (ch->count)
+    return; /* no need for a wakeup signal, since data is available */
+
   /* loop in case we need to release the lock temporarily to allocate: */
   while (1) {
     if (ch->wakeup_signal == o) {
@@ -3483,8 +3502,8 @@ static void lock_and_register_place_object_with_channel(Scheme_Place_Async_Chann
   }
 }
 
-static Scheme_Object *scheme_place_async_try_receive_raw(Scheme_Place_Async_Channel *ch, void **msg_memory_ptr,
-                                                         int *_no_writers) 
+static Scheme_Object *place_async_try_receive_raw(Scheme_Place_Async_Channel *ch, void **msg_memory_ptr,
+                                                  int *_no_writers) 
 /* The result must not be retained past extraction from `*msg_memory_ptr'! */
 {
   Scheme_Object *msg = NULL;
@@ -3532,12 +3551,12 @@ static void cleanup_msg_memmory(void *thread) {
   }
 }
 
-static Scheme_Object *scheme_place_async_try_receive(Scheme_Place_Async_Channel *ch, int *_no_writers) {
+static Scheme_Object *place_async_try_receive(Scheme_Place_Async_Channel *ch, int *_no_writers) {
   Scheme_Object *msg = NULL;
   Scheme_Thread *p = scheme_current_thread;
   GC_CAN_IGNORE void *msg_memory;
   BEGIN_ESCAPEABLE(cleanup_msg_memmory, p);
-  msg = scheme_place_async_try_receive_raw(ch, &msg_memory, _no_writers);
+  msg = place_async_try_receive_raw(ch, &msg_memory, _no_writers);
   if (msg) {
     p->place_channel_msg_in_flight = msg_memory;
     msg = scheme_places_deserialize(msg, msg_memory);
@@ -3587,8 +3606,8 @@ static int place_channel_ready(Scheme_Object *so, Scheme_Schedule_Info *sinfo) {
     ch = (Scheme_Place_Bi_Channel *)so;
   }
 
-  msg = scheme_place_async_try_receive_raw((Scheme_Place_Async_Channel *) ch->link->recvch, 
-                                           &msg_memory, &no_writers);
+  msg = place_async_try_receive_raw((Scheme_Place_Async_Channel *) ch->link->recvch, 
+                                    &msg_memory, &no_writers);
   if (msg != NULL) {
     Scheme_Object **msg_holder;
     Scheme_Thread *p = ((Syncing *)(sinfo->current_syncing))->thread;
@@ -3621,7 +3640,7 @@ static Scheme_Object *place_async_receive(Scheme_Place_Async_Channel *ch) {
   int no_writers = 0;
 
   while (1) {
-    msg = scheme_place_async_try_receive(ch, &no_writers);
+    msg = place_async_try_receive(ch, &no_writers);
     if (msg) 
       break;
     else {
@@ -3629,7 +3648,6 @@ static Scheme_Object *place_async_receive(Scheme_Place_Async_Channel *ch) {
         /* No writers are left for this channel, so suspend the thread */
         scheme_wait_sema(scheme_make_sema(0), 0);
       }
-
       scheme_thread_block(0);
       scheme_block_until((Scheme_Ready_Fun) scheme_place_async_ch_ready, NULL, (Scheme_Object *) ch, 0);
     }
@@ -3638,6 +3656,10 @@ static Scheme_Object *place_async_receive(Scheme_Place_Async_Channel *ch) {
   return msg;
 }
 
+Scheme_Object *scheme_place_async_channel_receive(Scheme_Object *ch) {
+  return place_async_receive((Scheme_Place_Async_Channel *)ch);
+}
+
 /*========================================================================*/
 /*                       precise GC traversers                            */
 /*========================================================================*/
diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h
index 9d338b5f5b..061dfde19b 100644
--- a/racket/src/racket/src/schpriv.h
+++ b/racket/src/racket/src/schpriv.h
@@ -4108,6 +4108,8 @@ intptr_t scheme_check_overflow(intptr_t n, intptr_t m, intptr_t a);
 Scheme_Object *scheme_make_environment_variables(Scheme_Hash_Tree *ht);
 void *scheme_environment_variables_to_block(Scheme_Object *env, int *_need_free);
 
+int scheme_compare_equal(void *v1, void *v2);
+
 /*========================================================================*/
 /*                           places                                       */
 /*========================================================================*/
@@ -4251,6 +4253,10 @@ void scheme_place_set_memory_use(intptr_t amt);
 void scheme_place_check_memory_use();
 void scheme_clear_place_ifs_stack();
 
-int scheme_compare_equal(void *v1, void *v2);
+#ifdef MZ_USE_PLACES
+Scheme_Object *scheme_place_make_async_channel();
+void scheme_place_async_channel_send(Scheme_Object *ch, Scheme_Object *uo);
+Scheme_Object *scheme_place_async_channel_receive(Scheme_Object *ch);
+#endif
 
 #endif /* __mzscheme_private__ */
diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h
index 5378fd8c6f..52ed52b5a4 100644
--- a/racket/src/racket/src/schvers.h
+++ b/racket/src/racket/src/schvers.h
@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.2.0.4"
+#define MZSCHEME_VERSION "6.2.0.5"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 2
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 4
+#define MZSCHEME_VERSION_W 5
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)