diff options
Diffstat (limited to 'gamma/eval.c')
-rw-r--r-- | gamma/eval.c | 71 |
1 files changed, 71 insertions, 0 deletions
diff --git a/gamma/eval.c b/gamma/eval.c new file mode 100644 index 0000000..1702ea0 --- /dev/null +++ b/gamma/eval.c @@ -0,0 +1,71 @@ +/* This file is part of Gamma. + Copyright (C) 2010, 2015 Sergey Poznyakoff + + Gamma is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + Gamma is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with Gamma. If not, see <http://www.gnu.org/licenses/>. */ + +#include "gamma-expat.h" + + +/* General-purpose eval handlers */ + +SCM +gamma_eval_catch_body(void *list) +{ + return scm_primitive_eval((SCM)list); +} + +static SCM +eval_catch_handler (void *data, SCM tag, SCM throw_args) +{ + scm_handle_by_message_noexit("gamma", tag, throw_args); + longjmp(*(jmp_buf*)data, 1); +} + +struct scheme_exec_data { + SCM (*handler) (void *data); + void *data; +}; + +static SCM +scheme_safe_exec_body (void *data) +{ + struct scheme_exec_data *ed = data; + return ed->handler(ed->data); +} + +int +gamma_safe_exec(SCM (*handler) (void *data), void *data, SCM *result) +{ + jmp_buf jmp_env; + struct scheme_exec_data ed; + SCM res; + + if (setjmp(jmp_env)) + exit(70); /* EX_SOFTWARE */ + ed.handler = handler; + ed.data = data; + res = scm_c_catch(SCM_BOOL_T, + scheme_safe_exec_body, (void*)&ed, + eval_catch_handler, &jmp_env, NULL, NULL); + if (result) + *result = res; + return 0; +} + +char * +gamma_proc_name(SCM proc) +{ + return scm_to_locale_string( + scm_symbol_to_string(scm_procedure_name(proc))); +} |