suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Matthew Flatt 2012-05-03 21:38:36 -06:00
parent 19d474d045
commit 4292c6e037
4 changed files with 33 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/scribblings/reference/data.scrbl
View File

@ -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]

5
collects/tests/racket/sync.rktl
View File

@ -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)

16
src/racket/src/jitinline.c
View File

@ -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));

41
src/racket/src/list.c
View File

@ -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)
{