add #%unsafe exports to implement ffi/unsafe/atomic

Export functions through the usual `#%unsafe` primitive module,
instead of using the FFI to get at unsafe operations.

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

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
+(define (start-atomic)
-  (get-ffi-obj 'scheme_start_atomic_no_break #f (_fun -> _void)))
+  (unsafe-start-atomic))
 
-(define end-atomic
+(define (end-atomic)
-  (get-ffi-obj 'scheme_end_atomic_can_break #f (_fun -> _void)))
+  (unsafe-end-atomic))
 
-(define start-breakable-atomic
+(define (start-breakable-atomic)
-  (get-ffi-obj 'scheme_start_atomic #f (_fun -> _void)))
+  (unsafe-start-breakable-atomic))
 
-(define end-breakable-atomic
+(define (end-breakable-atomic)
-  (get-ffi-obj 'scheme_end_atomic #f (_fun -> _void)))
+  (unsafe-end-breakable-atomic))
 
-(define in-atomic-mode?
+(define (in-atomic-mode?)
-  (get-ffi-obj 'scheme_is_atomic #f (_fun -> (r : _int) -> (positive? r))))
+  (unsafe-in-atomic?))
 
 ;; ----------------------------------------
 

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-

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,

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

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

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

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)

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)