From c52bd91c54cb416f42dc4c940a42cd2bf2cd4bcd Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 25 Oct 2017 11:55:25 -0700 Subject: [PATCH] add `unsafe-struct*-cas!` --- .../scribblings/reference/unsafe.scrbl | 9 +++++-- .../scribblings/reference/vectors.scrbl | 4 +-- .../racket-test-core/tests/racket/unsafe.rktl | 13 ++++++++++ racket/src/racket/src/cstartup.inc | 24 ++++++++--------- racket/src/racket/src/schminc.h | 2 +- racket/src/racket/src/vector.c | 26 +++++++++++++++++++ 6 files changed, 61 insertions(+), 17 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl index c48a855bce..2895feea4e 100644 --- a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl +++ b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl @@ -246,7 +246,7 @@ Unsafe versions of @racket[unbox] and @racket[set-box!], where the @defproc[(unsafe-vector*-length [v (and/c vector? (not/c impersonator?))]) fixnum?] @defproc[(unsafe-vector*-ref [v (and/c vector? (not/c impersonator?))] [k fixnum?]) any/c] @defproc[(unsafe-vector*-set! [v (and/c vector? (not/c impersonator?))] [k fixnum?] [val any/c]) void?] -@defproc[(unsafe-vector*-cas! [v (and/c vector? (not/c impersonator?))] [k fixnum?] [val any/c] [val any/c]) boolean?] +@defproc[(unsafe-vector*-cas! [v (and/c vector? (not/c impersonator?))] [k fixnum?] [old-val any/c] [new-val any/c]) boolean?] )]{ Unsafe versions of @racket[vector-length], @racket[vector-ref], @@ -340,6 +340,7 @@ Unsafe versions of @racket[u16vector-ref] and @defproc[(unsafe-struct-set! [v any/c] [k fixnum?] [val any/c]) void?] @defproc[(unsafe-struct*-ref [v (not/c impersonator?)] [k fixnum?]) any/c] @defproc[(unsafe-struct*-set! [v (not/c impersonator?)] [k fixnum?] [val any/c]) void?] +@defproc[(unsafe-struct*-cas! [v (not/c impersonator?)] [k fixnum?] [old-val any/c] [new-val any/c]) boolean?] )]{ Unsafe field access and update for an instance of a structure @@ -347,7 +348,11 @@ type, where the @schemeidfont{struct*} variants can be faster but do not work on @tech{impersonators}. The index @racket[k] must be between @racket[0] (inclusive) and the number of fields in the structure (exclusive). In the case of -@racket[unsafe-struct-set!], the field must be mutable.} +@racket[unsafe-struct-set!], @racket[unsafe-struct*-set!], and @racket[unsafe-struct*-cas!], the +field must be mutable. The @racket[unsafe-struct*-cas!] operation +is analogous to @racket[box-cas!] to perform an atomic compare-and-set. + +@history[#:changed "6.11.0.2" @elem{Added @racket[unsafe-struct*-cas!].}]} @deftogether[( @defproc[(unsafe-mutable-hash-iterate-first diff --git a/pkgs/racket-doc/scribblings/reference/vectors.scrbl b/pkgs/racket-doc/scribblings/reference/vectors.scrbl index 92f6172da9..c997ad3b0a 100644 --- a/pkgs/racket-doc/scribblings/reference/vectors.scrbl +++ b/pkgs/racket-doc/scribblings/reference/vectors.scrbl @@ -74,8 +74,8 @@ Updates the slot @racket[pos] of @racket[vec] to contain @racket[v].} @defproc[(vector-cas! [vec (and/c vector? (not/c immutable?) (not/c impersonator?))] [pos exact-nonnegative-integer?] - [v any/c] - [v any/c]) + [old-v any/c] + [new-v any/c]) boolean?]{ Compare and set operation for vectors. See @racket[box-cas!]. diff --git a/pkgs/racket-test-core/tests/racket/unsafe.rktl b/pkgs/racket-test-core/tests/racket/unsafe.rktl index 6cc3580e4f..b9bcccb3d7 100644 --- a/pkgs/racket-test-core/tests/racket/unsafe.rktl +++ b/pkgs/racket-test-core/tests/racket/unsafe.rktl @@ -468,6 +468,19 @@ (test-tri 500 'unsafe-struct-set! p 1 500 #:pre (lambda () (set-posn-y! p 0)) #:post (lambda (x) (posn-y p)) + #:literal-ok? #f)) + (let ([p (make-posn 100 200 300)]) + ;; success + (test-tri (list #true 201) + '(lambda (p ov nv) (unsafe-struct*-cas! p 1 ov nv)) p 200 201 + #:pre (lambda () (unsafe-struct*-set! p 1 200)) + #:post (lambda (x) (list x (unsafe-struct*-ref p 1))) + #:literal-ok? #f) + ;; failure + (test-tri (list #false 200) + '(lambda (p ov nv) (unsafe-struct*-cas! p 1 ov nv)) p 199 202 + #:pre (lambda () (unsafe-struct*-set! p 1 200)) + #:post (lambda (x) (list x (unsafe-struct*-ref p 1))) #:literal-ok? #f))) (define-values (prop:nothing nothing? nothing-ref) (make-struct-type-property 'nothing)) (try-struct prop:nothing 5) diff --git a/racket/src/racket/src/cstartup.inc b/racket/src/racket/src/cstartup.inc index e759ef944e..3bc9c8deac 100644 --- a/racket/src/racket/src/cstartup.inc +++ b/racket/src/racket/src/cstartup.inc @@ -480,7 +480,7 @@ 202,2,28,248,22,157,7,23,194,2,9,249,22,82,23,195,1,27,249,22,172, 6,8,128,128,23,205,2,28,248,22,157,7,23,194,2,9,249,22,82,23,195, 1,248,2,125,23,206,1,27,249,22,172,6,8,128,128,23,196,2,28,248,22, -151,8,23,194,2,28,249,22,178,20,248,22,170,21,23,196,2,8,128,128,249, +151,8,23,194,2,28,249,22,178,20,248,22,171,21,23,196,2,8,128,128,249, 22,1,22,163,8,249,22,82,23,197,1,27,249,22,172,6,8,128,128,23,201, 2,28,248,22,157,7,23,194,2,9,249,22,82,23,195,1,27,249,22,172,6, 8,128,128,23,204,2,28,248,22,157,7,23,194,2,9,249,22,82,23,195,1, @@ -568,7 +568,7 @@ 49,16,4,8,128,6,8,128,104,8,240,0,128,0,0,39,9,224,1,2,33, 143,2,23,195,1,0,7,35,114,120,34,47,43,34,28,248,22,162,7,23,195, 2,27,249,22,129,17,2,145,2,23,197,2,28,23,193,2,28,249,22,134,4, -248,22,104,23,196,2,248,22,188,3,248,22,167,21,23,199,2,249,22,7,250, +248,22,104,23,196,2,248,22,188,3,248,22,168,21,23,199,2,249,22,7,250, 22,184,7,23,200,1,39,248,22,104,23,199,1,23,198,1,249,22,7,250,22, 184,7,23,200,2,39,248,22,104,23,199,2,249,22,82,249,22,184,7,23,201, 1,248,22,106,23,200,1,23,200,1,86,94,23,193,1,249,22,7,23,197,1, @@ -576,7 +576,7 @@ 23,195,1,28,249,22,182,9,23,195,2,2,49,86,94,23,193,1,249,22,7, 23,196,1,23,200,1,27,249,22,82,23,197,1,23,201,1,28,248,22,162,7, 23,195,2,27,249,22,129,17,2,145,2,23,197,2,28,23,193,2,28,249,22, -134,4,248,22,104,23,196,2,248,22,188,3,248,22,167,21,23,199,2,249,22, +134,4,248,22,104,23,196,2,248,22,188,3,248,22,168,21,23,199,2,249,22, 7,250,22,184,7,23,200,1,39,248,22,104,23,199,1,23,196,1,249,22,7, 250,22,184,7,23,200,2,39,248,22,104,23,199,2,249,22,82,249,22,184,7, 23,201,1,248,22,106,23,200,1,23,198,1,86,94,23,193,1,249,22,7,23, @@ -671,7 +671,7 @@ 144,51,8,49,42,23,17,23,16,205,203,202,200,200,11,32,156,2,88,148,8, 36,42,57,11,2,50,222,33,157,2,28,248,22,139,4,195,249,22,143,16,251, 22,163,8,250,22,162,8,202,39,248,22,156,8,203,2,51,249,22,162,8,201, -248,22,170,21,202,2,68,28,248,22,134,16,195,248,22,135,16,195,247,22,136, +248,22,171,21,202,2,68,28,248,22,134,16,195,248,22,135,16,195,247,22,136, 16,27,248,22,188,3,196,28,28,248,22,139,4,193,11,249,22,182,9,8,46, 249,22,157,8,198,196,249,22,143,16,251,22,163,8,250,22,162,8,203,39,201, 2,69,249,22,162,8,202,248,22,187,3,201,2,68,28,248,22,134,16,196,248, @@ -697,7 +697,7 @@ 2,88,148,8,36,45,8,23,11,2,50,222,33,163,2,28,248,22,139,4,23, 199,2,86,95,23,198,1,23,196,1,19,248,22,156,8,23,199,2,249,22,143, 16,251,22,163,8,250,22,162,8,23,207,2,39,23,202,4,2,51,249,23,204, -1,23,206,2,248,22,170,21,23,207,1,28,248,22,162,7,200,249,22,177,8, +1,23,206,2,248,22,171,21,23,207,1,28,248,22,162,7,200,249,22,177,8, 201,8,63,199,28,248,22,134,16,197,248,22,135,16,197,247,22,136,16,2,27, 248,22,188,3,23,200,1,28,28,248,22,139,4,23,194,2,11,249,22,182,9, 8,46,249,22,157,8,23,202,2,23,197,2,249,22,143,16,251,22,163,8,250, @@ -706,7 +706,7 @@ 248,22,134,16,197,248,22,135,16,197,247,22,136,16,28,248,22,139,4,23,194, 2,86,95,23,197,1,23,193,1,19,248,22,156,8,23,200,2,249,22,143,16, 251,22,163,8,250,22,162,8,23,208,2,39,23,202,4,2,51,249,23,205,1, -23,207,2,248,22,170,21,23,208,1,28,248,22,162,7,201,249,22,177,8,202, +23,207,2,248,22,171,21,23,208,1,28,248,22,162,7,201,249,22,177,8,202, 8,63,200,28,248,22,134,16,198,248,22,135,16,198,247,22,136,16,2,27,248, 22,188,3,23,195,1,28,28,248,22,139,4,23,194,2,11,249,22,182,9,8, 46,249,22,157,8,23,203,2,23,197,2,249,22,143,16,251,22,163,8,250,22, @@ -715,7 +715,7 @@ 22,134,16,198,248,22,135,16,198,247,22,136,16,28,248,22,139,4,23,194,2, 86,95,23,198,1,23,193,1,19,248,22,156,8,23,201,2,249,22,143,16,251, 22,163,8,250,22,162,8,23,209,2,39,23,202,4,2,51,249,23,206,1,23, -208,2,248,22,170,21,23,209,1,28,248,22,162,7,202,249,22,177,8,203,8, +208,2,248,22,171,21,23,209,1,28,248,22,162,7,202,249,22,177,8,203,8, 63,201,28,248,22,134,16,199,248,22,135,16,199,247,22,136,16,2,27,248,22, 188,3,23,195,1,28,28,248,22,139,4,23,194,2,11,249,22,182,9,8,46, 249,22,157,8,23,204,2,23,197,2,249,22,143,16,251,22,163,8,250,22,162, @@ -731,8 +731,8 @@ 195,1,86,94,28,192,86,94,23,198,1,11,250,22,137,12,23,201,1,2,71, 23,204,2,249,22,7,194,195,27,248,22,139,16,23,196,1,27,19,248,22,156, 8,23,196,2,28,249,22,174,20,23,195,4,39,86,94,23,199,1,249,22,143, -16,251,22,163,8,250,22,162,8,23,204,2,39,248,22,170,21,23,205,2,2, -51,249,23,208,1,23,203,2,248,22,170,21,23,204,1,28,248,22,162,7,23, +16,251,22,163,8,250,22,162,8,23,204,2,39,248,22,171,21,23,205,2,2, +51,249,23,208,1,23,203,2,248,22,171,21,23,204,1,28,248,22,162,7,23, 16,249,22,177,8,23,17,8,63,23,15,28,248,22,134,16,203,248,22,135,16, 203,247,22,136,16,27,248,22,188,3,23,195,4,28,28,248,22,139,4,23,194, 2,11,249,22,182,9,8,46,249,22,157,8,23,200,2,23,197,2,249,22,143, @@ -740,8 +740,8 @@ 209,1,23,204,1,248,22,187,3,23,202,1,28,248,22,162,7,23,17,249,22, 177,8,23,18,8,63,23,16,28,248,22,134,16,204,248,22,135,16,204,247,22, 136,16,28,248,22,139,4,23,194,2,86,95,23,200,1,23,193,1,249,22,143, -16,251,22,163,8,250,22,162,8,23,205,2,39,248,22,170,21,23,206,2,2, -51,249,23,209,1,23,204,2,248,22,170,21,23,205,1,28,248,22,162,7,23, +16,251,22,163,8,250,22,162,8,23,205,2,39,248,22,171,21,23,206,2,2, +51,249,23,209,1,23,204,2,248,22,171,21,23,205,1,28,248,22,162,7,23, 17,249,22,177,8,23,18,8,63,23,16,28,248,22,134,16,204,248,22,135,16, 204,247,22,136,16,27,248,22,188,3,23,195,1,28,28,248,22,139,4,23,194, 2,11,249,22,182,9,8,46,249,22,157,8,23,201,2,23,197,2,249,22,143, @@ -768,7 +768,7 @@ 201,1,23,198,2,248,22,156,8,23,199,1,28,248,22,134,16,195,249,22,151, 16,196,194,192,32,168,2,88,148,8,36,43,58,11,2,50,222,33,169,2,28, 248,22,139,4,196,249,22,143,16,251,22,163,8,250,22,162,8,203,39,248,22, -156,8,204,2,51,249,22,162,8,202,248,22,170,21,203,28,248,22,162,7,199, +156,8,204,2,51,249,22,162,8,202,248,22,171,21,203,28,248,22,162,7,199, 249,22,177,8,200,8,63,198,28,248,22,134,16,196,248,22,135,16,196,247,22, 136,16,27,248,22,188,3,197,28,28,248,22,139,4,193,11,249,22,182,9,8, 46,249,22,157,8,199,196,249,22,143,16,251,22,163,8,250,22,162,8,204,39, diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 52b84fb0b9..9f9cf9059c 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -15,7 +15,7 @@ #define USE_COMPILED_STARTUP 1 #define EXPECTED_PRIM_COUNT 1160 -#define EXPECTED_UNSAFE_COUNT 149 +#define EXPECTED_UNSAFE_COUNT 150 #define EXPECTED_FLFXNUM_COUNT 69 #define EXPECTED_EXTFL_COUNT 45 #define EXPECTED_FUTURES_COUNT 15 diff --git a/racket/src/racket/src/vector.c b/racket/src/racket/src/vector.c index caf8b5f3ed..88a9b144a0 100644 --- a/racket/src/racket/src/vector.c +++ b/racket/src/racket/src/vector.c @@ -70,6 +70,7 @@ static Scheme_Object *unsafe_struct_ref (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_struct_set (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_struct_star_ref (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_struct_star_set (int argc, Scheme_Object *argv[]); +static Scheme_Object *unsafe_struct_star_cas (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_string_len (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_string_ref (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_string_set (int argc, Scheme_Object *argv[]); @@ -268,6 +269,9 @@ scheme_init_unsafe_vector (Scheme_Env *env) SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED); scheme_add_global_constant("unsafe-struct*-set!", p, env); + p = scheme_make_immed_prim(unsafe_struct_star_cas, "unsafe-struct*-cas!", 4, 4); + scheme_add_global_constant("unsafe-struct*-cas!", p, env); + REGISTER_SO(scheme_unsafe_string_length_proc); p = scheme_make_immed_prim(unsafe_string_len, "unsafe-string-length", 1, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED @@ -1157,6 +1161,28 @@ static Scheme_Object *unsafe_struct_star_set (int argc, Scheme_Object *argv[]) return scheme_void; } +static Scheme_Object *unsafe_struct_star_cas (int argc, Scheme_Object *argv[]) +{ + Scheme_Object *s = argv[0]; + Scheme_Object *idx = argv[1]; + Scheme_Object *ov = argv[2]; + Scheme_Object *nv = argv[3]; + +#ifdef MZ_USE_FUTURES + return (mzrt_cas((volatile uintptr_t *)(&((Scheme_Structure *)s)->slots[SCHEME_INT_VAL(idx)]), + (uintptr_t)ov, (uintptr_t)nv) + ? scheme_true : scheme_false); +#else + /* For cooperative threading, no atomicity required */ + if (((Scheme_Structure *)s)->slots[SCHEME_INT_VAL(idx)] == ov) { + SCHEME_VEC_ELS(vec)[SCHEME_INT_VAL(idx)] = nv; + return scheme_true; + } else { + return scheme_false; + } +#endif +} + static Scheme_Object *unsafe_string_len (int argc, Scheme_Object *argv[]) { intptr_t n = SCHEME_CHAR_STRLEN_VAL(argv[0]);