diff options
author | Andy Wingo <wingo@pobox.com> | 2009-02-05 00:51:34 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-02-05 00:51:34 +0100 |
commit | 4abef68f61f3ff4e674734a4aae18514dd96f221 (patch) | |
tree | a76e652f85abd36b1beecd78a74058b2260d0526 | |
parent | af35fc20a61f175f38b6d7d045c90ca924d82605 (diff) | |
download | guile-4abef68f61f3ff4e674734a4aae18514dd96f221.tar.gz |
scm_call_N doesn't cons for calling programs
* libguile/eval.c (scm_call_0, scm_call_1, scm_call_2, scm_call_3)
(scm_call_4): Special-case compiled procedures here, to avoid consing.
* libguile/vm.h:
* libguile/vm.c (scm_c_vm_run): Take a SCM after all.
(scm_vm_apply, scm_load_compiled_with_vm): Adapt to vm_run change.
-rw-r--r-- | libguile/eval.c | 38 | ||||
-rw-r--r-- | libguile/vm.c | 7 | ||||
-rw-r--r-- | libguile/vm.h | 2 |
3 files changed, 37 insertions, 10 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index 369682b03..73ad5dde1 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -52,6 +52,7 @@ #include "libguile/ports.h" #include "libguile/print.h" #include "libguile/procprop.h" +#include "libguile/programs.h" #include "libguile/root.h" #include "libguile/smob.h" #include "libguile/srcprop.h" @@ -62,6 +63,7 @@ #include "libguile/validate.h" #include "libguile/values.h" #include "libguile/vectors.h" +#include "libguile/vm.h" #include "libguile/eval.h" #include "libguile/private-options.h" @@ -3050,32 +3052,56 @@ SCM_DEFINE (scm_evaluator_traps, "evaluator-traps-interface", 0, 1, 0, SCM scm_call_0 (SCM proc) { - return scm_apply (proc, SCM_EOL, SCM_EOL); + if (SCM_PROGRAM_P (proc)) + return scm_c_vm_run (scm_the_vm (), proc, NULL, 0); + else + return scm_apply (proc, SCM_EOL, SCM_EOL); } SCM scm_call_1 (SCM proc, SCM arg1) { - return scm_apply (proc, arg1, scm_listofnull); + if (SCM_PROGRAM_P (proc)) + return scm_c_vm_run (scm_the_vm (), proc, &arg1, 1); + else + return scm_apply (proc, arg1, scm_listofnull); } SCM scm_call_2 (SCM proc, SCM arg1, SCM arg2) { - return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull)); + if (SCM_PROGRAM_P (proc)) + { + SCM args[] = { arg1, arg2 }; + return scm_c_vm_run (scm_the_vm (), proc, args, 2); + } + else + return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull)); } SCM scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3) { - return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull)); + if (SCM_PROGRAM_P (proc)) + { + SCM args[] = { arg1, arg2, arg3 }; + return scm_c_vm_run (scm_the_vm (), proc, args, 3); + } + else + return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull)); } SCM scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4) { - return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, - scm_cons (arg4, scm_listofnull))); + if (SCM_PROGRAM_P (proc)) + { + SCM args[] = { arg1, arg2, arg3, arg4 }; + return scm_c_vm_run (scm_the_vm (), proc, args, 4); + } + else + return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, + scm_cons (arg4, scm_listofnull))); } /* Simple procedure applies diff --git a/libguile/vm.c b/libguile/vm.c index 90a1f68c1..5dcce1b77 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -378,8 +378,9 @@ vm_free (SCM obj) } SCM -scm_c_vm_run (struct scm_vm *vp, SCM program, SCM *argv, int nargs) +scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs) { + struct scm_vm *vp = SCM_VM_DATA (vm); return vm_engines[vp->engine](vp, program, argv, nargs); } @@ -404,7 +405,7 @@ scm_vm_apply (SCM vm, SCM program, SCM args) args = SCM_CDR (args); } - return scm_c_vm_run (SCM_VM_DATA (vm), program, argv, nargs); + return scm_c_vm_run (vm, program, argv, nargs); } #undef FUNC_NAME @@ -625,7 +626,7 @@ SCM scm_load_compiled_with_vm (SCM file) SCM program = scm_make_program (scm_load_objcode (file), SCM_BOOL_F, SCM_EOL); - return scm_c_vm_run (SCM_VM_DATA (scm_the_vm ()), program, NULL, 0); + return scm_c_vm_run (scm_the_vm (), program, NULL, 0); } void diff --git a/libguile/vm.h b/libguile/vm.h index 218569619..5c38f9ffa 100644 --- a/libguile/vm.h +++ b/libguile/vm.h @@ -87,7 +87,7 @@ extern SCM scm_the_vm_fluid; extern SCM scm_the_vm (); extern SCM scm_make_vm (void); extern SCM scm_vm_apply (SCM vm, SCM program, SCM args); -extern SCM scm_c_vm_run (struct scm_vm *vp, SCM program, SCM *argv, int nargs); +extern SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs); extern SCM scm_vm_option_ref (SCM vm, SCM key); extern SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val); |