summaryrefslogtreecommitdiffhomepage
path: root/mixguile
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2006-03-20 22:46:46 +0000
committerJose Antonio Ortega Ruiz <jao@gnu.org>2006-03-20 22:46:46 +0000
commit300160e73da486946ae513f1d039dcd7b85ff17c (patch)
treef26691ff724b57dac450ab47e4eea91e63cdadc1 /mixguile
parent50375f34b611281a3b05a37221e2baa143f5f5ca (diff)
downloadmdk-300160e73da486946ae513f1d039dcd7b85ff17c.tar.gz
mdk-300160e73da486946ae513f1d039dcd7b85ff17c.tar.bz2
Version 1.2.1 imported1.2.1
git-archimport-id: mdk@sv.gnu.org/mdk--devel--1--patch-1
Diffstat (limited to 'mixguile')
-rw-r--r--mixguile/Makefile.am43
-rw-r--r--mixguile/mixguile-commands.scm254
-rw-r--r--mixguile/mixguile-vm-stat.scm71
-rw-r--r--mixguile/mixguile.c124
-rw-r--r--mixguile/mixguile.h72
-rw-r--r--mixguile/mixguile.scm25
-rw-r--r--mixguile/mixguile_cmd_dispatcher.c122
-rw-r--r--mixguile/mixguile_cmd_dispatcher.h57
-rw-r--r--mixguile/mixguile_main.c94
-rw-r--r--mixguile/xmixguile_cmd_dispatcher.c558
-rw-r--r--mixguile/xmixguile_cmd_dispatcher.h67
11 files changed, 1487 insertions, 0 deletions
diff --git a/mixguile/Makefile.am b/mixguile/Makefile.am
new file mode 100644
index 0000000..cdafcba
--- /dev/null
+++ b/mixguile/Makefile.am
@@ -0,0 +1,43 @@
+## Process this file with automake to produce Makefile.in
+
+# Copyright (C) 2001 Free Software Foundation, Inc.
+#
+# This file is free software; as a special exception the author gives
+# unlimited permission to copy and/or distribute it, with or without
+# modifications, as long as this notice is preserved.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
+# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+# $Id: Makefile.am,v 1.6 2001/09/30 20:29:30 jao Exp $
+
+SCM_FILES = mixguile.scm mixguile-commands.scm mixguile-vm-stat.scm
+EXTRA_DIST = $(SCM_FILES)
+
+noinst_LIBRARIES = libmixguile.a
+
+if MAKE_GUILE
+
+SCM_PATHS = -DSCM_FILE=\""$(pkgdatadir)/mixguile.scm"\"\
+ -DLOCAL_SCM_FILE=\"mixguile.scm\"
+
+pkgdata_DATA = $(SCM_FILES)
+INCLUDES = -I$(includedir) -I$(top_srcdir) $(SCM_PATHS)
+libmixguile_a_INCLUDES = -I$(includedir) -I$(top_srcdir) \
+ -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_LDADD = $(top_builddir)/mixlib/libmix.a \
+ $(top_builddir)/lib/libreplace.a \
+ $(top_builddir)/mixguile/libmixguile.a $(INTLLIBS)
+mixguile_SOURCES = mixguile_main.c
+
+else
+
+libmixguile_a_SOURCES =
+
+endif
diff --git a/mixguile/mixguile-commands.scm b/mixguile/mixguile-commands.scm
new file mode 100644
index 0000000..bc1aeb2
--- /dev/null
+++ b/mixguile/mixguile-commands.scm
@@ -0,0 +1,254 @@
+;; -*-scheme-*- -------------- mixguile-commands.scm :
+; mixvm commands implementation using the mixvm-cmd primitive
+; ------------------------------------------------------------------
+; $Id: mixguile-commands.scm,v 1.5 2005/09/20 19:43:14 jao Exp $
+; ------------------------------------------------------------------
+; Copyright (C) 2001 Free Software Foundation, Inc.
+;
+; This program 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 2 of the License, or
+; (at your option) any later version.
+;
+; This program 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 this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;
+;;
+
+;; auxiliar functions for argument conversion
+(define argsym->string
+ (lambda (arg)
+ (cond ((symbol? arg) (symbol->string arg))
+ ((string? arg) arg)
+ (else (error "Wrong argument type" arg)))))
+
+(define argnsym->string
+ (lambda (arg)
+ (cond ((null? arg) "")
+ ((pair? arg) (argsym->string (car arg)))
+ (else (argsym->string arg)))))
+
+(define argnum->string
+ (lambda (arg)
+ (cond ((number? arg) (number->string arg))
+ ((string? arg) arg)
+ (else (error "Wrong argument type" arg)))))
+
+(define argnnum->string
+ (lambda (arg)
+ (cond ((null? arg) "")
+ ((pair? arg) (argnum->string (car arg)))
+ (else (argnum->string arg)))))
+
+;;; mixvm commands
+
+; preg
+(define mix-preg
+ (lambda (. reg)
+ (mixvm-cmd "preg" (argnsym->string reg))))
+
+; sreg
+(define mix-sreg
+ (lambda (reg val) (mixvm-cmd "sreg" (string-append (argsym->string reg)
+ " "
+ (argnum->string val)))))
+
+; pmem
+(define mix-pmem
+ (lambda (from . to)
+ (cond ((null? to) (mixvm-cmd "pmem" (argnum->string from)))
+ (else (mixvm-cmd "pmem"
+ (string-append (argnum->string from)
+ "-"
+ (argnnum->string to)))))))
+
+; smem
+(define mix-smem
+ (lambda (cell val) (mixvm-cmd "smem" (string-append (argnum->string cell)
+ " "
+ (argnum->string val)))))
+
+; pall
+(define mix-pall (lambda () (mixvm-cmd "pall" "")))
+
+; pc
+(define mix-pc (lambda () (mixvm-cmd "pc" "")))
+
+; pflags
+(define mix-pflags (lambda () (mixvm-cmd "pflags" "")))
+
+; sover
+(define mix-sover
+ (lambda (val)
+ (mixvm-cmd "sover" (if val "T" "F"))))
+
+; psym
+(define mix-psym
+ (lambda (. sym)
+ (mixvm-cmd "psym" (argnsym->string sym))))
+
+; ssym
+(define mix-ssym
+ (lambda (sym value)
+ (mixvm-cmd "ssym"
+ (string-append
+ (argsym->string sym) " " (argnum->string value)))))
+
+; run
+(define mix-run
+ (lambda (. file)
+ (mixvm-cmd "run" (argnsym->string file))))
+
+; next
+(define mix-next
+ (lambda (. no)
+ (mixvm-cmd "next" (argnnum->string no))))
+
+; load
+(define mix-load
+ (lambda (file)
+ (mixvm-cmd "load" (argsym->string file))))
+
+; pstat
+(define mix-pstat (lambda () (mixvm-cmd "pstat" "")))
+
+; compile
+(define mix-compile
+ (lambda (. file)
+ (mixvm-cmd "compile" (argnsym->string file))))
+
+; devdir
+(define mix-sddir
+ (lambda (dir)
+ (mixvm-cmd "sddir" dir)))
+
+(define mix-pddir (lambda () (mixvm-cmd "pddir" "")))
+
+; edit
+(define mix-edit
+ (lambda (. file)
+ (mixvm-cmd "edit" (argnsym->string file))))
+
+; help
+(define mix-help
+ (lambda (. cmd)
+ (mixvm-cmd "help" (argnsym->string cmd))))
+
+; pasm
+(define mix-pasm (lambda () (mixvm-cmd "pasm" "")))
+
+; sasm
+(define mix-sasm
+ (lambda (path)
+ (mixvm-cmd "sasm" (argsym->string path))))
+
+; pedit
+(define mix-pedit (lambda () (mixvm-cmd "pedit" "")))
+
+; sedit
+(define mix-sedit
+ (lambda (path)
+ (mixvm-cmd "sedit" (argsym->string path))))
+
+; sbp
+(define mix-sbp
+ (lambda (line)
+ (mixvm-cmd "sbp" (argnum->string line))))
+
+; sbp
+(define mix-pline
+ (lambda (. no)
+ (mixvm-cmd "pline" (argnnum->string no))))
+
+; cbp
+(define mix-cbp
+ (lambda (line)
+ (mixvm-cmd "cbp" (argnum->string line))))
+
+; sbpa
+(define mix-sbpa
+ (lambda (addr)
+ (mixvm-cmd "sbpa" (argnum->string addr))))
+
+; cbpa
+(define mix-cbpa
+ (lambda (addr)
+ (mixvm-cmd "cbpa" (argnum->string addr))))
+
+
+; sbpc
+(define mix-sbpc (lambda () (mixvm-cmd "sbpc" "")))
+
+; cbpc
+(define mix-cbpc (lambda () (mixvm-cmd "cbpc" "")))
+
+; sbpo
+(define mix-sbpo (lambda () (mixvm-cmd "sbpo" "")))
+
+; cbpo
+(define mix-cbpo (lambda () (mixvm-cmd "cbpo" "")))
+
+; sbpm
+(define mix-sbpm
+ (lambda (cell)
+ (mixvm-cmd "sbpm" (argnum->string cell))))
+
+; cbpm
+(define mix-cbpm
+ (lambda (cell)
+ (mixvm-cmd "cbpm" (argnum->string cell))))
+
+; sbpr
+(define mix-sbpr
+ (lambda (reg)
+ (mixvm-cmd "sbpr" (argsym->string reg))))
+
+; cbpr
+(define mix-cbpr
+ (lambda (reg)
+ (mixvm-cmd "cbpr" (argsym->string reg))))
+
+; pbt
+(define mix-pbt
+ (lambda (. num)
+ (mixvm-cmd "pbt" (argnnum->string num))))
+
+; timing
+(define mix-stime
+ (lambda (on)
+ (mixvm-cmd "stime" (if on "on" "off"))))
+
+(define mix-ptime (lambda () (mixvm-cmd "ptime" "")))
+
+; timing
+(define mix-strace
+ (lambda (on)
+ (mixvm-cmd "strace" (if on "on" "off"))))
+
+; logging
+(define mix-slog
+ (lambda (on)
+ (mixvm-cmd "slog" (if on "on" "off"))))
+
+; w2d
+(define mix-w2d
+ (lambda (w)
+ (mixvm-cmd "w2d" w)));
+
+; weval
+(define mix-weval
+ (lambda (exp)
+ (mixvm-cmd "weval" (argsym->string exp))))
+
+; pprog
+(define mix-pprog (lambda () (mixvm-cmd "pprog" "")))
+
+; sprog
+(define mix-psrc (lambda () (mixvm-cmd "psrc" "")))
+
diff --git a/mixguile/mixguile-vm-stat.scm b/mixguile/mixguile-vm-stat.scm
new file mode 100644
index 0000000..1887b4c
--- /dev/null
+++ b/mixguile/mixguile-vm-stat.scm
@@ -0,0 +1,71 @@
+;; -*-scheme-*- -------------- mixguile-vm-stat.scm :
+; mixvm status functions
+; ------------------------------------------------------------------
+; $Id: mixguile-vm-stat.scm,v 1.4 2005/09/20 19:43:14 jao Exp $
+; ------------------------------------------------------------------
+; Copyright (C) 2001 Free Software Foundation, Inc.
+;
+; This program 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 2 of the License, or
+; (at your option) any later version.
+;
+; This program 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 this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;
+;;
+
+;; possible status index
+(define mix-status-values (vector 'MIX_ERROR
+ 'MIX_BREAK
+ 'MIX_COND_BREAK
+ 'MIX_HALTED
+ 'MIX_RUNNING
+ 'MIX_LOADED
+ 'MIX_EMPTY))
+;; return status as a simbol
+(define mix-vm-status (lambda () (vector-ref mix-status-values (mixvm-status))))
+
+;; check for a given status
+(define mix-vm-status?
+ (lambda (status) (eq? status (mix-vm-status))))
+
+;; predicates for each possible status
+(define mix-vm-error? (lambda () (mix-vm-status? 'MIX_ERROR)))
+(define mix-vm-break? (lambda () (mix-vm-status? 'MIX_BREAK)))
+(define mix-vm-cond-break? (lambda () (mix-vm-status? 'MIX_COND_BREAK)))
+(define mix-vm-halted? (lambda () (mix-vm-status? 'MIX_HALTED)))
+(define mix-vm-running? (lambda () (mix-vm-status? 'MIX_RUNNING)))
+(define mix-vm-loaded? (lambda () (mix-vm-status? 'MIX_LOADED)))
+(define mix-vm-empty? (lambda () (mix-vm-status? 'MIX_EMPTY)))
+
+
+;; define hooks on break conditions
+
+(define mix-make-conditional-hook
+ (lambda (test hook)
+ (lambda (arglist)
+ (if (test) (hook (mix-src-line-no) (mix-loc))))))
+
+(define mix-add-run-next-hook
+ (lambda (hook)
+ (mix-add-post-hook 'run hook)
+ (mix-add-post-hook 'next hook)))
+
+
+(define mix-add-break-hook
+ (lambda (hook)
+ (mix-add-run-next-hook (mix-make-conditional-hook mix-vm-break? hook))))
+
+(define mix-add-cond-break-hook
+ (lambda (hook)
+ (mix-add-run-next-hook (mix-make-conditional-hook
+ mix-vm-cond-break? hook))))
+
+
diff --git a/mixguile/mixguile.c b/mixguile/mixguile.c
new file mode 100644
index 0000000..f37424f
--- /dev/null
+++ b/mixguile/mixguile.c
@@ -0,0 +1,124 @@
+/* -*-c-*- -------------- mixguile.c :
+ * Implementation of the functions declared in mixguile.h
+ * ------------------------------------------------------------------
+ * $Id: mixguile.c,v 1.8 2005/09/20 19:43:14 jao Exp $
+ * ------------------------------------------------------------------
+ * Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+ *
+ * This program 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 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ */
+
+#include <unistd.h>
+
+#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_;
+static gboolean init_file_;
+
+/* 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 (init_file_);
+ }
+ (*main_fun_)(argc, argv);
+}
+
+/*
+ initialise the guile command dispatcher and enter the provided
+ main function.
+*/
+void
+mixguile_init (int argc, char *argv[], gboolean initfile,
+ main_func_t main_fun,
+ mix_vm_cmd_dispatcher_t *dis)
+{
+ main_fun_ = main_fun;
+ vm_dispatcher_ = dis;
+ init_file_ = initfile;
+ gh_enter (argc, argv, real_main_);
+}
+
+/* load bootstrap file */
+void
+mixguile_load_bootstrap (gboolean loadlocal)
+{
+ 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 (access (scmfile, R_OK) && access ((scmfile = LOCAL_SCM_FILE), R_OK))
+ {
+ g_warning (_("mixguile bootstrap file %s not found\n"), SCM_FILE);
+ scmfile = NULL;
+ }
+ else
+ mixguile_interpret_file (scmfile);
+
+ if (loadlocal && !access (lscmfile, R_OK))
+ {
+ mixguile_interpret_file (lscmfile);
+ }
+
+ g_free (lscmfile);
+}
+
+/* enter the guile repl */
+void
+mixguile_enter_repl (int argc, char *argv[])
+{
+ gh_repl (argc, argv);
+}
+
+/* set the command dispatcher */
+void
+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_);
+}
+
+/* access the mixguile comand dispatcher */
+mix_vm_cmd_dispatcher_t *
+mixguile_get_cmd_dispatcher (void)
+{
+ return mixguile_cmd_dispatcher_get_vm_dispatcher (dispatcher_);
+}
+
+/* execute a string or file using the guile interpreter */
+void
+mixguile_interpret_file (const gchar *path)
+{
+ mixguile_cmd_dispatcher_interpret_file (dispatcher_, path);
+}
+
+void
+mixguile_interpret_command (const gchar *command)
+{
+ mixguile_cmd_dispatcher_interpret_command (dispatcher_, command);
+}
diff --git a/mixguile/mixguile.h b/mixguile/mixguile.h
new file mode 100644
index 0000000..c2ef492
--- /dev/null
+++ b/mixguile/mixguile.h
@@ -0,0 +1,72 @@
+/* -*-c-*- ---------------- mixguile.h :
+ * Interface to the mixguile interpreter.
+ * ------------------------------------------------------------------
+ * $Id: mixguile.h,v 1.6 2005/09/20 19:43:14 jao Exp $
+ * ------------------------------------------------------------------
+ * Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program 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 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ */
+
+
+#ifndef MIXGUILE_H
+#define MIXGUILE_H
+
+#include <mixlib/mix.h>
+#include <mixlib/mix_vm_command.h>
+#include <guile/gh.h>
+
+/* 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 (gboolean localinit);
+
+/*
+ initialise the guile command dispatcher and enter the provided
+ main function.
+*/
+extern void
+mixguile_init (int argc, char *argv[], gboolean initfile, main_func_t main_fun,
+ mix_vm_cmd_dispatcher_t *dis);
+
+/* set the command dispatcher */
+extern void
+mixguile_set_cmd_dispatcher (mix_vm_cmd_dispatcher_t *dis);
+
+/* enter the guile repl */
+extern void
+mixguile_enter_repl (int argc, char *argv[]);
+
+/* access the comand dispatcher */
+extern mix_vm_cmd_dispatcher_t *
+mixguile_get_cmd_dispatcher (void);
+
+/* execute a string or file using the guile interpreter */
+extern void
+mixguile_interpret_file (const gchar *path);
+
+extern void
+mixguile_interpret_command (const gchar *command);
+
+
+#endif /* MIXGUILE_H */
+
diff --git a/mixguile/mixguile.scm b/mixguile/mixguile.scm
new file mode 100644
index 0000000..4e7dcbe
--- /dev/null
+++ b/mixguile/mixguile.scm
@@ -0,0 +1,25 @@
+;; -*-scheme-*- -------------- mixguile.scm :
+; mixguile bootstrap file
+; ------------------------------------------------------------------
+; Last change: Time-stamp: "01/09/05 01:05:29 jao"
+; ------------------------------------------------------------------
+; Copyright (C) 2001 Free Software Foundation, Inc.
+;
+; This program 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 2 of the License, or
+; (at your option) any later version.
+;
+; This program 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 this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;
+;;
+
+(load "mixguile-commands.scm")
+(load "mixguile-vm-stat.scm")
diff --git a/mixguile/mixguile_cmd_dispatcher.c b/mixguile/mixguile_cmd_dispatcher.c
new file mode 100644
index 0000000..2cc243b
--- /dev/null
+++ b/mixguile/mixguile_cmd_dispatcher.c
@@ -0,0 +1,122 @@
+/* -*-c-*- -------------- mixguile_cmd_dispatcher.c :
+ * Implementation of the functions declared in mixguile_cmd_dispatcher.h
+ * ------------------------------------------------------------------
+ * Last change: Time-stamp: "01/08/22 02:29:34 jao"
+ * ------------------------------------------------------------------
+ * Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program 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 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ */
+
+#include <stdio.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <errno.h>
+
+#include <guile/gh.h>
+#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 */
+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 k = 0;
+
+ g_return_val_if_fail (dis != NULL, NULL);
+
+ if (!REGISTERED)
+ {
+ register_scm_commands_ (DEFAULT_SCM_COMMANDS_);
+ REGISTERED = TRUE;
+ }
+
+ result = g_new (mixguile_cmd_dispatcher_t, 1);
+ result->dispatcher = dis;
+
+ while (commands_[k].name)
+ {
+ mix_vm_cmd_dispatcher_register_new (dis, commands_ + k);
+ ++k;
+ }
+
+ register_cmd_dispatcher_ (result);
+
+ return result;
+}
+
+
+void
+mixguile_cmd_dispatcher_delete (mixguile_cmd_dispatcher_t *dis)
+{
+ g_return_if_fail (dis != NULL);
+ mix_vm_cmd_dispatcher_delete (dis->dispatcher);
+}
+
+/* get the underlying vm dispatcher */
+mix_vm_cmd_dispatcher_t *
+mixguile_cmd_dispatcher_get_vm_dispatcher (const mixguile_cmd_dispatcher_t *dis)
+{
+ g_return_val_if_fail (dis != NULL, NULL);
+ return dis->dispatcher;
+}
+
+void
+mixguile_cmd_dispatcher_interpret_file (mixguile_cmd_dispatcher_t *dis,
+ const gchar *path)
+{
+ g_return_if_fail (dis != NULL);
+ g_return_if_fail (path != NULL);
+ mix_vm_cmd_dispatcher_dispatch_split_text (dis->dispatcher,
+ SCMF_CMD, path);
+}
+
+void
+mixguile_cmd_dispatcher_interpret_command (mixguile_cmd_dispatcher_t *dis,
+ const gchar *command)
+{
+ g_return_if_fail (dis != NULL);
+ g_return_if_fail (command != NULL);
+ mix_vm_cmd_dispatcher_dispatch_split_text (dis->dispatcher,
+ SCM_CMD, command);
+}
+
diff --git a/mixguile/mixguile_cmd_dispatcher.h b/mixguile/mixguile_cmd_dispatcher.h
new file mode 100644
index 0000000..1b10510
--- /dev/null
+++ b/mixguile/mixguile_cmd_dispatcher.h
@@ -0,0 +1,57 @@
+/* -*-c-*- ---------------- mixguile_cmd_dispatcher.h :
+ * Command dispatcher with guile support
+ * ------------------------------------------------------------------
+ * Last change: Time-stamp: <01/08/22 01:15:23 jao>
+ * ------------------------------------------------------------------
+ * Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program 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 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ */
+
+
+#ifndef MIXGUILE_CMD_DISPATCHER_H
+#define MIXGUILE_CMD_DISPATCHER_H
+
+#include <mixlib/mix.h>
+#include <mixlib/mix_vm_command.h>
+
+/* the guile command dispatcher type */
+typedef struct mixguile_cmd_dispatcher_t mixguile_cmd_dispatcher_t;
+
+/* create/destroy cmd dispatcher */
+extern mixguile_cmd_dispatcher_t *
+mixguile_cmd_dispatcher_new (mix_vm_cmd_dispatcher_t *dis);
+
+extern void
+mixguile_cmd_dispatcher_delete (mixguile_cmd_dispatcher_t *dis);
+
+/* get the underlying vm dispatcher */
+extern mix_vm_cmd_dispatcher_t *
+mixguile_cmd_dispatcher_get_vm_dispatcher (const
+ mixguile_cmd_dispatcher_t *disp);
+
+/* interpret commands from file or string */
+extern void
+mixguile_cmd_dispatcher_interpret_file (mixguile_cmd_dispatcher_t *dis,
+ const gchar *path);
+
+extern void
+mixguile_cmd_dispatcher_interpret_command (mixguile_cmd_dispatcher_t *dis,
+ const gchar *command);
+
+
+#endif /* MIXGUILE_CMD_DISPATCHER_H */
+
diff --git a/mixguile/mixguile_main.c b/mixguile/mixguile_main.c
new file mode 100644
index 0000000..22e65be
--- /dev/null
+++ b/mixguile/mixguile_main.c
@@ -0,0 +1,94 @@
+/* -*-c-*- -------------- mixguile_main.c :
+ * Main function for mixguile, the MIX Guile shell
+ * ------------------------------------------------------------------
+ * $Id: mixguile_main.c,v 1.6 2005/09/20 19:43:14 jao Exp $
+ * ------------------------------------------------------------------
+ * Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program 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 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include "mixguile.h"
+
+
+#ifdef HAVE_GETOPT_LONG
+# include <getopt.h>
+#else
+# include <lib/getopt.h>
+#endif /* HAVE_GETOPT_LONG */
+
+enum {
+ VER_OPT = 'v',
+ NOINIT_OPT = 'q',
+};
+
+static const char *options_ = "vq";
+
+static struct option long_options_[] =
+{
+ {"version", no_argument, 0, VER_OPT},
+ {0, 0, 0, 0}
+};
+
+int
+main (int argc, char *argv[])
+{
+ const gchar *CONFIG_FILE = "mixvm.config";
+ mix_config_t *config;
+ mix_vm_cmd_dispatcher_t *dis;
+ int c;
+
+ gboolean initfile = TRUE;
+
+ setlocale (LC_ALL, "");
+ bindtextdomain (PACKAGE, LOCALEDIR);
+ textdomain (PACKAGE);
+
+ /* prevent getopt printing a message for unknown options (stored in optopt) */
+ opterr = 0;
+
+ while (1)
+ {
+ c = getopt_long (argc, argv, options_, long_options_, (int*)0);
+
+ /* Detect the end of the options. */
+ if (c == -1)
+ break;
+
+ switch (c)
+ {
+ case VER_OPT:
+ mix_print_license ("mixguile, Scheme MIX Virtual Machine");
+ return EXIT_SUCCESS;
+ case NOINIT_OPT:
+ initfile = FALSE;
+ break;
+ default:
+ /* let guile try to understand the option */
+ break;
+ }
+ }
+
+ 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, initfile, mixguile_enter_repl, dis);
+
+ return EXIT_SUCCESS; /* never reached */
+}
diff --git a/mixguile/xmixguile_cmd_dispatcher.c b/mixguile/xmixguile_cmd_dispatcher.c
new file mode 100644
index 0000000..2ccd19c
--- /dev/null
+++ b/mixguile/xmixguile_cmd_dispatcher.c
@@ -0,0 +1,558 @@
+/* -*-c-*- -------------- xmixguile_cmd_dispatcher.c :
+ * Implementation of the functions declared in xmixguile_cmd_dispatcher.h
+ * ------------------------------------------------------------------
+ * $Id: xmixguile_cmd_dispatcher.c,v 1.14 2005/09/20 19:50:26 jao Exp $
+ * ------------------------------------------------------------------
+ * Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+ *
+ * This program 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 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ */
+
+#include <string.h>
+
+#include <mixlib/mix.h>
+#include <guile/gh.h>
+
+#include "xmixguile_cmd_dispatcher.h"
+
+/* cmd dispatcher for use within the scm commands */
+static mixguile_cmd_dispatcher_t *dispatcher_;
+static mix_vm_cmd_dispatcher_t *vm_dispatcher_;
+static mix_vm_t *vm_;
+
+/* register a NULL-terminated list of scm commands */
+void
+register_scm_commands_ (const scm_command_t *commands)
+{
+ int k = 0;
+ g_return_if_fail (commands != NULL);
+ while (commands[k].name)
+ {
+ gh_new_procedure (commands[k].name, commands[k].func,
+ commands[k].argno, commands[k].opt_argno,
+ commands[k].restp);
+ ++k;
+ }
+}
+
+/* register the mixvm cmd dispatcher to use with commands */
+void
+register_cmd_dispatcher_ (mixguile_cmd_dispatcher_t *dis)
+{
+ g_return_if_fail (dis != NULL);
+ dispatcher_ = dis;
+ vm_dispatcher_ = mixguile_cmd_dispatcher_get_vm_dispatcher (dis);
+ vm_ = (mix_vm_t *) mix_vm_cmd_dispatcher_get_vm (vm_dispatcher_);
+}
+
+/* commands */
+static SCM
+mixvm_cmd_ (SCM cmd, SCM arg)
+{
+ char *com = NULL, *argu = NULL;
+ unsigned int len;
+ gboolean result;
+
+ SCM_ASSERT (SCM_STRINGP (cmd) || SCM_SYMBOLP (cmd),
+ cmd, SCM_ARG1, "mixvm-cmd");
+ SCM_ASSERT (SCM_STRINGP (arg) || SCM_SYMBOLP (arg),
+ arg, SCM_ARG2, "mixvm-cmd");
+
+ SCM_DEFER_INTS;
+ com = gh_scm2newstr (cmd, &len);
+ argu = gh_scm2newstr (arg, &len);
+ result = mix_vm_cmd_dispatcher_dispatch (vm_dispatcher_,
+ mix_vm_command_from_string (com),
+ argu);
+ g_free (com);
+ g_free (argu);
+
+ SCM_ALLOW_INTS;
+
+ return SCM_UNSPECIFIED;
+}
+
+static SCM
+mixvm_status_ (void)
+{
+ return gh_long2scm (mix_vm_get_run_status (vm_));
+}
+
+static SCM
+mix_last_result_ (void)
+{
+ return gh_bool2scm (mix_vm_cmd_dispatcher_get_last_result (vm_dispatcher_));
+}
+
+static long
+word_to_long_ (mix_word_t word)
+{
+ long result = mix_word_magnitude (word);
+ return mix_word_is_negative (word) ? -result : result;
+}
+
+static long
+short_to_long_ (mix_short_t s)
+{
+ long result = mix_short_magnitude (s);
+ return mix_short_is_negative (s) ? -result : result;
+}
+
+static SCM
+mix_reg_ (SCM reg)
+{
+ char *regis;
+ unsigned int len;
+ long val = MIX_WORD_MAX + 1;
+
+ SCM_ASSERT (SCM_STRINGP (reg) || SCM_SYMBOLP (reg), reg, SCM_ARG1, "mix-reg");
+
+ SCM_DEFER_INTS;
+ if (SCM_SYMBOLP (reg)) reg = scm_symbol_to_string (reg);
+ regis = gh_scm2newstr (reg, &len);
+ switch (regis[0])
+ {
+ case 'A':
+ val = word_to_long_ (mix_vm_get_rA (vm_)); break;
+ case 'X':
+ val = word_to_long_ (mix_vm_get_rX (vm_)); break;
+ case 'J':
+ val = short_to_long_ (mix_vm_get_rJ (vm_)); break;
+ case 'I':
+ {
+ int i = regis[1] - '0';
+ if (i > 0 && i < 7) val = short_to_long_ (mix_vm_get_rI (vm_, i));
+ }
+ break;
+ default:
+ break;
+ }
+ g_free (regis);
+
+ SCM_ALLOW_INTS;
+
+ SCM_ASSERT (val <= MIX_WORD_MAX, reg, SCM_ARG1, "mix-reg");
+
+ return gh_long2scm (val);
+}
+
+static SCM
+mix_set_reg_ (SCM reg, SCM value)
+{
+ char *regis;
+ unsigned int len;
+ long val;
+ gboolean result = TRUE;
+
+ SCM_ASSERT (SCM_STRINGP (reg) || SCM_SYMBOLP (reg), reg, SCM_ARG1,
+ "mix-set-reg!");
+ SCM_ASSERT (SCM_NUMBERP (value), value, SCM_ARG2, "mix-set-reg!");
+
+ SCM_DEFER_INTS;
+ if (SCM_SYMBOLP (reg)) reg = scm_symbol_to_string (reg);
+ regis = gh_scm2newstr (reg, &len);
+ val = gh_scm2long (value);
+ switch (regis[0])
+ {
+ case 'A':
+ mix_vm_set_rA (vm_, mix_word_new (val)); break;
+ case 'X':
+ mix_vm_set_rX (vm_, mix_word_new (val)); break;
+ case 'J':
+ mix_vm_set_rJ (vm_, mix_short_new (val)); break;
+ case 'I':
+ {
+ int i = regis[1] - '0';
+ if (i > 0 && i < 7) mix_vm_set_rI (vm_, i, mix_short_new (val));
+ else result = FALSE;
+ }
+ break;
+ default:
+ result = FALSE; break;
+ }
+ g_free (regis);
+
+ SCM_ALLOW_INTS;
+
+ SCM_ASSERT (result, reg, SCM_ARG1, "mix-set-reg!");
+
+ return gh_symbol2scm ("ok");
+}
+
+static SCM
+mix_cell_ (SCM no)
+{
+ int cell;
+ long result;
+
+ SCM_ASSERT (SCM_NUMBERP (no), no, SCM_ARG1, "mix-cell");
+ cell = gh_scm2int (no);
+ SCM_ASSERT (cell < MIX_VM_CELL_NO, no, SCM_ARG1, "mix-cell");
+ result = word_to_long_ (mix_vm_get_addr_contents (vm_, cell));
+ return gh_long2scm (result);
+}
+
+static SCM
+mix_set_cell_ (SCM no, SCM val)
+{
+ int cell;
+ long result;
+
+ SCM_ASSERT (SCM_NUMBERP (no), no, SCM_ARG1, "mix-set-cell!");
+ SCM_ASSERT (SCM_NUMBERP (val), no, SCM_ARG2, "mix-set-cell!");
+ cell = gh_scm2int (no);
+ SCM_ASSERT (cell < MIX_VM_CELL_NO, no, SCM_ARG1, "mix-set-cell!");
+ result = gh_scm2long (val);
+ mix_vm_set_addr_contents (vm_, cell, mix_word_new (result));
+ return gh_symbol2scm ("ok");
+}
+
+static SCM
+mix_over_ (void)
+{
+ return gh_bool2scm (mix_vm_get_overflow (vm_));
+}
+
+static SCM
+mix_set_over_ (SCM over)
+{
+ mix_vm_set_overflow (vm_, gh_scm2bool (over));
+ return gh_symbol2scm ("ok");
+}
+
+static SCM
+mix_loc_ (void)
+{
+ return gh_long2scm (mix_vm_get_prog_count (vm_));
+}
+
+static SCM
+mix_cmp_ (void)
+{
+ gchar *result = NULL;
+ switch (mix_vm_get_cmpflag (vm_))
+ {
+ case mix_LESS: result = "L"; break;
+ case mix_EQ: result = "E"; break;
+ case mix_GREAT: result = "G"; break;
+ default: g_assert_not_reached ();
+ }
+ return gh_symbol2scm (result);
+}
+
+static SCM
+mix_set_cmp_ (SCM value)
+{
+ gchar *val = NULL;
+ unsigned int len;
+ mix_cmpflag_t result = -1;
+
+ SCM_ASSERT (SCM_STRINGP (value) || SCM_SYMBOLP (value), value, SCM_ARG1,
+ "mix-set-cmp!");
+
+ SCM_DEFER_INTS;
+ val = gh_scm2newstr (value, &len);
+ if (strlen (val) == 1)
+ {
+ switch (val[0])
+ {
+ case 'L': result = mix_LESS; break;
+ case 'E': result = mix_EQ; break;
+ case 'G': result = mix_GREAT; break;
+ default: break;
+ }
+ }
+ g_free (val);
+ SCM_ALLOW_INTS;
+ SCM_ASSERT (result != -1, value, SCM_ARG1, "mix-set-cmp!");
+ mix_vm_set_cmpflag (vm_, result);
+ return gh_symbol2scm ("ok");
+}
+
+static SCM
+mix_src_name_ (void)
+{
+ const gchar *path = mix_vm_cmd_dispatcher_get_src_file_path (vm_dispatcher_);
+ return gh_str02scm (path? g_path_get_basename (path) : "");
+}
+
+static SCM
+mix_src_path_ (void)
+{
+ const gchar *path = mix_vm_cmd_dispatcher_get_src_file_path (vm_dispatcher_);
+ return gh_str02scm (path? (char *)path : "");
+}
+
+static SCM
+mix_prog_name_ (void)
+{
+ const gchar *path = mix_vm_cmd_dispatcher_get_program_path (vm_dispatcher_);
+ return gh_str02scm (path? g_path_get_basename (path) : "");
+}
+
+static SCM
+mix_prog_path_ (void)
+{
+ const gchar *path = mix_vm_cmd_dispatcher_get_program_path (vm_dispatcher_);
+ return gh_str02scm (path? (char *)path : "");
+}
+
+static SCM
+mix_ddir_ (void)
+{
+ return gh_str02scm ((char *)mix_device_get_dir ());
+}
+
+static SCM
+mix_uptime_ (void)
+{
+ return gh_long2scm (mix_vm_cmd_dispatcher_get_uptime (vm_dispatcher_));
+}
+
+static SCM
+mix_progtime_ (void)
+{
+ return gh_long2scm (mix_vm_cmd_dispatcher_get_progtime (vm_dispatcher_));
+}
+
+static SCM
+mix_laptime_ (void)
+{
+ return gh_long2scm (mix_vm_cmd_dispatcher_get_laptime (vm_dispatcher_));
+}
+
+static SCM
+mix_src_line_ (SCM opt)
+{
+ gulong no = 0;
+ const gchar *line = "";
+ if (opt != SCM_UNDEFINED)
+ {
+ SCM_ASSERT (SCM_NUMBERP (opt), opt, SCM_ARG1, "mix-src-line");
+ no = gh_scm2long (opt);
+ }
+ else
+ no = mix_vm_cmd_dispatcher_get_src_file_lineno (vm_dispatcher_);
+
+ SCM_ASSERT (line >= 0, opt, SCM_ARG1, "mix-src-line");
+
+ if (no > 0)
+ line = mix_vm_cmd_dispatcher_get_src_file_line (vm_dispatcher_, no, FALSE);
+
+ return gh_str02scm ((char *)line);
+}
+
+static SCM
+mix_src_line_no_ (void)
+{
+ return
+ gh_long2scm (mix_vm_cmd_dispatcher_get_src_file_lineno (vm_dispatcher_));
+}
+
+/* ----- 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, SCM_EOL);
+ 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){}
+*/
+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;
+
+ g_assert (gh_procedure_p (h.function));
+
+ h.args = make_arg_list_ (arg);
+ g_assert (gh_list_p (h.args));
+
+ 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
+define_hook_procedure_ (SCM function)
+{
+ enum {BUFF_SIZE = 128};
+ static gchar BUFFER[BUFF_SIZE];
+ static const gchar *PATTERN = "____mix__hook__%d____";
+ static int K = 0;
+ g_snprintf (BUFFER, BUFF_SIZE, PATTERN, K++);
+ /* gh_define (name, val) returns a pair: (symbol . symbol-value) */
+ return gh_cdr (gh_define ((char *)BUFFER, function));
+}
+
+static SCM
+mix_add_hook_ (SCM cmd, SCM function, gboolean pre)
+{
+ gchar *cmdstr = NULL;
+ mix_vm_command_t command;
+ unsigned 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)
+ define_hook_procedure_ (function));
+ else
+ mix_vm_cmd_dispatcher_post_hook (vm_dispatcher_, command, scm_hook_,
+ (gpointer)
+ define_hook_procedure_ (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)
+ define_hook_procedure_ (function));
+ else
+ mix_vm_cmd_dispatcher_global_post_hook (vm_dispatcher_, scm_global_hook_,
+ (gpointer)
+ define_hook_procedure_ (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},
+ {"mixvm-status", mixvm_status_, 0, 0, 0},
+ {"mix-last-result", mix_last_result_, 0, 0, 0},
+ {"mix-reg", mix_reg_, 1, 0, 0},
+ {"mix-set-reg!", mix_set_reg_, 2, 0, 0},
+ {"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-up-time", mix_uptime_, 0, 0, 0},
+ {"mix-lap-time", mix_laptime_, 0, 0, 0},
+ {"mix-prog-time", mix_progtime_, 0, 0, 0},
+ {"mix-prog-name", mix_prog_name_, 0, 0, 0},
+ {"mix-prog-path", mix_prog_path_, 0, 0, 0},
+ {"mix-src-name", mix_src_name_, 0, 0, 0},
+ {"mix-src-path", mix_src_path_, 0, 0, 0},
+ {"mix-src-line-no", mix_src_line_no_, 0, 0, 0},
+ {"mix-src-line", mix_src_line_, 0, 1, 0},
+ {"mix-ddir", mix_ddir_, 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}
+};
diff --git a/mixguile/xmixguile_cmd_dispatcher.h b/mixguile/xmixguile_cmd_dispatcher.h
new file mode 100644
index 0000000..f7ef756
--- /dev/null
+++ b/mixguile/xmixguile_cmd_dispatcher.h
@@ -0,0 +1,67 @@
+/* -*-c-*- ---------------- xmixguile_cmd_dispatcher.h :
+ * Internal declarations for mixguile_cmd_dispatcher_t
+ * ------------------------------------------------------------------
+ * Last change: Time-stamp: <01/08/22 01:11:20 jao>
+ * ------------------------------------------------------------------
+ * Copyright (C) 2001 Free Software Foundation, Inc.
+ *
+ * This program 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 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ */
+
+
+#ifndef XMIXGUILE_CMD_DISPATCHER_H
+#define XMIXGUILE_CMD_DISPATCHER_H
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#include <guile/gh.h>
+#include "mixguile_cmd_dispatcher.h"
+
+/* the cmd dispatcher type */
+struct mixguile_cmd_dispatcher_t
+{
+ mix_vm_cmd_dispatcher_t *dispatcher;
+};
+
+/* scm commands types */
+/* prototype of a function implementing a new scm function */
+typedef SCM (*scm_func_t) ();
+
+/* record for a new scm command */
+typedef struct scm_command_t
+{
+ gchar *name; /* name of the scheme command */
+ scm_func_t func; /* implementation of the command */
+ int argno; /* no. of arguments */
+ int opt_argno; /* no. of optional arguments */
+ int restp; /* if 1, receive a list of remaining args */
+} scm_command_t;
+
+/* NULL-terminated list of available scm commands */
+extern const scm_command_t DEFAULT_SCM_COMMANDS_[];
+
+/* register a NULL-terminated list of scm commands */
+extern void
+register_scm_commands_ (const scm_command_t *commands);
+
+/* register the mixvm cmd dispatcher to use with commands */
+extern void
+register_cmd_dispatcher_ (mixguile_cmd_dispatcher_t *dis);
+
+
+#endif /* XMIXGUILE_CMD_DISPATCHER_H */
+