summaryrefslogtreecommitdiff
path: root/libguile/vm-i-system.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r--libguile/vm-i-system.c38
1 files changed, 34 insertions, 4 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 23bd239ab..86e65787b 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -516,8 +516,9 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
if (SCM_VM_CONT_P (x))
{
program = x;
- vm_call_cc:
+ vm_call_continuation:
/* Check the number of arguments */
+ /* FIXME multiple args */
if (nargs != 1)
scm_wrong_num_args (program);
@@ -534,10 +535,11 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
goto vm_error_wrong_type_apply;
}
-VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
{
register SCM x;
nargs = FETCH ();
+ vm_goto_args:
x = sp[-nargs];
SCM_TICK; /* allow interrupt here */
@@ -685,7 +687,7 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
* Continuation call
*/
if (SCM_VM_CONT_P (program))
- goto vm_call_cc;
+ goto vm_call_continuation;
goto vm_error_wrong_type_apply;
}
@@ -711,15 +713,43 @@ VM_DEFINE_INSTRUCTION (apply, "apply", 1, -1, 1)
goto vm_call;
}
+VM_DEFINE_INSTRUCTION (goto_apply, "goto/apply", 1, -1, 1)
+{
+ int len;
+ SCM ls;
+ POP (ls);
+
+ nargs = FETCH ();
+ if (nargs < 2)
+ goto vm_error_wrong_num_args;
+
+ len = scm_ilength (ls);
+ if (len < 0)
+ goto vm_error_wrong_type_arg;
+
+ for (; !SCM_NULLP (ls); ls = SCM_CDR (ls))
+ PUSH (SCM_CAR (ls));
+
+ nargs += len - 2;
+ goto vm_goto_args;
+}
+
VM_DEFINE_INSTRUCTION (call_cc, "call/cc", 1, 1, 1)
{
SYNC_BEFORE_GC ();
PUSH (capture_vm_cont (vp));
- POP (program);
nargs = 1;
goto vm_call;
}
+VM_DEFINE_INSTRUCTION (goto_cc, "goto/cc", 1, 1, 1)
+{
+ SYNC_BEFORE_GC ();
+ PUSH (capture_vm_cont (vp));
+ nargs = 1;
+ goto vm_goto_args;
+}
+
VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
{
vm_return: