diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/vm_engine.h | 8 | ||||
-rw-r--r-- | src/vm_system.c | 99 |
2 files changed, 95 insertions, 12 deletions
diff --git a/src/vm_engine.h b/src/vm_engine.h index 981f1f9ae..c90ca44a6 100644 --- a/src/vm_engine.h +++ b/src/vm_engine.h @@ -222,13 +222,13 @@ if (sp > stack_limit) \ goto vm_error_stack_overflow -#define CHECK_UNDERFLOW() \ - if (sp < stack_base) \ +#define CHECK_UNDERFLOW() \ + if (sp < stack_base) \ goto vm_error_stack_underflow #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0) -#define DROP() do { CHECK_UNDERFLOW (); sp--; } while (0) -#define DROPN(_n) do { CHECK_UNDERFLOW (); sp -= (_n); } while (0) +#define DROP() do { sp--; CHECK_UNDERFLOW (); } while (0) +#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); } while (0) #define POP(x) do { x = *sp; DROP (); } while (0) /* A fast CONS. This has to be fast since its used, for instance, by diff --git a/src/vm_system.c b/src/vm_system.c index f227e79fa..1c2992bcb 100644 --- a/src/vm_system.c +++ b/src/vm_system.c @@ -422,20 +422,58 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1) NEXT; } /* - * Function call + * Subr call + */ + switch (nargs) + { + case 0: + { + scm_t_trampoline_0 call = scm_trampoline_0 (x); + if (call) + { + SYNC_ALL (); + *sp = call (x); + NEXT; + } + break; + } + case 1: + { + scm_t_trampoline_1 call = scm_trampoline_1 (x); + if (call) + { + SCM arg1; + POP (arg1); + SYNC_ALL (); + *sp = call (x, arg1); + NEXT; + } + break; + } + case 2: + { + scm_t_trampoline_2 call = scm_trampoline_2 (x); + if (call) + { + SCM arg1, arg2; + POP (arg2); + POP (arg1); + SYNC_ALL (); + *sp = call (x, arg1, arg2); + NEXT; + } + break; + } + } + /* + * Other interpreted or compiled call */ if (!SCM_FALSEP (scm_procedure_p (x))) { /* At this point, the stack contains the procedure and each one of its arguments. */ SCM args; - -#if 1 POP_LIST (nargs); -#else - /* Experimental: Build the arglist on the VM stack. XXX */ - POP_LIST_ON_STACK (nargs); -#endif POP (args); *sp = scm_apply (x, args, SCM_EOL); NEXT; @@ -503,7 +541,52 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1) goto vm_call_program; } /* - * Function call + * Subr call + */ + switch (nargs) + { + case 0: + { + scm_t_trampoline_0 call = scm_trampoline_0 (x); + if (call) + { + SYNC_ALL (); + *sp = call (x); + goto vm_return; + } + break; + } + case 1: + { + scm_t_trampoline_1 call = scm_trampoline_1 (x); + if (call) + { + SCM arg1; + POP (arg1); + SYNC_ALL (); + *sp = call (x, arg1); + goto vm_return; + } + break; + } + case 2: + { + scm_t_trampoline_2 call = scm_trampoline_2 (x); + if (call) + { + SCM arg1, arg2; + POP (arg2); + POP (arg1); + SYNC_ALL (); + *sp = call (x, arg1, arg2); + goto vm_return; + } + break; + } + } + + /* + * Other interpreted or compiled call */ if (!SCM_FALSEP (scm_procedure_p (x))) { |