ffi/unsafe/atomic: add `in-atomic-mode?'

The new function can be useful for debugging, at least.

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)

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.}

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

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

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

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

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

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

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;

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)

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++;