diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 2381c8b357..2112e859e1 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "6.9.0.2") +(define version "6.9.0.3") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/collects/ffi/unsafe/atomic.rkt b/racket/collects/ffi/unsafe/atomic.rkt index daef99fdb3..ff0179b66c 100644 --- a/racket/collects/ffi/unsafe/atomic.rkt +++ b/racket/collects/ffi/unsafe/atomic.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require ffi/unsafe +(require '#%unsafe (for-syntax racket/base)) (provide (protect-out in-atomic-mode? @@ -10,20 +10,20 @@ call-as-atomic call-as-nonatomic)) -(define start-atomic - (get-ffi-obj 'scheme_start_atomic_no_break #f (_fun -> _void))) +(define (start-atomic) + (unsafe-start-atomic)) -(define end-atomic - (get-ffi-obj 'scheme_end_atomic_can_break #f (_fun -> _void))) +(define (end-atomic) + (unsafe-end-atomic)) -(define start-breakable-atomic - (get-ffi-obj 'scheme_start_atomic #f (_fun -> _void))) +(define (start-breakable-atomic) + (unsafe-start-breakable-atomic)) -(define end-breakable-atomic - (get-ffi-obj 'scheme_end_atomic #f (_fun -> _void))) +(define (end-breakable-atomic) + (unsafe-end-breakable-atomic)) -(define in-atomic-mode? - (get-ffi-obj 'scheme_is_atomic #f (_fun -> (r : _int) -> (positive? r)))) +(define (in-atomic-mode?) + (unsafe-in-atomic?)) ;; ---------------------------------------- diff --git a/racket/collects/racket/unsafe/ops.rkt b/racket/collects/racket/unsafe/ops.rkt index bd1d4527b1..2b301726f4 100644 --- a/racket/collects/racket/unsafe/ops.rkt +++ b/racket/collects/racket/unsafe/ops.rkt @@ -11,7 +11,10 @@ prop:chaperone-unsafe-undefined chaperone-struct-unsafe-undefined unsafe-chaperone-procedure - unsafe-impersonate-procedure) + unsafe-impersonate-procedure + unsafe-start-atomic unsafe-end-atomic + unsafe-start-breakable-atomic unsafe-end-breakable-atomic + unsafe-in-atomic?) (rename-out [new:unsafe-impersonate-procedure unsafe-impersonate-procedure] [new:unsafe-chaperone-procedure unsafe-chaperone-procedure]) (prefix-out unsafe- diff --git a/racket/src/racket/src/cstartup.inc b/racket/src/racket/src/cstartup.inc index 3e94fe436a..0e599998ad 100644 --- a/racket/src/racket/src/cstartup.inc +++ b/racket/src/racket/src/cstartup.inc @@ -1,5 +1,5 @@ { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,54,0,0,0,1,0,0,8,0,18,0, 22,0,26,0,31,0,38,0,42,0,47,0,59,0,66,0,69,0,82,0,89, 0,94,0,103,0,109,0,123,0,137,0,140,0,146,0,157,0,159,0,173,0, @@ -102,7 +102,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 2090); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,183,0,0,0,1,0,0,8,0,16,0, 29,0,34,0,51,0,63,0,85,0,114,0,158,0,164,0,178,0,193,0,211, 0,223,0,239,0,253,0,19,1,39,1,73,1,90,1,107,1,130,1,145,1, @@ -1011,7 +1011,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 19015); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,15,0,0,0,1,0,0,8,0,23,0, 48,0,65,0,83,0,105,0,128,0,149,0,171,0,181,0,191,0,199,0,209, 0,217,0,0,0,253,1,0,0,3,1,5,105,110,115,112,48,76,35,37,112, @@ -1042,7 +1042,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 581); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,102,0,0,0,1,0,0,8,0,15,0, 26,0,53,0,59,0,73,0,86,0,112,0,129,0,151,0,159,0,171,0,186, 0,202,0,220,0,241,0,253,0,13,1,36,1,60,1,72,1,103,1,108,1, @@ -1538,7 +1538,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 10343); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,57,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,18,0,0,0,1,0,0,8,0,18,0, 22,0,28,0,42,0,56,0,68,0,88,0,102,0,117,0,130,0,135,0,139, 0,151,0,235,0,242,0,20,1,0,0,224,1,0,0,3,1,5,105,110,115, diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c index 9a83b64d61..e3a02ff641 100644 --- a/racket/src/racket/src/env.c +++ b/racket/src/racket/src/env.c @@ -341,6 +341,7 @@ static void init_unsafe(Scheme_Env *env) scheme_init_unsafe_hash(unsafe_env); scheme_init_unsafe_vector(unsafe_env); scheme_init_unsafe_fun(unsafe_env); + scheme_init_unsafe_thread(unsafe_env); scheme_init_extfl_unsafe_number(unsafe_env); scheme_init_extfl_unsafe_numarith(unsafe_env); diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 14ba067924..9e16242693 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 1155 -#define EXPECTED_UNSAFE_COUNT 128 +#define EXPECTED_UNSAFE_COUNT 133 #define EXPECTED_FLFXNUM_COUNT 69 #define EXPECTED_EXTFL_COUNT 45 #define EXPECTED_FUTURES_COUNT 15 diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 1d841f2fb0..f4cb7640b8 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -374,6 +374,7 @@ void scheme_init_exn(Scheme_Env *env); #endif void scheme_init_debug(Scheme_Env *env); void scheme_init_thread(Scheme_Env *env); +void scheme_init_unsafe_thread(Scheme_Env *env); void scheme_init_read(Scheme_Env *env); void scheme_init_print(Scheme_Env *env); #ifndef NO_SCHEME_THREADS diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index ee94858b2f..f69815dba2 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.9.0.2" +#define MZSCHEME_VERSION "6.9.0.3" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 9 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 2 +#define MZSCHEME_VERSION_W 3 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/racket/src/racket/src/thread.c b/racket/src/racket/src/thread.c index 514556b8f6..172e664b57 100644 --- a/racket/src/racket/src/thread.c +++ b/racket/src/racket/src/thread.c @@ -433,6 +433,12 @@ 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 *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); +static Scheme_Object *unsafe_end_breakable_atomic(int argc, Scheme_Object **argv); +static Scheme_Object *unsafe_in_atomic_p(int argc, Scheme_Object **argv); + static void make_initial_config(Scheme_Thread *p); static int do_kill_thread(Scheme_Thread *p); @@ -637,6 +643,36 @@ void scheme_init_thread(Scheme_Env *env) GLOBAL_PRIM_W_ARITY("set-phantom-bytes!", set_phantom_bytes, 2, 2, env); } +void +scheme_init_unsafe_thread (Scheme_Env *env) +{ + scheme_add_global_constant("unsafe-start-atomic", + scheme_make_prim_w_arity(unsafe_start_atomic, + "unsafe-start-atomic", + 0, 0), + env); + scheme_add_global_constant("unsafe-end-atomic", + scheme_make_prim_w_arity(unsafe_end_atomic, + "unsafe-end-atomic", + 0, 0), + env); + scheme_add_global_constant("unsafe-start-breakable-atomic", + scheme_make_prim_w_arity(unsafe_start_breakable_atomic, + "unsafe-start-breakable-atomic", + 0, 0), + env); + scheme_add_global_constant("unsafe-end-breakable-atomic", + scheme_make_prim_w_arity(unsafe_end_breakable_atomic, + "unsafe-end-breakable-atomic", + 0, 0), + env); + scheme_add_global_constant("unsafe-in-atomic?", + scheme_make_prim_w_arity(unsafe_in_atomic_p, + "unsafe-in-atomic?", + 0, 0), + env); +} + void scheme_init_thread_places(void) { buffer_init_size = INIT_TB_SIZE; REGISTER_SO(recycle_cell); @@ -5467,6 +5503,37 @@ Scheme_On_Atomic_Timeout_Proc scheme_set_on_atomic_timeout(Scheme_On_Atomic_Time return old; } + +static Scheme_Object *unsafe_start_atomic(int argc, Scheme_Object **argv) +{ + scheme_start_atomic_no_break(); + return scheme_void; +} + +static Scheme_Object *unsafe_end_atomic(int argc, Scheme_Object **argv) +{ + scheme_end_atomic_can_break(); + return scheme_void; +} + +static Scheme_Object *unsafe_start_breakable_atomic(int argc, Scheme_Object **argv) +{ + scheme_start_atomic(); + return scheme_void; +} + +static Scheme_Object *unsafe_end_breakable_atomic(int argc, Scheme_Object **argv) +{ + scheme_end_atomic(); + return scheme_void; +} + +static Scheme_Object *unsafe_in_atomic_p(int argc, Scheme_Object **argv) +{ + return (scheme_is_atomic() ? scheme_true : scheme_false); +} + + void scheme_weak_suspend_thread(Scheme_Thread *r) { if (r->running & MZTHREAD_SUSPENDED)