add memory-order-{acquire,release}

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "7.8.0.1")
+(define version "7.8.0.2")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-doc/scribblings/reference/concurrency.scrbl

@@ -19,3 +19,4 @@ support for parallelism to improve performance.
 @include-section["futures.scrbl"]
 @include-section["places.scrbl"]
 @include-section["engine.scrbl"]
+@include-section["memory-order.scrbl"]

pkgs/racket-doc/scribblings/reference/data.scrbl

@@ -129,7 +129,7 @@ boxes that are not @tech{impersonators}.
   @racket[box-cas!] is guaranteed to use a hardware @emph{compare and
   set} operation. Uses of @racket[box-cas!] be performed safely in a
   @tech{future} (i.e., allowing the future thunk to continue in
-  parallel).}
+  parallel). See also @secref["memory-order"].}
 
 @; ----------------------------------------------------------------------
 @include-section["hashes.scrbl"]

pkgs/racket-doc/scribblings/reference/futures.scrbl

@@ -40,7 +40,8 @@ futures and threads. Furthermore, guarantees about the visibility of
 effects and ordering are determined by the operating system and
 hardware---which rarely support, for example, the guarantee of
 sequential consistency that is provided for @racket[thread]-based
-concurrency. At the same time, operations that seem obviously safe may
+concurrency; see also @secref["memory-order"]. At the same time, operations
+that seem obviously safe may
 have a complex enough implementation internally that they cannot run in
 parallel. See also @guidesecref["effective-futures"] in @|Guide|.
 
@@ -153,6 +154,13 @@ the futures may be @racket[touch]ed in any order.
   are not safe to perform in parallel, and they therefore prevent
   a computation from continuing in parallel.
 
+  Beware of trying to use an fsemaphore to implement a lock. A future
+  may run concurrently and in parallel to other futures, but a future
+  that is not demanded by a Racket thread can be suspended at any
+  time---such as just after it takes a lock and before it releases the
+  lock. If you must share mutable data among futures, lock-free data
+  structures are generally a better fit.
+
 }
 
 @defproc[(fsemaphore? [v any/c]) boolean?]{

pkgs/racket-doc/scribblings/reference/memory-order.scrbl

@@ -0,0 +1,44 @@
+#lang scribble/doc
+@(require "mz.rkt"
+          (for-label racket/unsafe/ops))
+
+@title[#:tag "memory-order"]{Machine Memory Order}
+
+Unlike Racket @tech{threads}, futures and places can expose the
+underlying machine's memory model, including a weak memory ordering.
+For example, when a future writes to multiple slots in a mutable
+vector, it's possible on some platforms for another future to observe
+the writes in a different order or not at all, unless the futures are
+explicitly synchronized. Similarly, shared byte strings or
+@tech{fxvectors} can expose the machine's memory model across places.
+
+Racket ensures that a machine's memory model is not observed in a way
+that unsafely exposes the implementation of primitive datatypes. For
+example, it is not possible for one future to see a partially
+constructed primitive value as a result of reading a vector that is
+mutated by another future.
+
+The @racket[box-cas!], @racket[vector-cas!],
+@racket[unsafe-box*-cas!], @racket[unsafe-vector*-cas!], and
+@racket[unsafe-struct*-cas!] operations all provide a machine-level
+compare-and-set, so they can be used in ways that are specifically
+supported by the a machine's memory model. The
+@racket[(memory-order-acquire)] and @racket[(memory-order-release)]
+operations similarly constrain machine-level stores and loads.
+Synchronization operations such as place messages, future
+@racket[touch]es, and @tech{future semaphores} imply suitable
+machine-level acquire and release ordering.
+
+@deftogether[(
+@defproc[(memory-order-acquire) void?]
+@defproc[(memory-order-release) void?]
+)]{
+
+Those operations implement a machine-level memory fence on platforms
+where one is needed for synchronization. The
+@racket[memory-order-acquire] operation ensures at least a load--load
+and load--store fence at the machine level, and the
+@racket[memory-order-release] operation ensures at least a
+store--store and store--load fence at the machine level.
+
+@history[#:added "7.7.0.11"]}

pkgs/racket-test/tests/future/fsema-lock.rkt

@@ -6,6 +6,12 @@
 ;; demanded by a thread (so it must continue to
 ;; run if it takes a lock)
 
+(define (box-cas!* b old new)
+  (or (box-cas! b old new)
+      ;; Try again if failure looks spurious:
+      (and (eq? (unbox b) old)
+           (box-cas!* b old new))))
+
 (for ([N (in-range 4 20)])
   (define f (make-fsemaphore 1))
   (define working (box 'ok))
@@ -16,10 +22,10 @@
          (lambda ()
            (for ([i (in-range 5000)])
              (fsemaphore-wait f)
-             (unless (box-cas! working 'ok 'not-ok)
+             (unless (box-cas!* working 'ok 'not-ok)
                (printf "FAIL\n")
                (exit 1))
-             (unless (box-cas! working 'not-ok 'ok)
+             (unless (box-cas!* working 'not-ok 'ok)
                (printf "FAIL\n")
                (exit 1))
              (fsemaphore-post f)))))

racket/src/cs/compile-file.ss

@@ -2,7 +2,7 @@
 ;; Check to make we're using a build of Chez Scheme
 ;; that has all the features we need.
 (define-values (need-maj need-min need-sub need-dev)
-  (values 9 5 3 31))
+  (values 9 5 3 32))
 
 (unless (guard (x [else #f]) (eval 'scheme-fork-version-number))
   (error 'compile-file

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1469
+#define EXPECTED_PRIM_COUNT 1471
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

racket/src/racket/src/schvers.h

@@ -16,7 +16,7 @@
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 8
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 1
+#define MZSCHEME_VERSION_W 2
 
 /* A level of indirection makes `#` work as needed: */
 #define AS_a_STR_HELPER(x) #x

racket/src/racket/src/thread.c

@@ -391,6 +391,8 @@ static Scheme_Object *will_executor_sema(Scheme_Object *w, int *repost);
 
 static Scheme_Object *check_break_now(int argc, Scheme_Object *args[]);
 
+static Scheme_Object *memory_order(int argc, Scheme_Object *args[]);
+
 static Scheme_Object *unsafe_start_atomic(int argc, Scheme_Object **argv);
 static Scheme_Object *unsafe_end_atomic(int argc, Scheme_Object **argv);
 static Scheme_Object *unsafe_start_breakable_atomic(int argc, Scheme_Object **argv);
@@ -608,7 +610,9 @@ void scheme_init_thread(Scheme_Startup_Env *env)
   ADD_PRIM_W_ARITY("custodian-require-memory"              , custodian_require_mem, 3, 3, env);
   ADD_PRIM_W_ARITY("custodian-limit-memory"                , custodian_limit_mem  , 2, 3, env);
   ADD_PRIM_W_ARITY("custodian-memory-accounting-available?", custodian_can_mem    , 0, 0, env);
-  
+
+  ADD_FOLDING_PRIM("memory-order-acquire", memory_order, 0, 0, 1, env);
+  ADD_FOLDING_PRIM("memory-order-release", memory_order, 0, 0, 1, env);
 
   ADD_FOLDING_PRIM("evt?"                      , evt_p                        , 1, 1 , 1, env);
   ADD_PRIM_W_ARITY2("sync"                     , sch_sync                     , 0, -1, 0, -1, env);
@@ -8848,6 +8852,19 @@ static Scheme_Object *will_executor_sema(Scheme_Object *w, int *repost)
 /*                         GC preparation and timing                      */
 /*========================================================================*/
 
+/* We don't currently support threads on a platform with a weaked
+   memory model than x86, and no memory-order operations are needed on
+   x86. */
+
+static Scheme_Object *memory_order(int argc, Scheme_Object *args[])
+{
+  return scheme_void;
+}
+
+/*========================================================================*/
+/*                         GC preparation and timing                      */
+/*========================================================================*/
+
 typedef struct Scheme_GC_Pre_Post_Callback_Desc {
   /* All pointer fields => allocate with GC_malloc() */
   Scheme_Object *boxed_key;

racket/src/thread/future-lock.rkt

@@ -53,12 +53,14 @@
 (define (lock-acquire lock)
   (start-future-uninterrupted)
   (let loop ()
-    (unless (box-cas! lock 0 1)
-      (loop))))
+    (if (box-cas! lock 0 1)
+        (memory-order-acquire)
+        (loop))))
 
 (define (lock-release lock)
   (cond
     [(box-cas! lock 1 0)
+     (memory-order-release)
      (end-future-uninterrupted)]
     [(eq? (unbox lock) 0)
      ;; not just a spurious failure...