mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-03 21:30:29 +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

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