mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

Eagerly initialize thread VM; remove scm_the_vm

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2018-06-24 09:32:11 +02:00
parent 2480761bde
commit 7f7169847e
6 changed files with 62 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/control.c
View file

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

20
libguile/eval.c
View file

@ -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;
}

10
libguile/threads.c
View file

@ -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_limit);
mark_stack_ptr = scm_i_vm_mark_stack (&t->vm, mark_stack_ptr,
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

21
libguile/throw.c
View file

@ -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_t_dynamic_state *dynamic_state = SCM_I_CURRENT_THREAD->dynamic_state;
scm_i_thread *t = SCM_I_CURRENT_THREAD;
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 = vp->resumable_prompt_cookie;
saved_stack_depth = vp->stack_top - vp->sp;
prev_cookie = t->vm.resumable_prompt_cookie;
saved_stack_depth = t->vm.stack_top - t->vm.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...

78
libguile/vm.c
View file

@ -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
init_vm (struct scm_vm *vp)
void
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;
vp->stack_size = 0;
/* Not strictly necessary, but good to avoid confusion when debugging
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; \
vp = scm_the_vm (); \
if (scm_is_false (vp->hooks[n])) \
vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
return vp->hooks[n]; \
scm_i_thread *t = SCM_I_CURRENT_THREAD; \
if (scm_is_false (t->vm.hooks[n])) \
t->vm.hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
return t->vm.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 = vp->stack_top - vp->sp;
stack_size = t->vm.stack_top - t->vm.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))
new_limit = scm_min (new_limit, scm_caar (vp->overflow_handler_stack));
if (scm_is_pair (t->vm.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
trigger. */
return_unused_stack_to_os (vp);
/* Reset sp_min_since_gc so that the VM checks actually trigger. */
return_unused_stack_to_os (&t->vm);
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");

2
libguile/vm.h
View file

@ -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 *,