fix docs for `box-cas!', fix JITted version to check mutability

collects/scribblings/reference/data.scrbl

@@ -112,13 +112,16 @@ Returns the content of @racket[box].}
 For any @racket[v], @racket[(unbox (box v))] returns @racket[v].
 
 
-@defproc[(set-box! [box (and/c box? (not/c immutable?) (not/c impersonator?))]
+@defproc[(set-box! [box (and/c box? (not/c immutable?))]
                    [v any/c]) void?]{
 
 Sets the content of @racket[box] to @racket[v].}
 
 
-@defproc[(box-cas! [box box?] [old any/c] [new any/c]) boolean?]{
+@defproc[(box-cas! [box (and/c box? (not/c immutable?) (not/c impersonator?))]
+                   [old any/c] 
+                   [new any/c]) 
+         boolean?]{
   Atomically updates the contents of @racket[box] to @racket[new], provided
   that @racket[box] currently contains a value that is @racket[eq?] to
   @racket[old], and returns @racket[#t] in that case.  If @racket[box] 

collects/tests/racket/sync.rktl

@@ -1203,6 +1203,11 @@
   (test #f box-cas! b x '())
   (test '() unbox b))
 
+(let ([g (lambda (x y) y)])
+  (err/rt-test (box-cas! (impersonate-box (box 1) g g) 1 2))
+  (err/rt-test (box-cas! (chaperone-box (box 1) g g) 1 2))
+  (err/rt-test (box-cas! (box-immutable 1) 1 2)))
+
 ;; ----------------------------------------
 
 (report-errs)

src/racket/src/jitinline.c

@@ -2825,7 +2825,7 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
     return 1;
   } else if (IS_NAMED_PRIM(rator, "box-cas!") || (IS_NAMED_PRIM(rator, "unsafe-box*-cas!"))) { 
 
-    GC_CAN_IGNORE jit_insn *ref, *ref3, *reffalse, *reftrue;
+    GC_CAN_IGNORE jit_insn *ref, *reffail, *reffalse, *reftrue;
     int unsafe = 0;
 
     if (IS_NAMED_PRIM(rator, "unsafe-box*-cas!")) {
@@ -2842,11 +2842,8 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
     if (!unsafe) {
       __START_TINY_JUMPS__(1);
       /* Fail if this isn't a pointer (0x1 is the integer tag) */
-      ref3 = jit_bmsi_ul(jit_forward(), JIT_R1, 0x1);
-      /* Get the type tag, fail if it isn't a box */
-      ref = mz_beqi_t(jit_forward(), JIT_R1, scheme_box_type, JIT_R2);
-      /* jump to here if it wasn't a pointer */
-      mz_patch_branch(ref3);
+      ref = jit_bmci_ul(jit_forward(), JIT_R1, 0x1);
+      reffail = _jit.x.pc;
       __END_TINY_JUMPS__(1);
 
       (void)jit_calli(sjc.box_cas_fail_code);
@@ -2854,8 +2851,15 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
       __START_TINY_JUMPS__(1);
       /* jump to here if the type tag tests succeed */
       mz_patch_branch(ref);
+
+      /* Get the type tag, fail if it isn't a box */
+      (void)mz_bnei_t(reffail, JIT_R1, scheme_box_type, JIT_R2);
+      /* fail if immutable: */
+      jit_ldxi_s(JIT_R2, JIT_R1, &MZ_OPT_HASH_KEY((Scheme_Inclhash_Object *)0x0));
+      (void)jit_bmsi_ul(reffail, JIT_R2, 0x1);
       __END_TINY_JUMPS__(1);
     }
+    CHECK_LIMIT();
 
     /* box is in JIT_R1 */
     jit_addi_l(JIT_R1, JIT_R1, (intptr_t)&SCHEME_BOX_VAL(0x0));

src/racket/src/list.c

@@ -1620,30 +1620,6 @@ Scheme_Object *scheme_unbox(Scheme_Object *obj)
   return (Scheme_Object *)SCHEME_BOX_VAL(obj);
 }
 
-#ifndef MZ_USE_FUTURES
-
-Scheme_Object *scheme_box_cas(int argc, Scheme_Object *argv[])
-XFORM_SKIP_PROC
-/* For cooperative threading, no atomicity required */
-{
-  Scheme_Object *box = argv[0];
-  Scheme_Object *ov = argv[1];
-  Scheme_Object *nv = argv[2];
-
-  if (!SCHEME_MUTABLE_BOXP(box)) || (SCHEME_NP_CHAPERONEP(box)) {
-    scheme_wrong_type("cas!", "unchaperoned mutable box", 0, 1, &box);
-  }
-
-  if (SCHEME_BOX_VAL(box) == ov) {
-    SCHEME_BOX_VAL(box) = nv;
-    return scheme_true;
-  } else {
-    return scheme_false;
-  }
-}
-
-#else
-
 Scheme_Object *scheme_box_cas(int argc, Scheme_Object *argv[])
 XFORM_SKIP_PROC
 {
@@ -1654,16 +1630,25 @@ XFORM_SKIP_PROC
   /* This procedure is used for both the safe and unsafe version, but
    * the JIT elides the checking for the unsafe version.
    */
-  if ((!SCHEME_MUTABLE_BOXP(box)) || (SCHEME_NP_CHAPERONEP(box))) {
-    scheme_wrong_type("box-cas!", "unchaperoned mutable box", 0, 1, &box);
+
+  if (!SCHEME_MUTABLE_BOXP(box)) {
+    scheme_wrong_type("cas!", "non-impersonated mutable box", 0, 1, &box);
   }
 
+#ifdef MZ_USE_FUTURES
   return mzrt_cas((volatile size_t *)(&SCHEME_BOX_VAL(box)), 
 		  (size_t)ov, (size_t)nv)
     ? scheme_true : scheme_false;
+#else
+  /* For cooperative threading, no atomicity required */
+  if (SCHEME_BOX_VAL(box) == ov) {
+    SCHEME_BOX_VAL(box) = nv;
+    return scheme_true;
+  } else {
+    return scheme_false;
   }
-
 #endif
+}
 
 static void chaperone_set_box(Scheme_Object *obj, Scheme_Object *v)
 {