mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

rename tail-call to goto/args, add some more tail instructions

Browse source 
* libguile/vm-i-system.c (call): Rename continuation invocation from
  `vm_call_cc' to `vm_call_continuation', because that's what it really
  does. Add a note that it doesn't handle multiple values at the moment.
  (goto/arg): Renamed from tail-call, in deference to the progenitors, on
  Dale Smith's suggestion.
  (goto/apply): New instruction, for `apply' in a tail context. Not yet
  used, or vetted for that matter.
  (call/cc): No need to pop the program, I don't think; although this
  isn't tested either.
  (goto/cc): New instruction, for call/cc in a tail context.

* module/language/scheme/translate.scm (*forbidden-primitives*): Rename
  from %forbidden-primitives.

* module/system/il/compile.scm (codegen): Adapt to goto/args instead of
  tail-call.

* module/system/il/inline.scm: Start inlining some macros used in
  r4rs.scm -- not yet fully tested.

* ice-9/boot-9.scm: Allow load of a compiled r4rs file.
This commit is contained in:
Andy Wingo 2008-09-13 19:19:10 +02:00
parent da320011a3
commit f03c31dbad
6 changed files with 49 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

38
libguile/vm-i-system.c
View file

@ -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: