fix a GC problem related to future and wcm; also fix a race condition related to JITing a delay-loaded procedure (and maybe specific to future-demanded JITting)

svn: r18739

collects/tests/future/random-future.ss

@@ -182,7 +182,7 @@ Errors/exceptions and other kinds of control?
                (gen-exp))]))
 
 (define-namespace-anchor ns-here)
-(let ([seed (+ 1 (random (expt 2 30)))])
+(let ([seed 587082310 #;(+ 1 (random (expt 2 30)))])
   (printf "DrDr Ignore! random-seed ~s\n" seed)
   (random-seed seed))
 

src/mzscheme/src/eval.c

@@ -8169,7 +8169,18 @@ MZ_MARK_STACK_TYPE scheme_set_cont_mark(Scheme_Object *key, Scheme_Object *val)
     pos = ((long)findpos) & SCHEME_MARK_SEGMENT_MASK;
 
     if (segpos >= p->cont_mark_seg_count) {
+#ifdef MZ_USE_FUTURES
+      jit_future_storage[0] = key;
+      jit_future_storage[1] = val;
+#endif
       ts_scheme_new_mark_segment(p);
+      p = scheme_current_thread;
+#ifdef MZ_USE_FUTURES
+      key = jit_future_storage[0];
+      val = jit_future_storage[1];
+      jit_future_storage[0] = NULL;
+      jit_future_storage[1] = NULL;
+#endif
     }
 
     seg = p->cont_mark_stack_segments[segpos];

src/mzscheme/src/future.c

@@ -351,6 +351,7 @@ void futures_init(void)
   REGISTER_SO(fs->future_queue);
   REGISTER_SO(fs->future_queue_end);
   REGISTER_SO(fs->future_waiting_atomic);
+  REGISTER_SO(jit_future_storage);
   
   mzrt_mutex_create(&fs->future_mutex);
   mzrt_sema_create(&fs->future_pending_sema, 0);

src/mzscheme/src/jit.c

@@ -12447,8 +12447,13 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Schem
   gdata.argc = argc;
   gdata.argv = argv;
 
+  /* This action is not atomic: */
   scheme_delay_load_closure(data);
 
+  /* So, check again whether we still need to generate: */
+  if (nc->code->code != scheme_on_demand_jit_code)
+    return;
+
   generate_one(NULL, do_generate_closure, &gdata, 1, data->name, ndata);
 
   if (gdata.max_depth > data->max_let_depth) {