mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
scm_call_n sets up boot continuation frame for VM
* libguile/vm-engine.c: * libguile/vm.c (scm_call_n): Move boot continuation setup to scm_call_n, so that vm-engine takes all of its state from the vp.
This commit is contained in:
parent
b85cd20f80
commit
bd63e5b2c3
2 changed files with 38 additions and 45 deletions
|
@ -424,8 +424,7 @@
|
||||||
((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
|
((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
|
||||||
|
|
||||||
static SCM
|
static SCM
|
||||||
VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
|
VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp)
|
||||||
SCM program, SCM *argv, size_t nargs_)
|
|
||||||
{
|
{
|
||||||
/* Instruction pointer: A pointer to the opcode that is currently
|
/* Instruction pointer: A pointer to the opcode that is currently
|
||||||
running. */
|
running. */
|
||||||
|
@ -478,49 +477,11 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
|
||||||
NEXT (0);
|
NEXT (0);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Load previous VM registers. */
|
/* Load VM registers. */
|
||||||
CACHE_REGISTER ();
|
CACHE_REGISTER ();
|
||||||
|
|
||||||
VM_HANDLE_INTERRUPTS;
|
VM_HANDLE_INTERRUPTS;
|
||||||
|
|
||||||
/* Initialization */
|
|
||||||
{
|
|
||||||
SCM *base;
|
|
||||||
ptrdiff_t base_frame_size;
|
|
||||||
|
|
||||||
/* Check that we have enough space: 3 words for the boot
|
|
||||||
continuation, 3 + nargs for the procedure application, and 3 for
|
|
||||||
setting up a new frame. */
|
|
||||||
base_frame_size = 3 + 3 + nargs_ + 3;
|
|
||||||
vp->sp += base_frame_size;
|
|
||||||
CHECK_OVERFLOW ();
|
|
||||||
base = vp->sp + 1 - base_frame_size;
|
|
||||||
|
|
||||||
/* Since it's possible to receive the arguments on the stack itself,
|
|
||||||
and indeed the regular VM invokes us that way, shuffle up the
|
|
||||||
arguments first. */
|
|
||||||
{
|
|
||||||
int i;
|
|
||||||
for (i = nargs_ - 1; i >= 0; i--)
|
|
||||||
base[6 + i] = argv[i];
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Initial frame, saving previous fp and ip, with the boot
|
|
||||||
continuation. */
|
|
||||||
base[0] = SCM_PACK (fp); /* dynamic link */
|
|
||||||
base[1] = SCM_PACK (ip); /* ra */
|
|
||||||
base[2] = vm_boot_continuation;
|
|
||||||
fp = &base[2];
|
|
||||||
ip = (scm_t_uint32 *) vm_boot_continuation_code;
|
|
||||||
|
|
||||||
/* MV-call frame, function & arguments */
|
|
||||||
base[3] = SCM_PACK (fp); /* dynamic link */
|
|
||||||
base[4] = SCM_PACK (ip); /* ra */
|
|
||||||
base[5] = program;
|
|
||||||
fp = vp->fp = &base[5];
|
|
||||||
RESET_FRAME (nargs_ + 1);
|
|
||||||
}
|
|
||||||
|
|
||||||
apply:
|
apply:
|
||||||
while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
|
while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
|
||||||
{
|
{
|
||||||
|
@ -2141,7 +2102,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
|
||||||
if (scm_is_eq (val, SCM_UNDEFINED))
|
if (scm_is_eq (val, SCM_UNDEFINED))
|
||||||
val = SCM_I_FLUID_DEFAULT (fluid);
|
val = SCM_I_FLUID_DEFAULT (fluid);
|
||||||
VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
|
VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
|
||||||
vm_error_unbound_fluid (program, fluid));
|
vm_error_unbound_fluid (SCM_FRAME_PROGRAM (fp), fluid));
|
||||||
LOCAL_SET (dst, val);
|
LOCAL_SET (dst, val);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -706,8 +706,7 @@ initialize_default_stack_size (void)
|
||||||
#undef VM_USE_HOOKS
|
#undef VM_USE_HOOKS
|
||||||
#undef VM_NAME
|
#undef VM_NAME
|
||||||
|
|
||||||
typedef SCM (*scm_t_vm_engine) (scm_i_thread *current_thread, struct scm_vm *vp,
|
typedef SCM (*scm_t_vm_engine) (scm_i_thread *current_thread, struct scm_vm *vp);
|
||||||
SCM program, SCM *argv, size_t nargs);
|
|
||||||
|
|
||||||
static const scm_t_vm_engine vm_engines[SCM_VM_NUM_ENGINES] =
|
static const scm_t_vm_engine vm_engines[SCM_VM_NUM_ENGINES] =
|
||||||
{ vm_regular_engine, vm_debug_engine };
|
{ vm_regular_engine, vm_debug_engine };
|
||||||
|
@ -808,12 +807,45 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
|
||||||
{
|
{
|
||||||
scm_i_thread *thread;
|
scm_i_thread *thread;
|
||||||
struct scm_vm *vp;
|
struct scm_vm *vp;
|
||||||
|
SCM *base;
|
||||||
|
ptrdiff_t base_frame_size;
|
||||||
|
size_t i;
|
||||||
|
|
||||||
thread = SCM_I_CURRENT_THREAD;
|
thread = SCM_I_CURRENT_THREAD;
|
||||||
vp = thread_vm (thread);
|
vp = thread_vm (thread);
|
||||||
|
|
||||||
SCM_CHECK_STACK;
|
SCM_CHECK_STACK;
|
||||||
return vm_engines[vp->engine](thread, vp, proc, argv, nargs);
|
|
||||||
|
/* Check that we have enough space: 3 words for the boot
|
||||||
|
continuation, 3 + nargs for the procedure application, and 3 for
|
||||||
|
setting up a new frame. */
|
||||||
|
base_frame_size = 3 + 3 + nargs + 3;
|
||||||
|
vp->sp += base_frame_size;
|
||||||
|
if (vp->sp >= vp->stack_limit)
|
||||||
|
vm_error_stack_overflow (vp);
|
||||||
|
base = vp->sp + 1 - base_frame_size;
|
||||||
|
|
||||||
|
/* Since it's possible to receive the arguments on the stack itself,
|
||||||
|
shuffle up the arguments first. */
|
||||||
|
for (i = nargs; i > 0; i--)
|
||||||
|
base[6 + i - 1] = argv[i - 1];
|
||||||
|
|
||||||
|
/* Push the boot continuation, which calls PROC and returns its
|
||||||
|
result(s). */
|
||||||
|
base[0] = SCM_PACK (vp->fp); /* dynamic link */
|
||||||
|
base[1] = SCM_PACK (vp->ip); /* ra */
|
||||||
|
base[2] = vm_boot_continuation;
|
||||||
|
vp->fp = &base[2];
|
||||||
|
vp->ip = (scm_t_uint32 *) vm_boot_continuation_code;
|
||||||
|
|
||||||
|
/* The pending call to PROC. */
|
||||||
|
base[3] = SCM_PACK (vp->fp); /* dynamic link */
|
||||||
|
base[4] = SCM_PACK (vp->ip); /* ra */
|
||||||
|
base[5] = proc;
|
||||||
|
vp->fp = &base[5];
|
||||||
|
vp->sp = &SCM_FRAME_LOCAL (vp->fp, nargs);
|
||||||
|
|
||||||
|
return vm_engines[vp->engine](thread, vp);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Scheme interface */
|
/* Scheme interface */
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue