diff options
| -rw-r--r-- | mixguile/xmixguile_cmd_dispatcher.c | 210 | 
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} +}; | 
