diff --git a/collects/scribblings/reference/data.scrbl b/collects/scribblings/reference/data.scrbl index 3149d52ab3..24b51f008a 100644 --- a/collects/scribblings/reference/data.scrbl +++ b/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] diff --git a/collects/tests/racket/sync.rktl b/collects/tests/racket/sync.rktl index f0bf05884d..27e11b7ccf 100644 --- a/collects/tests/racket/sync.rktl +++ b/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) diff --git a/src/racket/src/jitinline.c b/src/racket/src/jitinline.c index 5481c8aeca..8b509e9124 100644 --- a/src/racket/src/jitinline.c +++ b/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)); diff --git a/src/racket/src/list.c b/src/racket/src/list.c index 15547dfcce..facfb9e268 100644 --- a/src/racket/src/list.c +++ b/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) {