From d11e58b639ac1154fbd288c9deb28b05d9552107 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 29 Aug 2012 11:01:54 -0600 Subject: [PATCH] ffi/unsafe/atomic: add `in-atomic-mode?' The new function can be useful for debugging, at least. --- collects/ffi/unsafe/atomic.rkt | 6 +++++- collects/scribblings/foreign/atomic.scrbl | 5 +++++ src/racket/include/mzwin.def | 1 + src/racket/include/mzwin3m.def | 1 + src/racket/include/racket.exp | 1 + src/racket/include/racket3m.exp | 1 + src/racket/src/schemef.h | 1 + src/racket/src/schemex.h | 1 + src/racket/src/schemex.inc | 1 + src/racket/src/schemexm.h | 1 + src/racket/src/thread.c | 5 +++++ 11 files changed, 23 insertions(+), 1 deletion(-) diff --git a/collects/ffi/unsafe/atomic.rkt b/collects/ffi/unsafe/atomic.rkt index a53b5231c6..30144685cf 100644 --- a/collects/ffi/unsafe/atomic.rkt +++ b/collects/ffi/unsafe/atomic.rkt @@ -2,7 +2,8 @@ (require ffi/unsafe (for-syntax racket/base)) -(provide (protect-out start-atomic +(provide (protect-out in-atomic-mode? + start-atomic end-atomic start-breakable-atomic end-breakable-atomic @@ -21,6 +22,9 @@ (define end-breakable-atomic (get-ffi-obj 'scheme_end_atomic #f (_fun -> _void))) +(define in-atomic-mode? + (get-ffi-obj 'scheme_is_atomic #f (_fun -> (r : _int) -> (positive? r)))) + ;; ---------------------------------------- (define monitor-owner #f) diff --git a/collects/scribblings/foreign/atomic.scrbl b/collects/scribblings/foreign/atomic.scrbl index 353a1aa544..ade38ba8f0 100644 --- a/collects/scribblings/foreign/atomic.scrbl +++ b/collects/scribblings/foreign/atomic.scrbl @@ -54,3 +54,8 @@ in which case the call never returns. When used not in the dynamic extent of @racket[call-as-atomic], @racket[call-as-nonatomic] raises @racket[exn:fail:contract].} + +@defproc[(in-atomic-mode?) boolean?]{ + +Returns @racket[#t] if Racket context switches are disables, +@racket[#f] otherwise.} diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index f4f01a3074..d38b385319 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -24,6 +24,7 @@ EXPORTS scheme_current_thread_ptr DATA scheme_fuel_counter_ptr DATA scheme_get_current_thread + scheme_is_atomic scheme_start_atomic scheme_end_atomic scheme_end_atomic_no_swap diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index 76db8860ac..2f1e18cdfb 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -24,6 +24,7 @@ EXPORTS scheme_current_thread_ptr DATA scheme_fuel_counter_ptr DATA scheme_get_current_thread + scheme_is_atomic scheme_start_atomic scheme_end_atomic scheme_end_atomic_no_swap diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index 5806af12f2..551b863a13 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -22,6 +22,7 @@ scheme_fuel_counter scheme_current_thread_ptr scheme_fuel_counter_ptr scheme_get_current_thread +scheme_is_atomic scheme_start_atomic scheme_end_atomic scheme_end_atomic_no_swap diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index acdacf78ab..5dccc8a59d 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -22,6 +22,7 @@ scheme_fuel_counter scheme_current_thread_ptr scheme_fuel_counter_ptr scheme_get_current_thread +scheme_is_atomic scheme_start_atomic scheme_end_atomic scheme_end_atomic_no_swap diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index 72dd0ea2ee..09d7e14d9c 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -88,6 +88,7 @@ MZ_EXTERN volatile int *scheme_fuel_counter_ptr; MZ_EXTERN Scheme_Thread *scheme_get_current_thread(); +MZ_EXTERN int scheme_is_atomic(void); MZ_EXTERN void scheme_start_atomic(void); MZ_EXTERN void scheme_end_atomic(void); MZ_EXTERN void scheme_end_atomic_no_swap(void); diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index 0bcb4562db..b6ad149f57 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -55,6 +55,7 @@ volatile int *scheme_fuel_counter_ptr; # endif #endif Scheme_Thread *(*scheme_get_current_thread)(); +int (*scheme_is_atomic)(void); void (*scheme_start_atomic)(void); void (*scheme_end_atomic)(void); void (*scheme_end_atomic_no_swap)(void); diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index 31a83a9d0d..f5fd7186c0 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -30,6 +30,7 @@ # endif #endif scheme_extension_table->scheme_get_current_thread = scheme_get_current_thread; + scheme_extension_table->scheme_is_atomic = scheme_is_atomic; scheme_extension_table->scheme_start_atomic = scheme_start_atomic; scheme_extension_table->scheme_end_atomic = scheme_end_atomic; scheme_extension_table->scheme_end_atomic_no_swap = scheme_end_atomic_no_swap; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 22e240fe03..962b73ffd5 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -30,6 +30,7 @@ # endif #endif #define scheme_get_current_thread (scheme_extension_table->scheme_get_current_thread) +#define scheme_is_atomic (scheme_extension_table->scheme_is_atomic) #define scheme_start_atomic (scheme_extension_table->scheme_start_atomic) #define scheme_end_atomic (scheme_extension_table->scheme_end_atomic) #define scheme_end_atomic_no_swap (scheme_extension_table->scheme_end_atomic_no_swap) diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 0c7d1de18e..ad9e9442b1 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -4971,6 +4971,11 @@ void scheme_thread_block_enable_break(float sleep_time, int enable_break) scheme_thread_block(sleep_time); } +int scheme_is_atomic(void) +{ + return !!do_atomic; +} + void scheme_start_atomic(void) { do_atomic++;