aboutsummaryrefslogtreecommitdiff
path: root/src/guile.c
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2009-03-16 17:17:27 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2009-03-16 17:17:27 +0200
commit08057b45c5baad283f7132b64faa05018ff2f5f7 (patch)
treebbeefaa36b0542a25cfdf29cc68c71b03afd4d2f /src/guile.c
parent4385b872616eba08c2b8c8b7f465e81ff379b43c (diff)
downloadidest-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.c112
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

Return to:

Send suggestions and report system problems to the System administrator.