summaryrefslogtreecommitdiff
path: root/libguile/vm-i-system.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-12-01 21:59:42 +0100
committerAndy Wingo <wingo@pobox.com>2009-12-01 21:59:42 +0100
commit23f276dea70668b7291589de1c7d7ea7ebd9026f (patch)
tree9efe3687daed1e4d3d09d9c9b26c919dffc9890d /libguile/vm-i-system.c
parent5161a3c0d7ec59e32a637bd093644a1a5b7b8dcf (diff)
downloadguile-23f276dea70668b7291589de1c7d7ea7ebd9026f.tar.gz
first step to make the vm stop calling the interpreter
* libguile/eval.h: * libguile/eval.c (scm_closure_apply): New function, applies a closure. Won't be necessary in the future, but for now here it is, with internal linkage. * libguile/gsubr.h: * libguile/gsubr.c (scm_i_gsubr_apply_array): New function, applies a gsubr to an array of values, potentially extending that array for optional arguments and rest arguments and such. * libguile/vm.c (apply_foreign): New function, applies a foreign function to arguments on the stack, in place. * libguile/vm-i-system.c (call): Add a case for procedures-with-setters (will go away when they are applicable structs). Instead of calling the evaluator for foreign functions, call apply_foreign.
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r--libguile/vm-i-system.c32
1 files changed, 19 insertions, 13 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index a8fa2d3d3..5cfeab055 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -766,32 +766,38 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (x);
goto vm_call;
}
+ else if (SCM_PROCEDURE_WITH_SETTER_P (x))
+ {
+ sp[-nargs] = SCM_PROCEDURE (x);
+ goto vm_call;
+ }
/*
* Other interpreted or compiled call
*/
if (!scm_is_false (scm_procedure_p (x)))
{
- SCM args;
+ SCM ret;
/* At this point, the stack contains the frame, the procedure and each one
of its arguments. */
- POP_LIST (nargs);
- POP (args);
- DROP (); /* drop the procedure */
- DROP_FRAME ();
-
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_UNLIKELY (SCM_VALUESP (*sp)))
+ DROPN (nargs + 1); /* drop args and procedure */
+ DROP_FRAME ();
+
+ if (SCM_UNLIKELY (SCM_VALUESP (ret)))
{
/* truncate values */
- SCM values;
- POP (values);
- values = scm_struct_ref (values, SCM_INUM0);
- if (scm_is_null (values))
+ ret = scm_struct_ref (ret, SCM_INUM0);
+ if (scm_is_null (ret))
goto vm_error_not_enough_values;
- PUSH (SCM_CAR (values));
+ PUSH (SCM_CAR (ret));
}
+ else
+ PUSH (ret);
NEXT;
}