more commands

1 files changed, 198 insertions, 12 deletions

diff --git a/mixguile/xmixguile_cmd_dispatcher.c b/mixguile/xmixguile_cmd_dispatcher.c
index 38a1200..711bc52 100644
--- a/mixguile/xmixguile_cmd_dispatcher.c
+++ b/mixguile/xmixguile_cmd_dispatcher.c
@@ -28,6 +28,7 @@
 /* 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
@@ -51,19 +52,23 @@ 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
-mix_command_ (SCM cmd, SCM arg)
+mixvm_cmd_ (SCM cmd, SCM arg)
 {
-  char *com, *argu;
+  char *com = NULL, *argu = NULL;
   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;
-  SCM_ASSERT (SCM_STRINGP (cmd), cmd, SCM_ARG1, "mix-command");
-  SCM_ASSERT (SCM_STRINGP (arg), arg, SCM_ARG2, "mix-command");
   com = gh_scm2newstr (cmd, &len);
   argu = gh_scm2newstr (arg, &len);
   result = mix_vm_cmd_dispatcher_dispatch (vm_dispatcher_,
@@ -71,20 +76,201 @@ mix_command_ (SCM cmd, SCM arg)
 					   argu);
   g_free (com);
   g_free (argu);
-  SCM_ALLOW_INTS;
   com = (char *) mixguile_cmd_dispatcher_last_result (dispatcher_);
+  SCM_ALLOW_INTS;
+
   if (!com || strlen (com) == 0)
-    com = result? "ok" : "fail";
+    return gh_symbol2scm (result? "ok" : "fail");
   return gh_str02scm (com);
 }
 
-/* NULL-terminated list of available scm commands */
-const scm_command_t DEFAULT_SCM_COMMANDS_[] = {
-  {"mix-command", mix_command_, 2, 0, 0},
-  {NULL}
-};
+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;
+  int len;
+  long val = MIX_WORD_MAX + 1;
   
-    
+  SCM_ASSERT (SCM_STRINGP (reg) || SCM_SYMBOLP (reg), reg, SCM_ARG1, "mix-reg");
+
+  SCM_DEFER_INTS;
+  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;
+  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;
+  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_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;
+  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");
+}
+
+/* NULL-terminated list of available scm commands */
+const scm_command_t DEFAULT_SCM_COMMANDS_[] = {
+  {"mixvm-cmd", mixvm_cmd_, 2, 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-set-over!", mix_set_over_, 1, 0, 0},
+  {"mix-cmp", mix_cmp_, 0, 0, 0},
+  {"mix-set-cmp!", mix_set_cmp_, 1, 0, 0},
+  {NULL}
+};