path: root/mixguile/xmixguile_cmd_dispatcher.c

/* -*-c-*- -------------- xmixguile_cmd_dispatcher.c :
 * Implementation of the functions declared in xmixguile_cmd_dispatcher.h
 * ------------------------------------------------------------------
 *  Last change: Time-stamp: "01/08/21 23:55:06 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *  
 */

#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;
  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);
  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);
}

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}
};