diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-03-22 15:28:35 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-03-22 15:28:35 +0100 |
commit | d9e59f894e1b41958203ddda7f21f4817cfcfe37 (patch) | |
tree | f0d6b0b38ed000aabf327dba4e281c37c60f92a5 /libguile/eval.c | |
parent | f307fbcec2cbaaa95b8c861395133b519c7519cf (diff) | |
parent | 80540f391498ebb0f955db2fafb6a36ed03b7886 (diff) | |
download | guile-d9e59f894e1b41958203ddda7f21f4817cfcfe37.tar.gz |
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts:
libguile/continuations.c
libguile/gc-freelist.c
libguile/gc-mark.c
libguile/symbols.c
libguile/threads.c
module/ice-9/boot-9.scm
Diffstat (limited to 'libguile/eval.c')
-rw-r--r-- | libguile/eval.c | 58 |
1 files changed, 47 insertions, 11 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index 18cd3b11f..a1b352d68 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" @@ -2966,7 +2968,7 @@ scm_t_option scm_debug_opts[] = { { SCM_OPTION_BOOLEAN, "backtrace", 0, "Show backtrace on error." }, { SCM_OPTION_BOOLEAN, "debug", 0, "Use the debugging evaluator." }, - { SCM_OPTION_INTEGER, "stack", 20000, "Stack size limit (measured in words; 0 = no check)." }, + { SCM_OPTION_INTEGER, "stack", 40000, "Stack size limit (measured in words; 0 = no check)." }, { SCM_OPTION_SCM, "show-file-name", (unsigned long)SCM_BOOL_T, "Show file names and line numbers " "in backtraces when not `#f'. A value of `base' " @@ -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 @@ -3663,13 +3689,23 @@ scm_closure (SCM code, SCM env) scm_t_bits scm_tc16_promise; -SCM -scm_makprom (SCM code) -{ +SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0, + (SCM thunk), + "Create a new promise object.\n\n" + "@code{make-promise} is a procedural form of @code{delay}.\n" + "These two expressions are equivalent:\n" + "@lisp\n" + "(delay @var{exp})\n" + "(make-promise (lambda () @var{exp}))\n" + "@end lisp\n") +#define FUNC_NAME s_scm_make_promise +{ + SCM_VALIDATE_THUNK (1, thunk); SCM_RETURN_NEWSMOB2 (scm_tc16_promise, - SCM_UNPACK (code), + SCM_UNPACK (thunk), scm_make_recursive_mutex ()); } +#undef FUNC_NAME static int |