new mixguile commands

5 files changed, 94 insertions, 146 deletions

diff --git a/mixguile/mixguile-commands.scm b/mixguile/mixguile-commands.scm
index 2615179..5d5c503 100644
--- a/mixguile/mixguile-commands.scm
+++ b/mixguile/mixguile-commands.scm
@@ -1,7 +1,7 @@
 ;; -*-scheme-*- -------------- mixguile-commands.scm :
 ;  mixvm commands implementation using the mixvm-cmd primitive
 ;  ------------------------------------------------------------------
-;   Last change: Time-stamp: "01/08/23 00:15:59 jao"
+;   Last change: Time-stamp: "01/09/01 01:01:02 jao"
 ;  ------------------------------------------------------------------
 ;  Copyright (C) 2001 Free Software Foundation, Inc.
 ;   
@@ -114,9 +114,11 @@
     (mixvm-cmd "compile" (argnsym->string file))))
 
 ; devdir
-(define mix-devdir
-  (lambda (. dir)
-    (mixvm-cmd "devdir" (argnsym->string dir))))
+(define mix-sddir
+  (lambda (dir)
+    (mixvm-cmd "sddir" dir)))
+
+(define mix-pddir (lambda () (mixvm-cmd "pddir" "")))
 
 ; edit
 (define mix-edit
@@ -126,7 +128,7 @@
 ; help
 (define mix-help
   (lambda (. cmd)
-    (mixvm-cmd "help" (argnsym->string help))))
+    (mixvm-cmd "help" (argnsym->string cmd))))
 
 ; pasm
 (define mix-pasm (lambda () (mixvm-cmd "pasm" "")))
@@ -149,6 +151,11 @@
   (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)
@@ -203,18 +210,21 @@
     (mixvm-cmd "pbt" (argnnum->string num))))
 
 ; timing
-(define mix-timing
-  (lambda (. on)
-    (mixvm-cmd "timing" (cond ((null? on) "")
-			       (on "on")
-			       (else "off")))))
+(define mix-stime
+  (lambda (on)
+    (mixvm-cmd "stime" (if on "on" "off"))))
+
+(define mix-ptime (lambda () (mixvm-cmd "ptime" "")))
 
 ; timing
-(define mix-tracing
-  (lambda (. on)
-    (mixvm-cmd "tracing" (cond ((null? on) "")
-			       (on "on")
-			       (else "off")))))
+(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
@@ -225,3 +235,10 @@
 (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_cmd_dispatcher.c b/mixguile/mixguile_cmd_dispatcher.c
index b55d0ed..df3c051 100644
--- a/mixguile/mixguile_cmd_dispatcher.c
+++ b/mixguile/mixguile_cmd_dispatcher.c
@@ -55,25 +55,6 @@ static mix_vm_command_info_t commands_[] = {
 };
   
 /* 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)
 {
@@ -91,10 +72,6 @@ mixguile_cmd_dispatcher_new (mix_vm_cmd_dispatcher_t *dis)
 
   result = g_new (mixguile_cmd_dispatcher_t, 1);
   result->dispatcher = dis;
-  result->err = result->out = NULL;
-  result->result = NULL;
-  result->fildes[0] = result->fildes[1] = -1;
-  result->guile_out = NULL;
   
   while (commands_[k].name)
     {
@@ -112,12 +89,6 @@ void
 mixguile_cmd_dispatcher_delete (mixguile_cmd_dispatcher_t *dis)
 {
   g_return_if_fail (dis != NULL);
-  if (dis->guile_out)
-    {
-      fclose (dis->guile_out);
-      close (dis->fildes[0]);
-      close (dis->fildes[1]);
-    }
   mix_vm_cmd_dispatcher_delete (dis->dispatcher);
 }
 
@@ -129,66 +100,6 @@ mixguile_cmd_dispatcher_get_vm_dispatcher (const mixguile_cmd_dispatcher_t *dis)
   return dis->dispatcher;
 }
 
-/* get the result string of last executed command */
-const gchar *
-mixguile_cmd_dispatcher_last_result (mixguile_cmd_dispatcher_t *dis)
-{
-  enum {BLKSIZE = 256};
-  static gchar BUFFER[BLKSIZE + 1];
-  
-  ssize_t k;
-  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);
-  while ((k = read (dis->fildes[0], BUFFER, BLKSIZE)) != 0)
-    {
-      if (k == -1 && errno != EINTR) break;
-      if (k != -1)
-	{
-	  tmp = dis->result;
-	  BUFFER[k] = '\0';
-	  dis->result = g_strconcat (tmp ? tmp : "", BUFFER, NULL);
-	  g_free (tmp);
-	}
-    }
-
-  if (dis->result && dis->result[strlen (dis->result) - 1] == '\n')
-    dis->result[strlen (dis->result) - 1] = '\0';
-  
-  return dis->result;
-}
-
-/* prepare dispatcher for repl */
-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,
-						     dis->guile_out);
-}
-
-void
-mixguile_cmd_dispatcher_prepare (mixguile_cmd_dispatcher_t *dis)
-{
-  g_return_if_fail (dis != NULL);
-  prepare_dispatcher_ (dis);
-}
-
-/* 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,
 					const gchar *path)
diff --git a/mixguile/mixguile_cmd_dispatcher.h b/mixguile/mixguile_cmd_dispatcher.h
index 4dba9d0..35ac5b7 100644
--- a/mixguile/mixguile_cmd_dispatcher.h
+++ b/mixguile/mixguile_cmd_dispatcher.h
@@ -43,14 +43,6 @@ extern mix_vm_cmd_dispatcher_t *
 mixguile_cmd_dispatcher_get_vm_dispatcher (const
 					   mixguile_cmd_dispatcher_t *disp);
 
-/* get the result string of last executed command */
-extern const gchar *
-mixguile_cmd_dispatcher_last_result (mixguile_cmd_dispatcher_t *disp);
-
-/* prepare dispatcher for repl */
-extern void
-mixguile_cmd_dispatcher_prepare (mixguile_cmd_dispatcher_t *dis);
-
 /* interpret commands from file or string */
 extern void
 mixguile_cmd_dispatcher_interpret_file (mixguile_cmd_dispatcher_t *dis,
diff --git a/mixguile/xmixguile_cmd_dispatcher.c b/mixguile/xmixguile_cmd_dispatcher.c
index 5590e5f..3e357a2 100644
--- a/mixguile/xmixguile_cmd_dispatcher.c
+++ b/mixguile/xmixguile_cmd_dispatcher.c
@@ -76,12 +76,10 @@ mixvm_cmd_ (SCM cmd, SCM arg)
 					   argu);
   g_free (com);
   g_free (argu);
-  com = (char *) mixguile_cmd_dispatcher_last_result (dispatcher_);
+
   SCM_ALLOW_INTS;
 
-  if (!com || strlen (com) == 0)
-    return gh_symbol2scm (result? "ok" : "fail");
-  return gh_str02scm (com);
+  return SCM_UNSPECIFIED;
 }
 
 static long
@@ -268,24 +266,10 @@ mix_set_cmp_ (SCM value)
 }
 
 static SCM
-mix_basename_ (const gchar *path)
-{
-  SCM result;
-  gchar *name;
-  if (!path) return gh_str02scm ("");
-  SCM_DEFER_INTS;
-  name = g_basename (path);
-  result = gh_str02scm (name);
-  g_free (name);
-  SCM_ALLOW_INTS;
-  return gh_str02scm (name);
-}
-
-static SCM
 mix_src_name_ (void)
 {
-  return
-    mix_basename_ (mix_vm_cmd_dispatcher_get_src_file_path (vm_dispatcher_));
+  const gchar *path = mix_vm_cmd_dispatcher_get_src_file_path (vm_dispatcher_);
+  return gh_str02scm (path? g_basename (path) : "");
 }
 
 static SCM
@@ -298,8 +282,8 @@ mix_src_path_ (void)
 static SCM
 mix_prog_name_ (void)
 {
-  return
-    mix_basename_ (mix_vm_cmd_dispatcher_get_program_path (vm_dispatcher_));
+  const gchar *path = mix_vm_cmd_dispatcher_get_program_path (vm_dispatcher_);
+  return gh_str02scm (path? g_basename (path) : "");
 }
 
 static SCM
@@ -309,6 +293,29 @@ mix_prog_path_ (void)
   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_));
+}
 
 
 /* ----- hook functions ---- */
@@ -317,7 +324,7 @@ static SCM
 make_arg_list_ (const gchar *arg)
 {
   gchar **arglist = g_strsplit (arg, " ", -1);
-  SCM argument = gh_list (SCM_UNDEFINED);
+  SCM argument = gh_list (SCM_UNDEFINED, SCM_EOL);
   if (arglist && arglist[0])
     {
       int k = 0;
@@ -352,7 +359,12 @@ 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);
 }
@@ -385,6 +397,18 @@ scm_global_hook_ (mix_vm_cmd_dispatcher_t *dis, mix_vm_command_t cmd,
 }
 
 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;
+  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;
@@ -402,11 +426,13 @@ mix_add_hook_ (SCM cmd, SCM function, gboolean pre)
   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);
+    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) function);
+    mix_vm_cmd_dispatcher_post_hook (vm_dispatcher_, command, scm_hook_,
+				     (gpointer)
+				     define_hook_procedure_ (function));
   SCM_ALLOW_INTS;
   return gh_symbol2scm ("ok");
 }
@@ -421,10 +447,12 @@ mix_add_global_hook_ (SCM function, gboolean pre)
   SCM_DEFER_INTS;
   if (pre)
     mix_vm_cmd_dispatcher_global_pre_hook (vm_dispatcher_, scm_global_hook_,
-					   (gpointer) function);
+					   (gpointer)
+					   define_hook_procedure_ (function));
   else
     mix_vm_cmd_dispatcher_global_post_hook (vm_dispatcher_, scm_global_hook_,
-					    (gpointer) function);
+					    (gpointer)
+					    define_hook_procedure_ (function));
   SCM_ALLOW_INTS;
   return gh_symbol2scm ("ok");
 }
@@ -464,10 +492,15 @@ const scm_command_t DEFAULT_SCM_COMMANDS_[] = {
   {"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, 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},
diff --git a/mixguile/xmixguile_cmd_dispatcher.h b/mixguile/xmixguile_cmd_dispatcher.h
index c399632..cfae23a 100644
--- a/mixguile/xmixguile_cmd_dispatcher.h
+++ b/mixguile/xmixguile_cmd_dispatcher.h
@@ -35,11 +35,6 @@
 struct mixguile_cmd_dispatcher_t 
 {
   mix_vm_cmd_dispatcher_t *dispatcher;
-  FILE *err;			/* the vm dispatcher err stream */
-  FILE *out;			/* the vm dispatcher out stream */
-  FILE *guile_out;		/* output file of the dispatcher */
-  int fildes[2];		/* pipe for communication with dispatcher */
-  gchar *result;		/* last result string */
 };
 
 /* scm commands types */