summaryrefslogtreecommitdiff
path: root/libguile/vm-i-system.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-01-05 16:51:58 +0100
committerAndy Wingo <wingo@pobox.com>2010-01-07 10:19:53 +0100
commitfd629322442e3a7131d779a266745ffd05e83c56 (patch)
tree96e244d7f3817689c9fa331c2163a3ca6cbcc783 /libguile/vm-i-system.c
parentf318aa1e386a941df1d2cb2f4d82f8337578baa5 (diff)
downloadguile-fd629322442e3a7131d779a266745ffd05e83c56.tar.gz
add subr-call VM op
* libguile/vm-i-system.c (subr_call): Add subr-call VM op.
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r--libguile/vm-i-system.c69
1 files changed, 69 insertions, 0 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 99c638192..546c9e09f 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -886,6 +886,75 @@ VM_DEFINE_INSTRUCTION (55, tail_call, "tail-call", 1, -1, 1)
goto vm_error_wrong_type_apply;
}
+VM_DEFINE_INSTRUCTION (80, subr_call, "subr-call", 1, -1, -1)
+{
+ SCM foreign, ret;
+ SCM (*subr)();
+ nargs = FETCH ();
+ POP (foreign);
+
+ subr = SCM_FOREIGN_OBJECT_REF (foreign, void*);
+
+ VM_HANDLE_INTERRUPTS;
+ SYNC_REGISTER ();
+
+ switch (nargs)
+ {
+ case 0:
+ ret = subr ();
+ break;
+ case 1:
+ ret = subr (sp[0]);
+ break;
+ case 2:
+ ret = subr (sp[-1], sp[0]);
+ break;
+ case 3:
+ ret = subr (sp[-2], sp[-1], sp[0]);
+ break;
+ case 4:
+ ret = subr (sp[-3], sp[-2], sp[-1], sp[0]);
+ break;
+ case 5:
+ ret = subr (sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+ break;
+ case 6:
+ ret = subr (sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+ break;
+ case 7:
+ ret = subr (sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+ break;
+ case 8:
+ ret = subr (sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+ break;
+ case 9:
+ ret = subr (sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+ break;
+ case 10:
+ ret = subr (sp[-9], sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+ break;
+ default:
+ abort ();
+ }
+
+ NULLSTACK_FOR_NONLOCAL_EXIT ();
+ DROPN (nargs + 1); /* drop args and procedure */
+
+ if (SCM_UNLIKELY (SCM_VALUESP (ret)))
+ {
+ /* multiple values returned to continuation */
+ ret = scm_struct_ref (ret, SCM_INUM0);
+ nvalues = scm_ilength (ret);
+ PUSH_LIST (ret, scm_is_null);
+ goto vm_return_values;
+ }
+ else
+ {
+ PUSH (ret);
+ goto vm_return;
+ }
+}
+
VM_DEFINE_INSTRUCTION (56, tail_call_nargs, "tail-call/nargs", 0, 0, 1)
{
SCM x;