mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
scm_the_vm now returns raw struct scm_vm pointer
* libguile/vm.h (scm_the_vm): Return struct scm_vm*. (scm_c_vm_run): Remove. * libguile/control.c: * libguile/eval.c: * libguile/throw.c: * libguile/vm.c: Adapt.
This commit is contained in:
parent
55ee360700
commit
e7f9ababe0
5 changed files with 17 additions and 25 deletions
|
@ -198,7 +198,7 @@ SCM_DEFINE (scm_abort_to_prompt_star, "abort-to-prompt*", 2, 0, 0,
|
||||||
for (i = 0; i < n; i++, args = scm_cdr (args))
|
for (i = 0; i < n; i++, args = scm_cdr (args))
|
||||||
argv[i] = scm_car (args);
|
argv[i] = scm_car (args);
|
||||||
|
|
||||||
scm_c_abort (SCM_VM_DATA (scm_the_vm ()), tag, n, argv, NULL);
|
scm_c_abort (scm_the_vm (), tag, n, argv, NULL);
|
||||||
|
|
||||||
/* Oh, what, you're still here? The abort must have been reinstated. Actually,
|
/* 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...
|
that's quite impossible, given that we're already in C-land here, so...
|
||||||
|
|
|
@ -447,7 +447,7 @@ eval (SCM x, SCM env)
|
||||||
|
|
||||||
k = EVAL1 (CAR (mx), env);
|
k = EVAL1 (CAR (mx), env);
|
||||||
handler = EVAL1 (CDDR (mx), env);
|
handler = EVAL1 (CDDR (mx), env);
|
||||||
vp = SCM_VM_DATA (scm_the_vm ());
|
vp = scm_the_vm ();
|
||||||
|
|
||||||
/* Push the prompt onto the dynamic stack. */
|
/* Push the prompt onto the dynamic stack. */
|
||||||
scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
|
scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
|
||||||
|
@ -463,7 +463,7 @@ eval (SCM x, SCM env)
|
||||||
{
|
{
|
||||||
/* The prompt exited nonlocally. */
|
/* The prompt exited nonlocally. */
|
||||||
proc = handler;
|
proc = handler;
|
||||||
vp = SCM_VM_DATA (scm_the_vm ());
|
vp = scm_the_vm ();
|
||||||
args = scm_i_prompt_pop_abort_args_x (vp);
|
args = scm_i_prompt_pop_abort_args_x (vp);
|
||||||
goto apply_proc;
|
goto apply_proc;
|
||||||
}
|
}
|
||||||
|
|
|
@ -470,7 +470,7 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
|
||||||
|
|
||||||
/* These two are volatile, so we know we can access them after a
|
/* These two are volatile, so we know we can access them after a
|
||||||
nonlocal return to the setjmp. */
|
nonlocal return to the setjmp. */
|
||||||
vp = SCM_VM_DATA (scm_the_vm ());
|
vp = scm_the_vm ();
|
||||||
v_handler = handler;
|
v_handler = handler;
|
||||||
|
|
||||||
/* Push the prompt onto the dynamic stack. */
|
/* Push the prompt onto the dynamic stack. */
|
||||||
|
@ -488,7 +488,7 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
|
||||||
/* nonlocal exit */
|
/* nonlocal exit */
|
||||||
SCM args;
|
SCM args;
|
||||||
/* vp is not volatile */
|
/* vp is not volatile */
|
||||||
vp = SCM_VM_DATA (scm_the_vm ());
|
vp = scm_the_vm ();
|
||||||
args = scm_i_prompt_pop_abort_args_x (vp);
|
args = scm_i_prompt_pop_abort_args_x (vp);
|
||||||
/* cdr past the continuation */
|
/* cdr past the continuation */
|
||||||
return scm_apply_0 (v_handler, scm_cdr (args));
|
return scm_apply_0 (v_handler, scm_cdr (args));
|
||||||
|
|
|
@ -157,7 +157,7 @@ scm_i_capture_current_stack (void)
|
||||||
struct scm_vm *vp;
|
struct scm_vm *vp;
|
||||||
|
|
||||||
thread = SCM_I_CURRENT_THREAD;
|
thread = SCM_I_CURRENT_THREAD;
|
||||||
vp = SCM_VM_DATA (scm_the_vm ());
|
vp = scm_the_vm ();
|
||||||
|
|
||||||
return scm_i_vm_capture_stack (vp->stack_base, vp->fp, vp->sp, vp->ip,
|
return scm_i_vm_capture_stack (vp->stack_base, vp->fp, vp->sp, vp->ip,
|
||||||
scm_dynstack_capture_all (&thread->dynstack),
|
scm_dynstack_capture_all (&thread->dynstack),
|
||||||
|
@ -816,21 +816,15 @@ vm_stack_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
|
||||||
#endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
|
#endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
|
||||||
|
|
||||||
|
|
||||||
SCM
|
|
||||||
scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
|
|
||||||
{
|
|
||||||
struct scm_vm *vp = SCM_VM_DATA (vm);
|
|
||||||
SCM_CHECK_STACK;
|
|
||||||
return vm_engines[vp->engine](vp, program, argv, nargs);
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_call_n (SCM proc, SCM *argv, size_t nargs)
|
scm_call_n (SCM proc, SCM *argv, size_t nargs)
|
||||||
{
|
{
|
||||||
return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
|
struct scm_vm *vp = scm_the_vm ();
|
||||||
|
SCM_CHECK_STACK;
|
||||||
|
return vm_engines[vp->engine](vp, proc, argv, nargs);
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
struct scm_vm *
|
||||||
scm_the_vm (void)
|
scm_the_vm (void)
|
||||||
{
|
{
|
||||||
scm_i_thread *t = SCM_I_CURRENT_THREAD;
|
scm_i_thread *t = SCM_I_CURRENT_THREAD;
|
||||||
|
@ -838,7 +832,7 @@ scm_the_vm (void)
|
||||||
if (SCM_UNLIKELY (scm_is_false (t->vm)))
|
if (SCM_UNLIKELY (scm_is_false (t->vm)))
|
||||||
t->vm = make_vm ();
|
t->vm = make_vm ();
|
||||||
|
|
||||||
return t->vm;
|
return SCM_VM_DATA (t->vm);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Scheme interface */
|
/* Scheme interface */
|
||||||
|
@ -846,7 +840,7 @@ scm_the_vm (void)
|
||||||
#define VM_DEFINE_HOOK(n) \
|
#define VM_DEFINE_HOOK(n) \
|
||||||
{ \
|
{ \
|
||||||
struct scm_vm *vp; \
|
struct scm_vm *vp; \
|
||||||
vp = SCM_VM_DATA (scm_the_vm ()); \
|
vp = scm_the_vm (); \
|
||||||
if (scm_is_false (vp->hooks[n])) \
|
if (scm_is_false (vp->hooks[n])) \
|
||||||
vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
|
vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
|
||||||
return vp->hooks[n]; \
|
return vp->hooks[n]; \
|
||||||
|
@ -911,7 +905,7 @@ SCM_DEFINE (scm_vm_trace_level, "vm-trace-level", 0, 0, 0,
|
||||||
"")
|
"")
|
||||||
#define FUNC_NAME s_scm_vm_trace_level
|
#define FUNC_NAME s_scm_vm_trace_level
|
||||||
{
|
{
|
||||||
return scm_from_int (SCM_VM_DATA (scm_the_vm ())->trace_level);
|
return scm_from_int (scm_the_vm ()->trace_level);
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -920,7 +914,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
|
#define FUNC_NAME s_scm_set_vm_trace_level_x
|
||||||
{
|
{
|
||||||
SCM_VM_DATA (scm_the_vm ())->trace_level = scm_to_int (level);
|
scm_the_vm ()->trace_level = scm_to_int (level);
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
@ -962,7 +956,7 @@ SCM_DEFINE (scm_vm_engine, "vm-engine", 0, 0, 0,
|
||||||
"")
|
"")
|
||||||
#define FUNC_NAME s_scm_vm_engine
|
#define FUNC_NAME s_scm_vm_engine
|
||||||
{
|
{
|
||||||
return vm_engine_to_symbol (SCM_VM_DATA (scm_the_vm ())->engine, FUNC_NAME);
|
return vm_engine_to_symbol (scm_the_vm ()->engine, FUNC_NAME);
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -974,7 +968,7 @@ scm_c_set_vm_engine_x (int engine)
|
||||||
SCM_MISC_ERROR ("Unknown VM engine: ~a",
|
SCM_MISC_ERROR ("Unknown VM engine: ~a",
|
||||||
scm_list_1 (scm_from_int (engine)));
|
scm_list_1 (scm_from_int (engine)));
|
||||||
|
|
||||||
SCM_VM_DATA (scm_the_vm ())->engine = engine;
|
scm_the_vm ()->engine = engine;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -56,7 +56,7 @@ SCM_API SCM scm_the_vm_fluid;
|
||||||
#define SCM_VM_DATA(vm) ((struct scm_vm *) SCM_CELL_WORD_1 (vm))
|
#define SCM_VM_DATA(vm) ((struct scm_vm *) SCM_CELL_WORD_1 (vm))
|
||||||
#define SCM_VALIDATE_VM(pos,x) SCM_MAKE_VALIDATE (pos, x, VM_P)
|
#define SCM_VALIDATE_VM(pos,x) SCM_MAKE_VALIDATE (pos, x, VM_P)
|
||||||
|
|
||||||
SCM_API SCM scm_the_vm (void);
|
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_vm (SCM proc, SCM args);
|
||||||
|
|
||||||
SCM_API SCM scm_vm_apply_hook (void);
|
SCM_API SCM scm_vm_apply_hook (void);
|
||||||
|
@ -94,8 +94,6 @@ struct scm_vm_cont {
|
||||||
|
|
||||||
SCM_API SCM scm_load_compiled_with_vm (SCM file);
|
SCM_API SCM scm_load_compiled_with_vm (SCM file);
|
||||||
|
|
||||||
SCM_INTERNAL SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs);
|
|
||||||
|
|
||||||
SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
|
SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
|
||||||
scm_print_state *pstate);
|
scm_print_state *pstate);
|
||||||
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
|
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue