diff options
author | Andy Wingo <wingo@pobox.com> | 2009-12-01 21:59:42 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-12-01 21:59:42 +0100 |
commit | 23f276dea70668b7291589de1c7d7ea7ebd9026f (patch) | |
tree | 9efe3687daed1e4d3d09d9c9b26c919dffc9890d /libguile/vm-i-system.c | |
parent | 5161a3c0d7ec59e32a637bd093644a1a5b7b8dcf (diff) | |
download | guile-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.c | 32 |
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; } |