add scheme_register_process_global() to C API

src/racket/include/mzwin.def

@@ -577,3 +577,4 @@ EXPORTS
  scheme_get_signal_handle
  scheme_char_strlen
  scheme_stx_extract_marks
+ scheme_register_process_global

src/racket/include/mzwin3m.def

@@ -593,3 +593,4 @@ EXPORTS
  scheme_get_signal_handle
  scheme_char_strlen
  scheme_stx_extract_marks
+ scheme_register_process_global

src/racket/include/racket.exp

@@ -594,3 +594,4 @@ scheme_signal_received_at
 scheme_get_signal_handle
 scheme_char_strlen
 scheme_stx_extract_marks
+scheme_register_process_global

src/racket/include/racket3m.exp

@@ -601,3 +601,4 @@ scheme_signal_received_at
 scheme_get_signal_handle
 scheme_char_strlen
 scheme_stx_extract_marks
+scheme_register_process_global

src/racket/src/env.c

@@ -311,11 +311,13 @@ Scheme_Env *scheme_engine_instance_init() {
 #endif
 
   scheme_starting_up = 1;
- 
+
   scheme_init_portable_case();
   init_scheme_local();
   init_toplevels();
 
+  scheme_init_process_globals();
+
   scheme_init_true_false();
 
 #ifdef MZ_PRECISE_GC
@@ -358,11 +360,11 @@ Scheme_Env *scheme_engine_instance_init() {
   env = place_instance_init(stack_base, 1);
 
 #if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES)
-{
-  void *signal_fd;
-  signal_fd = scheme_get_signal_handle();
-  GC_set_put_external_event_fd(signal_fd);
-}
+  {
+    void *signal_fd;
+    signal_fd = scheme_get_signal_handle();
+    GC_set_put_external_event_fd(signal_fd);
+  }
 #endif
 
   return env;

src/racket/src/schemef.h

@@ -1119,3 +1119,5 @@ MZ_EXTERN void *scheme_get_signal_handle();
 MZ_EXTERN int scheme_char_strlen(const mzchar *s);
 
 MZ_EXTERN Scheme_Object *scheme_stx_extract_marks(Scheme_Object *stx);
+
+MZ_EXTERN void *scheme_register_process_global(const char *key, void *val);

src/racket/src/schemex.h

@@ -923,6 +923,7 @@ void (*scheme_signal_received_at)(void *);
 void *(*scheme_get_signal_handle)();
 int (*scheme_char_strlen)(const mzchar *s);
 Scheme_Object *(*scheme_stx_extract_marks)(Scheme_Object *stx);
+void *(*scheme_register_process_global)(const char *key, void *val);
 #ifndef SCHEME_EX_INLINE
 } Scheme_Extension_Table;
 #endif

src/racket/src/schemex.inc

@@ -649,3 +649,4 @@
   scheme_extension_table->scheme_get_signal_handle = scheme_get_signal_handle;
   scheme_extension_table->scheme_char_strlen = scheme_char_strlen;
   scheme_extension_table->scheme_stx_extract_marks = scheme_stx_extract_marks;
+  scheme_extension_table->scheme_register_process_global = scheme_register_process_global;

src/racket/src/schemexm.h

@@ -649,6 +649,7 @@
 #define scheme_get_signal_handle (scheme_extension_table->scheme_get_signal_handle)
 #define scheme_char_strlen (scheme_extension_table->scheme_char_strlen)
 #define scheme_stx_extract_marks (scheme_extension_table->scheme_stx_extract_marks)
+#define scheme_register_process_global (scheme_extension_table->scheme_register_process_global)
 #ifdef MZ_PRECISE_GC
 #pragma GC_VARIABLE_STACK_THOUGH_TABLE
 #endif

src/racket/src/schpriv.h

@@ -180,6 +180,7 @@ void scheme_register_traversers(void);
 void scheme_init_hash_key_procs(void);
 #endif
 Scheme_Thread *scheme_make_thread(void*);
+void scheme_init_process_globals(void);
 void scheme_init_true_false(void);
 void scheme_init_symbol_table(void);
 void scheme_init_symbol_type(Scheme_Env *env);

src/racket/src/thread.c

@@ -271,6 +271,17 @@ typedef struct {
 # define xCUSTODIAN_FAM(x) (*(x))
 #endif
 
+typedef struct Proc_Global_Rec {
+  const char *key;
+  void *val;
+  struct Proc_Global_Rec *next;
+} Proc_Global_Rec;
+
+SHARED_OK static Proc_Global_Rec *process_globals;
+#if defined(MZ_USE_MZRT)
+static mzrt_mutex *process_global_lock;
+#endif
+
 #ifdef MZ_PRECISE_GC
 static void register_traversers(void);
 #endif
@@ -2524,6 +2535,49 @@ void scheme_set_runstack_limits(Scheme_Object **rs, long len, long start, long e
 #endif
 }
 
+void *scheme_register_process_global(const char *key, void *val)
+{
+  void *old_val = NULL;
+  char *key2;
+  Proc_Global_Rec *pg;
+  long len;
+
+#if defined(MZ_USE_MZRT)
+  mzrt_mutex_lock(process_global_lock);
+#endif
+
+  for (pg = process_globals; pg; pg = pg->next) {
+    if (!strcmp(pg->key, key)) {
+      old_val = pg->val;
+      break;
+    }
+  }
+
+  if (!old_val && val) {
+    len = strlen(key);
+    key2 = (char *)malloc(len + 1);
+    memcpy(key2, key, len + 1);
+    pg = (Proc_Global_Rec *)malloc(sizeof(Proc_Global_Rec));
+    pg->key = key2;
+    pg->val = val;
+    pg->next = process_globals;
+    process_globals = pg;
+  }
+
+#if defined(MZ_USE_MZRT)
+  mzrt_mutex_unlock(process_global_lock);
+#endif
+
+  return old_val;
+}
+
+void scheme_init_process_globals(void)
+{
+#if defined(MZ_USE_MZRT)
+  mzrt_mutex_create(&process_global_lock);
+#endif
+}
+
 /*========================================================================*/
 /*                     thread creation and swapping                       */
 /*========================================================================*/