Eagerly initialize thread VM; remove scm_the_vm

* libguile/threads.c (thread_mark): Unconditionally call
  scm_i_vm_mark_stack.
  (guilify_self_1): Eagerly prepare the thread stack, before entering
  Guile mode.  It's only a page of mmap, after all.
* libguile/vm.c (scm_i_vm_prepare_stack): Rename from init_vm.
  (thread_vm, scm_the_vm): Remove.
  (VM_DEFINE_HOOK, scm_vm_trace_level, scm_set_vm_trace_level_x)
  (scm_vm_engine, scm_c_set_vm_engine_x, scm_i_capture_current_stack)
  (scm_call_n, scm_call_with_stack_overflow_handler): Adapt to get VM
  from thread.
  (scm_i_vm_free_stack): Memset the whole thing to 0 when we're done.
* libguile/control.c (scm_abort_to_prompt_star)
* libguile/eval.c (eval):
* libguile/throw.c (catch, abort_to_prompt): Get VM from thread.

libguile/control.c

@@ -204,7 +204,7 @@ SCM_DEFINE (scm_abort_to_prompt_star, "abort-to-prompt*", 2, 0, 0,
   for (i = 0; i < n; i++, args = scm_cdr (args))
     argv[i] = scm_car (args);
 
-  scm_c_abort (scm_the_vm (), tag, n, argv, NULL);
+  scm_c_abort (&SCM_I_CURRENT_THREAD->vm, tag, n, argv, NULL);
 
   /* Oh, what, you're still here? The abort must have been reinstated. Actually,
      that's quite impossible, given that we're already in C-land here, so...

libguile/eval.c

@@ -431,7 +431,7 @@ eval (SCM x, SCM env)
 
     case SCM_M_CALL_WITH_PROMPT:
       {
-        struct scm_vm *vp;
+        scm_i_thread *t;
         SCM k, handler, res;
         jmp_buf registers;
         const void *prev_cookie;
@@ -439,32 +439,32 @@ eval (SCM x, SCM env)
 
         k = EVAL1 (CAR (mx), env);
         handler = EVAL1 (CDDR (mx), env);
-        vp = scm_the_vm ();
+        t = SCM_I_CURRENT_THREAD;
 
-        saved_stack_depth = vp->stack_top - vp->sp;
+        saved_stack_depth = t->vm.stack_top - t->vm.sp;
 
         /* Push the prompt onto the dynamic stack. */
-        scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
+        scm_dynstack_push_prompt (&t->dynstack,
                                   SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
                                   k,
-                                  vp->stack_top - vp->fp,
+                                  t->vm.stack_top - t->vm.fp,
                                   saved_stack_depth,
-                                  vp->ip,
+                                  t->vm.ip,
                                   &registers);
 
-        prev_cookie = vp->resumable_prompt_cookie;
+        prev_cookie = t->vm.resumable_prompt_cookie;
         if (setjmp (registers))
           {
             /* The prompt exited nonlocally. */
-            vp->resumable_prompt_cookie = prev_cookie;
+            t->vm.resumable_prompt_cookie = prev_cookie;
             scm_gc_after_nonlocal_exit ();
             proc = handler;
-            args = scm_i_prompt_pop_abort_args_x (vp, saved_stack_depth);
+            args = scm_i_prompt_pop_abort_args_x (&t->vm, saved_stack_depth);
             goto apply_proc;
           }
         
         res = scm_call_0 (eval (CADR (mx), env));
-        scm_dynstack_pop (&SCM_I_CURRENT_THREAD->dynstack);
+        scm_dynstack_pop (&t->dynstack);
         return res;
       }
 

libguile/threads.c

@@ -114,9 +114,8 @@ thread_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
         }
     }
 
-  if (t->vm.stack_bottom)
+  mark_stack_ptr = scm_i_vm_mark_stack (&t->vm, mark_stack_ptr,
-    mark_stack_ptr = scm_i_vm_mark_stack (&t->vm, mark_stack_ptr,
+                                        mark_stack_limit);
-                                          mark_stack_limit);
 
   return mark_stack_ptr;
 }
@@ -391,6 +390,7 @@ guilify_self_1 (struct GC_stack_base *base, int needs_unregister)
   t.continuation_root = SCM_EOL;
   t.continuation_base = t.base;
   scm_i_pthread_cond_init (&t.sleep_cond, NULL);
+  scm_i_vm_prepare_stack (&t.vm);
 
   if (pipe2 (t.sleep_pipe, O_CLOEXEC) != 0)
     /* FIXME: Error conditions during the initialization phase are handled
@@ -491,6 +491,10 @@ on_thread_exit (void *v)
       }
   thread_count--;
 
+  /* Prevent any concurrent or future marker from visiting this
+     thread.  */
+  t->handle = SCM_PACK (0);
+
   /* If there's only one other thread, it could be the signal delivery
      thread, so we need to notify it to shut down by closing its read pipe.
      If it's not the signal delivery thread, then closing the read pipe isn't

libguile/throw.c

@@ -80,11 +80,11 @@ static SCM exception_handler_fluid;
 static SCM
 catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
 {
-  struct scm_vm *vp;
   SCM eh, prompt_tag;
   SCM res;
-  scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
+  scm_i_thread *t = SCM_I_CURRENT_THREAD;
-  scm_t_dynamic_state *dynamic_state = SCM_I_CURRENT_THREAD->dynamic_state;
+  scm_t_dynstack *dynstack = &t->dynstack;
+  scm_t_dynamic_state *dynamic_state = t->dynamic_state;
   jmp_buf registers;
   const void *prev_cookie;
   ptrdiff_t saved_stack_depth;
@@ -109,17 +109,16 @@ catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
   scm_c_vector_set_x (eh, 1, prompt_tag);
   scm_c_vector_set_x (eh, 2, pre_unwind_handler);
 
-  vp = scm_the_vm ();
+  prev_cookie = t->vm.resumable_prompt_cookie;
-  prev_cookie = vp->resumable_prompt_cookie;
+  saved_stack_depth = t->vm.stack_top - t->vm.sp;
-  saved_stack_depth = vp->stack_top - vp->sp;
 
   /* Push the prompt and exception handler onto the dynamic stack. */
   scm_dynstack_push_prompt (dynstack,
                             SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
                             prompt_tag,
-                            vp->stack_top - vp->fp,
+                            t->vm.stack_top - t->vm.fp,
                             saved_stack_depth,
-                            vp->ip,
+                            t->vm.ip,
                             &registers);
   scm_dynstack_push_fluid (dynstack, exception_handler_fluid, eh,
                            dynamic_state);
@@ -129,12 +128,12 @@ catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
       /* A non-local return.  */
       SCM args;
 
-      vp->resumable_prompt_cookie = prev_cookie;
+      t->vm.resumable_prompt_cookie = prev_cookie;
       scm_gc_after_nonlocal_exit ();
 
       /* FIXME: We know where the args will be on the stack; we could
          avoid consing them.  */
-      args = scm_i_prompt_pop_abort_args_x (vp, saved_stack_depth);
+      args = scm_i_prompt_pop_abort_args_x (&t->vm, saved_stack_depth);
 
       /* Cdr past the continuation. */
       args = scm_cdr (args);
@@ -196,7 +195,7 @@ abort_to_prompt (SCM prompt_tag, SCM tag, SCM args)
   for (i = 1; i < n; i++, args = scm_cdr (args))
     argv[i] = scm_car (args);
 
-  scm_c_abort (scm_the_vm (), prompt_tag, n, argv, NULL);
+  scm_c_abort (&SCM_I_CURRENT_THREAD->vm, prompt_tag, n, argv, NULL);
 
   /* Oh, what, you're still here? The abort must have been reinstated. Actually,
      that's quite impossible, given that we're already in C-land here, so...

libguile/vm.c

@@ -238,7 +238,6 @@ vm_return_to_continuation (struct scm_vm *vp, SCM cont, size_t n,
   vp->ip = cp->ra;
 }
 
-static struct scm_vm * thread_vm (scm_i_thread *t);
 SCM
 scm_i_capture_current_stack (void)
 {
@@ -246,7 +245,7 @@ scm_i_capture_current_stack (void)
   struct scm_vm *vp;
 
   thread = SCM_I_CURRENT_THREAD;
-  vp = thread_vm (thread);
+  vp = &thread->vm;
 
   return scm_i_vm_capture_stack (vp->stack_top, vp->fp, vp->sp, vp->ip,
                                  scm_dynstack_capture_all (&thread->dynstack),
@@ -826,11 +825,21 @@ expand_stack (union scm_vm_stack_element *old_bottom, size_t old_size,
 }
 #undef FUNC_NAME
 
-static void
+void
-init_vm (struct scm_vm *vp)
+scm_i_vm_prepare_stack (struct scm_vm *vp)
 {
   int i;
 
+  /* Not racey, as this will be run the first time a thread enters
+     Guile.  */
+  if (page_size == 0)
+    {
+      page_size = getpagesize ();
+      /* page_size should be a power of two.  */
+      if (page_size & (page_size - 1))
+        abort ();
+    }
+
   vp->stack_size = page_size / sizeof (union scm_vm_stack_element);
   vp->stack_bottom = allocate_stack (vp->stack_size);
   if (!vp->stack_bottom)
@@ -992,8 +1001,9 @@ void
 scm_i_vm_free_stack (struct scm_vm *vp)
 {
   free_stack (vp->stack_bottom, vp->stack_size);
-  vp->stack_bottom = vp->stack_top = vp->stack_limit = NULL;
+  /* Not strictly necessary, but good to avoid confusion when debugging
-  vp->stack_size = 0;
+     thread-related GC issues.  */
+  memset (vp, 0, sizeof (*vp));
 }
 
 struct vm_expand_stack_data
@@ -1148,21 +1158,6 @@ vm_expand_stack (struct scm_vm *vp, union scm_vm_stack_element *new_sp)
     }
 }
 
-static struct scm_vm *
-thread_vm (scm_i_thread *t)
-{
-  if (SCM_UNLIKELY (!t->vm.stack_bottom))
-    init_vm (&t->vm);
-
-  return &t->vm;
-}
-
-struct scm_vm *
-scm_the_vm (void)
-{
-  return thread_vm (SCM_I_CURRENT_THREAD);
-}
-
 SCM
 scm_call_n (SCM proc, SCM *argv, size_t nargs)
 {
@@ -1178,7 +1173,7 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
   size_t i;
 
   thread = SCM_I_CURRENT_THREAD;
-  vp = thread_vm (thread);
+  vp = &thread->vm;
 
   SCM_CHECK_STACK;
 
@@ -1236,11 +1231,10 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
 
 #define VM_DEFINE_HOOK(n)				\
 {							\
-  struct scm_vm *vp;					\
+  scm_i_thread *t = SCM_I_CURRENT_THREAD;		\
-  vp = scm_the_vm ();                                   \
+  if (scm_is_false (t->vm.hooks[n]))			\
-  if (scm_is_false (vp->hooks[n]))			\
+    t->vm.hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
-    vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
+  return t->vm.hooks[n];				\
-  return vp->hooks[n];					\
 }
 
 SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 0, 0, 0,
@@ -1293,7 +1287,7 @@ SCM_DEFINE (scm_vm_trace_level, "vm-trace-level", 0, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_trace_level
 {
-  return scm_from_int (scm_the_vm ()->trace_level);
+  return scm_from_int (SCM_I_CURRENT_THREAD->vm.trace_level);
 }
 #undef FUNC_NAME
 
@@ -1302,7 +1296,7 @@ SCM_DEFINE (scm_set_vm_trace_level_x, "set-vm-trace-level!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_set_vm_trace_level_x
 {
-  scm_the_vm ()->trace_level = scm_to_int (level);
+  SCM_I_CURRENT_THREAD->vm.trace_level = scm_to_int (level);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1344,7 +1338,7 @@ SCM_DEFINE (scm_vm_engine, "vm-engine", 0, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_engine
 {
-  return vm_engine_to_symbol (scm_the_vm ()->engine, FUNC_NAME);
+  return vm_engine_to_symbol (SCM_I_CURRENT_THREAD->vm.engine, FUNC_NAME);
 }
 #undef FUNC_NAME
 
@@ -1356,7 +1350,7 @@ scm_c_set_vm_engine_x (int engine)
     SCM_MISC_ERROR ("Unknown VM engine: ~a",
                     scm_list_1 (scm_from_int (engine)));
     
-  scm_the_vm ()->engine = engine;
+  SCM_I_CURRENT_THREAD->vm.engine = engine;
 }
 #undef FUNC_NAME
 
@@ -1416,29 +1410,28 @@ SCM_DEFINE (scm_call_with_stack_overflow_handler,
             "@code{call-with-stack-overflow-handler} was called.")
 #define FUNC_NAME s_scm_call_with_stack_overflow_handler
 {
-  struct scm_vm *vp;
+  struct scm_i_thread *t = SCM_I_CURRENT_THREAD;
   ptrdiff_t c_limit, stack_size;
   struct overflow_handler_data data;
   SCM new_limit, ret;
 
-  vp = scm_the_vm ();
+  stack_size = t->vm.stack_top - t->vm.sp;
-  stack_size = vp->stack_top - vp->sp;
 
   c_limit = scm_to_ptrdiff_t (limit);
   if (c_limit <= 0)
     scm_out_of_range (FUNC_NAME, limit);
 
   new_limit = scm_sum (scm_from_ptrdiff_t (stack_size), limit);
-  if (scm_is_pair (vp->overflow_handler_stack))
+  if (scm_is_pair (t->vm.overflow_handler_stack))
-    new_limit = scm_min (new_limit, scm_caar (vp->overflow_handler_stack));
+    new_limit = scm_min (new_limit, scm_caar (t->vm.overflow_handler_stack));
 
   /* Hacky check that the current stack depth plus the limit is within
      the range of a ptrdiff_t.  */
   scm_to_ptrdiff_t (new_limit);
 
-  data.vp = vp;
+  data.vp = &t->vm;
   data.overflow_handler_stack =
-    scm_acons (limit, handler, vp->overflow_handler_stack);
+    scm_acons (limit, handler, t->vm.overflow_handler_stack);
 
   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 
@@ -1447,9 +1440,8 @@ SCM_DEFINE (scm_call_with_stack_overflow_handler,
   scm_dynwind_unwind_handler (unwind_overflow_handler, &data,
                               SCM_F_WIND_EXPLICITLY);
 
-  /* Reset vp->sp_min_since_gc so that the VM checks actually
+  /* Reset sp_min_since_gc so that the VM checks actually trigger.  */
-     trigger.  */
+  return_unused_stack_to_os (&t->vm);
-  return_unused_stack_to_os (vp);
 
   ret = scm_call_0 (thunk);
 
@@ -1504,10 +1496,6 @@ scm_bootstrap_vm (void)
                             (scm_t_extension_init_func)scm_init_vm_builtins,
                             NULL);
 
-  page_size = getpagesize ();
-  /* page_size should be a power of two.  */
-  if (page_size & (page_size - 1))
-    abort ();
   scm_vm_intrinsics.expand_stack = vm_expand_stack;
 
   sym_vm_run = scm_from_latin1_symbol ("vm-run");

libguile/vm.h

@@ -61,7 +61,6 @@ struct scm_vm {
   int engine;                   /* which vm engine we're using */
 };
 
-SCM_INTERNAL struct scm_vm *scm_the_vm (void);
 SCM_API SCM scm_call_with_vm (SCM proc, SCM args);
 
 SCM_API SCM scm_call_with_stack_overflow_handler (SCM limit, SCM thunk,
@@ -80,6 +79,7 @@ SCM_API SCM scm_set_default_vm_engine_x (SCM engine);
 SCM_API void scm_c_set_vm_engine_x (int engine);
 SCM_API void scm_c_set_default_vm_engine_x (int engine);
 
+SCM_INTERNAL void scm_i_vm_prepare_stack (struct scm_vm *vp);
 struct GC_ms_entry;
 SCM_INTERNAL struct GC_ms_entry * scm_i_vm_mark_stack (struct scm_vm *,
                                                        struct GC_ms_entry *,