summaryrefslogtreecommitdiff
path: root/libguile/vm-i-system.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-12-01 22:11:15 +0100
committerAndy Wingo <wingo@pobox.com>2009-12-01 22:11:15 +0100
commitcc8d1f5fcd97de920111d407d2c9e88d6aedbc6d (patch)
tree946bffb3cf6c1aa5ce728d4a454e43271c5d2322 /libguile/vm-i-system.c
parent23f276dea70668b7291589de1c7d7ea7ebd9026f (diff)
downloadguile-cc8d1f5fcd97de920111d407d2c9e88d6aedbc6d.tar.gz
vm doesn't call the evaluator at all (at least not directly)
* libguile/vm-i-system.c (goto/args, mv-call): Finish the port to use apply_foreign instead of scm_apply.
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r--libguile/vm-i-system.c70
1 files changed, 42 insertions, 28 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 5cfeab055..6d32a6ccd 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -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 */
- DROP_FRAME ();
-
+ SCM ret;
+ /* At this point, the stack contains the frame, the procedure and each one
+ of its arguments. */
SYNC_REGISTER ();
- PUSH (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_VALUESP (*sp))
+ DROPN (nargs + 1); /* drop args and procedure */
+ DROP_FRAME ();
+
+ 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;
}