From ef4616f943c15d40cc2ff189b70e0ef6251af561 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 28 Aug 2001 16:38:06 +0000
Subject: guile integration
---
mixguile/Makefile.am | 3 +-
mixguile/mixguile.c | 46 +++++++++-
mixguile/mixguile.h | 13 ++-
mixguile/mixguile_cmd_dispatcher.c | 91 ++++++++++++++------
mixguile/mixguile_main.c | 23 +++--
mixguile/xmixguile_cmd_dispatcher.c | 163 ++++++++++++++++++++++++++++++++++++
6 files changed, 295 insertions(+), 44 deletions(-)
(limited to 'mixguile')
diff --git a/mixguile/Makefile.am b/mixguile/Makefile.am
index 392b08d..fed3371 100644
--- a/mixguile/Makefile.am
+++ b/mixguile/Makefile.am
@@ -22,14 +22,13 @@ SCM_PATHS = -DSCM_FILE=\""$(pkgdatadir)/mixguile.scm"\"\
-DLOCAL_SCM_FILE=\"mixguile.scm\"
pkgdata_DATA = $(SCM_FILES)
-
+INCLUDES = -I$(includedir) $(SCM_PATHS)
libmixguile_a_INCLUDES = -I$(includedir) -DG_LOG_DOMAIN=\"libmixguile\"
libmixguile_a_SOURCES = mixguile.h mixguile.c \
mixguile_cmd_dispatcher.h mixguile_cmd_dispatcher.c \
xmixguile_cmd_dispatcher.h xmixguile_cmd_dispatcher.c
bin_PROGRAMS = mixguile
-mixguile_INCLUDES = -I$(includedir) $(SCM_PATHS)
mixguile_LDADD = $(top_builddir)/mixlib/libmix.a \
$(top_builddir)/lib/libreplace.a \
$(top_builddir)/mixguile/libmixguile.a $(INTLLIBS)
diff --git a/mixguile/mixguile.c b/mixguile/mixguile.c
index 52321ca..4072869 100644
--- a/mixguile/mixguile.c
+++ b/mixguile/mixguile.c
@@ -21,31 +21,70 @@
*
*/
+#include <mixlib/mix_config.h>
#include "mixguile_cmd_dispatcher.h"
#include "mixguile.h"
static mixguile_cmd_dispatcher_t *dispatcher_ = NULL;
+static mix_vm_cmd_dispatcher_t *vm_dispatcher_ = NULL;
static main_func_t main_fun_;
/* do local initialisation and enter the user provided main */
+
static void
real_main_ (int argc, char *argv[])
{
+ if (vm_dispatcher_)
+ {
+ mixguile_set_cmd_dispatcher (vm_dispatcher_);
+ mixguile_load_bootstrap ();
+ }
(*main_fun_)(argc, argv);
}
/*
initialise the guile command dispatcher and enter the provided
- main function. the mixlib is also initialised.
+ main function.
*/
void
-mixguile_init (int argc, char *argv[], main_func_t main_fun)
+mixguile_init (int argc, char *argv[], main_func_t main_fun,
+ mix_vm_cmd_dispatcher_t *dis)
{
- mix_init_lib ();
main_fun_ = main_fun;
+ vm_dispatcher_ = dis;
gh_enter (argc, argv, real_main_);
}
+/* load bootstrap file */
+void
+mixguile_load_bootstrap (void)
+{
+ FILE *scm = NULL;
+ const gchar *scmfile = SCM_FILE;
+ gchar *lscmfile =
+ g_strconcat (g_get_home_dir (), G_DIR_SEPARATOR_S, MIX_CONFIG_DIR,
+ G_DIR_SEPARATOR_S, LOCAL_SCM_FILE, NULL);
+
+ if (!(scm = fopen (scmfile, "r"))
+ && !(scm = fopen ((scmfile = LOCAL_SCM_FILE), "r")))
+ {
+ g_warning ("mixguile bootstrap file %s not found\n", SCM_FILE);
+ scmfile = NULL;
+ }
+ else
+ fclose (scm);
+
+ if (scmfile) mixguile_interpret_file (scmfile);
+
+ if ((scm = fopen (lscmfile, "r")) != NULL)
+ {
+ fclose (scm);
+ mixguile_interpret_file (lscmfile);
+ }
+
+ g_free (lscmfile);
+}
+
/* enter the guile repl */
void
mixguile_enter_repl (int argc, char *argv[])
@@ -60,6 +99,7 @@ mixguile_set_cmd_dispatcher (mix_vm_cmd_dispatcher_t *dis)
{
g_return_if_fail (dis != NULL);
if (dispatcher_) mixguile_cmd_dispatcher_delete (dispatcher_);
+ vm_dispatcher_ = dis;
dispatcher_ = mixguile_cmd_dispatcher_new (dis);
g_assert (dispatcher_);
}
diff --git a/mixguile/mixguile.h b/mixguile/mixguile.h
index 8897d29..6cc7918 100644
--- a/mixguile/mixguile.h
+++ b/mixguile/mixguile.h
@@ -32,12 +32,21 @@
/* the main function type */
typedef void (*main_func_t) (int argc, char *argv[]);
+
+/* enter and do the initialisation manually inside the guile world */
+#define mixguile_enter(argc,argv,main_fun) gh_enter (argc, argv, main_fun)
+
+/* load mixguile startup file */
+extern void
+mixguile_load_bootstrap ();
+
/*
initialise the guile command dispatcher and enter the provided
- main function. the mixlib is also initialised.
+ main function.
*/
extern void
-mixguile_init (int argc, char *argv[], main_func_t main_fun);
+mixguile_init (int argc, char *argv[], main_func_t main_fun,
+ mix_vm_cmd_dispatcher_t *dis);
/* set the command dispatcher */
extern void
diff --git a/mixguile/mixguile_cmd_dispatcher.c b/mixguile/mixguile_cmd_dispatcher.c
index 4676c43..b55d0ed 100644
--- a/mixguile/mixguile_cmd_dispatcher.c
+++ b/mixguile/mixguile_cmd_dispatcher.c
@@ -30,14 +30,56 @@
#include "mixguile.h"
#include "xmixguile_cmd_dispatcher.h"
+#define SCM_CMD "scm"
+#define SCMF_CMD "scmf"
+
+/*local commands */
+static gboolean
+cmd_scm_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg)
+{
+ (void) gh_eval_str_with_catch ((char *)arg, scm_handle_by_message_noexit);
+ return TRUE;
+}
+
+static gboolean
+cmd_scmf_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg)
+{
+ (void) gh_eval_file_with_catch ((char *)arg, scm_handle_by_message_noexit);
+ return TRUE;
+}
+
+static mix_vm_command_info_t commands_[] = {
+ { SCM_CMD, cmd_scm_, N_("Eval Scheme command using Guile"), "scm COMMAND"},
+ { SCMF_CMD, cmd_scmf_, N_("Eval Scheme file using Guile"), "scm PATH"},
+ {NULL}
+};
+
/* create/destroy cmd dispatcher */
+static void
+make_pipe_ (mixguile_cmd_dispatcher_t *dis)
+{
+ int fildes[2], r;
+ FILE *out;
+ r = pipe (fildes);
+ g_return_if_fail (r == 0);
+ out = fdopen (fildes[1], "w");
+ g_return_if_fail (out != NULL);
+ r = fcntl (fildes[0], F_GETFL, 0);
+ g_return_if_fail (r != -1);
+ r = fcntl (fildes[0], F_SETFL, r | O_NONBLOCK);
+ g_return_if_fail (r != -1);
+
+ dis->guile_out = out;
+ dis->fildes[0] = fildes[0];
+ dis->fildes[1] = fildes[1];
+}
+
mixguile_cmd_dispatcher_t *
mixguile_cmd_dispatcher_new (mix_vm_cmd_dispatcher_t *dis)
{
static gboolean REGISTERED = FALSE;
mixguile_cmd_dispatcher_t *result = NULL;
- int fildes[2], r;
- FILE *out;
+ int k = 0;
g_return_val_if_fail (dis != NULL, NULL);
@@ -46,23 +88,19 @@ mixguile_cmd_dispatcher_new (mix_vm_cmd_dispatcher_t *dis)
register_scm_commands_ (DEFAULT_SCM_COMMANDS_);
REGISTERED = TRUE;
}
-
- r = pipe (fildes);
- g_return_val_if_fail (r == 0, NULL);
- out = fdopen (fildes[1], "w");
- g_return_val_if_fail (out != NULL, NULL);
- r = fcntl (fildes[0], F_GETFL, 0);
- g_return_val_if_fail (r != -1, NULL);
- r = fcntl (fildes[0], F_SETFL, r | O_NONBLOCK);
- g_return_val_if_fail (r != -1, NULL);
result = g_new (mixguile_cmd_dispatcher_t, 1);
result->dispatcher = dis;
result->err = result->out = NULL;
- result->guile_out = out;
- result->fildes[0] = fildes[0];
- result->fildes[1] = fildes[1];
result->result = NULL;
+ result->fildes[0] = result->fildes[1] = -1;
+ result->guile_out = NULL;
+
+ while (commands_[k].name)
+ {
+ mix_vm_cmd_dispatcher_register_new (dis, commands_ + k);
+ ++k;
+ }
register_cmd_dispatcher_ (result);
@@ -74,9 +112,12 @@ void
mixguile_cmd_dispatcher_delete (mixguile_cmd_dispatcher_t *dis)
{
g_return_if_fail (dis != NULL);
- fclose (dis->guile_out);
- close (dis->fildes[0]);
- close (dis->fildes[1]);
+ if (dis->guile_out)
+ {
+ fclose (dis->guile_out);
+ close (dis->fildes[0]);
+ close (dis->fildes[1]);
+ }
mix_vm_cmd_dispatcher_delete (dis->dispatcher);
}
@@ -99,6 +140,7 @@ mixguile_cmd_dispatcher_last_result (mixguile_cmd_dispatcher_t *dis)
gchar *tmp = NULL;
g_return_val_if_fail (dis != NULL, NULL);
+ if (!dis->guile_out) return NULL;
if (dis->result) g_free (dis->result);
dis->result = NULL;
fflush (dis->guile_out);
@@ -124,6 +166,7 @@ mixguile_cmd_dispatcher_last_result (mixguile_cmd_dispatcher_t *dis)
static void
prepare_dispatcher_ (mixguile_cmd_dispatcher_t *dis)
{
+ if (!dis->guile_out) make_pipe_ (dis);
dis->out = mix_vm_cmd_dispatcher_set_out_stream (dis->dispatcher,
dis->guile_out);
dis->err = mix_vm_cmd_dispatcher_set_error_stream (dis->dispatcher,
@@ -137,14 +180,14 @@ mixguile_cmd_dispatcher_prepare (mixguile_cmd_dispatcher_t *dis)
prepare_dispatcher_ (dis);
}
-/* interpret commands from file or string */
+/* interpret commands from file or string
static void
reset_dispatcher_ (mixguile_cmd_dispatcher_t *dis)
{
(void) mix_vm_cmd_dispatcher_set_out_stream (dis->dispatcher, dis->out);
(void) mix_vm_cmd_dispatcher_set_error_stream (dis->dispatcher, dis->err);
}
-
+*/
void
mixguile_cmd_dispatcher_interpret_file (mixguile_cmd_dispatcher_t *dis,
@@ -152,9 +195,8 @@ mixguile_cmd_dispatcher_interpret_file (mixguile_cmd_dispatcher_t *dis,
{
g_return_if_fail (dis != NULL);
g_return_if_fail (path != NULL);
- prepare_dispatcher_ (dis);
- (void) gh_eval_file ((char *)path);
- reset_dispatcher_ (dis);
+ mix_vm_cmd_dispatcher_dispatch_split_text (dis->dispatcher,
+ SCMF_CMD, path);
}
void
@@ -163,8 +205,7 @@ mixguile_cmd_dispatcher_interpret_command (mixguile_cmd_dispatcher_t *dis,
{
g_return_if_fail (dis != NULL);
g_return_if_fail (command != NULL);
- prepare_dispatcher_ (dis);
- (void) gh_eval_str ((char *)command);
- reset_dispatcher_ (dis);
+ mix_vm_cmd_dispatcher_dispatch_split_text (dis->dispatcher,
+ SCM_CMD, command);
}
diff --git a/mixguile/mixguile_main.c b/mixguile/mixguile_main.c
index de9bfa4..183dfaf 100644
--- a/mixguile/mixguile_main.c
+++ b/mixguile/mixguile_main.c
@@ -25,20 +25,19 @@
#include <stdio.h>
#include "mixguile.h"
-static void
-inner_main_ (int argc, char *argv[])
-{
- mix_vm_cmd_dispatcher_t *dis = mix_vm_cmd_dispatcher_new (stdout, stderr);
- mixguile_set_cmd_dispatcher (dis);
- mixguile_enter_repl (argc, argv);
-}
-
int
main (int argc, char *argv[])
{
- mixguile_init (argc, argv, inner_main_);
- return EXIT_SUCCESS; /* never reached */
-}
-
+ const gchar *CONFIG_FILE = "mixvm.config";
+ mix_config_t *config;
+ mix_vm_cmd_dispatcher_t *dis;
+
+
+ mix_init_lib ();
+ config = mix_config_new (NULL, CONFIG_FILE);
+ dis = mix_vm_cmd_dispatcher_new_with_config (stdout, stderr, config);
+ mixguile_init (argc, argv, mixguile_enter_repl, dis);
+ return EXIT_SUCCESS; /* never reached */
+}
diff --git a/mixguile/xmixguile_cmd_dispatcher.c b/mixguile/xmixguile_cmd_dispatcher.c
index 711bc52..744b76b 100644
--- a/mixguile/xmixguile_cmd_dispatcher.c
+++ b/mixguile/xmixguile_cmd_dispatcher.c
@@ -218,6 +218,12 @@ mix_set_over_ (SCM over)
return gh_symbol2scm ("ok");
}
+static SCM
+mix_loc_ (void)
+{
+ return gh_long2scm (mix_vm_get_prog_count (vm_));
+}
+
static SCM
mix_cmp_ (void)
{
@@ -261,6 +267,158 @@ mix_set_cmp_ (SCM value)
return gh_symbol2scm ("ok");
}
+/* ----- hook functions ---- */
+/* auxiliar arg list maker */
+static SCM
+make_arg_list_ (const gchar *arg)
+{
+ gchar **arglist = g_strsplit (arg, " ", -1);
+ SCM argument = gh_list (SCM_UNDEFINED);
+ if (arglist && arglist[0])
+ {
+ int k = 0;
+ while (arglist[k])
+ argument = gh_cons (gh_str02scm (arglist[k++]), argument);
+ argument = gh_reverse (argument);
+ }
+ g_strfreev (arglist);
+ return argument;
+}
+
+/* command hook auxiliar functions and types */
+/*
+static SCM
+hook_error_handler_ (void *data, SCM tag, SCM args)
+{
+ int len;
+ mix_vm_cmd_dispatcher_t *dis = (mix_vm_cmd_dispatcher_t *)dis;
+ gchar *argstr = gh_scm2newstr (args, &len);
+ fprintf (mix_vm_cmd_dispatcher_get_err_stream (dis), "Error in hook: %s\n",
+ argstr);
+ g_free (argstr);
+ return SCM_BOOL_T;
+}
+*/
+
+typedef struct
+{
+ SCM function;
+ SCM args;
+} hook_data_t;
+
+static SCM
+hook_catch_body_ (void *data)
+{
+ hook_data_t *h = (hook_data_t *)data;
+ return gh_call1 (h->function, h->args);
+}
+
+static void
+scm_hook_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg, gpointer data)
+{
+ hook_data_t h;
+ h.function = (SCM) data;
+ h.args = make_arg_list_ (arg);
+ gh_catch (SCM_BOOL_T, hook_catch_body_, &h,
+ scm_handle_by_message_noexit, dis);
+}
+
+/* global hook auxiliar functions and types */
+typedef struct
+{
+ SCM function;
+ SCM cmd;
+ SCM args;
+} global_hook_data_t;
+
+static SCM
+global_hook_catch_body_ (void *data)
+{
+ global_hook_data_t *h = (global_hook_data_t *)data;
+ return gh_call2 (h->function, h->cmd, h->args);
+}
+
+static void
+scm_global_hook_ (mix_vm_cmd_dispatcher_t *dis, mix_vm_command_t cmd,
+ const gchar *arg, gpointer data)
+{
+ global_hook_data_t h;
+ h.function = (SCM) data;
+ h.cmd = gh_str02scm ((char *)mix_vm_command_to_string (cmd));
+ h.args = make_arg_list_ (arg);
+ gh_catch (SCM_BOOL_T, global_hook_catch_body_, &h,
+ scm_handle_by_message_noexit, NULL);
+}
+
+static SCM
+mix_add_hook_ (SCM cmd, SCM function, gboolean pre)
+{
+ gchar *cmdstr = NULL;
+ mix_vm_command_t command;
+ int len;
+ const gchar *fun = pre? "mix-add-pre-hook" : "mix-add-post-hook";
+
+ SCM_ASSERT (SCM_STRINGP (cmd) || SCM_SYMBOLP (cmd), cmd, SCM_ARG1, fun);
+ SCM_ASSERT (gh_procedure_p (function), function, SCM_ARG2, fun);
+ SCM_DEFER_INTS;
+ cmdstr = gh_scm2newstr (cmd, &len);
+ command = mix_vm_command_from_string (cmdstr);
+ g_free (cmdstr);
+ SCM_ALLOW_INTS;
+ SCM_ASSERT (command != MIX_CMD_INVALID, cmd, SCM_ARG1, fun);
+ SCM_DEFER_INTS;
+ if (pre)
+ mix_vm_cmd_dispatcher_pre_hook (vm_dispatcher_, command,
+ scm_hook_, (gpointer) function);
+ else
+ mix_vm_cmd_dispatcher_post_hook (vm_dispatcher_, command,
+ scm_hook_, (gpointer) function);
+ SCM_ALLOW_INTS;
+ return gh_symbol2scm ("ok");
+}
+
+static SCM
+mix_add_global_hook_ (SCM function, gboolean pre)
+{
+ const gchar *fun =
+ pre? "mix-add-global-pre-hook" : "mix-add-global-post-hook";
+
+ SCM_ASSERT (gh_procedure_p (function), function, SCM_ARG1, fun);
+ SCM_DEFER_INTS;
+ if (pre)
+ mix_vm_cmd_dispatcher_global_pre_hook (vm_dispatcher_, scm_global_hook_,
+ (gpointer) function);
+ else
+ mix_vm_cmd_dispatcher_global_post_hook (vm_dispatcher_, scm_global_hook_,
+ (gpointer) function);
+ SCM_ALLOW_INTS;
+ return gh_symbol2scm ("ok");
+}
+
+static SCM
+mix_add_pre_hook_ (SCM cmd, SCM function)
+{
+ return mix_add_hook_ (cmd, function, TRUE);
+}
+
+static SCM
+mix_add_post_hook_ (SCM cmd, SCM function)
+{
+ return mix_add_hook_ (cmd, function, FALSE);
+}
+
+static SCM
+mix_add_global_pre_hook_ (SCM function)
+{
+ return mix_add_global_hook_ (function, TRUE);
+}
+
+static SCM
+mix_add_global_post_hook_ (SCM function)
+{
+ return mix_add_global_hook_ (function, FALSE);
+}
+
/* NULL-terminated list of available scm commands */
const scm_command_t DEFAULT_SCM_COMMANDS_[] = {
{"mixvm-cmd", mixvm_cmd_, 2, 0, 0},
@@ -269,8 +427,13 @@ const scm_command_t DEFAULT_SCM_COMMANDS_[] = {
{"mix-cell", mix_cell_, 1, 0, 0},
{"mix-set-cell!", mix_set_cell_, 2, 0, 0},
{"mix-over", mix_over_, 0, 0, 0},
+ {"mix-loc", mix_loc_, 0, 0, 0},
{"mix-set-over!", mix_set_over_, 1, 0, 0},
{"mix-cmp", mix_cmp_, 0, 0, 0},
{"mix-set-cmp!", mix_set_cmp_, 1, 0, 0},
+ {"mix-add-pre-hook", mix_add_pre_hook_, 2, 0, 0},
+ {"mix-add-post-hook", mix_add_post_hook_, 2, 0, 0},
+ {"mix-add-global-pre-hook", mix_add_global_pre_hook_, 1, 0, 0},
+ {"mix-add-global-post-hook", mix_add_global_post_hook_, 1, 0, 0},
{NULL}
};
--
cgit v1.2.3