mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

vm doesn't call the evaluator at all (at least not directly)

Browse source 
* libguile/vm-i-system.c (goto/args, mv-call): Finish the port to use
  apply_foreign instead of scm_apply.
This commit is contained in:
Andy Wingo 2009-12-01 22:11:15 +01:00
parent 23f276dea7
commit cc8d1f5fcd
1 changed files with 42 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

70
libguile/vm-i-system.c
View file

@ -850,32 +850,39 @@ VM_DEFINE_INSTRUCTION (54, goto_args, "goto/args", 1, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (x);
goto vm_goto_args;
}
else if (SCM_PROCEDURE_WITH_SETTER_P (x))
{
sp[-nargs] = SCM_PROCEDURE (x);
goto vm_goto_args;
}
/*
* Other interpreted or compiled call
*/
if (!scm_is_false (scm_procedure_p (x)))
{
SCM args;
POP_LIST (nargs);
POP (args);
SCM ret;
SYNC_REGISTER ();
*sp = scm_apply (x, args, SCM_EOL);
ret = apply_foreign (sp[-nargs],
sp - nargs + 1,
nargs,
vp->stack_limit - sp + 1);
NULLSTACK_FOR_NONLOCAL_EXIT ();
if (SCM_UNLIKELY (SCM_VALUESP (*sp)))
DROPN (nargs + 1); /* drop args and procedure */
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
{
/* multiple values returned to continuation */
SCM values;
POP (values);
values = scm_struct_ref (values, SCM_INUM0);
nvalues = scm_ilength (values);
PUSH_LIST (values, scm_is_null);
ret = scm_struct_ref (ret, SCM_INUM0);
nvalues = scm_ilength (ret);
PUSH_LIST (ret, scm_is_null);
goto vm_return_values;
}
else
goto vm_return;
{
PUSH (ret);
goto vm_return;
}
}
program = x;
@ -936,32 +943,39 @@ VM_DEFINE_INSTRUCTION (57, mv_call, "mv-call", 4, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (x);
goto vm_mv_call;
}
else if (SCM_PROCEDURE_WITH_SETTER_P (x))
{
sp[-nargs] = SCM_PROCEDURE (x);
goto vm_mv_call;
}
/*
* Other interpreted or compiled call
*/
if (!scm_is_false (scm_procedure_p (x)))
{
SCM args;
/* At this point, the stack contains the procedure and each one of its
arguments. */
POP_LIST (nargs);
POP (args);
DROP (); /* drop the procedure */
SCM ret;
/* At this point, the stack contains the frame, the procedure and each one
of its arguments. */
SYNC_REGISTER ();
ret = apply_foreign (sp[-nargs],
sp - nargs + 1,
nargs,
vp->stack_limit - sp + 1);
NULLSTACK_FOR_NONLOCAL_EXIT ();
DROPN (nargs + 1); /* drop args and procedure */
DROP_FRAME ();
SYNC_REGISTER ();
PUSH (scm_apply (x, args, SCM_EOL));
NULLSTACK_FOR_NONLOCAL_EXIT ();
if (SCM_VALUESP (*sp))
if (SCM_VALUESP (ret))
{
SCM values, len;
POP (values);
values = scm_struct_ref (values, SCM_INUM0);
len = scm_length (values);
PUSH_LIST (values, scm_is_null);
SCM len;
ret = scm_struct_ref (ret, SCM_INUM0);
len = scm_length (ret);
PUSH_LIST (ret, scm_is_null);
PUSH (len);
ip = mvra;
}
else
PUSH (ret);
NEXT;
}