Add Guile as an extension language.

	* NEWS: Mention Guile scripting.
	* Makefile.in (SUBDIR_GUILE_OBS): New variable.
	(SUBDIR_GUILE_SRCS, SUBDIR_GUILE_DEPS): New variables
	(SUBDIR_GUILE_LDFLAGS, SUBDIR_GUILE_CFLAGS): New variables.
	(INTERNAL_CPPFLAGS): Add GUILE_CPPFLAGS.
	(CLIBS): Add GUILE_LIBS.
	(install-guile): New rule.
	(guile.o): New rule.
	(scm-arch.o, scm-auto-load.o, scm-block.o): New rules.
	(scm-breakpoint.o, scm-disasm.o, scm-exception.o): New rules.
	(scm-frame.o, scm-iterator.o, scm-lazy-string.o): New rules.
	(scm-math.o, scm-objfile.o, scm-ports.o): New rules.
	(scm-pretty-print.o, scm-safe-call.o, scm-gsmob.o): New rules.
	(scm-string.o, scm-symbol.o, scm-symtab.o): New rules.
	(scm-type.o, scm-utils.o, scm-value.o): New rules.
	* configure.ac: New option --with-guile.
	* configure: Regenerate.
	* config.in: Regenerate.
	* auto-load.c: Remove #include "python/python.h".  Add #include
	"gdb/section-scripts.h".
	(source_section_scripts): Handle Guile scripts.
	(_initialize_auto_load): Add name of Guile objfile script to
	scripts-directory help text.
	* breakpoint.c (condition_command): Tweak comment to include Scheme.
	* breakpoint.h (gdbscm_breakpoint_object): Add forward decl.
	(struct breakpoint): New member scm_bp_object.
	* defs.h (enum command_control_type): New value guile_control.
	* cli/cli-cmds.c: Remove #include "python/python.h".  Add #include
	"extension.h".
	(show_user): Update comment.
	(_initialize_cli_cmds): Update help text for "show user".  Update help
	text for max-user-call-depth.
	* cli/cli-script.c: Remove #include "python/python.h".  Add #include
	"extension.h".
	(multi_line_command_p): Add guile_control.
	(print_command_lines): Handle guile_control.
	(execute_control_command, recurse_read_control_structure): Ditto.
	(process_next_line): Recognize "guile" commands.
	* disasm.c (gdb_disassemble_info): Make non-static.
	* disasm.h: #include "dis-asm.h".
	(struct gdbarch): Add forward decl.
	(gdb_disassemble_info): Declare.
	* extension.c: #include "guile/guile.h".
	(extension_languages): Add guile.
	(get_ext_lang_defn): Handle EXT_LANG_GDB.
	* extension.h (enum extension_language): New value EXT_LANG_GUILE.
	* gdbtypes.c (get_unsigned_type_max): New function.
	(get_signed_type_minmax): New function.
	* gdbtypes.h (get_unsigned_type_max): Declare.
	(get_signed_type_minmax): Declare.
	* guile/README: New file.
	* guile/guile-internal.h: New file.
	* guile/guile.c: New file.
	* guile/guile.h: New file.
	* guile/scm-arch.c: New file.
	* guile/scm-auto-load.c: New file.
	* guile/scm-block.c: New file.
	* guile/scm-breakpoint.c: New file.
	* guile/scm-disasm.c: New file.
	* guile/scm-exception.c: New file.
	* guile/scm-frame.c: New file.
	* guile/scm-gsmob.c: New file.
	* guile/scm-iterator.c: New file.
	* guile/scm-lazy-string.c: New file.
	* guile/scm-math.c: New file.
	* guile/scm-objfile.c: New file.
	* guile/scm-ports.c: New file.
	* guile/scm-pretty-print.c: New file.
	* guile/scm-safe-call.c: New file.
	* guile/scm-string.c: New file.
	* guile/scm-symbol.c: New file.
	* guile/scm-symtab.c: New file.
	* guile/scm-type.c: New file.
	* guile/scm-utils.c: New file.
	* guile/scm-value.c: New file.
	* guile/lib/gdb.scm: New file.
	* guile/lib/gdb/boot.scm: New file.
	* guile/lib/gdb/experimental.scm: New file.
	* guile/lib/gdb/init.scm: New file.
	* guile/lib/gdb/iterator.scm: New file.
	* guile/lib/gdb/printing.scm: New file.
	* guile/lib/gdb/types.scm: New file.
	* data-directory/Makefile.in (GUILE_SRCDIR): New variable.
	(VPATH): Add $(GUILE_SRCDIR).
	(GUILE_DIR): New variable.
	(GUILE_INSTALL_DIR, GUILE_FILES): New variables.
	(all): Add stamp-guile dependency.
	(stamp-guile): New rule.
	(clean-guile, install-guile, uninstall-guile): New rules.
	(install-only): Add install-guile dependency.
	(uninstall): Add uninstall-guile dependency.
	(clean): Add clean-guile dependency.

	doc/
	* Makefile.in (GDB_DOC_FILES): Add guile.texi.
	* gdb.texinfo (Auto-loading): Add set/show auto-load guile-scripts.
	(Extending GDB): New menu entries Guile, Multiple Extension Languages.
	(Guile docs): Include guile.texi.
	(objfile-gdbdotext file): Add objfile-gdb.scm.
	(dotdebug_gdb_scripts section): Mention Guile scripts.
	(Multiple Extension Languages): New node.
	* guile.texi: New file.

	testsuite/
	* configure.ac (AC_OUTPUT): Add gdb.guile.
	* configure: Regenerate.
	* lib/gdb-guile.exp: New file.
	* lib/gdb.exp (get_target_charset): New function.
	* gdb.base/help.exp: Update expected output from "apropos apropos".
	* gdb.guile/Makefile.in: New file.
	* gdb.guile/guile.exp: New file.
	* gdb.guile/scm-arch.c: New file.
	* gdb.guile/scm-arch.exp: New file.
	* gdb.guile/scm-block.c: New file.
	* gdb.guile/scm-block.exp: New file.
	* gdb.guile/scm-breakpoint.c: New file.
	* gdb.guile/scm-breakpoint.exp: New file.
	* gdb.guile/scm-disasm.c: New file.
	* gdb.guile/scm-disasm.exp: New file.
	* gdb.guile/scm-equal.c: New file.
	* gdb.guile/scm-equal.exp: New file.
	* gdb.guile/scm-error.exp: New file.
	* gdb.guile/scm-error.scm: New file.
	* gdb.guile/scm-frame-args.c: New file.
	* gdb.guile/scm-frame-args.exp: New file.
	* gdb.guile/scm-frame-args.scm: New file.
	* gdb.guile/scm-frame-inline.c: New file.
	* gdb.guile/scm-frame-inline.exp: New file.
	* gdb.guile/scm-frame.c: New file.
	* gdb.guile/scm-frame.exp: New file.
	* gdb.guile/scm-generics.exp: New file.
	* gdb.guile/scm-gsmob.exp: New file.
	* gdb.guile/scm-iterator.c: New file.
	* gdb.guile/scm-iterator.exp: New file.
	* gdb.guile/scm-math.c: New file.
	* gdb.guile/scm-math.exp: New file.
	* gdb.guile/scm-objfile-script-gdb.in: New file.
	* gdb.guile/scm-objfile-script.c: New file.
	* gdb.guile/scm-objfile-script.exp: New file.
	* gdb.guile/scm-objfile.c: New file.
	* gdb.guile/scm-objfile.exp: New file.
	* gdb.guile/scm-ports.exp: New file.
	* gdb.guile/scm-pretty-print.c: New file.
	* gdb.guile/scm-pretty-print.exp: New file.
	* gdb.guile/scm-pretty-print.scm: New file.
	* gdb.guile/scm-section-script.c: New file.
	* gdb.guile/scm-section-script.exp: New file.
	* gdb.guile/scm-section-script.scm: New file.
	* gdb.guile/scm-symbol.c: New file.
	* gdb.guile/scm-symbol.exp: New file.
	* gdb.guile/scm-symtab-2.c: New file.
	* gdb.guile/scm-symtab.c: New file.
	* gdb.guile/scm-symtab.exp: New file.
	* gdb.guile/scm-type.c: New file.
	* gdb.guile/scm-type.exp: New file.
	* gdb.guile/scm-value-cc.cc: New file.
	* gdb.guile/scm-value-cc.exp: New file.
	* gdb.guile/scm-value.c: New file.
	* gdb.guile/scm-value.exp: New file.
	* gdb.guile/source2.scm: New file.
	* gdb.guile/types-module.cc: New file.
	* gdb.guile/types-module.exp: New file.

1 files changed, 998 insertions, 0 deletions

diff --git a/gdb/guile/scm-math.c b/gdb/guile/scm-math.c
new file mode 100644
index 0000000..80e1673
--- /dev/null
+++ b/gdb/guile/scm-math.c
@@ -0,0 +1,998 @@
+/* GDB/Scheme support for math operations on values.
+
+   Copyright (C) 2008-2014 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   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 3 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, see <http://www.gnu.org/licenses/>.  */
+
+/* See README file in this directory for implementation notes, coding
+   conventions, et.al.  */
+
+#include "defs.h"
+#include "arch-utils.h"
+#include "charset.h"
+#include "cp-abi.h"
+#include "doublest.h" /* Needed by dfp.h.  */
+#include "expression.h" /* Needed by dfp.h.  */
+#include "dfp.h"
+#include "gdb_assert.h"
+#include "symtab.h" /* Needed by language.h.  */
+#include "language.h"
+#include "valprint.h"
+#include "value.h"
+#include "guile-internal.h"
+
+/* Note: Use target types here to remain consistent with the values system in
+   GDB (which uses target arithmetic).  */
+
+enum valscm_unary_opcode
+{
+  VALSCM_NOT,
+  VALSCM_NEG,
+  VALSCM_NOP,
+  VALSCM_ABS,
+  /* Note: This is Scheme's "logical not", not GDB's.
+     GDB calls this UNOP_COMPLEMENT.  */
+  VALSCM_LOGNOT
+};
+
+enum valscm_binary_opcode
+{
+  VALSCM_ADD,
+  VALSCM_SUB,
+  VALSCM_MUL,
+  VALSCM_DIV,
+  VALSCM_REM,
+  VALSCM_MOD,
+  VALSCM_POW,
+  VALSCM_LSH,
+  VALSCM_RSH,
+  VALSCM_MIN,
+  VALSCM_MAX,
+  VALSCM_BITAND,
+  VALSCM_BITOR,
+  VALSCM_BITXOR
+};
+
+/* If TYPE is a reference, return the target; otherwise return TYPE.  */
+#define STRIP_REFERENCE(TYPE) \
+  ((TYPE_CODE (TYPE) == TYPE_CODE_REF) ? (TYPE_TARGET_TYPE (TYPE)) : (TYPE))
+
+/* Returns a value object which is the result of applying the operation
+   specified by OPCODE to the given argument.
+   If there's an error a Scheme exception is thrown.  */
+
+static SCM
+vlscm_unop (enum valscm_unary_opcode opcode, SCM x, const char *func_name)
+{
+  struct gdbarch *gdbarch = get_current_arch ();
+  const struct language_defn *language = current_language;
+  struct value *arg1;
+  SCM result = SCM_BOOL_F;
+  struct value *res_val = NULL;
+  SCM except_scm;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
+					  &except_scm, gdbarch, language);
+  if (arg1 == NULL)
+    {
+      do_cleanups (cleanups);
+      gdbscm_throw (except_scm);
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      switch (opcode)
+	{
+	case VALSCM_NOT:
+	  /* Alas gdb and guile use the opposite meaning for "logical not".  */
+	  {
+	    struct type *type = language_bool_type (language, gdbarch);
+	    res_val
+	      = value_from_longest (type, (LONGEST) value_logical_not (arg1));
+	  }
+	  break;
+	case VALSCM_NEG:
+	  res_val = value_neg (arg1);
+	  break;
+	case VALSCM_NOP:
+	  /* Seemingly a no-op, but if X was a Scheme value it is now
+	     a <gdb:value> object.  */
+	  res_val = arg1;
+	  break;
+	case VALSCM_ABS:
+	  if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
+	    res_val = value_neg (arg1);
+	  else
+	    res_val = arg1;
+	  break;
+	case VALSCM_LOGNOT:
+	  res_val = value_complement (arg1);
+	  break;
+	default:
+	  gdb_assert_not_reached ("unsupported operation");
+	}
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+
+  gdb_assert (res_val != NULL);
+  result = vlscm_scm_from_value (res_val);
+
+  do_cleanups (cleanups);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+
+  return result;
+}
+
+/* Returns a value object which is the result of applying the operation
+   specified by OPCODE to the given arguments.
+   If there's an error a Scheme exception is thrown.  */
+
+static SCM
+vlscm_binop (enum valscm_binary_opcode opcode, SCM x, SCM y,
+	     const char *func_name)
+{
+  struct gdbarch *gdbarch = get_current_arch ();
+  const struct language_defn *language = current_language;
+  struct value *arg1, *arg2;
+  SCM result = SCM_BOOL_F;
+  struct value *res_val = NULL;
+  SCM except_scm;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
+					  &except_scm, gdbarch, language);
+  if (arg1 == NULL)
+    {
+      do_cleanups (cleanups);
+      gdbscm_throw (except_scm);
+    }
+  arg2 = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y,
+					  &except_scm, gdbarch, language);
+  if (arg2 == NULL)
+    {
+      do_cleanups (cleanups);
+      gdbscm_throw (except_scm);
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      switch (opcode)
+	{
+	case VALSCM_ADD:
+	  {
+	    struct type *ltype = value_type (arg1);
+	    struct type *rtype = value_type (arg2);
+
+	    CHECK_TYPEDEF (ltype);
+	    ltype = STRIP_REFERENCE (ltype);
+	    CHECK_TYPEDEF (rtype);
+	    rtype = STRIP_REFERENCE (rtype);
+
+	    if (TYPE_CODE (ltype) == TYPE_CODE_PTR
+		&& is_integral_type (rtype))
+	      res_val = value_ptradd (arg1, value_as_long (arg2));
+	    else if (TYPE_CODE (rtype) == TYPE_CODE_PTR
+		     && is_integral_type (ltype))
+	      res_val = value_ptradd (arg2, value_as_long (arg1));
+	    else
+	      res_val = value_binop (arg1, arg2, BINOP_ADD);
+	  }
+	  break;
+	case VALSCM_SUB:
+	  {
+	    struct type *ltype = value_type (arg1);
+	    struct type *rtype = value_type (arg2);
+
+	    CHECK_TYPEDEF (ltype);
+	    ltype = STRIP_REFERENCE (ltype);
+	    CHECK_TYPEDEF (rtype);
+	    rtype = STRIP_REFERENCE (rtype);
+
+	    if (TYPE_CODE (ltype) == TYPE_CODE_PTR
+		&& TYPE_CODE (rtype) == TYPE_CODE_PTR)
+	      {
+		/* A ptrdiff_t for the target would be preferable here.  */
+		res_val
+		  = value_from_longest (builtin_type (gdbarch)->builtin_long,
+					value_ptrdiff (arg1, arg2));
+	      }
+	    else if (TYPE_CODE (ltype) == TYPE_CODE_PTR
+		     && is_integral_type (rtype))
+	      res_val = value_ptradd (arg1, - value_as_long (arg2));
+	    else
+	      res_val = value_binop (arg1, arg2, BINOP_SUB);
+	  }
+	  break;
+	case VALSCM_MUL:
+	  res_val = value_binop (arg1, arg2, BINOP_MUL);
+	  break;
+	case VALSCM_DIV:
+	  res_val = value_binop (arg1, arg2, BINOP_DIV);
+	  break;
+	case VALSCM_REM:
+	  res_val = value_binop (arg1, arg2, BINOP_REM);
+	  break;
+	case VALSCM_MOD:
+	  res_val = value_binop (arg1, arg2, BINOP_MOD);
+	  break;
+	case VALSCM_POW:
+	  res_val = value_binop (arg1, arg2, BINOP_EXP);
+	  break;
+	case VALSCM_LSH:
+	  res_val = value_binop (arg1, arg2, BINOP_LSH);
+	  break;
+	case VALSCM_RSH:
+	  res_val = value_binop (arg1, arg2, BINOP_RSH);
+	  break;
+	case VALSCM_MIN:
+	  res_val = value_binop (arg1, arg2, BINOP_MIN);
+	  break;
+	case VALSCM_MAX:
+	  res_val = value_binop (arg1, arg2, BINOP_MAX);
+	  break;
+	case VALSCM_BITAND:
+	  res_val = value_binop (arg1, arg2, BINOP_BITWISE_AND);
+	  break;
+	case VALSCM_BITOR:
+	  res_val = value_binop (arg1, arg2, BINOP_BITWISE_IOR);
+	  break;
+	case VALSCM_BITXOR:
+	  res_val = value_binop (arg1, arg2, BINOP_BITWISE_XOR);
+	  break;
+	default:
+	  gdb_assert_not_reached ("unsupported operation");
+	}
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+
+  gdb_assert (res_val != NULL);
+  result = vlscm_scm_from_value (res_val);
+
+  do_cleanups (cleanups);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+
+  return result;
+}
+
+/* (value-add x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_add (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_ADD, x, y, FUNC_NAME);
+}
+
+/* (value-sub x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_sub (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_SUB, x, y, FUNC_NAME);
+}
+
+/* (value-mul x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_mul (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_MUL, x, y, FUNC_NAME);
+}
+
+/* (value-div x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_div (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_DIV, x, y, FUNC_NAME);
+}
+
+/* (value-rem x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_rem (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_REM, x, y, FUNC_NAME);
+}
+
+/* (value-mod x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_mod (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_MOD, x, y, FUNC_NAME);
+}
+
+/* (value-pow x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_pow (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_POW, x, y, FUNC_NAME);
+}
+
+/* (value-neg x) -> <gdb:value> */
+
+static SCM
+gdbscm_value_neg (SCM x)
+{
+  return vlscm_unop (VALSCM_NEG, x, FUNC_NAME);
+}
+
+/* (value-pos x) -> <gdb:value> */
+
+static SCM
+gdbscm_value_pos (SCM x)
+{
+  return vlscm_unop (VALSCM_NOP, x, FUNC_NAME);
+}
+
+/* (value-abs x) -> <gdb:value> */
+
+static SCM
+gdbscm_value_abs (SCM x)
+{
+  return vlscm_unop (VALSCM_ABS, x, FUNC_NAME);
+}
+
+/* (value-lsh x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_lsh (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_LSH, x, y, FUNC_NAME);
+}
+
+/* (value-rsh x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_rsh (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_RSH, x, y, FUNC_NAME);
+}
+
+/* (value-min x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_min (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_MIN, x, y, FUNC_NAME);
+}
+
+/* (value-max x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_max (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_MAX, x, y, FUNC_NAME);
+}
+
+/* (value-not x) -> <gdb:value> */
+
+static SCM
+gdbscm_value_not (SCM x)
+{
+  return vlscm_unop (VALSCM_NOT, x, FUNC_NAME);
+}
+
+/* (value-lognot x) -> <gdb:value> */
+
+static SCM
+gdbscm_value_lognot (SCM x)
+{
+  return vlscm_unop (VALSCM_LOGNOT, x, FUNC_NAME);
+}
+
+/* (value-logand x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_logand (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_BITAND, x, y, FUNC_NAME);
+}
+
+/* (value-logior x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_logior (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_BITOR, x, y, FUNC_NAME);
+}
+
+/* (value-logxor x y) -> <gdb:value> */
+
+static SCM
+gdbscm_value_logxor (SCM x, SCM y)
+{
+  return vlscm_binop (VALSCM_BITXOR, x, y, FUNC_NAME);
+}
+
+/* Utility to perform all value comparisons.
+   If there's an error a Scheme exception is thrown.  */
+
+static SCM
+vlscm_rich_compare (int op, SCM x, SCM y, const char *func_name)
+{
+  struct gdbarch *gdbarch = get_current_arch ();
+  const struct language_defn *language = current_language;
+  struct value *v1, *v2;
+  int result = 0;
+  SCM except_scm;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  v1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
+					&except_scm, gdbarch, language);
+  if (v1 == NULL)
+    {
+      do_cleanups (cleanups);
+      gdbscm_throw (except_scm);
+    }
+  v2 = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y,
+					&except_scm, gdbarch, language);
+  if (v2 == NULL)
+    {
+      do_cleanups (cleanups);
+      gdbscm_throw (except_scm);
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      switch (op)
+	{
+        case BINOP_LESS:
+	  result = value_less (v1, v2);
+	  break;
+	case BINOP_LEQ:
+	  result = (value_less (v1, v2)
+		    || value_equal (v1, v2));
+	  break;
+	case BINOP_EQUAL:
+	  result = value_equal (v1, v2);
+	  break;
+	case BINOP_NOTEQUAL:
+	  gdb_assert_not_reached ("not-equal not implemented");
+        case BINOP_GTR:
+	  result = value_less (v2, v1);
+	  break;
+	case BINOP_GEQ:
+	  result = (value_less (v2, v1)
+		    || value_equal (v1, v2));
+	  break;
+	default:
+	  gdb_assert_not_reached ("invalid <gdb:value> comparison");
+      }
+    }
+  do_cleanups (cleanups);
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return scm_from_bool (result);
+}
+
+/* (value=? x y) -> boolean
+   There is no "not-equal?" function (value!= ?) on purpose.
+   We're following string=?, etc. as our Guide here.  */
+
+static SCM
+gdbscm_value_eq_p (SCM x, SCM y)
+{
+  return vlscm_rich_compare (BINOP_EQUAL, x, y, FUNC_NAME);
+}
+
+/* (value<? x y) -> boolean */
+
+static SCM
+gdbscm_value_lt_p (SCM x, SCM y)
+{
+  return vlscm_rich_compare (BINOP_LESS, x, y, FUNC_NAME);
+}
+
+/* (value<=? x y) -> boolean */
+
+static SCM
+gdbscm_value_le_p (SCM x, SCM y)
+{
+  return vlscm_rich_compare (BINOP_LEQ, x, y, FUNC_NAME);
+}
+
+/* (value>? x y) -> boolean */
+
+static SCM
+gdbscm_value_gt_p (SCM x, SCM y)
+{
+  return vlscm_rich_compare (BINOP_GTR, x, y, FUNC_NAME);
+}
+
+/* (value>=? x y) -> boolean */
+
+static SCM
+gdbscm_value_ge_p (SCM x, SCM y)
+{
+  return vlscm_rich_compare (BINOP_GEQ, x, y, FUNC_NAME);
+}
+
+/* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
+   Convert OBJ, a Scheme number, to a <gdb:value> object.
+   OBJ_ARG_POS is its position in the argument list, used in exception text.
+
+   TYPE is the result type.  TYPE_ARG_POS is its position in
+   the argument list, used in exception text.
+   TYPE_SCM is Scheme object wrapping TYPE, used in exception text.
+
+   If the number isn't representable, e.g. it's too big, a <gdb:exception>
+   object is stored in *EXCEPT_SCMP and NULL is returned.
+   The conversion may throw a gdb error, e.g., if TYPE is invalid.  */
+
+static struct value *
+vlscm_convert_typed_number (const char *func_name, int obj_arg_pos, SCM obj,
+			    int type_arg_pos, SCM type_scm, struct type *type,
+			    struct gdbarch *gdbarch, SCM *except_scmp)
+{
+  if (is_integral_type (type)
+      || TYPE_CODE (type) == TYPE_CODE_PTR)
+    {
+      if (TYPE_UNSIGNED (type))
+	{
+	  ULONGEST max;
+
+	  get_unsigned_type_max (type, &max);
+	  if (!scm_is_unsigned_integer (obj, 0, max))
+	    {
+	      *except_scmp
+		= gdbscm_make_out_of_range_error (func_name,
+						  obj_arg_pos, obj,
+					_("value out of range for type"));
+	      return NULL;
+	    }
+	  return value_from_longest (type, gdbscm_scm_to_ulongest (obj));
+	}
+      else
+	{
+	  LONGEST min, max;
+
+	  get_signed_type_minmax (type, &min, &max);
+	  if (!scm_is_signed_integer (obj, min, max))
+	    {
+	      *except_scmp
+		= gdbscm_make_out_of_range_error (func_name,
+						  obj_arg_pos, obj,
+					_("value out of range for type"));
+	      return NULL;
+	    }
+	  return value_from_longest (type, gdbscm_scm_to_longest (obj));
+	}
+    }
+  else if (TYPE_CODE (type) == TYPE_CODE_FLT)
+    return value_from_double (type, scm_to_double (obj));
+  else
+    {
+      *except_scmp = gdbscm_make_type_error (func_name, obj_arg_pos, obj,
+					     NULL);
+      return NULL;
+    }
+}
+
+/* Return non-zero if OBJ, an integer, fits in TYPE.  */
+
+static int
+vlscm_integer_fits_p (SCM obj, struct type *type)
+{
+  if (TYPE_UNSIGNED (type))
+    {
+      ULONGEST max;
+
+      /* If scm_is_unsigned_integer can't work with this type, just punt.  */
+      if (TYPE_LENGTH (type) > sizeof (scm_t_uintmax))
+	return 0;
+      get_unsigned_type_max (type, &max);
+      return scm_is_unsigned_integer (obj, 0, max);
+    }
+  else
+    {
+      LONGEST min, max;
+
+      /* If scm_is_signed_integer can't work with this type, just punt.  */
+      if (TYPE_LENGTH (type) > sizeof (scm_t_intmax))
+	return 0;
+      get_signed_type_minmax (type, &min, &max);
+      return scm_is_signed_integer (obj, min, max);
+    }
+}
+
+/* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
+   Convert OBJ, a Scheme number, to a <gdb:value> object.
+   OBJ_ARG_POS is its position in the argument list, used in exception text.
+
+   If OBJ is an integer, then the smallest int that will hold the value in
+   the following progression is chosen:
+   int, unsigned int, long, unsigned long, long long, unsigned long long.
+   Otherwise, if OBJ is a real number, then it is converted to a double.
+   Otherwise an exception is thrown.
+
+   If the number isn't representable, e.g. it's too big, a <gdb:exception>
+   object is stored in *EXCEPT_SCMP and NULL is returned.  */
+
+static struct value *
+vlscm_convert_number (const char *func_name, int obj_arg_pos, SCM obj,
+		      struct gdbarch *gdbarch, SCM *except_scmp)
+{
+  const struct builtin_type *bt = builtin_type (gdbarch);
+
+  /* One thing to keep in mind here is that we are interested in the
+     target's representation of OBJ, not the host's.  */
+
+  if (scm_is_exact (obj) && scm_is_integer (obj))
+    {
+      if (vlscm_integer_fits_p (obj, bt->builtin_int))
+	return value_from_longest (bt->builtin_int,
+				   gdbscm_scm_to_longest (obj));
+      if (vlscm_integer_fits_p (obj, bt->builtin_unsigned_int))
+	return value_from_longest (bt->builtin_unsigned_int,
+				   gdbscm_scm_to_ulongest (obj));
+      if (vlscm_integer_fits_p (obj, bt->builtin_long))
+	return value_from_longest (bt->builtin_long,
+				   gdbscm_scm_to_longest (obj));
+      if (vlscm_integer_fits_p (obj, bt->builtin_unsigned_long))
+	return value_from_longest (bt->builtin_unsigned_long,
+				   gdbscm_scm_to_ulongest (obj));
+      if (vlscm_integer_fits_p (obj, bt->builtin_long_long))
+	return value_from_longest (bt->builtin_long_long,
+				   gdbscm_scm_to_longest (obj));
+      if (vlscm_integer_fits_p (obj, bt->builtin_unsigned_long_long))
+	return value_from_longest (bt->builtin_unsigned_long_long,
+				   gdbscm_scm_to_ulongest (obj));
+    }
+  else if (scm_is_real (obj))
+    return value_from_double (bt->builtin_double, scm_to_double (obj));
+
+  *except_scmp = gdbscm_make_out_of_range_error (func_name, obj_arg_pos, obj,
+			_("value not a number representable on the target"));
+  return NULL;
+}
+
+/* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
+   Convert BV, a Scheme bytevector, to a <gdb:value> object.
+
+   TYPE, if non-NULL, is the result type.  Otherwise, a vector of type
+   uint8_t is used.
+   TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
+   or #f if TYPE is NULL.
+
+   If the bytevector isn't the same size as the type, then a <gdb:exception>
+   object is stored in *EXCEPT_SCMP, and NULL is returned.  */
+
+static struct value *
+vlscm_convert_bytevector (SCM bv, struct type *type, SCM type_scm,
+			  int arg_pos, const char *func_name,
+			  SCM *except_scmp, struct gdbarch *gdbarch)
+{
+  LONGEST length = SCM_BYTEVECTOR_LENGTH (bv);
+  struct value *value;
+
+  if (type == NULL)
+    {
+      type = builtin_type (gdbarch)->builtin_uint8;
+      type = lookup_array_range_type (type, 0, length);
+      make_vector_type (type);
+    }
+  type = check_typedef (type);
+  if (TYPE_LENGTH (type) != length)
+    {
+      *except_scmp = gdbscm_make_out_of_range_error (func_name, arg_pos,
+						     type_scm,
+			_("size of type does not match size of bytevector"));
+      return NULL;
+    }
+
+  value = value_from_contents (type,
+			       (gdb_byte *) SCM_BYTEVECTOR_CONTENTS (bv));
+  return value;
+}
+
+/* Convert OBJ, a Scheme value, to a <gdb:value> object.
+   OBJ_ARG_POS is its position in the argument list, used in exception text.
+
+   TYPE, if non-NULL, is the result type which must be compatible with
+   the value being converted.
+   If TYPE is NULL then a suitable default type is chosen.
+   TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
+   or SCM_UNDEFINED if TYPE is NULL.
+   TYPE_ARG_POS is its position in the argument list, used in exception text,
+   or -1 if TYPE is NULL.
+
+   OBJ may also be a <gdb:value> object, in which case a copy is returned
+   and TYPE must be NULL.
+
+   If the value cannot be converted, NULL is returned and a gdb:exception
+   object is stored in *EXCEPT_SCMP.
+   Otherwise the new value is returned, added to the all_values chain.  */
+
+struct value *
+vlscm_convert_typed_value_from_scheme (const char *func_name,
+				       int obj_arg_pos, SCM obj,
+				       int type_arg_pos, SCM type_scm,
+				       struct type *type,
+				       SCM *except_scmp,
+				       struct gdbarch *gdbarch,
+				       const struct language_defn *language)
+{
+  struct value *value = NULL;
+  SCM except_scm = SCM_BOOL_F;
+  volatile struct gdb_exception except;
+
+  if (type == NULL)
+    {
+      gdb_assert (type_arg_pos == -1);
+      gdb_assert (SCM_UNBNDP (type_scm));
+    }
+
+  *except_scmp = SCM_BOOL_F;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (vlscm_is_value (obj))
+	{
+	  if (type != NULL)
+	    {
+	      except_scm = gdbscm_make_misc_error (func_name, type_arg_pos,
+						   type_scm,
+						   _("No type allowed"));
+	      value = NULL;
+	    }
+	  else
+	    value = value_copy (vlscm_scm_to_value (obj));
+	}
+      else if (gdbscm_is_true (scm_bytevector_p (obj)))
+	{
+	  value = vlscm_convert_bytevector (obj, type, type_scm,
+					    obj_arg_pos, func_name,
+					    &except_scm, gdbarch);
+	}
+      else if (gdbscm_is_bool (obj)) 
+	{
+	  if (type != NULL
+	      && !is_integral_type (type))
+	    {
+	      except_scm = gdbscm_make_type_error (func_name, type_arg_pos,
+						   type_scm, NULL);
+	    }
+	  else
+	    {
+	      value = value_from_longest (type
+					  ? type
+					  : language_bool_type (language,
+								gdbarch),
+					  gdbscm_is_true (obj));
+	    }
+	}
+      else if (scm_is_number (obj))
+	{
+	  if (type != NULL)
+	    {
+	      value = vlscm_convert_typed_number (func_name, obj_arg_pos, obj,
+						  type_arg_pos, type_scm, type,
+						  gdbarch, &except_scm);
+	    }
+	  else
+	    {
+	      value = vlscm_convert_number (func_name, obj_arg_pos, obj,
+					    gdbarch, &except_scm);
+	    }
+	}
+      else if (scm_is_string (obj))
+	{
+	  char *s;
+	  size_t len;
+	  struct cleanup *cleanup;
+
+	  if (type != NULL)
+	    {
+	      except_scm = gdbscm_make_misc_error (func_name, type_arg_pos,
+						   type_scm,
+						   _("No type allowed"));
+	      value = NULL;
+	    }
+	  else
+	    {
+	      /* TODO: Provide option to specify conversion strategy.  */
+	      s = gdbscm_scm_to_string (obj, &len,
+					target_charset (gdbarch),
+					0 /*non-strict*/,
+					&except_scm);
+	      if (s != NULL)
+		{
+		  cleanup = make_cleanup (xfree, s);
+		  value
+		    = value_cstring (s, len,
+				     language_string_char_type (language,
+								gdbarch));
+		  do_cleanups (cleanup);
+		}
+	      else
+		value = NULL;
+	    }
+	}
+      else if (lsscm_is_lazy_string (obj))
+	{
+	  if (type != NULL)
+	    {
+	      except_scm = gdbscm_make_misc_error (func_name, type_arg_pos,
+						   type_scm,
+						   _("No type allowed"));
+	      value = NULL;
+	    }
+	  else
+	    {
+	      value = lsscm_safe_lazy_string_to_value (obj, obj_arg_pos,
+						       func_name,
+						       &except_scm);
+	    }
+	}
+      else /* OBJ isn't anything we support.  */
+	{
+	  except_scm = gdbscm_make_type_error (func_name, obj_arg_pos, obj,
+					       NULL);
+	  value = NULL;
+	}
+    }
+  if (except.reason < 0)
+    except_scm = gdbscm_scm_from_gdb_exception (except);
+
+  if (gdbscm_is_true (except_scm))
+    {
+      gdb_assert (value == NULL);
+      *except_scmp = except_scm;
+    }
+
+  return value;
+}
+
+/* Wrapper around vlscm_convert_typed_value_from_scheme for cases where there
+   is no supplied type.  See vlscm_convert_typed_value_from_scheme for
+   details.  */
+
+struct value *
+vlscm_convert_value_from_scheme (const char *func_name,
+				 int obj_arg_pos, SCM obj,
+				 SCM *except_scmp, struct gdbarch *gdbarch,
+				 const struct language_defn *language)
+{
+  return vlscm_convert_typed_value_from_scheme (func_name, obj_arg_pos, obj,
+						-1, SCM_UNDEFINED, NULL,
+						except_scmp,
+						gdbarch, language);
+}
+
+/* Initialize value math support.  */
+
+static const scheme_function math_functions[] =
+{
+  { "value-add", 2, 0, 0, gdbscm_value_add,
+    "\
+Return a + b." },
+
+  { "value-sub", 2, 0, 0, gdbscm_value_sub,
+    "\
+Return a - b." },
+
+  { "value-mul", 2, 0, 0, gdbscm_value_mul,
+    "\
+Return a * b." },
+
+  { "value-div", 2, 0, 0, gdbscm_value_div,
+    "\
+Return a / b." },
+
+  { "value-rem", 2, 0, 0, gdbscm_value_rem,
+    "\
+Return a % b." },
+
+  { "value-mod", 2, 0, 0, gdbscm_value_mod,
+    "\
+Return a mod b.  See Knuth 1.2.4." },
+
+  { "value-pow", 2, 0, 0, gdbscm_value_pow,
+    "\
+Return pow (x, y)." },
+
+  { "value-not", 1, 0, 0, gdbscm_value_not,
+    "\
+Return !a." },
+
+  { "value-neg", 1, 0, 0, gdbscm_value_neg,
+    "\
+Return -a." },
+
+  { "value-pos", 1, 0, 0, gdbscm_value_pos,
+    "\
+Return a." },
+
+  { "value-abs", 1, 0, 0, gdbscm_value_abs,
+    "\
+Return abs (a)." },
+
+  { "value-lsh", 2, 0, 0, gdbscm_value_lsh,
+    "\
+Return a << b." },
+
+  { "value-rsh", 2, 0, 0, gdbscm_value_rsh,
+    "\
+Return a >> b." },
+
+  { "value-min", 2, 0, 0, gdbscm_value_min,
+    "\
+Return min (a, b)." },
+
+  { "value-max", 2, 0, 0, gdbscm_value_max,
+    "\
+Return max (a, b)." },
+
+  { "value-lognot", 1, 0, 0, gdbscm_value_lognot,
+    "\
+Return ~a." },
+
+  { "value-logand", 2, 0, 0, gdbscm_value_logand,
+    "\
+Return a & b." },
+
+  { "value-logior", 2, 0, 0, gdbscm_value_logior,
+    "\
+Return a | b." },
+
+  { "value-logxor", 2, 0, 0, gdbscm_value_logxor,
+    "\
+Return a ^ b." },
+
+  { "value=?", 2, 0, 0, gdbscm_value_eq_p,
+    "\
+Return a == b." },
+
+  { "value<?", 2, 0, 0, gdbscm_value_lt_p,
+    "\
+Return a < b." },
+
+  { "value<=?", 2, 0, 0, gdbscm_value_le_p,
+    "\
+Return a <= b." },
+
+  { "value>?", 2, 0, 0, gdbscm_value_gt_p,
+    "\
+Return a > b." },
+
+  { "value>=?", 2, 0, 0, gdbscm_value_ge_p,
+    "\
+Return a >= b." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_math (void)
+{
+  gdbscm_define_functions (math_functions, 1);
+}