diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2009-03-16 17:17:27 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2009-03-16 17:17:27 +0200 |
commit | 08057b45c5baad283f7132b64faa05018ff2f5f7 (patch) | |
tree | bbeefaa36b0542a25cfdf29cc68c71b03afd4d2f /src/guile.c | |
parent | 4385b872616eba08c2b8c8b7f465e81ff379b43c (diff) | |
download | idest-08057b45c5baad283f7132b64faa05018ff2f5f7.tar.gz idest-08057b45c5baad283f7132b64faa05018ff2f5f7.tar.bz2 |
Add framework for Guile scripting.
* am/guile.m4: New file.
* Makefile.am (ACLOCAL_AMFLAGS): Add -I am
* configure.ac: Check for Guile.
* src/Makefile.am (idest_SOURCES): guile.c
(INCLUDES,LDADD): Add guile variables.
* src/cmdline.opt: New options: --script and --function.
* src/getopt.m4: Support conditional compilation.
* src/idest.h (guile_debug, guile_script, guile_function): New externs.
* src/guile.c: New file.
Diffstat (limited to 'src/guile.c')
-rw-r--r-- | src/guile.c | 112 |
1 files changed, 112 insertions, 0 deletions
diff --git a/src/guile.c b/src/guile.c new file mode 100644 index 0000000..3044db4 --- /dev/null +++ b/src/guile.c @@ -0,0 +1,112 @@ +/* This file is part of Idest. + Copyright (C) 2009 Sergey Poznyakoff + + Idest 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. + + Idest 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 Idest. If not, see <http://www.gnu.org/licenses/>. */ + +#include "idest.h" + +#ifdef GUILE_VERSION_NUMBER +#include <libguile.h> +#include <setjmp.h> + +int guile_debug = 1; +char *guile_script; +char *guile_function = "main"; + +static SCM +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("idest", tag, throw_args); + longjmp(*(jmp_buf*)data, 1); +} + +struct scheme_exec_data { + SCM (*handler) (void *data); + void *data; + SCM result; +}; + +static SCM +scheme_safe_exec_body (void *data) +{ + struct scheme_exec_data *ed = data; + ed->result = ed->handler (ed->data); + return SCM_BOOL_F; +} + +static int +guile_safe_exec(SCM (*handler) (void *data), void *data, SCM *result) +{ + jmp_buf jmp_env; + struct scheme_exec_data ed; + + if (setjmp(jmp_env)) + return 1; + ed.handler = handler; + ed.data = data; + scm_internal_lazy_catch(SCM_BOOL_T, + scheme_safe_exec_body, (void*)&ed, + eval_catch_handler, &jmp_env); + if (result) + *result = ed.result; + return 0; +} + +struct load_closure { + char *filename; + int argc; + char **argv; +}; + +static SCM +load_path_handler(void *data) +{ + struct load_closure *lp = data; + + scm_set_program_arguments(lp->argc, lp->argv, lp->filename); + scm_primitive_load_path(scm_makfrom0str(lp->filename)); + return SCM_UNDEFINED; +} + +static int +guile_load(char *filename) +{ + struct load_closure lc; + lc.argc = 0; + lc.argv = NULL; + lc.filename = filename; + return guile_safe_exec(load_path_handler, &lc, NULL); +} + +void +init_guile() +{ + if (!guile_script) + return; + if (guile_debug) { + SCM_DEVAL_P = 1; + SCM_BACKTRACE_P = 1; + SCM_RECORD_POSITIONS_P = 1; + SCM_RESET_DEBUG_MODE; + } + if (guile_load(guile_script)) + error(1, 0, "cannot load init script %s", guile_script); +} +#endif |