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.

32 files changed, 18291 insertions, 0 deletions

diff --git a/gdb/guile/README b/gdb/guile/README
new file mode 100644
index 0000000..81306e5
--- /dev/null
+++ b/gdb/guile/README
@@ -0,0 +1,229 @@
+README for gdb/guile
+====================
+
+This file contains important notes for gdb/guile developers.
+["gdb/guile" refers to the directory you found this file in]
+
+Nomenclature:
+
+  In the implementation we use "Scheme" or "Guile" depending on context.
+  And sometimes it doesn't matter.
+  Guile is Scheme, and for the most part this is what we present to the user
+  as well.  However, to highlight the fact that it is Guile, the GDB commands
+  that invoke Scheme functions are named "guile" and "guile-repl",
+  abbreviated "gu" and "gr" respectively.
+
+Co-existence with Python:
+
+  Keep the user interfaces reasonably consistent, but don't shy away from
+  providing a clearer (or more Scheme-friendly/consistent) user interface
+  where appropriate.
+
+  Additions to Python support or Scheme support don't require corresponding
+  changes in the other scripting language.
+
+  Scheme-wrapped breakpoints are created lazily so that if the user
+  doesn't use Scheme s/he doesn't pay any cost.
+
+Importing the gdb module into Scheme:
+
+  To import the gdb module:
+  (gdb) guile (use-modules (gdb))
+
+  If you want to add a prefix to gdb module symbols:
+  (gdb) guile (use-modules ((gdb) #:renamer (symbol-prefix-proc 'gdb:)))
+  This gives every symbol a "gdb:" prefix which is a common convention.
+  OTOH it's more to type.
+
+Implementation/Hacking notes:
+
+  Don't use scm_is_false.
+  For this C function, () == #f (a la Lisp) and it's not clear how treating
+  them as equivalent for truth values will affect the GDB interface.
+  Until the effect is clear avoid them.
+  Instead use gdbscm_is_false, gdbscm_is_true, gdbscm_is_bool.
+  There are macros in guile-internal.h to enforce this.
+
+  Use gdbscm_foo as the name of functions that implement Scheme procedures
+  to provide consistent naming in error messages.  The user can see "gdbscm"
+  in the name and immediately know where the function came from.
+
+  All smobs contain gdb_smob or chained_gdb_smob as the first member.
+  This provides a mechanism for extending them in the Scheme side without
+  tying GDB to the details.
+
+  The lifetime of a smob, AIUI, is decided by the containing SCM.
+  When there is no longer a reference to the containing SCM then the
+  smob can be GC'd.  Objects that have references from outside of Scheme,
+  e.g., breakpoints, need to be protected from GC.
+
+  Don't do something that can cause a Scheme exception inside a TRY_CATCH,
+  and, in code that can be called from Scheme, don't do something that can
+  cause a GDB exception outside a TRY_CATCH.
+  This makes the code a little tricky to write sometimes, but it is a
+  rule imposed by the programming environment.  Bugs often happen because
+  this rule is broken.  Learn it, follow it.
+
+Coding style notes:
+
+  - If you find violations to these rules, let's fix the code.
+    Some attempt has been made to be consistent, but it's early.
+    Over time we want things to be more consistent, not less.
+
+  - None of this really needs to be read.  Instead, do not be creative:
+    Monkey-See-Monkey-Do hacking should generally Just Work.
+
+  - Absence of the word "typically" means the rule is reasonably strict.
+
+  - The gdbscm_initialize_foo function (e.g., gdbscm_initialize_values)
+    is the last thing to appear in the file, immediately preceded by any
+    tables of exported variables and functions.
+
+  - In addition to these of course, follow GDB coding conventions.
+
+General naming rules:
+
+  - The word "object" absent any modifier (like "GOOPS object") means a
+    Scheme object (of any type), and is never used otherwise.
+    If you want to refer to, e.g., a GOOPS object, say "GOOPS object".
+
+  - Do not begin any function, global variable, etc. name with scm_.
+    That's what the Guile implementation uses.
+    (kinda obvious, just being complete).
+
+  - The word "invalid" carries a specific connotation.  Try not to use it
+    in a different way.  It means the underlying GDB object has disappeared.
+    For example, a <gdb:objfile> smob becomes "invalid" when the underlying
+    objfile is removed from GDB.
+
+  - We typically use the word "exception" to mean Scheme exceptions,
+    and we typically use the word "error" to mean GDB errors.
+
+Comments:
+
+  - function comments for functions implementing Scheme procedures begin with
+    a description of the Scheme usage.  Example:
+    /* (gsmob-aux gsmob) -> object */
+
+  - the following comment appears after the copyright header:
+    /* See README file in this directory for implementation notes, coding
+       conventions, et.al.  */
+
+Smob naming:
+
+  - gdb smobs are named, internally, "gdb:foo"
+  - in Guile they become <gdb:foo>, that is the convention for naming classes
+    and smobs have rudimentary GOOPS support (they can't be inherited from,
+    but generics can work with them)
+  - in comments use the Guile naming for smobs,
+    i.e., <gdb:foo> instead of gdb:foo.
+    Note: This only applies to smobs.  Exceptions are also named gdb:foo,
+    but since they are not "classes" they are not wrapped in <>.
+  - smob names are stored in a global, and for simplicity we pass this
+    global as the "expected type" parameter to SCM_ASSERT_TYPE, thus in
+    this instance smob types are printed without the <>.
+    [Hmmm, this rule seems dated now.  Plus I18N rules in GDB are not always
+    clear, sometimes we pass the smob name through _(), however it's not
+    clear that's actually a good idea.]
+
+Type naming:
+
+  - smob structs are typedefs named foo_smob
+
+Variable naming:
+
+  - "scm" by itself is reserved for arbitrary Scheme objects
+
+  - variables that are pointers to smob structs are named <char>_smob or
+    <char><char>_smob, e.g., f_smob for a pointer to a frame smob
+
+  - variables that are gdb smob objects are typically named <char>_scm or
+    <char><char>_scm, e.g., f_scm for a <gdb:frame> object
+
+  - the name of the first argument for method-like functions is "self"
+
+Function naming:
+
+  General:
+
+  - all non-static functions have a prefix,
+    either gdbscm_ or <char><char>scm_ [or <char><char><char>scm_]
+
+  - all functions that implement Scheme procedures have a gdbscm_ prefix,
+    this is for consistency and readability of Scheme exception text
+
+  - static functions typically have a prefix
+    - the prefix is typically <char><char>scm_ where the first two letters
+      are unique to the file or class the function works with.
+      E.g., the scm-arch.c prefix is arscm_.
+      This follows something used in gdb/python in some places,
+      we make it formal.
+
+  - if the function is of a general nature, or no other prefix works,
+    use gdbscm_
+
+  Conversion functions:
+
+  - the from/to in function names follows from libguile's existing style
+  - conversions from/to Scheme objects are named:
+      prefix_scm_from_foo: converts from foo to scm
+      prefix_scm_to_foo: converts from scm to foo
+
+  Exception handling:
+
+  - functions that may throw a Scheme exception have an _unsafe suffix
+    - This does not apply to functions that implement Scheme procedures.
+    - This does not apply to functions whose explicit job is to throw
+      an exception.  Adding _unsafe to gdbscm_throw is kinda superfluous. :-)
+  - functions that can throw a GDB error aren't adorned with _unsafe
+
+  - "_safe" in a function name means it will never throw an exception
+    - Generally unnecessary, since the convention is to mark the ones that
+      *can* throw an exception.  But sometimes it's useful to highlight the
+      fact that the function is safe to call without worrying about exception
+      handling.
+
+  - except for functions that implement Scheme procedures, all functions
+    that can throw exceptions (GDB or Scheme) say so in their function comment
+
+  - functions that don't throw an exception, but still need to indicate to
+    the caller that one happened (i.e., "safe" functions), either return
+    a <gdb:exception> smob as a result or pass it back via a parameter.
+    For this reason don't pass back <gdb:exception> smobs for any other
+    reason.  There are functions that explicitly construct <gdb:exception>
+    smobs.  They're obviously the, umm, exception.
+
+  Internal functions:
+
+  - internal Scheme functions begin with "%" and are intentionally undocumented
+    in the manual
+
+  Standard Guile/Scheme conventions:
+
+  - predicates that return Scheme values have the suffix _p and have suffix "?"
+    in the Scheme procedure's name
+  - functions that implement Scheme procedures that modify state have the
+    suffix _x and have suffix "!" in the Scheme procedure's name
+  - object predicates that return a C truth value are named prefix_is_foo
+  - functions that set something have "set" at the front (except for a prefix)
+    write this: gdbscm_set_gsmob_aux_x implements (set-gsmob-aux! ...)
+    not this: gdbscm_gsmob_set_aux_x implements (gsmob-set-aux! ...)
+
+Doc strings:
+
+  - there are lots of existing examples, they should be pretty consistent,
+    use them as boilerplate/examples
+  - begin with a one line summary (can be multiple lines if necessary)
+  - if the arguments need description:
+    - blank line
+    - "  Arguments: arg1 arg2"
+      "    arg1: blah ..."
+      "    arg2: blah ..."
+  - if the result requires more description:
+    - blank line
+    - "  Returns:"
+      "    Blah ..."
+  - if it's important to list exceptions that can be thrown:
+    - blank line
+    - "  Throws:"
+      "    exception-name: blah ..."
diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
new file mode 100644
index 0000000..dcdd422
--- /dev/null
+++ b/gdb/guile/guile-internal.h
@@ -0,0 +1,567 @@
+/* Internal header for GDB/Scheme code.
+
+   Copyright (C) 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.  */
+
+#ifndef GDB_GUILE_INTERNAL_H
+#define GDB_GUILE_INTERNAL_H
+
+#include "hashtab.h"
+#include "extension-priv.h"
+#include "symtab.h"
+#include "libguile.h"
+
+struct block;
+struct frame_info;
+struct objfile;
+struct symbol;
+
+/* A function to pass to the safe-call routines to ignore things like
+   memory errors.  */
+typedef int excp_matcher_func (SCM key);
+
+/* Scheme variables to define during initialization.  */
+
+typedef struct
+{
+  const char *name;
+  SCM value;
+  const char *doc_string;
+} scheme_variable;
+
+/* End of scheme_variable table mark.  */
+
+#define END_VARIABLES { NULL, SCM_BOOL_F, NULL }
+
+/* Scheme functions to define during initialization.  */
+
+typedef struct
+{
+  const char *name;
+  int required;
+  int optional;
+  int rest;
+  scm_t_subr func;
+  const char *doc_string;
+} scheme_function;
+
+/* End of scheme_function table mark.  */
+
+#define END_FUNCTIONS { NULL, 0, 0, 0, NULL, NULL }
+
+/* Useful for defining a set of constants.  */
+
+typedef struct
+{
+  const char *name;
+  int value;
+} scheme_integer_constant;
+
+#define END_INTEGER_CONSTANTS { NULL, 0 }
+
+/* Pass this instead of 0 to routines like SCM_ASSERT to indicate the value
+   is not a function argument.  */
+#define GDBSCM_ARG_NONE 0
+
+/* Ensure new code doesn't accidentally try to use this.  */
+#undef scm_make_smob_type
+#define scm_make_smob_type USE_gdbscm_make_smob_type_INSTEAD
+
+/* They brought over () == #f from lisp.
+   Let's avoid that for now.  */
+#undef scm_is_bool
+#undef scm_is_false
+#undef scm_is_true
+#define scm_is_bool USE_gdbscm_is_bool_INSTEAD
+#define scm_is_false USE_gdbscm_is_false_INSTEAD
+#define scm_is_true USE_gdbscm_is_true_INSTEAD
+#define gdbscm_is_bool(scm) \
+  (scm_is_eq ((scm), SCM_BOOL_F) || scm_is_eq ((scm), SCM_BOOL_T))
+#define gdbscm_is_false(scm) scm_is_eq ((scm), SCM_BOOL_F)
+#define gdbscm_is_true(scm) (!gdbscm_is_false (scm))
+
+/* Function name that is passed around in case an error needs to be reported.
+   __func is in C99, but we provide a wrapper "just in case",
+   and because FUNC_NAME is the canonical value used in guile sources.
+   IWBN to use the Scheme version of the name (e.g. foo-bar vs foo_bar),
+   but let's KISS for now.  */
+#define FUNC_NAME __func__
+
+extern const char gdbscm_module_name[];
+extern const char gdbscm_init_module_name[];
+
+extern int gdb_scheme_initialized;
+
+extern const char gdbscm_print_excp_none[];
+extern const char gdbscm_print_excp_full[];
+extern const char gdbscm_print_excp_message[];
+extern const char *gdbscm_print_excp;
+
+extern SCM gdbscm_documentation_symbol;
+extern SCM gdbscm_invalid_object_error_symbol;
+
+extern SCM gdbscm_map_string;
+extern SCM gdbscm_array_string;
+extern SCM gdbscm_string_string;
+
+/* scm-utils.c */
+
+extern void gdbscm_define_variables (const scheme_variable *, int public);
+
+extern void gdbscm_define_functions (const scheme_function *, int public);
+
+extern void gdbscm_define_integer_constants (const scheme_integer_constant *,
+					     int public);
+
+extern void gdbscm_printf (SCM port, const char *format, ...);
+
+extern void gdbscm_debug_display (SCM obj);
+
+extern void gdbscm_debug_write (SCM obj);
+
+extern void gdbscm_parse_function_args (const char *function_name,
+					int beginning_arg_pos,
+					const SCM *keywords,
+					const char *format, ...);
+
+extern SCM gdbscm_scm_from_longest (LONGEST l);
+
+extern LONGEST gdbscm_scm_to_longest (SCM l);
+
+extern SCM gdbscm_scm_from_ulongest (ULONGEST l);
+
+extern ULONGEST gdbscm_scm_to_ulongest (SCM u);
+
+extern void gdbscm_dynwind_xfree (void *ptr);
+
+extern int gdbscm_is_procedure (SCM proc);
+
+/* GDB smobs, from scm-smob.c */
+
+/* All gdb smobs must contain one of the following as the first member:
+   gdb_smob, chained_gdb_smob, or eqable_gdb_smob.
+
+   The next,prev members of chained_gdb_smob allow for chaining gsmobs
+   together so that, for example, when an objfile is deleted we can clean up
+   all smobs that reference it.
+
+   The containing_scm member of eqable_gdb_smob allows for returning the
+   same gsmob instead of creating a new one, allowing them to be eq?-able.
+
+   IMPORTANT: chained_gdb_smob and eqable_gdb-smob are a "subclasses" of
+   gdb_smob.  The layout of chained_gdb_smob,eqable_gdb_smob must match
+   gdb_smob as if it is a subclass.  To that end we use macro GDB_SMOB_HEAD
+   to ensure this.  */
+
+#define GDB_SMOB_HEAD					\
+  /* Property list for externally added fields.  */	\
+  SCM properties;
+
+typedef struct
+{
+  GDB_SMOB_HEAD
+} gdb_smob;
+
+typedef struct _chained_gdb_smob
+{
+  GDB_SMOB_HEAD
+
+  struct _chained_gdb_smob *prev;
+  struct _chained_gdb_smob *next;
+} chained_gdb_smob;
+
+typedef struct _eqable_gdb_smob
+{
+  GDB_SMOB_HEAD
+
+  /* The object we are contained in.
+     This can be used for several purposes.
+     This is used by the eq? machinery:  We need to be able to see if we have
+     already created an object for a symbol, and if so use that SCM.
+     This may also be used to protect the smob from GC if there is
+     a reference to this smob from outside of GC space (i.e., from gdb).
+     This can also be used in place of chained_gdb_smob where we need to
+     keep track of objfile referencing objects.  When the objfile is deleted
+     we need to invalidate the objects: we can do that using the same hashtab
+     used to record the smob for eq-ability.  */
+  SCM containing_scm;
+} eqable_gdb_smob;
+
+#undef GDB_SMOB_HEAD
+
+struct objfile;
+struct objfile_data;
+
+/* A predicate that returns non-zero if an object is a particular kind
+   of gsmob.  */
+typedef int (gsmob_pred_func) (SCM);
+
+extern scm_t_bits gdbscm_make_smob_type (const char *name, size_t size);
+
+extern void gdbscm_init_gsmob (gdb_smob *base);
+
+extern void gdbscm_init_chained_gsmob (chained_gdb_smob *base);
+
+extern void gdbscm_init_eqable_gsmob (eqable_gdb_smob *base);
+
+extern SCM gdbscm_mark_gsmob (gdb_smob *base);
+
+extern SCM gdbscm_mark_chained_gsmob (chained_gdb_smob *base);
+
+extern SCM gdbscm_mark_eqable_gsmob (eqable_gdb_smob *base);
+
+extern void gdbscm_add_objfile_ref (struct objfile *objfile,
+				    const struct objfile_data *data_key,
+				    chained_gdb_smob *g_smob);
+
+extern void gdbscm_remove_objfile_ref (struct objfile *objfile,
+				       const struct objfile_data *data_key,
+				       chained_gdb_smob *g_smob);
+
+extern htab_t gdbscm_create_eqable_gsmob_ptr_map (htab_hash hash_fn,
+						  htab_eq eq_fn);
+
+extern eqable_gdb_smob **gdbscm_find_eqable_gsmob_ptr_slot
+  (htab_t htab, eqable_gdb_smob *base);
+
+extern void gdbscm_fill_eqable_gsmob_ptr_slot (eqable_gdb_smob **slot,
+					       eqable_gdb_smob *base,
+					       SCM containing_scm);
+
+extern void gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab,
+						eqable_gdb_smob *base);
+
+/* Exceptions and calling out to Guile.  */
+
+/* scm-exception.c */
+
+extern SCM gdbscm_make_exception (SCM tag, SCM args);
+
+extern int gdbscm_is_exception (SCM scm);
+
+extern SCM gdbscm_exception_key (SCM excp);
+
+extern SCM gdbscm_exception_args (SCM excp);
+
+extern SCM gdbscm_make_exception_with_stack (SCM key, SCM args, SCM stack);
+
+extern SCM gdbscm_make_error_scm (SCM key, SCM subr, SCM message,
+				  SCM args, SCM data);
+
+extern SCM gdbscm_make_error (SCM key, const char *subr, const char *message,
+			      SCM args, SCM data);
+
+extern SCM gdbscm_make_type_error (const char *subr, int arg_pos,
+				   SCM bad_value, const char *expected_type);
+
+extern SCM gdbscm_make_invalid_object_error (const char *subr, int arg_pos,
+					     SCM bad_value, const char *error);
+
+extern SCM gdbscm_invalid_object_error (const char *subr, int arg_pos,
+					SCM bad_value, const char *error)
+   ATTRIBUTE_NORETURN;
+
+extern SCM gdbscm_make_out_of_range_error (const char *subr, int arg_pos,
+					   SCM bad_value, const char *error);
+
+extern SCM gdbscm_out_of_range_error (const char *subr, int arg_pos,
+				      SCM bad_value, const char *error)
+   ATTRIBUTE_NORETURN;
+
+extern SCM gdbscm_make_misc_error (const char *subr, int arg_pos,
+				   SCM bad_value, const char *error);
+
+extern void gdbscm_throw (SCM exception) ATTRIBUTE_NORETURN;
+
+extern SCM gdbscm_scm_from_gdb_exception (struct gdb_exception exception);
+
+extern void gdbscm_throw_gdb_exception (struct gdb_exception exception)
+  ATTRIBUTE_NORETURN;
+
+extern void gdbscm_print_exception_with_stack (SCM port, SCM stack,
+					       SCM key, SCM args);
+
+extern void gdbscm_print_gdb_exception (SCM port, SCM exception);
+
+extern char *gdbscm_exception_message_to_string (SCM exception);
+
+extern excp_matcher_func gdbscm_memory_error_p;
+
+extern SCM gdbscm_make_memory_error (const char *subr, const char *msg,
+				     SCM args);
+
+extern SCM gdbscm_memory_error (const char *subr, const char *msg, SCM args);
+
+/* scm-safe-call.c */
+
+extern void *gdbscm_with_guile (void *(*func) (void *), void *data);
+
+extern SCM gdbscm_call_guile (SCM (*func) (void *), void *data,
+			      excp_matcher_func *ok_excps);
+
+extern SCM gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps);
+
+extern SCM gdbscm_safe_call_1 (SCM proc, SCM arg0,
+			       excp_matcher_func *ok_excps);
+
+extern SCM gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1,
+			       excp_matcher_func *ok_excps);
+
+extern SCM gdbscm_safe_call_3 (SCM proc, SCM arg0, SCM arg1, SCM arg2,
+			       excp_matcher_func *ok_excps);
+
+extern SCM gdbscm_safe_call_4 (SCM proc, SCM arg0, SCM arg1, SCM arg2,
+			       SCM arg3,
+			       excp_matcher_func *ok_excps);
+
+extern SCM gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM args,
+				excp_matcher_func *ok_excps);
+
+extern SCM gdbscm_unsafe_call_1 (SCM proc, SCM arg0);
+
+extern char *gdbscm_safe_eval_string (const char *string, int display_result);
+
+extern char *gdbscm_safe_source_script (const char *filename);
+
+extern void gdbscm_enter_repl (void);
+
+/* Interface to various GDB objects, in alphabetical order.  */
+
+/* scm-arch.c */
+
+typedef struct _arch_smob arch_smob;
+
+extern struct gdbarch *arscm_get_gdbarch (arch_smob *a_smob);
+
+extern arch_smob *arscm_get_arch_smob_arg_unsafe (SCM arch_scm, int arg_pos,
+						  const char *func_name);
+
+extern SCM arscm_scm_from_arch (struct gdbarch *gdbarch);
+
+/* scm-block.c */
+
+extern SCM bkscm_scm_from_block (const struct block *block,
+				 struct objfile *objfile);
+
+extern const struct block *bkscm_scm_to_block
+  (SCM block_scm, int arg_pos, const char *func_name, SCM *excp);
+
+/* scm-frame.c */
+
+typedef struct _frame_smob frame_smob;
+
+extern int frscm_is_frame (SCM scm);
+
+extern frame_smob *frscm_get_frame_smob_arg_unsafe (SCM frame_scm, int arg_pos,
+						    const char *func_name);
+
+extern struct frame_info *frscm_frame_smob_to_frame (frame_smob *);
+
+/* scm-iterator.c */
+
+typedef struct _iterator_smob iterator_smob;
+
+extern SCM itscm_iterator_smob_object (iterator_smob *i_smob);
+
+extern SCM itscm_iterator_smob_progress (iterator_smob *i_smob);
+
+extern void itscm_set_iterator_smob_progress_x (iterator_smob *i_smob,
+						SCM progress);
+
+extern const char *itscm_iterator_smob_name (void);
+
+extern SCM gdbscm_make_iterator (SCM object, SCM progress, SCM next);
+
+extern int itscm_is_iterator (SCM scm);
+
+extern SCM gdbscm_end_of_iteration (void);
+
+extern int itscm_is_end_of_iteration (SCM obj);
+
+extern SCM itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps);
+
+extern SCM itscm_get_iterator_arg_unsafe (SCM self, int arg_pos,
+					  const char *func_name);
+
+/* scm-lazy-string.c */
+
+extern int lsscm_is_lazy_string (SCM scm);
+
+extern SCM lsscm_make_lazy_string (CORE_ADDR address, int length,
+				   const char *encoding, struct type *type);
+
+extern struct value *lsscm_safe_lazy_string_to_value (SCM string,
+						      int arg_pos,
+						      const char *func_name,
+						      SCM *except_scmp);
+
+extern void lsscm_val_print_lazy_string
+  (SCM string, struct ui_file *stream,
+   const struct value_print_options *options);
+
+/* scm-objfile.c */
+
+typedef struct _objfile_smob objfile_smob;
+
+extern SCM ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob);
+
+extern objfile_smob *ofscm_objfile_smob_from_objfile (struct objfile *objfile);
+
+extern SCM ofscm_scm_from_objfile (struct objfile *objfile);
+
+/* scm-string.c */
+
+extern char *gdbscm_scm_to_c_string (SCM string);
+
+extern SCM gdbscm_scm_from_c_string (const char *string);
+
+extern SCM gdbscm_scm_from_printf (const char *format, ...);
+
+extern char *gdbscm_scm_to_string (SCM string, size_t *lenp,
+				   const char *charset,
+				   int strict, SCM *except_scmp);
+
+extern SCM gdbscm_scm_from_string (const char *string, size_t len,
+				   const char *charset, int strict);
+
+extern char *gdbscm_scm_to_target_string_unsafe (SCM string, size_t *lenp,
+						 struct gdbarch *gdbarch);
+
+/* scm-symbol.c */
+
+extern int syscm_is_symbol (SCM scm);
+
+extern SCM syscm_scm_from_symbol (struct symbol *symbol);
+
+extern struct symbol *syscm_get_valid_symbol_arg_unsafe
+  (SCM self, int arg_pos, const char *func_name);
+
+/* scm-symtab.c */
+
+extern SCM stscm_scm_from_symtab (struct symtab *symtab);
+
+extern SCM stscm_scm_from_sal (struct symtab_and_line sal);
+
+/* scm-type.c */
+
+typedef struct _type_smob type_smob;
+
+extern int tyscm_is_type (SCM scm);
+
+extern SCM tyscm_scm_from_type (struct type *type);
+
+extern type_smob *tyscm_get_type_smob_arg_unsafe (SCM type_scm, int arg_pos,
+						  const char *func_name);
+
+extern struct type *tyscm_type_smob_type (type_smob *t_smob);
+
+extern SCM tyscm_scm_from_field (SCM type_scm, int field_num);
+
+/* scm-value.c */
+
+extern struct value *vlscm_scm_to_value (SCM scm);
+
+extern int vlscm_is_value (SCM scm);
+
+extern SCM vlscm_scm_from_value (struct value *value);
+
+extern SCM vlscm_scm_from_value_unsafe (struct value *value);
+
+extern 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);
+
+extern 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);
+
+/* stript_lang methods */
+
+extern objfile_script_sourcer_func gdbscm_source_objfile_script;
+
+extern int gdbscm_auto_load_enabled (const struct extension_language_defn *);
+
+extern void gdbscm_preserve_values
+  (const struct extension_language_defn *,
+   struct objfile *, htab_t copied_types);
+
+extern enum ext_lang_rc gdbscm_apply_val_pretty_printer
+  (const struct extension_language_defn *,
+   struct type *type, const gdb_byte *valaddr,
+   int embedded_offset, CORE_ADDR address,
+   struct ui_file *stream, int recurse,
+   const struct value *val,
+   const struct value_print_options *options,
+   const struct language_defn *language);
+
+extern int gdbscm_breakpoint_has_cond (const struct extension_language_defn *,
+				       struct breakpoint *b);
+
+extern enum ext_lang_bp_stop gdbscm_breakpoint_cond_says_stop
+  (const struct extension_language_defn *, struct breakpoint *b);
+
+/* Initializers for each piece of Scheme support, in alphabetical order.  */
+
+extern void gdbscm_initialize_arches (void);
+extern void gdbscm_initialize_auto_load (void);
+extern void gdbscm_initialize_blocks (void);
+extern void gdbscm_initialize_breakpoints (void);
+extern void gdbscm_initialize_disasm (void);
+extern void gdbscm_initialize_exceptions (void);
+extern void gdbscm_initialize_frames (void);
+extern void gdbscm_initialize_iterators (void);
+extern void gdbscm_initialize_lazy_strings (void);
+extern void gdbscm_initialize_math (void);
+extern void gdbscm_initialize_objfiles (void);
+extern void gdbscm_initialize_pretty_printers (void);
+extern void gdbscm_initialize_ports (void);
+extern void gdbscm_initialize_smobs (void);
+extern void gdbscm_initialize_strings (void);
+extern void gdbscm_initialize_symbols (void);
+extern void gdbscm_initialize_symtabs (void);
+extern void gdbscm_initialize_types (void);
+extern void gdbscm_initialize_values (void);
+
+/* Use these after a TRY_CATCH to throw the appropriate Scheme exception
+   if a GDB error occurred.  */
+
+#define GDBSCM_HANDLE_GDB_EXCEPTION(exception)		\
+  do {							\
+    if (exception.reason < 0)				\
+      {							\
+	gdbscm_throw_gdb_exception (exception);		\
+        /*NOTREACHED */					\
+      }							\
+  } while (0)
+
+/* If cleanups are establish outside the TRY_CATCH block, use this version.  */
+
+#define GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS(exception, cleanups)	\
+  do {									\
+    if (exception.reason < 0)						\
+      {									\
+	do_cleanups (cleanups);						\
+	gdbscm_throw_gdb_exception (exception);				\
+        /*NOTREACHED */							\
+      }									\
+  } while (0)
+
+#endif /* GDB_GUILE_INTERNAL_H */
diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c
new file mode 100644
index 0000000..b7134f7
--- /dev/null
+++ b/gdb/guile/guile.c
@@ -0,0 +1,724 @@
+/* General GDB/Guile code.
+
+   Copyright (C) 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 <string.h>
+#include "breakpoint.h"
+#include "cli/cli-cmds.h"
+#include "cli/cli-script.h"
+#include "cli/cli-utils.h"
+#include "command.h"
+#include "gdbcmd.h"
+#include "interps.h"
+#include "extension-priv.h"
+#include "utils.h"
+#include "version.h"
+#ifdef HAVE_GUILE
+#include "guile.h"
+#include "guile-internal.h"
+#endif
+
+/* Declared constants and enum for guile exception printing.  */
+const char gdbscm_print_excp_none[] = "none";
+const char gdbscm_print_excp_full[] = "full";
+const char gdbscm_print_excp_message[] = "message";
+
+/* "set guile print-stack" choices.  */
+static const char *const guile_print_excp_enums[] =
+  {
+    gdbscm_print_excp_none,
+    gdbscm_print_excp_full,
+    gdbscm_print_excp_message,
+    NULL
+  };
+
+/* The exception printing variable.  'full' if we want to print the
+   error message and stack, 'none' if we want to print nothing, and
+   'message' if we only want to print the error message.  'message' is
+   the default.  */
+const char *gdbscm_print_excp = gdbscm_print_excp_message;
+
+#ifdef HAVE_GUILE
+/* Forward decls, these are defined later.  */
+static const struct extension_language_script_ops guile_extension_script_ops;
+static const struct extension_language_ops guile_extension_ops;
+#endif
+
+/* The main struct describing GDB's interface to the Guile
+   extension language.  */
+const struct extension_language_defn extension_language_guile =
+{
+  EXT_LANG_GUILE,
+  "guile",
+  "Guile",
+
+  ".scm",
+  "-gdb.scm",
+
+  guile_control,
+
+#ifdef HAVE_GUILE
+  &guile_extension_script_ops,
+  &guile_extension_ops
+#else
+  NULL,
+  NULL
+#endif
+};
+
+#ifdef HAVE_GUILE
+
+static void gdbscm_finish_initialization
+  (const struct extension_language_defn *);
+static int gdbscm_initialized (const struct extension_language_defn *);
+static void gdbscm_eval_from_control_command
+  (const struct extension_language_defn *, struct command_line *);
+static script_sourcer_func gdbscm_source_script;
+
+int gdb_scheme_initialized;
+
+/* Symbol for setting documentation strings.  */
+SCM gdbscm_documentation_symbol;
+
+/* Keywords used by various functions.  */
+static SCM from_tty_keyword;
+static SCM to_string_keyword;
+
+/* The name of the various modules (without the surrounding parens).  */
+const char gdbscm_module_name[] = "gdb";
+const char gdbscm_init_module_name[] = "gdb init";
+
+/* The name of the bootstrap file.  */
+static const char boot_scm_filename[] = "boot.scm";
+
+/* The interface between gdb proper and loading of python scripts.  */
+
+static const struct extension_language_script_ops guile_extension_script_ops =
+{
+  gdbscm_source_script,
+  gdbscm_source_objfile_script,
+  gdbscm_auto_load_enabled
+};
+
+/* The interface between gdb proper and guile scripting.  */
+
+static const struct extension_language_ops guile_extension_ops =
+{
+  gdbscm_finish_initialization,
+  gdbscm_initialized,
+
+  gdbscm_eval_from_control_command,
+
+  NULL, /* gdbscm_start_type_printers, */
+  NULL, /* gdbscm_apply_type_printers, */
+  NULL, /* gdbscm_free_type_printers, */
+
+  gdbscm_apply_val_pretty_printer,
+
+  NULL, /* gdbscm_apply_frame_filter, */
+
+  gdbscm_preserve_values,
+
+  gdbscm_breakpoint_has_cond,
+  gdbscm_breakpoint_cond_says_stop,
+
+  NULL, /* gdbscm_check_quit_flag, */
+  NULL, /* gdbscm_clear_quit_flag, */
+  NULL, /* gdbscm_set_quit_flag, */
+};
+
+/* Implementation of the gdb "guile-repl" command.  */
+
+static void
+guile_repl_command (char *arg, int from_tty)
+{
+  struct cleanup *cleanup;
+
+  cleanup = make_cleanup_restore_integer (&interpreter_async);
+  interpreter_async = 0;
+
+  arg = skip_spaces (arg);
+
+  /* This explicitly rejects any arguments for now.
+     "It is easier to relax a restriction than impose one after the fact."
+     We would *like* to be able to pass arguments to the interactive shell
+     but that's not what python-interactive does.  Until there is time to
+     sort it out, we forbid arguments.  */
+
+  if (arg && *arg)
+    error (_("guile-repl currently does not take any arguments."));
+  else
+    {
+      dont_repeat ();
+      gdbscm_enter_repl ();
+    }
+
+  do_cleanups (cleanup);
+}
+
+/* Implementation of the gdb "guile" command.
+   Note: Contrary to the Python version this displays the result.
+   Have to see which is better.
+
+   TODO: Add the result to Guile's history?  */
+
+static void
+guile_command (char *arg, int from_tty)
+{
+  struct cleanup *cleanup;
+
+  cleanup = make_cleanup_restore_integer (&interpreter_async);
+  interpreter_async = 0;
+
+  arg = skip_spaces (arg);
+
+  if (arg && *arg)
+    {
+      char *msg = gdbscm_safe_eval_string (arg, 1);
+
+      if (msg != NULL)
+	{
+	  make_cleanup (xfree, msg);
+	  error ("%s", msg);
+	}
+    }
+  else
+    {
+      struct command_line *l = get_command_line (guile_control, "");
+
+      make_cleanup_free_command_lines (&l);
+      execute_control_command_untraced (l);
+    }
+
+  do_cleanups (cleanup);
+}
+
+/* Given a command_line, return a command string suitable for passing
+   to Guile.  Lines in the string are separated by newlines.  The return
+   value is allocated using xmalloc and the caller is responsible for
+   freeing it.  */
+
+static char *
+compute_scheme_string (struct command_line *l)
+{
+  struct command_line *iter;
+  char *script = NULL;
+  int size = 0;
+  int here;
+
+  for (iter = l; iter; iter = iter->next)
+    size += strlen (iter->line) + 1;
+
+  script = xmalloc (size + 1);
+  here = 0;
+  for (iter = l; iter; iter = iter->next)
+    {
+      int len = strlen (iter->line);
+
+      strcpy (&script[here], iter->line);
+      here += len;
+      script[here++] = '\n';
+    }
+  script[here] = '\0';
+  return script;
+}
+
+/* Take a command line structure representing a "guile" command, and
+   evaluate its body using the Guile interpreter.
+   This is the extension_language_ops.eval_from_control_command "method".  */
+
+static void
+gdbscm_eval_from_control_command
+  (const struct extension_language_defn *extlang, struct command_line *cmd)
+{
+  char *script, *msg;
+  struct cleanup *cleanup;
+
+  if (cmd->body_count != 1)
+    error (_("Invalid \"guile\" block structure."));
+
+  cleanup = make_cleanup (null_cleanup, NULL);
+
+  script = compute_scheme_string (cmd->body_list[0]);
+  msg = gdbscm_safe_eval_string (script, 0);
+  xfree (script);
+  if (msg != NULL)
+    {
+      make_cleanup (xfree, msg);
+      error ("%s", msg);
+    }
+
+  do_cleanups (cleanup);
+}
+
+/* Read a file as Scheme code.
+   This is the extension_language_script_ops.script_sourcer "method".
+   FILE is the file to run.  FILENAME is name of the file FILE.
+   This does not throw any errors.  If an exception occurs an error message
+   is printed.  */
+
+static void
+gdbscm_source_script (const struct extension_language_defn *extlang,
+		      FILE *file, const char *filename)
+{
+  char *msg = gdbscm_safe_source_script (filename);
+
+  if (msg != NULL)
+    {
+      fprintf_filtered (gdb_stderr, "%s\n", msg);
+      xfree (msg);
+    }
+}
+
+/* (execute string [#:from-tty boolean] [#:to-string boolean\
+   A Scheme function which evaluates a string using the gdb CLI.  */
+
+static SCM
+gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
+{
+  int from_tty_arg_pos = -1, to_string_arg_pos = -1;
+  int from_tty = 0, to_string = 0;
+  volatile struct gdb_exception except;
+  const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
+  char *command;
+  char *result = NULL;
+  struct cleanup *cleanups;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
+			      command_scm, &command, rest,
+			      &from_tty_arg_pos, &from_tty,
+			      &to_string_arg_pos, &to_string);
+
+  /* Note: The contents of "command" may get modified while it is
+     executed.  */
+  cleanups = make_cleanup (xfree, command);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct cleanup *inner_cleanups;
+
+      inner_cleanups = make_cleanup_restore_integer (&interpreter_async);
+      interpreter_async = 0;
+
+      prevent_dont_repeat ();
+      if (to_string)
+	result = execute_command_to_string (command, from_tty);
+      else
+	{
+	  execute_command (command, from_tty);
+	  result = NULL;
+	}
+
+      /* Do any commands attached to breakpoint we stopped at.  */
+      bpstat_do_actions ();
+
+      do_cleanups (inner_cleanups);
+    }
+  do_cleanups (cleanups);
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (result)
+    {
+      SCM r = gdbscm_scm_from_c_string (result);
+      xfree (result);
+      return r;
+    }
+  return SCM_UNSPECIFIED;
+}
+
+/* (data-directory) -> string */
+
+static SCM
+gdbscm_data_directory (void)
+{
+  return gdbscm_scm_from_c_string (gdb_datadir);
+}
+
+/* (gdb-version) -> string */
+
+static SCM
+gdbscm_gdb_version (void)
+{
+  return gdbscm_scm_from_c_string (version);
+}
+
+/* (host-config) -> string */
+
+static SCM
+gdbscm_host_config (void)
+{
+  return gdbscm_scm_from_c_string (host_name);
+}
+
+/* (target-config) -> string */
+
+static SCM
+gdbscm_target_config (void)
+{
+  return gdbscm_scm_from_c_string (target_name);
+}
+
+#else /* ! HAVE_GUILE */
+
+/* Dummy implementation of the gdb "guile-repl" and "guile"
+   commands. */
+
+static void
+guile_repl_command (char *arg, int from_tty)
+{
+  arg = skip_spaces (arg);
+  if (arg && *arg)
+    error (_("guile-repl currently does not take any arguments."));
+  error (_("Guile scripting is not supported in this copy of GDB."));
+}
+
+static void
+guile_command (char *arg, int from_tty)
+{
+  arg = skip_spaces (arg);
+  if (arg && *arg)
+    error (_("Guile scripting is not supported in this copy of GDB."));
+  else
+    {
+      /* Even if Guile isn't enabled, we still have to slurp the
+	 command list to the corresponding "end".  */
+      struct command_line *l = get_command_line (guile_control, "");
+      struct cleanup *cleanups = make_cleanup_free_command_lines (&l);
+
+      execute_control_command_untraced (l);
+      do_cleanups (cleanups);
+    }
+}
+
+#endif /* ! HAVE_GUILE */
+
+/* Lists for 'set,show,info guile' commands.  */
+
+static struct cmd_list_element *set_guile_list;
+static struct cmd_list_element *show_guile_list;
+static struct cmd_list_element *info_guile_list;
+
+/* Function for use by 'set guile' prefix command.  */
+
+static void
+set_guile_command (char *args, int from_tty)
+{
+  help_list (set_guile_list, "set guile ", all_commands, gdb_stdout);
+}
+
+/* Function for use by 'show guile' prefix command.  */
+
+static void
+show_guile_command (char *args, int from_tty)
+{
+  cmd_show_list (show_guile_list, from_tty, "");
+}
+
+/* The "info scheme" command is defined as a prefix, with
+   allow_unknown 0.  Therefore, its own definition is called only for
+   "info scheme" with no args.  */
+
+static void
+info_guile_command (char *args, int from_tty)
+{
+  printf_unfiltered (_("\"info guile\" must be followed"
+		       " by the name of an info command.\n"));
+  help_list (info_guile_list, "info guile ", -1, gdb_stdout);
+}
+
+/* Initialization.  */
+
+#ifdef HAVE_GUILE
+
+static const scheme_function misc_guile_functions[] =
+{
+  { "execute", 1, 0, 1, gdbscm_execute_gdb_command,
+  "\
+Execute the given GDB command.\n\
+\n\
+  Arguments: string [#:to-string boolean] [#:from-tty boolean]\n\
+    If #:from-tty is true then the command executes as if entered\n\
+    from the keyboard.  The default is false (#f).\n\
+    If #:to-string is true then the result is returned as a string.\n\
+    Otherwise output is sent to the current output port,\n\
+    which is the default.\n\
+  Returns: The result of the command if #:to-string is true.\n\
+    Otherwise returns unspecified." },
+
+  { "data-directory", 0, 0, 0, gdbscm_data_directory,
+    "\
+Return the name of GDB's data directory." },
+
+  { "gdb-version", 0, 0, 0, gdbscm_gdb_version,
+    "\
+Return GDB's version string." },
+
+  { "host-config", 0, 0, 0, gdbscm_host_config,
+    "\
+Return the name of the host configuration." },
+
+  { "target-config", 0, 0, 0, gdbscm_target_config,
+    "\
+Return the name of the target configuration." },
+
+  END_FUNCTIONS
+};
+
+/* Load gdb/boot.scm, the Scheme side of GDB/Guile support.
+   Note: This function assumes it's called within the gdb module.  */
+
+static void
+initialize_scheme_side (void)
+{
+  char *gdb_guile_dir = concat (gdb_datadir, SLASH_STRING, "guile", NULL);
+  char *boot_scm_path = concat (gdb_guile_dir, SLASH_STRING, "gdb",
+				SLASH_STRING, boot_scm_filename, NULL);
+  char *msg;
+
+  /* While scm_c_primitive_load works, the loaded code is not compiled,
+     instead it is left to be interpreted.  Eh?
+     Anyways, this causes a ~100x slowdown, so we only use it to load
+     gdb/boot.scm, and then let boot.scm do the rest.  */
+  msg = gdbscm_safe_source_script (boot_scm_path);
+
+  if (msg != NULL)
+    {
+      fprintf_filtered (gdb_stderr, "%s", msg);
+      xfree (msg);
+      warning (_("\n"
+		 "Could not complete Guile gdb module initialization from:\n"
+		 "%s.\n"
+		 "Limited Guile support is available.\n"
+		 "Suggest passing --data-directory=/path/to/gdb/data-directory.\n"),
+	       boot_scm_path);
+    }
+
+  xfree (gdb_guile_dir);
+  xfree (boot_scm_path);
+}
+
+/* Install the gdb scheme module.
+   The result is a boolean indicating success.
+   If initializing the gdb module fails an error message is printed.
+   Note: This function runs in the context of the gdb module.  */
+
+static void
+initialize_gdb_module (void *data)
+{
+  /* The documentation symbol needs to be defined before any calls to
+     gdbscm_define_{variables,functions}.  */
+  gdbscm_documentation_symbol = scm_from_latin1_symbol ("documentation");
+
+  /* The smob and exception support must be initialized early.  */
+  gdbscm_initialize_smobs ();
+  gdbscm_initialize_exceptions ();
+
+  /* The rest are initialized in alphabetical order.  */
+  gdbscm_initialize_arches ();
+  gdbscm_initialize_auto_load ();
+  gdbscm_initialize_blocks ();
+  gdbscm_initialize_breakpoints ();
+  gdbscm_initialize_disasm ();
+  gdbscm_initialize_frames ();
+  gdbscm_initialize_iterators ();
+  gdbscm_initialize_lazy_strings ();
+  gdbscm_initialize_math ();
+  gdbscm_initialize_objfiles ();
+  gdbscm_initialize_ports ();
+  gdbscm_initialize_pretty_printers ();
+  gdbscm_initialize_strings ();
+  gdbscm_initialize_symbols ();
+  gdbscm_initialize_symtabs ();
+  gdbscm_initialize_types ();
+  gdbscm_initialize_values ();
+
+  gdbscm_define_functions (misc_guile_functions, 1);
+
+  from_tty_keyword = scm_from_latin1_keyword ("from-tty");
+  to_string_keyword = scm_from_latin1_keyword ("to-string");
+
+  initialize_scheme_side ();
+
+  gdb_scheme_initialized = 1;
+}
+
+/* A callback to finish Guile initialization after gdb has finished all its
+   initialization.
+   This is the extension_language_ops.finish_initialization "method".  */
+
+static void
+gdbscm_finish_initialization (const struct extension_language_defn *extlang)
+{
+  /* Restore the environment to the user interaction one.  */
+  scm_set_current_module (scm_interaction_environment ());
+}
+
+/* The extension_language_ops.initialized "method".  */
+
+static int
+gdbscm_initialized (const struct extension_language_defn *extlang)
+{
+  return gdb_scheme_initialized;
+}
+
+/* Enable or disable Guile backtraces.  */
+
+static void
+gdbscm_set_backtrace (int enable)
+{
+  static const char disable_bt[] = "(debug-disable 'backtrace)";
+  static const char enable_bt[] = "(debug-enable 'backtrace)";
+
+  if (enable)
+    gdbscm_safe_eval_string (enable_bt, 0);
+  else
+    gdbscm_safe_eval_string (disable_bt, 0);
+}
+
+#endif /* HAVE_GUILE */
+
+/* Install the various gdb commands used by Guile.  */
+
+static void
+install_gdb_commands (void)
+{
+  add_com ("guile-repl", class_obscure,
+	   guile_repl_command,
+#ifdef HAVE_GUILE
+	   _("\
+Start an interactive Guile prompt.\n\
+\n\
+To return to GDB, type the EOF character (e.g., Ctrl-D on an empty\n\
+prompt) or ,quit.")
+#else /* HAVE_GUILE */
+	   _("\
+Start a Guile interactive prompt.\n\
+\n\
+Guile scripting is not supported in this copy of GDB.\n\
+This command is only a placeholder.")
+#endif /* HAVE_GUILE */
+	   );
+  add_com_alias ("gr", "guile-repl", class_obscure, 1);
+
+  /* Since "help guile" is easy to type, and intuitive, we add general help
+     in using GDB+Guile to this command.  */
+  add_com ("guile", class_obscure, guile_command,
+#ifdef HAVE_GUILE
+	   _("\
+Evaluate one or more Guile expressions.\n\
+\n\
+The expression(s) can be given as an argument, for instance:\n\
+\n\
+    guile (display 23)\n\
+\n\
+The result of evaluating the last expression is printed.\n\
+\n\
+If no argument is given, the following lines are read and passed\n\
+to Guile for evaluation.  Type a line containing \"end\" to indicate\n\
+the end of the set of expressions.\n\
+\n\
+The Guile GDB module must first be imported before it can be used.\n\
+Do this with:\n\
+(gdb) guile (use-modules (gdb))\n\
+or if you want to import the (gdb) module with a prefix, use:\n\
+(gdb) guile (use-modules ((gdb) #:renamer (symbol-prefix-proc 'gdb:)))\n\
+\n\
+The Guile interactive session, started with the \"guile-repl\"\n\
+command, provides extensive help and apropos capabilities.\n\
+Type \",help\" once in a Guile interactive session.")
+#else /* HAVE_GUILE */
+	   _("\
+Evaluate a Guile expression.\n\
+\n\
+Guile scripting is not supported in this copy of GDB.\n\
+This command is only a placeholder.")
+#endif /* HAVE_GUILE */
+	   );
+  add_com_alias ("gu", "guile", class_obscure, 1);
+
+  add_prefix_cmd ("guile", class_obscure, set_guile_command,
+		  _("Prefix command for Guile preference settings."),
+		  &set_guile_list, "set guile ", 0,
+		  &setlist);
+  add_alias_cmd ("gu", "guile", class_obscure, 1, &setlist);
+
+  add_prefix_cmd ("guile", class_obscure, show_guile_command,
+		  _("Prefix command for Guile preference settings."),
+		  &show_guile_list, "show guile ", 0,
+		  &showlist);
+  add_alias_cmd ("gu", "guile", class_obscure, 1, &showlist);
+
+  add_prefix_cmd ("guile", class_obscure, info_guile_command,
+		  _("Prefix command for Guile info displays."),
+		  &info_guile_list, "info guile ", 0,
+		  &infolist);
+  add_info_alias ("gu", "guile", 1);
+
+  /* The name "print-stack" is carried over from Python.
+     A better name is "print-exception".  */
+  add_setshow_enum_cmd ("print-stack", no_class, guile_print_excp_enums,
+			&gdbscm_print_excp, _("\
+Set mode for Guile exception printing on error."), _("\
+Show the mode of Guile exception printing on error."), _("\
+none  == no stack or message will be printed.\n\
+full == a message and a stack will be printed.\n\
+message == an error message without a stack will be printed."),
+			NULL, NULL,
+			&set_guile_list, &show_guile_list);
+}
+
+/* Provide a prototype to silence -Wmissing-prototypes.  */
+extern initialize_file_ftype _initialize_guile;
+
+void
+_initialize_guile (void)
+{
+  char *msg;
+
+  install_gdb_commands ();
+
+#if HAVE_GUILE
+  /* The Guile docs say scm_init_guile isn't as portable as the other Guile
+     initialization routines.  However, this is the easiest to use.
+     We can switch to a more portable routine if/when the need arises
+     and if it can be used with gdb.  */
+  scm_init_guile ();
+
+  /* The Python support puts the C side in module "_gdb", leaving the Python
+     side to define module "gdb" which imports "_gdb".  There is evidently no
+     similar convention in Guile so we skip this.  */
+
+  /* The rest of the initialization is done by initialize_gdb_module.
+     scm_c_define_module is used as it allows us to perform the initialization
+     within the desired module.  */
+  scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
+
+  /* Set Guile's backtrace to match the "set guile print-stack" default.
+     [N.B. The two settings are still separate.]
+     But only do this after we've initialized Guile, it's nice to see a
+     backtrace if there's an error during initialization.
+     OTOH, if the error is that gdb/init.scm wasn't found because gdb is being
+     run from the build tree, the backtrace is more noise than signal.
+     Sigh.  */
+  gdbscm_set_backtrace (0);
+#endif
+}
diff --git a/gdb/guile/guile.h b/gdb/guile/guile.h
new file mode 100644
index 0000000..333047d
--- /dev/null
+++ b/gdb/guile/guile.h
@@ -0,0 +1,28 @@
+/* General GDB/Scheme code.
+
+   Copyright (C) 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/>.  */
+
+#ifndef GDB_GUILE_H
+#define GDB_GUILE_H
+
+#include "extension.h"
+
+/* This is all that guile exports to gdb.  */
+extern const struct extension_language_defn extension_language_guile;
+
+#endif /* GDB_GUILE_H */
diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm
new file mode 100644
index 0000000..f12769e
--- /dev/null
+++ b/gdb/guile/lib/gdb.scm
@@ -0,0 +1,452 @@
+;; Scheme side of the gdb module.
+;;
+;; Copyright (C) 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/>.
+
+;; This file is loaded with scm_c_primitive_load, which is ok, but files
+;; loaded with it are not compiled.  So we do very little here, and do
+;; most of the initialization in init.scm.
+
+(define-module (gdb)
+  ;; The version of the (gdb) module as (major minor).
+  ;; Incompatible changes bump the major version.
+  ;; Other changes bump the minor version.
+  ;; It's not clear whether we need a patch-level as well, but this can
+  ;; be added later if necessary.
+  ;; This is not the GDB version on purpose.  This version tracks the Scheme
+  ;; gdb module version.
+  ;; TODO: Change to (1 0) when ready.
+  #:version (0 1))
+
+;; Export the bits provided by the C side.
+;; This is so that the compiler can see the exports when
+;; other code uses this module.
+;; TODO: Generating this list would be nice, but it would require an addition
+;; to the GDB build system.  Still, I think it's worth it.
+
+(export
+
+ ;; guile.c
+
+ execute
+ data-directory
+ gdb-version
+ host-config
+ target-config
+
+ ;; scm-arch.c
+
+ arch?
+ current-arch
+ arch-name
+ arch-charset
+ arch-wide-charset
+
+ arch-void-type
+ arch-char-type
+ arch-short-type
+ arch-int-type
+ arch-long-type
+
+ arch-schar-type
+ arch-uchar-type
+ arch-ushort-type
+ arch-uint-type
+ arch-ulong-type
+ arch-float-type
+ arch-double-type
+ arch-longdouble-type
+ arch-bool-type
+ arch-longlong-type
+ arch-ulonglong-type
+
+ arch-int8-type
+ arch-uint8-type
+ arch-int16-type
+ arch-uint16-type
+ arch-int32-type
+ arch-uint32-type
+ arch-int64-type
+ arch-uint64-type
+
+ ;; scm-block.c
+
+ block?
+ block-valid?
+ block-start
+ block-end
+ block-function
+ block-superblock
+ block-global-block
+ block-static-block
+ block-global?
+ block-static?
+ block-symbols
+ make-block-symbols-iterator
+ block-symbols-progress?
+ lookup-block
+
+ ;; scm-breakpoint.c
+
+ BP_NONE
+ BP_BREAKPOINT
+ BP_WATCHPOINT
+ BP_HARDWARE_WATCHPOINT
+ BP_READ_WATCHPOINT
+ BP_ACCESS_WATCHPOINT
+
+ WP_READ
+ WP_WRITE
+ WP_ACCESS
+
+ make-breakpoint
+ breakpoint-delete!
+ breakpoints
+ breakpoint?
+ breakpoint-valid?
+ breakpoint-number
+ breakpoint-type
+ brekapoint-visible?
+ breakpoint-location
+ breakpoint-expression
+ breakpoint-enabled?
+ set-breakpoint-enabled!
+ breakpoint-silent?
+ set-breakpoint-silent!
+ breakpoint-ignore-count
+ set-breakpoint-ignore-count!
+ breakpoint-hit-count
+ set-breakpoint-hit-count!
+ breakpoint-thread
+ set-breakpoint-thread!
+ breakpoint-task
+ set-breakpoint-task!
+ breakpoint-condition
+ set-breakpoint-condition!
+ breakpoint-stop
+ set-breakpoint-stop!
+ breakpoint-commands
+
+ ;; scm-disasm.c
+
+ arch-disassemble
+
+ ;; scm-exception.c
+
+ make-exception
+ exception?
+ exception-key
+ exception-args
+
+ ;; scm-frame.c
+
+ NORMAL_FRAME
+ DUMMY_FRAME
+ INLINE_FRAME
+ TAILCALL_FRAME
+ SIGTRAMP_FRAME
+ ARCH_FRAME
+ SENTINEL_FRAME
+
+ FRAME_UNWIND_NO_REASON
+ FRAME_UNWIND_NULL_ID
+ FRAME_UNWIND_OUTERMOST
+ FRAME_UNWIND_UNAVAILABLE
+ FRAME_UNWIND_INNER_ID
+ FRAME_UNWIND_SAME_ID
+ FRAME_UNWIND_NO_SAVED_PC
+
+ frame?
+ frame-valid?
+ frame-name
+ frame-type
+ frame-arch
+ frame-unwind-stop-reason
+ frame-pc
+ frame-block
+ frame-function
+ frame-older
+ frame-newer
+ frame-sal
+ frame-read-var
+ frame-select
+ newest-frame
+ selected-frame
+ unwind-stop-reason-string
+
+ ;; scm-iterator.c
+
+ make-iterator
+ iterator?
+ iterator-object
+ iterator-progress
+ set-iterator-progress!
+ iterator-next!
+ end-of-iteration
+ end-of-iteration?
+
+ ;; scm-lazy-string.c
+ ;; FIXME: Where's the constructor?
+
+ lazy-string?
+ lazy-string-address
+ lazy-string-length
+ lazy-string-encoding
+ lazy-string-type
+ lazy-string->value
+
+ ;; scm-math.c
+
+ valid-add
+ value-sub
+ value-mul
+ value-div
+ value-rem
+ value-mod
+ value-pow
+ value-not
+ value-neg
+ value-pos
+ value-abs
+ value-lsh
+ value-rsh
+ value-min
+ value-max
+ value-lognot
+ value-logand
+ value-logior
+ value-logxor
+ value=?
+ value<?
+ value<=?
+ value>?
+ value>=?
+
+ ;; scm-objfile.c
+
+ objfile?
+ objfile-valid?
+ objfile-filename
+ objfile-pretty-printers
+ set-objfile-pretty-printers!
+ current-objfile
+ objfiles
+
+ ;; scm-ports.c
+
+ input-port
+ output-port
+ error-port
+ stdio-port?
+ open-memory
+ memory-port?
+ memory-port-range
+ memory-port-read-buffer-size
+ set-memory-port-read-buffer-size!
+ memory-port-write-buffer-size
+ set-memory-port-write-buffer-size!
+ ;; with-gdb-output-to-port, with-gdb-error-to-port are in experimental.scm.
+
+ ;; scm-pretty-print.c
+
+ make-pretty-printer
+ pretty-printer?
+ pretty-printer-enabled?
+ set-pretty-printer-enabled!
+ make-pretty-printer-worker
+ pretty-printer-worker?
+
+ ;; scm-smob.c
+
+ gsmob-kind
+ gsmob-property
+ set-gsmob-property!
+ gsmob-has-property?
+ gsmob-properties
+
+ ;; scm-string.c
+
+ string->argv
+
+ ;; scm-symbol.c
+
+ SYMBOL_LOC_UNDEF
+ SYMBOL_LOC_CONST
+ SYMBOL_LOC_STATIC
+ SYMBOL_LOC_REGISTER
+ SYMBOL_LOC_ARG
+ SYMBOL_LOC_REF_ARG
+ SYMBOL_LOC_LOCAL
+ SYMBOL_LOC_TYPEDEF
+ SYMBOL_LOC_LABEL
+ SYMBOL_LOC_BLOCK
+ SYMBOL_LOC_CONST_BYTES
+ SYMBOL_LOC_UNRESOLVED
+ SYMBOL_LOC_OPTIMIZED_OUT
+ SYMBOL_LOC_COMPUTED
+ SYMBOL_LOC_REGPARM_ADDR
+
+ SYMBOL_UNDEF_DOMAIN
+ SYMBOL_VAR_DOMAIN
+ SYMBOL_STRUCT_DOMAIN
+ SYMBOL_LABEL_DOMAIN
+ SYMBOL_VARIABLES_DOMAIN
+ SYMBOL_FUNCTIONS_DOMAIN
+ SYMBOL_TYPES_DOMAIN
+
+ symbol?
+ symbol-valid?
+ symbol-type
+ symbol-symtab
+ symbol-line
+ symbol-name
+ symbol-linkage-name
+ symbol-print-name
+ symbol-addr-class
+ symbol-argument?
+ symbol-constant?
+ symbol-function?
+ symbol-variable?
+ symbol-needs-frame?
+ symbol-value
+ lookup-symbol
+ lookup-global-symbol
+
+ ;; scm-symtab.c
+
+ symtab?
+ symtab-valid?
+ symtab-filename
+ symtab-fullname
+ symtab-objfile
+ symtab-global-block
+ symtab-static-block
+ sal?
+ sal-valid?
+ sal-symtab
+ sal-line
+ sal-pc
+ sal-last
+ find-pc-line
+
+ ;; scm-type.c
+
+ TYPE_CODE_BITSTRING
+ TYPE_CODE_PTR
+ TYPE_CODE_ARRAY
+ TYPE_CODE_STRUCT
+ TYPE_CODE_UNION
+ TYPE_CODE_ENUM
+ TYPE_CODE_FLAGS
+ TYPE_CODE_FUNC
+ TYPE_CODE_INT
+ TYPE_CODE_FLT
+ TYPE_CODE_VOID
+ TYPE_CODE_SET
+ TYPE_CODE_RANGE
+ TYPE_CODE_STRING
+ TYPE_CODE_ERROR
+ TYPE_CODE_METHOD
+ TYPE_CODE_METHODPTR
+ TYPE_CODE_MEMBERPTR
+ TYPE_CODE_REF
+ TYPE_CODE_CHAR
+ TYPE_CODE_BOOL
+ TYPE_CODE_COMPLEX
+ TYPE_CODE_TYPEDEF
+ TYPE_CODE_NAMESPACE
+ TYPE_CODE_DECFLOAT
+ TYPE_CODE_INTERNAL_FUNCTION
+
+ type?
+ lookup-type
+ type-code
+ type-fields
+ type-tag
+ type-sizeof
+ type-strip-typedefs
+ type-array
+ type-vector
+ type-pointer
+ type-range
+ type-reference
+ type-target
+ type-const
+ type-volatile
+ type-unqualified
+ type-name
+ type-num-fields
+ type-fields
+ make-field-iterator
+ type-field
+ type-has-field?
+ field?
+ field-name
+ field-type
+ field-enumval
+ field-bitpos
+ field-bitsize
+ field-artificial?
+ field-baseclass?
+
+ ;; scm-value.c
+
+ value?
+ make-value
+ value-optimized-out?
+ value-address
+ value-type
+ value-dynamic-type
+ value-cast
+ value-dynamic-cast
+ value-reinterpret-cast
+ value-dereference
+ value-referenced-value
+ value-field
+ value-subscript
+ value-call
+ value->bool
+ value->integer
+ value->real
+ value->bytevector
+ value->string
+ value->lazy-string
+ value-lazy?
+ make-lazy-value
+ value-fetch-lazy!
+ value-print
+ parse-and-eval
+ history-ref
+)
+
+;; Load the rest of the Scheme side.
+;; data-directory is provided by the C code.
+
+(add-to-load-path
+ (string-append (data-directory) file-name-separator-string "guile"))
+
+(use-modules ((gdb init)))
+
+;; These come from other files, but they're really part of this module.
+
+(re-export
+
+ ;; init.scm
+ orig-input-port
+ orig-output-port
+ orig-error-port
+)
diff --git a/gdb/guile/lib/gdb/boot.scm b/gdb/guile/lib/gdb/boot.scm
new file mode 100644
index 0000000..cf7d305
--- /dev/null
+++ b/gdb/guile/lib/gdb/boot.scm
@@ -0,0 +1,31 @@
+;; Bootstrap the Scheme side of the gdb module.
+;;
+;; Copyright (C) 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/>.
+
+;; This file is loaded with scm_c_primitive_load, which is ok, but files
+;; loaded with it are not compiled.  So we do very little here, and do
+;; most of the initialization elsewhere.
+
+;; data-directory is provided by the C code.
+(load (string-append
+       (data-directory) file-name-separator-string "guile"
+       file-name-separator-string "gdb.scm"))
+
+;; Now that the Scheme side support is loaded, initialize it.
+(let ((init-proc (@@ (gdb init) %initialize!)))
+  (init-proc))
diff --git a/gdb/guile/lib/gdb/experimental.scm b/gdb/guile/lib/gdb/experimental.scm
new file mode 100644
index 0000000..ffded84
--- /dev/null
+++ b/gdb/guile/lib/gdb/experimental.scm
@@ -0,0 +1,35 @@
+;; Various experimental utilities.
+;; Anything in this file can change or disappear.
+;;
+;; Copyright (C) 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/>.
+
+;; TODO: Split this file up by function?
+;; E.g., (gdb experimental ports), etc.
+
+(define-module (gdb experimental)
+  #:use-module (gdb)
+  #:use-module (gdb init))
+
+;; These are defined in C.
+(define-public with-gdb-output-to-port (@@ (gdb) %with-gdb-output-to-port))
+(define-public with-gdb-error-to-port (@@ (gdb) %with-gdb-error-to-port))
+
+(define-public (with-gdb-output-to-string thunk)
+  "Calls THUNK and returns all GDB output as a string."
+  (call-with-output-string
+   (lambda (p) (with-gdb-output-to-port p thunk))))
diff --git a/gdb/guile/lib/gdb/init.scm b/gdb/guile/lib/gdb/init.scm
new file mode 100644
index 0000000..12ad67d
--- /dev/null
+++ b/gdb/guile/lib/gdb/init.scm
@@ -0,0 +1,173 @@
+;; Scheme side of the gdb module.
+;;
+;; Copyright (C) 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/>.
+
+(define-module (gdb init)
+  #:use-module (gdb))
+
+(define-public SCM_ARG1 1)
+(define-public SCM_ARG2 2)
+
+;; The original i/o ports.  In case the user wants them back.
+(define %orig-input-port #f)
+(define %orig-output-port #f)
+(define %orig-error-port #f)
+
+;; %exception-print-style is exported as "private" by gdb.
+(define %exception-print-style (@@ (gdb) %exception-print-style))
+
+;; Keys for GDB-generated exceptions.
+;; gdb:with-stack is handled separately.
+
+(define %exception-keys '(gdb:error
+			  gdb:invalid-object-error
+			  gdb:memory-error
+			  gdb:pp-type-error))
+
+;; Printer for gdb exceptions, used when Scheme tries to print them directly.
+
+(define (%exception-printer port key args default-printer)
+  (apply (case-lambda
+	  ((subr msg args . rest)
+	   (if subr
+	       (format port "In procedure ~a: " subr))
+	   (apply format port msg (or args '())))
+	  (_ (default-printer)))
+	 args))
+
+;; Print the message part of a gdb:with-stack exception.
+;; The arg list is the way it is because it's passed to set-exception-printer!.
+;; We don't print a backtrace here because Guile will have already printed a
+;; backtrace.
+
+(define (%with-stack-exception-printer port key args default-printer)
+  (let ((real-key (car args))
+	(real-args (cddr args)))
+    (%exception-printer port real-key real-args default-printer)))
+
+;; Copy of Guile's print-exception that tweaks the output for our purposes.
+;; TODO: It's not clear the tweaking is still necessary.
+
+(define (%print-exception-message-worker port key args)
+  (define (default-printer)
+    (format port "Throw to key `~a' with args `~s'." key args))
+  (format port "ERROR: ")
+  ;; Pass #t for tag to catch all errors.
+  (catch #t
+	 (lambda ()
+	   (%exception-printer port key args default-printer))
+	 (lambda (k . args)
+	   (format port "Error while printing gdb exception: ~a ~s."
+		   k args)))
+  (newline port)
+  (force-output port))
+
+;; Called from the C code to print an exception.
+;; Guile prints them a little differently than we want.
+;; See boot-9.scm:print-exception.
+
+(define (%print-exception-message port frame key args)
+  (cond ((memq key %exception-keys)
+	 (%print-exception-message-worker port key args))
+	(else
+	 (print-exception port frame key args)))
+  *unspecified*)
+
+;; Called from the C code to print an exception according to the setting
+;; of "guile print-stack".
+;;
+;; If PORT is #f, use the standard error port.
+;; If STACK is #f, never print the stack, regardless of whether printing it
+;; is enabled.  If STACK is #t, then print it if it is contained in ARGS
+;; (i.e., KEY is gdb:with-stack).  Otherwise STACK is the result of calling
+;; scm_make_stack (which will be ignored in favor of the stack in ARGS if
+;; KEY is gdb:with-stack).
+;; KEY, ARGS are the standard arguments to scm_throw, et.al.
+
+(define (%print-exception-with-stack port stack key args)
+  (let ((style (%exception-print-style)))
+    (if (not (eq? style 'none))
+	(let ((error-port (current-error-port))
+	      (frame #f))
+	  (if (not port)
+	      (set! port error-port))
+	  (if (eq? port error-port)
+	      (begin
+		(force-output (current-output-port))
+		;; In case the current output port is not gdb's output port.
+		(force-output (output-port))))
+
+	  ;; If the exception is gdb:with-stack, unwrap it to get the stack and
+	  ;; underlying exception.  If the caller happens to pass in a stack,
+	  ;; we ignore it and use the one in ARGS instead.
+	  (if (eq? key 'gdb:with-stack)
+	      (begin
+		(set! key (car args))
+		(if stack
+		    (set! stack (cadr args)))
+		(set! args (cddr args))))
+
+	  ;; If caller wanted a stack and there isn't one, disable backtracing.
+	  (if (eq? stack #t)
+	      (set! stack #f))
+	  ;; At this point if stack is true, then it is assumed to be a stack.
+	  (if stack
+	      (set! frame (stack-ref stack 0)))
+
+	  (if (and (eq? style 'full) stack)
+	      (begin
+		;; This is derived from libguile/throw.c:handler_message.
+		;; We include "Guile" in "Guile Backtrace" whereas the Guile
+		;; version does not so that tests can know it's us printing
+		;; the backtrace.  Plus it could help beginners.
+		(display "Guile Backtrace:\n" port)
+		(display-backtrace stack port #f #f '())
+		(newline port)))
+
+	  (%print-exception-message port frame key args)))))
+
+;; Internal utility to check the type of an argument, akin to SCM_ASSERT_TYPE.
+;; It's public so other gdb modules can use it.
+
+(define-public (%assert-type test-result arg pos func-name)
+  (if (not test-result)
+      (scm-error 'wrong-type-arg func-name
+		 "Wrong type argument in position ~a: ~s"
+		 (list pos arg) (list arg))))
+
+;; Internal utility called during startup to initialize the Scheme side of
+;; GDB+Guile.
+
+(define (%initialize!)
+  (add-to-load-path (string-append (data-directory)
+				   file-name-separator-string "guile"))
+
+  (for-each (lambda (key)
+	      (set-exception-printer! key %exception-printer))
+	    %exception-keys)
+  (set-exception-printer! 'gdb:with-stack %with-stack-exception-printer)
+
+  (set! %orig-input-port (set-current-input-port (input-port)))
+  (set! %orig-output-port (set-current-output-port (output-port)))
+  (set! %orig-error-port (set-current-error-port (error-port))))
+
+;; Public routines.
+
+(define-public (orig-input-port) %orig-input-port)
+(define-public (orig-output-port) %orig-output-port)
+(define-public (orig-error-port) %orig-error-port)
diff --git a/gdb/guile/lib/gdb/iterator.scm b/gdb/guile/lib/gdb/iterator.scm
new file mode 100644
index 0000000..9cfbe85
--- /dev/null
+++ b/gdb/guile/lib/gdb/iterator.scm
@@ -0,0 +1,80 @@
+;; Iteration utilities.
+;; Anything in this file can change or disappear.
+;;
+;; Copyright (C) 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/>.
+
+(define-module (gdb iterator)
+  #:use-module (gdb))
+
+(define-public (make-list-iterator l)
+  "Return a <gdb:iterator> object for a list."
+  (%assert-type (list? l) l SCM_ARG1 'make-list-iterator)
+  (let ((next! (lambda (iter)
+		 (let ((l (iterator-progress iter)))
+		   (if (eq? l '())
+		       (end-of-iteration)
+		       (begin
+			 (set-iterator-progress! iter (cdr l))
+			 (car l)))))))
+    (make-iterator l l next!)))
+
+(define-public (iterator->list iter)
+  "Return the elements of ITER as a list."
+  (let loop ((iter iter)
+	     (result '()))
+    (let ((next (iterator-next! iter)))
+      (if (end-of-iteration? next)
+	  (reverse! result)
+	  (loop iter (cons next result))))))
+
+(define-public (iterator-map proc iter)
+  "Return a list of PROC applied to each element."
+  (let loop ((proc proc)
+	     (iter iter)
+	     (result '()))
+    (let ((next (iterator-next! iter)))
+      (if (end-of-iteration? next)
+	  (reverse! result)
+	  (loop proc iter (cons (proc next) result))))))
+
+(define-public (iterator-for-each proc iter)
+  "Apply PROC to each element.  The result is unspecified."
+  (let ((next (iterator-next! iter)))
+    (if (not (end-of-iteration? next))
+	(begin
+	  (proc next)
+	  (iterator-for-each proc iter)))))
+
+(define-public (iterator-filter pred iter)
+  "Return the elements that satify predicate PRED."
+  (let loop ((result '()))
+    (let ((next (iterator-next! iter)))
+      (cond ((end-of-iteration? next) (reverse! result))
+	    ((pred next) (loop (cons next result)))
+	    (else (loop result))))))
+
+(define-public (iterator-until pred iter)
+  "Run the iterator until the result of (pred element) is true.
+
+  Returns:
+    The result of the first (pred element) call that returns true,
+    or #f if no element matches."
+  (let loop ((next (iterator-next! iter)))
+    (cond ((end-of-iteration? next) #f)
+	  ((pred next) => identity)
+	  (else (loop (iterator-next! iter))))))
diff --git a/gdb/guile/lib/gdb/printing.scm b/gdb/guile/lib/gdb/printing.scm
new file mode 100644
index 0000000..36e3275
--- /dev/null
+++ b/gdb/guile/lib/gdb/printing.scm
@@ -0,0 +1,52 @@
+;; Additional pretty-printer support.
+;;
+;; Copyright (C) 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/>.
+
+(define-module (gdb printing)
+  #:use-module ((gdb) #:select
+		(*pretty-printers* pretty-printer? objfile?
+		 objfile-pretty-printers set-objfile-pretty-printers!))
+  #:use-module (gdb init))
+
+(define-public (prepend-pretty-printer! obj matcher)
+  "Add MATCHER to the beginning of the pretty-printer list for OBJ.
+If OBJ is #f, add MATCHER to the global list."
+  (%assert-type (pretty-printer? matcher) matcher SCM_ARG1
+		'prepend-pretty-printer!)
+  (cond ((eq? obj #f)
+	 (set! *pretty-printers* (cons matcher *pretty-printers*)))
+	((objfile? obj)
+	 (set-objfile-pretty-printers! obj
+				       (cons matcher
+					     (objfile-pretty-printers obj))))
+	(else
+	 (%assert-type #f obj SCM_ARG1 'prepend-pretty-printer!))))
+
+(define-public (append-pretty-printer! obj matcher)
+  "Add MATCHER to the end of the pretty-printer list for OBJ.
+If OBJ is #f, add MATCHER to the global list."
+  (%assert-type (pretty-printer? matcher) matcher SCM_ARG1
+		'append-pretty-printer!)
+  (cond ((eq? obj #f)
+	 (set! *pretty-printers* (append! *pretty-printers* (list matcher))))
+	((objfile? obj)
+	 (set-objfile-pretty-printers! obj
+				       (append! (objfile-pretty-printers obj)
+						matcher)))
+	(else
+	 (%assert-type #f obj SCM_ARG1 'append-pretty-printer!))))
diff --git a/gdb/guile/lib/gdb/types.scm b/gdb/guile/lib/gdb/types.scm
new file mode 100644
index 0000000..31ea192
--- /dev/null
+++ b/gdb/guile/lib/gdb/types.scm
@@ -0,0 +1,78 @@
+;; Type utilities.
+;; Copyright (C) 2010-2014 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 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/>.
+
+(define-module (gdb types)
+  #:use-module (gdb)
+  #:use-module (gdb init)
+  #:use-module (gdb iterator))
+
+(define-public (type-has-field-deep? type field-name)
+  "Return #t if the type, including baseclasses, has the specified field.
+
+  Arguments:
+    type: The type to examine.  It must be a struct or union.
+    field-name: The name of the field to look up.
+
+  Returns:
+    True if the field is present either in type_ or any baseclass.
+
+  Raises:
+    wrong-type-arg: The type is not a struct or union."
+
+  (define (search-class type)
+    (let ((find-in-baseclass (lambda (field)
+			       (if (field-baseclass? field)
+				   (search-class (field-type field))
+				   ;; Not a baseclass, search ends now.
+				   ;; Return #:end to end search.
+				   #:end))))
+      (let ((search-baseclasses
+	     (lambda (type)
+	       (iterator-until find-in-baseclass
+			       (make-field-iterator type)))))
+	(or (type-has-field? type field-name)
+	    (not (eq? (search-baseclasses type) #:end))))))
+
+  (if (= (type-code type) TYPE_CODE_REF)
+      (set! type (type-target type)))
+  (set! type (type-strip-typedefs type))
+
+  (%assert-type (memq (type-code type) (list TYPE_CODE_STRUCT TYPE_CODE_UNION))
+		type SCM_ARG1 'type-has-field-deep?)
+
+  (search-class type))
+
+(define-public (make-enum-hashtable enum-type)
+  "Return a hash table from a program's enum type.
+
+  Elements in the hash table are fetched with hashq-ref.
+
+  Arguments:
+    enum-type: The enum to compute the hash table for.
+
+  Returns:
+    The hash table of the enum.
+
+  Raises:
+    wrong-type-arg: The type is not an enum."
+
+  (%assert-type (= (type-code enum-type) TYPE_CODE_ENUM)
+		enum-type SCM_ARG1 'make-enum-hashtable)
+  (let ((htab (make-hash-table)))
+    (for-each (lambda (enum)
+		(hash-set! htab (field-name enum) (field-enumval enum)))
+	      (type-fields enum-type))
+    htab))
diff --git a/gdb/guile/scm-arch.c b/gdb/guile/scm-arch.c
new file mode 100644
index 0000000..fa578f3
--- /dev/null
+++ b/gdb/guile/scm-arch.c
@@ -0,0 +1,668 @@
+/* Scheme interface to architecture.
+
+   Copyright (C) 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 "charset.h"
+#include "gdbarch.h"
+#include "arch-utils.h"
+#include "guile-internal.h"
+
+/* The <gdb:arch> smob.
+   The typedef for this struct is in guile-internal.h.  */
+
+struct _arch_smob
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  struct gdbarch *gdbarch;
+};
+
+static const char arch_smob_name[] = "gdb:arch";
+
+/* The tag Guile knows the arch smob by.  */
+static scm_t_bits arch_smob_tag;
+
+static struct gdbarch_data *arch_object_data = NULL;
+
+static int arscm_is_arch (SCM);
+
+/* Administrivia for arch smobs.  */
+
+/* The smob "mark" function for <gdb:arch>.  */
+
+static SCM
+arscm_mark_arch_smob (SCM self)
+{
+  arch_smob *a_smob = (arch_smob *) SCM_SMOB_DATA (self);
+
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&a_smob->base);
+}
+
+/* The smob "print" function for <gdb:arch>.  */
+
+static int
+arscm_print_arch_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  arch_smob *a_smob = (arch_smob *) SCM_SMOB_DATA (self);
+  struct gdbarch *gdbarch = a_smob->gdbarch;
+
+  gdbscm_printf (port, "#<%s", arch_smob_name);
+  gdbscm_printf (port, " %s", gdbarch_bfd_arch_info (gdbarch)->printable_name);
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:arch> object for GDBARCH.  */
+
+static SCM
+arscm_make_arch_smob (struct gdbarch *gdbarch)
+{
+  arch_smob *a_smob = (arch_smob *)
+    scm_gc_malloc (sizeof (arch_smob), arch_smob_name);
+  SCM a_scm;
+
+  a_smob->gdbarch = gdbarch;
+  a_scm = scm_new_smob (arch_smob_tag, (scm_t_bits) a_smob);
+  gdbscm_init_gsmob (&a_smob->base);
+
+  return a_scm;
+}
+
+/* Return the gdbarch field of A_SMOB.  */
+
+struct gdbarch *
+arscm_get_gdbarch (arch_smob *a_smob)
+{
+  return a_smob->gdbarch;
+}
+
+/* Return non-zero if SCM is an architecture smob.  */
+
+static int
+arscm_is_arch (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (arch_smob_tag, scm);
+}
+
+/* (arch? object) -> boolean */
+
+static SCM
+gdbscm_arch_p (SCM scm)
+{
+  return scm_from_bool (arscm_is_arch (scm));
+}
+
+/* Associates an arch_object with GDBARCH as gdbarch_data via the gdbarch
+   post init registration mechanism (gdbarch_data_register_post_init).  */
+
+static void *
+arscm_object_data_init (struct gdbarch *gdbarch)
+{
+  SCM arch_scm = arscm_make_arch_smob (gdbarch);
+
+  /* This object lasts the duration of the GDB session, so there is no
+     call to scm_gc_unprotect_object for it.  */
+  scm_gc_protect_object (arch_scm);
+
+  return (void *) arch_scm;
+}
+
+/* Return the <gdb:arch> object corresponding to GDBARCH.
+   The object is cached in GDBARCH so this is simple.  */
+
+SCM
+arscm_scm_from_arch (struct gdbarch *gdbarch)
+{
+  SCM a_scm = (SCM) gdbarch_data (gdbarch, arch_object_data);
+
+  return a_scm;
+}
+
+/* Return the <gdb:arch> smob in SELF.
+   Throws an exception if SELF is not a <gdb:arch> object.  */
+
+static SCM
+arscm_get_arch_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (arscm_is_arch (self), self, arg_pos, func_name,
+		   arch_smob_name);
+
+  return self;
+}
+
+/* Return a pointer to the arch smob of SELF.
+   Throws an exception if SELF is not a <gdb:arch> object.  */
+
+arch_smob *
+arscm_get_arch_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM a_scm = arscm_get_arch_arg_unsafe (self, arg_pos, func_name);
+  arch_smob *a_smob = (arch_smob *) SCM_SMOB_DATA (a_scm);
+
+  return a_smob;
+}
+
+/* Arch methods.  */
+
+/* (current-arch) -> <gdb:arch>
+   Return the architecture of the currently selected stack frame,
+   if there is one, or the current target if there isn't.  */
+
+static SCM
+gdbscm_current_arch (void)
+{
+  return arscm_scm_from_arch (get_current_arch ());
+}
+
+/* (arch-name <gdb:arch>) -> string
+   Return the name of the architecture as a string value.  */
+
+static SCM
+gdbscm_arch_name (SCM self)
+{
+  arch_smob *a_smob
+    = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct gdbarch *gdbarch = a_smob->gdbarch;
+  const char *name;
+
+  name = (gdbarch_bfd_arch_info (gdbarch))->printable_name;
+
+  return gdbscm_scm_from_c_string (name);
+}
+
+/* (arch-charset <gdb:arch>) -> string */
+
+static SCM
+gdbscm_arch_charset (SCM self)
+{
+  arch_smob *a_smob
+    =arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct gdbarch *gdbarch = a_smob->gdbarch;
+
+  return gdbscm_scm_from_c_string (target_charset (gdbarch));
+}
+
+/* (arch-wide-charset <gdb:arch>) -> string */
+
+static SCM
+gdbscm_arch_wide_charset (SCM self)
+{
+  arch_smob *a_smob
+    = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct gdbarch *gdbarch = a_smob->gdbarch;
+
+  return gdbscm_scm_from_c_string (target_wide_charset (gdbarch));
+}
+
+/* Builtin types.
+
+   The order the types are defined here follows the order in
+   struct builtin_type.  */
+
+/* Helper routine to return a builtin type for <gdb:arch> object SELF.
+   OFFSET is offsetof (builtin_type, the_type).
+   Throws an exception if SELF is not a <gdb:arch> object.  */
+
+static const struct builtin_type *
+gdbscm_arch_builtin_type (SCM self, const char *func_name)
+{
+  arch_smob *a_smob
+    = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, func_name);
+  struct gdbarch *gdbarch = a_smob->gdbarch;
+
+  return builtin_type (gdbarch);
+}
+
+/* (arch-void-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_void_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_void;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-char-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_char_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_char;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-short-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_short_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_short;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-int-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_int_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-long-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_long_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_long;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-schar-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_schar_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_signed_char;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-uchar-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_uchar_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_char;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-ushort-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_ushort_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_short;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-uint-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_uint_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_int;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-ulong-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_ulong_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_long;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-float-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_float_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_float;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-double-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_double_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_double;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-longdouble-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_longdouble_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_long_double;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-bool-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_bool_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_bool;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-longlong-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_longlong_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_long_long;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-ulonglong-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_ulonglong_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_long_long;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-int8-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_int8_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int8;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-uint8-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_uint8_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_uint8;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-int16-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_int16_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int16;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-uint16-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_uint16_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_uint16;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-int32-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_int32_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int32;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-uint32-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_uint32_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_uint32;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-int64-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_int64_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int64;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (arch-uint64-type <gdb:arch>) -> <gdb:type> */
+
+static SCM
+gdbscm_arch_uint64_type (SCM self)
+{
+  struct type *type
+    = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_uint64;
+
+  return tyscm_scm_from_type (type);
+}
+
+/* Initialize the Scheme architecture support.  */
+
+static const scheme_function arch_functions[] =
+{
+  { "arch?", 1, 0, 0, gdbscm_arch_p,
+    "\
+Return #t if the object is a <gdb:arch> object." },
+
+  { "current-arch", 0, 0, 0, gdbscm_current_arch,
+    "\
+Return the <gdb:arch> object representing the architecture of the\n\
+currently selected stack frame, if there is one, or the architecture of the\n\
+current target if there isn't.\n\
+\n\
+  Arguments: none" },
+
+  { "arch-name", 1, 0, 0, gdbscm_arch_name,
+    "\
+Return the name of the architecture." },
+
+  { "arch-charset", 1, 0, 0, gdbscm_arch_charset,
+  "\
+Return name of target character set as a string." },
+
+  { "arch-wide-charset", 1, 0, 0, gdbscm_arch_wide_charset,
+  "\
+Return name of target wide character set as a string." },
+
+  { "arch-void-type", 1, 0, 0, gdbscm_arch_void_type,
+    "\
+Return the <gdb:type> object for the \"void\" type\n\
+of the architecture." },
+
+  { "arch-char-type", 1, 0, 0, gdbscm_arch_char_type,
+    "\
+Return the <gdb:type> object for the \"char\" type\n\
+of the architecture." },
+
+  { "arch-short-type", 1, 0, 0, gdbscm_arch_short_type,
+    "\
+Return the <gdb:type> object for the \"short\" type\n\
+of the architecture." },
+
+  { "arch-int-type", 1, 0, 0, gdbscm_arch_int_type,
+    "\
+Return the <gdb:type> object for the \"int\" type\n\
+of the architecture." },
+
+  { "arch-long-type", 1, 0, 0, gdbscm_arch_long_type,
+    "\
+Return the <gdb:type> object for the \"long\" type\n\
+of the architecture." },
+
+  { "arch-schar-type", 1, 0, 0, gdbscm_arch_schar_type,
+    "\
+Return the <gdb:type> object for the \"signed char\" type\n\
+of the architecture." },
+
+  { "arch-uchar-type", 1, 0, 0, gdbscm_arch_uchar_type,
+    "\
+Return the <gdb:type> object for the \"unsigned char\" type\n\
+of the architecture." },
+
+  { "arch-ushort-type", 1, 0, 0, gdbscm_arch_ushort_type,
+    "\
+Return the <gdb:type> object for the \"unsigned short\" type\n\
+of the architecture." },
+
+  { "arch-uint-type", 1, 0, 0, gdbscm_arch_uint_type,
+    "\
+Return the <gdb:type> object for the \"unsigned int\" type\n\
+of the architecture." },
+
+  { "arch-ulong-type", 1, 0, 0, gdbscm_arch_ulong_type,
+    "\
+Return the <gdb:type> object for the \"unsigned long\" type\n\
+of the architecture." },
+
+  { "arch-float-type", 1, 0, 0, gdbscm_arch_float_type,
+    "\
+Return the <gdb:type> object for the \"float\" type\n\
+of the architecture." },
+
+  { "arch-double-type", 1, 0, 0, gdbscm_arch_double_type,
+    "\
+Return the <gdb:type> object for the \"double\" type\n\
+of the architecture." },
+
+  { "arch-longdouble-type", 1, 0, 0, gdbscm_arch_longdouble_type,
+    "\
+Return the <gdb:type> object for the \"long double\" type\n\
+of the architecture." },
+
+  { "arch-bool-type", 1, 0, 0, gdbscm_arch_bool_type,
+    "\
+Return the <gdb:type> object for the \"bool\" type\n\
+of the architecture." },
+
+  { "arch-longlong-type", 1, 0, 0, gdbscm_arch_longlong_type,
+    "\
+Return the <gdb:type> object for the \"long long\" type\n\
+of the architecture." },
+
+  { "arch-ulonglong-type", 1, 0, 0,
+    gdbscm_arch_ulonglong_type,
+    "\
+Return the <gdb:type> object for the \"unsigned long long\" type\n\
+of the architecture." },
+
+  { "arch-int8-type", 1, 0, 0, gdbscm_arch_int8_type,
+    "\
+Return the <gdb:type> object for the \"int8\" type\n\
+of the architecture." },
+
+  { "arch-uint8-type", 1, 0, 0, gdbscm_arch_uint8_type,
+    "\
+Return the <gdb:type> object for the \"uint8\" type\n\
+of the architecture." },
+
+  { "arch-int16-type", 1, 0, 0, gdbscm_arch_int16_type,
+    "\
+Return the <gdb:type> object for the \"int16\" type\n\
+of the architecture." },
+
+  { "arch-uint16-type", 1, 0, 0, gdbscm_arch_uint16_type,
+    "\
+Return the <gdb:type> object for the \"uint16\" type\n\
+of the architecture." },
+
+  { "arch-int32-type", 1, 0, 0, gdbscm_arch_int32_type,
+    "\
+Return the <gdb:type> object for the \"int32\" type\n\
+of the architecture." },
+
+  { "arch-uint32-type", 1, 0, 0, gdbscm_arch_uint32_type,
+    "\
+Return the <gdb:type> object for the \"uint32\" type\n\
+of the architecture." },
+
+  { "arch-int64-type", 1, 0, 0, gdbscm_arch_int64_type,
+    "\
+Return the <gdb:type> object for the \"int64\" type\n\
+of the architecture." },
+
+  { "arch-uint64-type", 1, 0, 0, gdbscm_arch_uint64_type,
+    "\
+Return the <gdb:type> object for the \"uint64\" type\n\
+of the architecture." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_arches (void)
+{
+  arch_smob_tag = gdbscm_make_smob_type (arch_smob_name, sizeof (arch_smob));
+  scm_set_smob_mark (arch_smob_tag, arscm_mark_arch_smob);
+  scm_set_smob_print (arch_smob_tag, arscm_print_arch_smob);
+
+  gdbscm_define_functions (arch_functions, 1);
+
+  arch_object_data
+    = gdbarch_data_register_post_init (arscm_object_data_init);
+}
diff --git a/gdb/guile/scm-auto-load.c b/gdb/guile/scm-auto-load.c
new file mode 100644
index 0000000..5b9eb23
--- /dev/null
+++ b/gdb/guile/scm-auto-load.c
@@ -0,0 +1,81 @@
+/* GDB routines for supporting auto-loaded Guile scripts.
+
+   Copyright (C) 2010-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/>.  */
+
+#include "defs.h"
+#include <string.h>
+#include "top.h"
+#include "exceptions.h"
+#include "gdbcmd.h"
+#include "objfiles.h"
+#include "cli/cli-cmds.h"
+#include "auto-load.h"
+#include "guile.h"
+#include "guile-internal.h"
+
+/* User-settable option to enable/disable auto-loading of Guile scripts:
+   set auto-load guile-scripts on|off
+   This is true if we should auto-load associated Guile scripts when an
+   objfile is opened, false otherwise.  */
+static int auto_load_guile_scripts = 1;
+
+/* "show" command for the auto_load_guile_scripts configuration variable.  */
+
+static void
+show_auto_load_guile_scripts (struct ui_file *file, int from_tty,
+			      struct cmd_list_element *c, const char *value)
+{
+  fprintf_filtered (file, _("Auto-loading of Guile scripts is %s.\n"), value);
+}
+
+/* Return non-zero if auto-loading Guile scripts is enabled.
+   This is the extension_language_script_ops.auto_load_enabled "method".  */
+
+int
+gdbscm_auto_load_enabled (const struct extension_language_defn *extlang)
+{
+  return auto_load_guile_scripts;
+}
+
+/* Wrapper for "info auto-load guile-scripts".  */
+
+static void
+info_auto_load_guile_scripts (char *pattern, int from_tty)
+{
+  auto_load_info_scripts (pattern, from_tty, &extension_language_guile);
+}
+
+void
+gdbscm_initialize_auto_load (void)
+{
+  add_setshow_boolean_cmd ("guile-scripts", class_support,
+			   &auto_load_guile_scripts, _("\
+Set the debugger's behaviour regarding auto-loaded Guile scripts."), _("\
+Show the debugger's behaviour regarding auto-loaded Guile scripts."), _("\
+If enabled, auto-loaded Guile scripts are loaded when the debugger reads\n\
+an executable or shared library.\n\
+This options has security implications for untrusted inferiors."),
+			   NULL, show_auto_load_guile_scripts,
+			   auto_load_set_cmdlist_get (),
+			   auto_load_show_cmdlist_get ());
+
+  add_cmd ("guile-scripts", class_info, info_auto_load_guile_scripts,
+	   _("Print the list of automatically loaded Guile scripts.\n\
+Usage: info auto-load guile-scripts [REGEXP]"),
+	   auto_load_info_cmdlist_get ());
+}
diff --git a/gdb/guile/scm-block.c b/gdb/guile/scm-block.c
new file mode 100644
index 0000000..de41af2
--- /dev/null
+++ b/gdb/guile/scm-block.c
@@ -0,0 +1,828 @@
+/* Scheme interface to blocks.
+
+   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 "block.h"
+#include "dictionary.h"
+#include "objfiles.h"
+#include "source.h"
+#include "symtab.h"
+#include "guile-internal.h"
+
+/* A smob describing a gdb block.  */
+
+typedef struct _block_smob
+{
+  /* This always appears first.
+     We want blocks to be eq?-able.  And we need to be able to invalidate
+     blocks when the associated objfile is deleted.  */
+  eqable_gdb_smob base;
+
+  /* The GDB block structure that represents a frame's code block.  */
+  const struct block *block;
+
+  /* The backing object file.  There is no direct relationship in GDB
+     between a block and an object file.  When a block is created also
+     store a pointer to the object file for later use.  */
+  struct objfile *objfile;
+} block_smob;
+
+/* To iterate over block symbols from Scheme we need to store
+   struct block_iterator somewhere.  This is stored in the "progress" field
+   of <gdb:iterator>.  We store the block object in iterator_smob.object,
+   so we don't store it here.
+
+   Remember: While iterating over block symbols, you must continually check
+   whether the block is still valid.  */
+
+typedef struct
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* The iterator for that block.  */
+  struct block_iterator iter;
+
+  /* Has the iterator been initialized flag.  */
+  int initialized_p;
+} block_syms_progress_smob;
+
+static const char block_smob_name[] = "gdb:block";
+static const char block_syms_progress_smob_name[] = "gdb:block-symbols-iterator";
+
+/* The tag Guile knows the block smobs by.  */
+static scm_t_bits block_smob_tag;
+static scm_t_bits block_syms_progress_smob_tag;
+
+/* The "next!" block syms iterator method.  */
+static SCM bkscm_next_symbol_x_proc;
+
+static const struct objfile_data *bkscm_objfile_data_key;
+
+/* Administrivia for block smobs.  */
+
+/* Helper function to hash a block_smob.  */
+
+static hashval_t
+bkscm_hash_block_smob (const void *p)
+{
+  const block_smob *b_smob = p;
+
+  return htab_hash_pointer (b_smob->block);
+}
+
+/* Helper function to compute equality of block_smobs.  */
+
+static int
+bkscm_eq_block_smob (const void *ap, const void *bp)
+{
+  const block_smob *a = ap;
+  const block_smob *b = bp;
+
+  return (a->block == b->block
+	  && a->block != NULL);
+}
+
+/* Return the struct block pointer -> SCM mapping table.
+   It is created if necessary.  */
+
+static htab_t
+bkscm_objfile_block_map (struct objfile *objfile)
+{
+  htab_t htab = objfile_data (objfile, bkscm_objfile_data_key);
+
+  if (htab == NULL)
+    {
+      htab = gdbscm_create_eqable_gsmob_ptr_map (bkscm_hash_block_smob,
+						 bkscm_eq_block_smob);
+      set_objfile_data (objfile, bkscm_objfile_data_key, htab);
+    }
+
+  return htab;
+}
+
+/* The smob "mark" function for <gdb:block>.  */
+
+static SCM
+bkscm_mark_block_smob (SCM self)
+{
+  block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (self);
+
+  /* Do this last.  */
+  return gdbscm_mark_eqable_gsmob (&b_smob->base);
+}
+
+/* The smob "free" function for <gdb:block>.  */
+
+static size_t
+bkscm_free_block_smob (SCM self)
+{
+  block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (self);
+
+  if (b_smob->block != NULL)
+    {
+      htab_t htab = bkscm_objfile_block_map (b_smob->objfile);
+
+      gdbscm_clear_eqable_gsmob_ptr_slot (htab, &b_smob->base);
+    }
+
+  /* Not necessary, done to catch bugs.  */
+  b_smob->block = NULL;
+  b_smob->objfile = NULL;
+
+  return 0;
+}
+
+/* The smob "print" function for <gdb:block>.  */
+
+static int
+bkscm_print_block_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (self);
+  const struct block *b = b_smob->block;
+
+  gdbscm_printf (port, "#<%s", block_smob_name);
+
+  if (BLOCK_SUPERBLOCK (b) == NULL)
+    gdbscm_printf (port, " global");
+  else if (BLOCK_SUPERBLOCK (BLOCK_SUPERBLOCK (b)) == NULL)
+    gdbscm_printf (port, " static");
+
+  if (BLOCK_FUNCTION (b) != NULL)
+    gdbscm_printf (port, " %s", SYMBOL_PRINT_NAME (BLOCK_FUNCTION (b)));
+
+  gdbscm_printf (port, " %s-%s",
+		 hex_string (BLOCK_START (b)), hex_string (BLOCK_END (b)));
+
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:block> object.  */
+
+static SCM
+bkscm_make_block_smob (void)
+{
+  block_smob *b_smob = (block_smob *)
+    scm_gc_malloc (sizeof (block_smob), block_smob_name);
+  SCM b_scm;
+
+  b_smob->block = NULL;
+  b_smob->objfile = NULL;
+  b_scm = scm_new_smob (block_smob_tag, (scm_t_bits) b_smob);
+  gdbscm_init_eqable_gsmob (&b_smob->base);
+
+  return b_scm;
+}
+
+/* Returns non-zero if SCM is a <gdb:block> object.  */
+
+static int
+bkscm_is_block (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (block_smob_tag, scm);
+}
+
+/* (block? scm) -> boolean */
+
+static SCM
+gdbscm_block_p (SCM scm)
+{
+  return scm_from_bool (bkscm_is_block (scm));
+}
+
+/* Return the existing object that encapsulates BLOCK, or create a new
+   <gdb:block> object.  */
+
+SCM
+bkscm_scm_from_block (const struct block *block, struct objfile *objfile)
+{
+  htab_t htab;
+  eqable_gdb_smob **slot;
+  block_smob *b_smob, b_smob_for_lookup;
+  SCM b_scm;
+
+  /* If we've already created a gsmob for this block, return it.
+     This makes blocks eq?-able.  */
+  htab = bkscm_objfile_block_map (objfile);
+  b_smob_for_lookup.block = block;
+  slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &b_smob_for_lookup.base);
+  if (*slot != NULL)
+    return (*slot)->containing_scm;
+
+  b_scm = bkscm_make_block_smob ();
+  b_smob = (block_smob *) SCM_SMOB_DATA (b_scm);
+  b_smob->block = block;
+  b_smob->objfile = objfile;
+  gdbscm_fill_eqable_gsmob_ptr_slot (slot, &b_smob->base, b_scm);
+
+  return b_scm;
+}
+
+/* Returns the <gdb:block> object in SELF.
+   Throws an exception if SELF is not a <gdb:block> object.  */
+
+static SCM
+bkscm_get_block_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (bkscm_is_block (self), self, arg_pos, func_name,
+		   block_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the block smob of SELF.
+   Throws an exception if SELF is not a <gdb:block> object.  */
+
+static block_smob *
+bkscm_get_block_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM b_scm = bkscm_get_block_arg_unsafe (self, arg_pos, func_name);
+  block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (b_scm);
+
+  return b_smob;
+}
+
+/* Returns non-zero if block B_SMOB is valid.  */
+
+static int
+bkscm_is_valid (block_smob *b_smob)
+{
+  return b_smob->block != NULL;
+}
+
+/* Returns the block smob in SELF, verifying it's valid.
+   Throws an exception if SELF is not a <gdb:block> object or is invalid.  */
+
+static block_smob *
+bkscm_get_valid_block_smob_arg_unsafe (SCM self, int arg_pos,
+				       const char *func_name)
+{
+  block_smob *b_smob
+    = bkscm_get_block_smob_arg_unsafe (self, arg_pos, func_name);
+
+  if (!bkscm_is_valid (b_smob))
+    {
+      gdbscm_invalid_object_error (func_name, arg_pos, self,
+				   _("<gdb:block>"));
+    }
+
+  return b_smob;
+}
+
+/* Returns the block smob contained in SCM or NULL if SCM is not a
+   <gdb:block> object.
+   If there is an error a <gdb:exception> object is stored in *EXCP.  */
+
+static block_smob *
+bkscm_get_valid_block (SCM scm, int arg_pos, const char *func_name, SCM *excp)
+{
+  block_smob *b_smob;
+
+  if (!bkscm_is_block (scm))
+    {
+      *excp = gdbscm_make_type_error (func_name, arg_pos, scm,
+				      block_smob_name);
+      return NULL;
+    }
+
+  b_smob = (block_smob *) SCM_SMOB_DATA (scm);
+  if (!bkscm_is_valid (b_smob))
+    {
+      *excp = gdbscm_make_invalid_object_error (func_name, arg_pos, scm,
+						_("<gdb:block>"));
+      return NULL;
+    }
+
+  return b_smob;
+}
+
+/* Returns the struct block that is wrapped by BLOCK_SCM.
+   If BLOCK_SCM is not a block, or is an invalid block, then NULL is returned
+   and a <gdb:exception> object is stored in *EXCP.  */
+
+const struct block *
+bkscm_scm_to_block (SCM block_scm, int arg_pos, const char *func_name,
+		    SCM *excp)
+{
+  block_smob *b_smob;
+
+  b_smob = bkscm_get_valid_block (block_scm, arg_pos, func_name, excp);
+
+  if (b_smob != NULL)
+    return b_smob->block;
+  return NULL;
+}
+
+/* Helper function for bkscm_del_objfile_blocks to mark the block
+   as invalid.  */
+
+static int
+bkscm_mark_block_invalid (void **slot, void *info)
+{
+  block_smob *b_smob = (block_smob *) *slot;
+
+  b_smob->block = NULL;
+  b_smob->objfile = NULL;
+  return 1;
+}
+
+/* This function is called when an objfile is about to be freed.
+   Invalidate the block as further actions on the block would result
+   in bad data.  All access to b_smob->block should be gated by
+   checks to ensure the block is (still) valid.  */
+
+static void
+bkscm_del_objfile_blocks (struct objfile *objfile, void *datum)
+{
+  htab_t htab = datum;
+
+  if (htab != NULL)
+    {
+      htab_traverse_noresize (htab, bkscm_mark_block_invalid, NULL);
+      htab_delete (htab);
+    }
+}
+
+/* Block methods.  */
+
+/* (block-valid? <gdb:block>) -> boolean
+   Returns #t if SELF still exists in GDB.  */
+
+static SCM
+gdbscm_block_valid_p (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (bkscm_is_valid (b_smob));
+}
+
+/* (block-start <gdb:block>) -> address */
+
+static SCM
+gdbscm_block_start (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+
+  return gdbscm_scm_from_ulongest (BLOCK_START (block));
+}
+
+/* (block-end <gdb:block>) -> address */
+
+static SCM
+gdbscm_block_end (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+
+  return gdbscm_scm_from_ulongest (BLOCK_END (block));
+}
+
+/* (block-function <gdb:block>) -> <gdb:symbol> */
+
+static SCM
+gdbscm_block_function (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+  struct symbol *sym;
+
+  sym = BLOCK_FUNCTION (block);
+
+  if (sym != NULL)
+    return syscm_scm_from_symbol (sym);
+  return SCM_BOOL_F;
+}
+
+/* (block-superblock <gdb:block>) -> <gdb:block> */
+
+static SCM
+gdbscm_block_superblock (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+  const struct block *super_block;
+
+  super_block = BLOCK_SUPERBLOCK (block);
+
+  if (super_block)
+    return bkscm_scm_from_block (super_block, b_smob->objfile);
+  return SCM_BOOL_F;
+}
+
+/* (block-global-block <gdb:block>) -> <gdb:block>
+   Returns the global block associated to this block.  */
+
+static SCM
+gdbscm_block_global_block (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+  const struct block *global_block;
+
+  global_block = block_global_block (block);
+
+  return bkscm_scm_from_block (global_block, b_smob->objfile);
+}
+
+/* (block-static-block <gdb:block>) -> <gdb:block>
+   Returns the static block associated to this block.
+   Returns #f if we cannot get the static block (this is the global block).  */
+
+static SCM
+gdbscm_block_static_block (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+  const struct block *static_block;
+
+  if (BLOCK_SUPERBLOCK (block) == NULL)
+    return SCM_BOOL_F;
+
+  static_block = block_static_block (block);
+
+  return bkscm_scm_from_block (static_block, b_smob->objfile);
+}
+
+/* (block-global? <gdb:block>) -> boolean
+   Returns #t if this block object is a global block.  */
+
+static SCM
+gdbscm_block_global_p (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+
+  return scm_from_bool (BLOCK_SUPERBLOCK (block) == NULL);
+}
+
+/* (block-static? <gdb:block>) -> boolean
+   Returns #t if this block object is a static block.  */
+
+static SCM
+gdbscm_block_static_p (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+
+  if (BLOCK_SUPERBLOCK (block) != NULL
+      && BLOCK_SUPERBLOCK (BLOCK_SUPERBLOCK (block)) == NULL)
+    return SCM_BOOL_T;
+  return SCM_BOOL_F;
+}
+
+/* (block-symbols <gdb:block>) -> list of <gdb:symbol objects
+   Returns a list of symbols of the block.  */
+
+static SCM
+gdbscm_block_symbols (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+  struct block_iterator iter;
+  struct symbol *sym;
+  SCM result;
+
+  result = SCM_EOL;
+
+  sym = block_iterator_first (block, &iter);
+
+  while (sym != NULL)
+    {
+      SCM s_scm = syscm_scm_from_symbol (sym);
+
+      result = scm_cons (s_scm, result);
+      sym = block_iterator_next (&iter);
+    }
+
+  return scm_reverse_x (result, SCM_EOL);
+}
+
+/* The <gdb:block-symbols-iterator> object,
+   for iterating over all symbols in a block.  */
+
+/* The smob "mark" function for <gdb:block-symbols-iterator>.  */
+
+static SCM
+bkscm_mark_block_syms_progress_smob (SCM self)
+{
+  block_syms_progress_smob *i_smob
+    = (block_syms_progress_smob *) SCM_SMOB_DATA (self);
+
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&i_smob->base);
+}
+
+/* The smob "print" function for <gdb:block-symbols-iterator>.  */
+
+static int
+bkscm_print_block_syms_progress_smob (SCM self, SCM port,
+				      scm_print_state *pstate)
+{
+  block_syms_progress_smob *i_smob
+    = (block_syms_progress_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s", block_syms_progress_smob_name);
+
+  if (i_smob->initialized_p)
+    {
+      switch (i_smob->iter.which)
+	{
+	case GLOBAL_BLOCK:
+	case STATIC_BLOCK:
+	  {
+	    struct symtab *s;
+
+	    gdbscm_printf (port, " %s", 
+			   i_smob->iter.which == GLOBAL_BLOCK
+			   ? "global" : "static");
+	    if (i_smob->iter.idx != -1)
+	      gdbscm_printf (port, " @%d", i_smob->iter.idx);
+	    s = (i_smob->iter.idx == -1
+		 ? i_smob->iter.d.symtab
+		 : i_smob->iter.d.symtab->includes[i_smob->iter.idx]);
+	    gdbscm_printf (port, " %s", symtab_to_filename_for_display (s));
+	    break;
+	  }
+	case FIRST_LOCAL_BLOCK:
+	  gdbscm_printf (port, " single block");
+	  break;
+	}
+    }
+  else
+    gdbscm_printf (port, " !initialized");
+
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:block-symbols-progress> object.  */
+
+static SCM
+bkscm_make_block_syms_progress_smob (void)
+{
+  block_syms_progress_smob *i_smob = (block_syms_progress_smob *)
+    scm_gc_malloc (sizeof (block_syms_progress_smob),
+		   block_syms_progress_smob_name);
+  SCM smob;
+
+  memset (&i_smob->iter, 0, sizeof (i_smob->iter));
+  i_smob->initialized_p = 0;
+  smob = scm_new_smob (block_syms_progress_smob_tag, (scm_t_bits) i_smob);
+  gdbscm_init_gsmob (&i_smob->base);
+
+  return smob;
+}
+
+/* Returns non-zero if SCM is a <gdb:block-symbols-progress> object.  */
+
+static int
+bkscm_is_block_syms_progress (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (block_syms_progress_smob_tag, scm);
+}
+
+/* (block-symbols-progress? scm) -> boolean */
+
+static SCM
+bkscm_block_syms_progress_p (SCM scm)
+{
+  return scm_from_bool (bkscm_is_block_syms_progress (scm));
+}
+
+/* (make-block-symbols-iterator <gdb:block>) -> <gdb:iterator>
+   Return a <gdb:iterator> object for iterating over the symbols of SELF.  */
+
+static SCM
+gdbscm_make_block_syms_iter (SCM self)
+{
+  block_smob *b_smob
+    = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct block *block = b_smob->block;
+  SCM progress, iter;
+
+  progress = bkscm_make_block_syms_progress_smob ();
+
+  iter = gdbscm_make_iterator (self, progress, bkscm_next_symbol_x_proc);
+
+  return iter;
+}
+
+/* Returns the next symbol in the iteration through the block's dictionary,
+   or (end-of-iteration).
+   This is the iterator_smob.next_x method.  */
+
+static SCM
+gdbscm_block_next_symbol_x (SCM self)
+{
+  SCM progress, iter_scm, block_scm;
+  iterator_smob *iter_smob;
+  block_smob *b_smob;
+  const struct block *block;
+  block_syms_progress_smob *p_smob;
+  struct symbol *sym;
+
+  iter_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  iter_smob = (iterator_smob *) SCM_SMOB_DATA (iter_scm);
+
+  block_scm = itscm_iterator_smob_object (iter_smob);
+  b_smob = bkscm_get_valid_block_smob_arg_unsafe (block_scm,
+						  SCM_ARG1, FUNC_NAME);
+  block = b_smob->block;
+
+  progress = itscm_iterator_smob_progress (iter_smob);
+
+  SCM_ASSERT_TYPE (bkscm_is_block_syms_progress (progress),
+		   progress, SCM_ARG1, FUNC_NAME,
+		   block_syms_progress_smob_name);
+  p_smob = (block_syms_progress_smob *) SCM_SMOB_DATA (progress);
+
+  if (!p_smob->initialized_p)
+    {
+      sym = block_iterator_first (block, &p_smob->iter);
+      p_smob->initialized_p = 1;
+    }
+  else
+    sym = block_iterator_next (&p_smob->iter);
+
+  if (sym == NULL)
+    return gdbscm_end_of_iteration ();
+
+  return syscm_scm_from_symbol (sym);
+}
+
+/* (lookup-block address) -> <gdb:block>
+   Returns the innermost lexical block containing the specified pc value,
+   or #f if there is none.  */
+
+static SCM
+gdbscm_lookup_block (SCM pc_scm)
+{
+  CORE_ADDR pc;
+  struct block *block = NULL;
+  struct obj_section *section = NULL;
+  struct symtab *symtab = NULL;
+  volatile struct gdb_exception except;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      section = find_pc_mapped_section (pc);
+      symtab = find_pc_sect_symtab (pc, section);
+
+      if (symtab != NULL && symtab->objfile != NULL)
+	block = block_for_pc (pc);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (symtab == NULL || symtab->objfile == NULL)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, pc_scm,
+				 _("cannot locate object file for block"));
+    }
+
+  if (block != NULL)
+    return bkscm_scm_from_block (block, symtab->objfile);
+  return SCM_BOOL_F;
+}
+
+/* Initialize the Scheme block support.  */
+
+static const scheme_function block_functions[] =
+{
+  { "block?", 1, 0, 0, gdbscm_block_p,
+    "\
+Return #t if the object is a <gdb:block> object." },
+
+  { "block-valid?", 1, 0, 0, gdbscm_block_valid_p,
+    "\
+Return #t if the block is valid.\n\
+A block becomes invalid when its objfile is freed." },
+
+  { "block-start", 1, 0, 0, gdbscm_block_start,
+    "\
+Return the start address of the block." },
+
+  { "block-end", 1, 0, 0, gdbscm_block_end,
+    "\
+Return the end address of the block." },
+
+  { "block-function", 1, 0, 0, gdbscm_block_function,
+    "\
+Return the gdb:symbol object of the function containing the block\n\
+or #f if the block does not live in any function." },
+
+  { "block-superblock", 1, 0, 0, gdbscm_block_superblock,
+    "\
+Return the superblock (parent block) of the block." },
+
+  { "block-global-block", 1, 0, 0, gdbscm_block_global_block,
+    "\
+Return the global block of the block." },
+
+  { "block-static-block", 1, 0, 0, gdbscm_block_static_block,
+    "\
+Return the static block of the block." },
+
+  { "block-global?", 1, 0, 0, gdbscm_block_global_p,
+    "\
+Return #t if block is a global block." },
+
+  { "block-static?", 1, 0, 0, gdbscm_block_static_p,
+    "\
+Return #t if block is a static block." },
+
+  { "block-symbols", 1, 0, 0, gdbscm_block_symbols,
+    "\
+Return a list of all symbols (as <gdb:symbol> objects) in the block." },
+
+  { "make-block-symbols-iterator", 1, 0, 0, gdbscm_make_block_syms_iter,
+    "\
+Return a <gdb:iterator> object for iterating over all symbols in the block." },
+
+  { "block-symbols-progress?", 1, 0, 0, bkscm_block_syms_progress_p,
+    "\
+Return #t if the object is a <gdb:block-symbols-progress> object." },
+
+  { "lookup-block", 1, 0, 0, gdbscm_lookup_block,
+    "\
+Return the innermost GDB block containing the address or #f if none found.\n\
+\n\
+  Arguments:\n\
+    address: the address to lookup" },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_blocks (void)
+{
+  block_smob_tag
+    = gdbscm_make_smob_type (block_smob_name, sizeof (block_smob));
+  scm_set_smob_mark (block_smob_tag, bkscm_mark_block_smob);
+  scm_set_smob_free (block_smob_tag, bkscm_free_block_smob);
+  scm_set_smob_print (block_smob_tag, bkscm_print_block_smob);
+
+  block_syms_progress_smob_tag
+    = gdbscm_make_smob_type (block_syms_progress_smob_name,
+			     sizeof (block_syms_progress_smob));
+  scm_set_smob_mark (block_syms_progress_smob_tag,
+		     bkscm_mark_block_syms_progress_smob);
+  scm_set_smob_print (block_syms_progress_smob_tag,
+		      bkscm_print_block_syms_progress_smob);
+
+  gdbscm_define_functions (block_functions, 1);
+
+  /* This function is "private".  */
+  bkscm_next_symbol_x_proc
+    = scm_c_define_gsubr ("%block-next-symbol!", 1, 0, 0,
+			  gdbscm_block_next_symbol_x);
+  scm_set_procedure_property_x (bkscm_next_symbol_x_proc,
+				gdbscm_documentation_symbol,
+				gdbscm_scm_from_c_string ("\
+Internal function to assist the block symbols iterator."));
+
+  /* Register an objfile "free" callback so we can properly
+     invalidate blocks when an object file is about to be deleted.  */
+  bkscm_objfile_data_key
+    = register_objfile_data_with_cleanup (NULL, bkscm_del_objfile_blocks);
+}
diff --git a/gdb/guile/scm-breakpoint.c b/gdb/guile/scm-breakpoint.c
new file mode 100644
index 0000000..d022377
--- /dev/null
+++ b/gdb/guile/scm-breakpoint.c
@@ -0,0 +1,1200 @@
+/* Scheme interface to breakpoints.
+
+   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 "value.h"
+#include "exceptions.h"
+#include "breakpoint.h"
+#include "gdbcmd.h"
+#include "gdbthread.h"
+#include "observer.h"
+#include "cli/cli-script.h"
+#include "ada-lang.h"
+#include "arch-utils.h"
+#include "language.h"
+#include "guile-internal.h"
+
+/* The <gdb:breakpoint> smob.
+   N.B.: The name of this struct is known to breakpoint.h.  */
+
+typedef struct gdbscm_breakpoint_object
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* The breakpoint number according to gdb.
+     This is recorded here because BP will be NULL when deleted.  */
+  int number;
+
+  /* The gdb breakpoint object, or NULL if the breakpoint has been deleted.  */
+  struct breakpoint *bp;
+
+  /* Backlink to our containing <gdb:breakpoint> smob.
+     This is needed when we are deleted, we need to unprotect the object
+     from GC.  */
+  SCM containing_scm;
+
+  /* A stop condition or #f.  */
+  SCM stop;
+} breakpoint_smob;
+
+static const char breakpoint_smob_name[] = "gdb:breakpoint";
+
+/* The tag Guile knows the breakpoint smob by.  */
+static scm_t_bits breakpoint_smob_tag;
+
+/* Variables used to pass information between the breakpoint_smob
+   constructor and the breakpoint-created hook function.  */
+static SCM pending_breakpoint_scm = SCM_BOOL_F;
+
+/* Keywords used by create-breakpoint!.  */
+static SCM type_keyword;
+static SCM wp_class_keyword;
+static SCM internal_keyword;
+
+/* Administrivia for breakpoint smobs.  */
+
+/* The smob "mark" function for <gdb:breakpoint>.  */
+
+static SCM
+bpscm_mark_breakpoint_smob (SCM self)
+{
+  breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
+
+  /* We don't mark containing_scm here.  It is just a backlink to our
+     container, and is gc'protected until the breakpoint is deleted.  */
+
+  scm_gc_mark (bp_smob->stop);
+
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&bp_smob->base);
+}
+
+/* The smob "free" function for <gdb:breakpoint>.  */
+
+static size_t
+bpscm_free_breakpoint_smob (SCM self)
+{
+  breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
+
+  if (bp_smob->bp)
+    bp_smob->bp->scm_bp_object = NULL;
+
+  /* Not necessary, done to catch bugs.  */
+  bp_smob->bp = NULL;
+  bp_smob->containing_scm = SCM_UNDEFINED;
+  bp_smob->stop = SCM_UNDEFINED;
+
+  return 0;
+}
+
+/* Return the name of TYPE.
+   This doesn't handle all types, just the ones we export.  */
+
+static const char *
+bpscm_type_to_string (enum bptype type)
+{
+  switch (type)
+    {
+    case bp_none: return "BP_NONE";
+    case bp_breakpoint: return "BP_BREAKPOINT";
+    case bp_watchpoint: return "BP_WATCHPOINT";
+    case bp_hardware_watchpoint: return "BP_HARDWARE_WATCHPOINT";
+    case bp_read_watchpoint: return "BP_READ_WATCHPOINT";
+    case bp_access_watchpoint: return "BP_ACCESS_WATCHPOINT";
+    default: return "internal/other";
+    }
+}
+
+/* Return the name of ENABLE_STATE.  */
+
+static const char *
+bpscm_enable_state_to_string (enum enable_state enable_state)
+{
+  switch (enable_state)
+    {
+    case bp_disabled: return "disabled";
+    case bp_enabled: return "enabled";
+    case bp_call_disabled: return "call_disabled";
+    case bp_permanent: return "permanent";
+    default: return "unknown";
+    }
+}
+
+/* The smob "print" function for <gdb:breakpoint>.  */
+
+static int
+bpscm_print_breakpoint_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
+  struct breakpoint *b = bp_smob->bp;
+
+  gdbscm_printf (port, "#<%s", breakpoint_smob_name);
+
+  /* Only print what we export to the user.
+     The rest are possibly internal implementation details.  */
+
+  gdbscm_printf (port, " #%d", bp_smob->number);
+
+  /* Careful, the breakpoint may be invalid.  */
+  if (b != NULL)
+    {
+      gdbscm_printf (port, " %s %s %s",
+		     bpscm_type_to_string (b->type),
+		     bpscm_enable_state_to_string (b->enable_state),
+		     b->silent ? "silent" : "noisy");
+
+      gdbscm_printf (port, " hit:%d", b->hit_count);
+      gdbscm_printf (port, " ignore:%d", b->ignore_count);
+
+      if (b->addr_string != NULL)
+	gdbscm_printf (port, " @%s", b->addr_string);
+    }
+
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:breakpoint> object.  */
+
+static SCM
+bpscm_make_breakpoint_smob (void)
+{
+  breakpoint_smob *bp_smob = (breakpoint_smob *)
+    scm_gc_malloc (sizeof (breakpoint_smob), breakpoint_smob_name);
+  SCM bp_scm;
+
+  bp_smob->number = -1;
+  bp_smob->bp = NULL;
+  bp_smob->stop = SCM_BOOL_F;
+  bp_scm = scm_new_smob (breakpoint_smob_tag, (scm_t_bits) bp_smob);
+  bp_smob->containing_scm = bp_scm;
+  gdbscm_init_gsmob (&bp_smob->base);
+
+  return bp_scm;
+}
+
+/* Return non-zero if we want a Scheme wrapper for breakpoint B.
+   If FROM_SCHEME is non-zero,this is called for a breakpoint created
+   by the user from Scheme.  Otherwise it is zero.  */
+
+static int
+bpscm_want_scm_wrapper_p (struct breakpoint *bp, int from_scheme)
+{
+  /* Don't create <gdb:breakpoint> objects for internal GDB breakpoints.  */
+  if (bp->number < 0 && !from_scheme)
+    return 0;
+
+  /* The others are not supported.  */
+  if (bp->type != bp_breakpoint
+      && bp->type != bp_watchpoint
+      && bp->type != bp_hardware_watchpoint
+      && bp->type != bp_read_watchpoint
+      && bp->type != bp_access_watchpoint)
+    return 0;
+
+  return 1;
+}
+
+/* Install the Scheme side of a breakpoint, CONTAINING_SCM, in
+   the gdb side BP.  */
+
+static void
+bpscm_attach_scm_to_breakpoint (struct breakpoint *bp, SCM containing_scm)
+{
+  breakpoint_smob *bp_smob;
+
+  bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (containing_scm);
+  bp_smob->number = bp->number;
+  bp_smob->bp = bp;
+  bp_smob->containing_scm = containing_scm;
+  bp_smob->bp->scm_bp_object = bp_smob;
+
+  /* The owner of this breakpoint is not in GC-controlled memory, so we need
+     to protect it from GC until the breakpoint is deleted.  */
+  scm_gc_protect_object (containing_scm);
+}
+
+/* Return non-zero if SCM is a breakpoint smob.  */
+
+static int
+bpscm_is_breakpoint (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (breakpoint_smob_tag, scm);
+}
+
+/* (breakpoint? scm) -> boolean */
+
+static SCM
+gdbscm_breakpoint_p (SCM scm)
+{
+  return scm_from_bool (bpscm_is_breakpoint (scm));
+}
+
+/* Returns the <gdb:breakpoint> object in SELF.
+   Throws an exception if SELF is not a <gdb:breakpoint> object.  */
+
+static SCM
+bpscm_get_breakpoint_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (bpscm_is_breakpoint (self), self, arg_pos, func_name,
+		   breakpoint_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the breakpoint smob of SELF.
+   Throws an exception if SELF is not a <gdb:breakpoint> object.  */
+
+static breakpoint_smob *
+bpscm_get_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
+				      const char *func_name)
+{
+  SCM bp_scm = bpscm_get_breakpoint_arg_unsafe (self, arg_pos, func_name);
+  breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (bp_scm);
+
+  return bp_smob;
+}
+
+/* Return non-zero if breakpoint BP_SMOB is valid.  */
+
+static int
+bpscm_is_valid (breakpoint_smob *bp_smob)
+{
+  return bp_smob->bp != NULL;
+}
+
+/* Returns the breakpoint smob in SELF, verifying it's valid.
+   Throws an exception if SELF is not a <gdb:breakpoint> object,
+   or is invalid.  */
+
+static breakpoint_smob *
+bpscm_get_valid_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
+					    const char *func_name)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_breakpoint_smob_arg_unsafe (self, arg_pos, func_name);
+
+  if (!bpscm_is_valid (bp_smob))
+    {
+      gdbscm_invalid_object_error (func_name, arg_pos, self,
+				   _("<gdb:breakpoint>"));
+    }
+
+  return bp_smob;
+}
+
+/* Breakpoint methods.  */
+
+/* (create-breakpoint! string [#:type integer] [#:wp-class integer]
+    [#:internal boolean) -> <gdb:breakpoint> */
+
+static SCM
+gdbscm_create_breakpoint_x (SCM spec_scm, SCM rest)
+{
+  const SCM keywords[] = {
+    type_keyword, wp_class_keyword, internal_keyword, SCM_BOOL_F
+  };
+  char *spec;
+  int type_arg_pos = -1, access_type_arg_pos = -1, internal_arg_pos = -1;
+  int type = bp_breakpoint;
+  int access_type = hw_write;
+  int internal = 0;
+  SCM result;
+  volatile struct gdb_exception except;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iit",
+			      spec_scm, &spec, rest,
+			      &type_arg_pos, &type,
+			      &access_type_arg_pos, &access_type,
+			      &internal_arg_pos, &internal);
+
+  result = bpscm_make_breakpoint_smob ();
+  pending_breakpoint_scm = result;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct cleanup *cleanup = make_cleanup (xfree, spec);
+
+      switch (type)
+	{
+	case bp_breakpoint:
+	  {
+	    create_breakpoint (get_current_arch (),
+			       spec, NULL, -1, NULL,
+			       0,
+			       0, bp_breakpoint,
+			       0,
+			       AUTO_BOOLEAN_TRUE,
+			       &bkpt_breakpoint_ops,
+			       0, 1, internal, 0);
+	    break;
+	  }
+	case bp_watchpoint:
+	  {
+	    if (access_type == hw_write)
+	      watch_command_wrapper (spec, 0, internal);
+	    else if (access_type == hw_access)
+	      awatch_command_wrapper (spec, 0, internal);
+	    else if (access_type == hw_read)
+	      rwatch_command_wrapper (spec, 0, internal);
+	    else
+	      error (_("Invalid watchpoint access type"));
+	    break;
+	  }
+	default:
+	  error (_("Invalid breakpoint type"));
+	}
+
+      do_cleanups (cleanup);
+    }
+  /* Ensure this gets reset, even if there's an error.  */
+  pending_breakpoint_scm = SCM_BOOL_F;
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return result;
+}
+
+/* (breakpoint-delete! <gdb:breakpoint>) -> unspecified
+   Scheme function which deletes the underlying GDB breakpoint.  This
+   triggers the breakpoint_deleted observer which will call
+   gdbscm_breakpoint_deleted; that function cleans up the Scheme sections.  */
+
+static SCM
+gdbscm_breakpoint_delete_x (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      delete_breakpoint (bp_smob->bp);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* iterate_over_breakpoints function for gdbscm_breakpoints.  */
+
+static int
+bpscm_build_bp_list (struct breakpoint *bp, void *arg)
+{
+  SCM *list = arg;
+  breakpoint_smob *bp_smob = bp->scm_bp_object;
+
+  /* Lazily create wrappers for breakpoints created outside Scheme.  */
+
+  if (bp_smob == NULL)
+    {
+      if (bpscm_want_scm_wrapper_p (bp, 0))
+	{
+	  SCM bp_scm;
+
+	  bp_scm = bpscm_make_breakpoint_smob ();
+	  bpscm_attach_scm_to_breakpoint (bp, bp_scm);
+	  /* Refetch it.  */
+	  bp_smob = bp->scm_bp_object;
+	}
+    }
+
+  /* Not all breakpoints will have a companion Scheme object.
+     Only breakpoints that trigger the created_breakpoint observer call,
+     and satisfy certain conditions (see bpscm_want_scm_wrapper_p),
+     get a companion object (this includes Scheme-created breakpoints).  */
+
+  if (bp_smob != NULL)
+    *list = scm_cons (bp_smob->containing_scm, *list);
+
+  return 0;
+}
+
+/* (breakpoints) -> list
+   Return a list of all breakpoints.  */
+
+static SCM
+gdbscm_breakpoints (void)
+{
+  SCM list = SCM_EOL;
+
+  /* If iterate_over_breakpoints returns non-NULL it means the iteration
+     terminated early.
+     In that case abandon building the list and return #f.  */
+  if (iterate_over_breakpoints (bpscm_build_bp_list, &list) != NULL)
+    return SCM_BOOL_F;
+
+  return scm_reverse_x (list, SCM_EOL);
+}
+
+/* (breakpoint-valid? <gdb:breakpoint>) -> boolean
+   Returns #t if SELF is still valid.  */
+
+static SCM
+gdbscm_breakpoint_valid_p (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (bpscm_is_valid (bp_smob));
+}
+
+/* (breakpoint-enabled? <gdb:breakpoint>) -> boolean */
+
+static SCM
+gdbscm_breakpoint_enabled_p (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (bp_smob->bp->enable_state == bp_enabled);
+}
+
+/* (set-breakpoint-enabled? <gdb:breakpoint> boolean) -> unspecified */
+
+static SCM
+gdbscm_set_breakpoint_enabled_x (SCM self, SCM newvalue)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  volatile struct gdb_exception except;
+
+  SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
+		   _("boolean"));
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (gdbscm_is_true (newvalue))
+	enable_breakpoint (bp_smob->bp);
+      else
+	disable_breakpoint (bp_smob->bp);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (breakpoint-silent? <gdb:breakpoint>) -> boolean */
+
+static SCM
+gdbscm_breakpoint_silent_p (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (bp_smob->bp->silent);
+}
+
+/* (set-breakpoint-silent?! <gdb:breakpoint> boolean) -> unspecified */
+
+static SCM
+gdbscm_set_breakpoint_silent_x (SCM self, SCM newvalue)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  volatile struct gdb_exception except;
+
+  SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
+		   _("boolean"));
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      breakpoint_set_silent (bp_smob->bp, gdbscm_is_true (newvalue));
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (breakpoint-ignore-count <gdb:breakpoint>) -> integer */
+
+static SCM
+gdbscm_breakpoint_ignore_count (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_long (bp_smob->bp->ignore_count);
+}
+
+/* (set-breakpoint-ignore-count! <gdb:breakpoint> integer)
+     -> unspecified */
+
+static SCM
+gdbscm_set_breakpoint_ignore_count_x (SCM self, SCM newvalue)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  long value;
+  volatile struct gdb_exception except;
+
+  SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
+		   newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
+
+  value = scm_to_long (newvalue);
+  if (value < 0)
+    value = 0;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      set_ignore_count (bp_smob->number, (int) value, 0);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (breakpoint-hit-count <gdb:breakpoint>) -> integer */
+
+static SCM
+gdbscm_breakpoint_hit_count (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_long (bp_smob->bp->hit_count);
+}
+
+/* (set-breakpoint-hit-count! <gdb:breakpoint> integer) -> unspecified */
+
+static SCM
+gdbscm_set_breakpoint_hit_count_x (SCM self, SCM newvalue)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  long value;
+
+  SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
+		   newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
+
+  value = scm_to_long (newvalue);
+  if (value < 0)
+    value = 0;
+
+  if (value != 0)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
+				 _("hit-count must be zero"));
+    }
+
+  bp_smob->bp->hit_count = 0;
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (breakpoint-thread <gdb:breakpoint>) -> integer */
+
+static SCM
+gdbscm_breakpoint_thread (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  if (bp_smob->bp->thread == -1)
+    return SCM_BOOL_F;
+
+  return scm_from_long (bp_smob->bp->thread);
+}
+
+/* (set-breakpoint-thread! <gdb:breakpoint> integer) -> unspecified */
+
+static SCM
+gdbscm_set_breakpoint_thread_x (SCM self, SCM newvalue)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  long id;
+
+  if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
+    {
+      id = scm_to_long (newvalue);
+      if (! valid_thread_id (id))
+	{
+	  gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
+				     _("invalid thread id"));
+	}
+    }
+  else if (gdbscm_is_false (newvalue))
+    id = -1;
+  else
+    SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
+
+  breakpoint_set_thread (bp_smob->bp, id);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (breakpoint-task <gdb:breakpoint>) -> integer */
+
+static SCM
+gdbscm_breakpoint_task (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  if (bp_smob->bp->task == 0)
+    return SCM_BOOL_F;
+
+  return scm_from_long (bp_smob->bp->task);
+}
+
+/* (set-breakpoint-task! <gdb:breakpoint> integer) -> unspecified */
+
+static SCM
+gdbscm_set_breakpoint_task_x (SCM self, SCM newvalue)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  long id;
+  int valid_id = 0;
+  volatile struct gdb_exception except;
+
+  if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
+    {
+      id = scm_to_long (newvalue);
+
+      TRY_CATCH (except, RETURN_MASK_ALL)
+	{
+	  valid_id = valid_task_id (id);
+	}
+      GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+      if (! valid_id)
+	{
+	  gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
+				     _("invalid task id"));
+	}
+    }
+  else if (gdbscm_is_false (newvalue))
+    id = 0;
+  else
+    SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      breakpoint_set_task (bp_smob->bp, id);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (breakpoint-location <gdb:breakpoint>) -> string */
+
+static SCM
+gdbscm_breakpoint_location (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  char *str;
+
+  if (bp_smob->bp->type != bp_breakpoint)
+    return SCM_BOOL_F;
+
+  str = bp_smob->bp->addr_string;
+  if (! str)
+    str = "";
+
+  return gdbscm_scm_from_c_string (str);
+}
+
+/* (breakpoint-expression <gdb:breakpoint>) -> string
+   This is only valid for watchpoints.
+   Returns #f for non-watchpoints.  */
+
+static SCM
+gdbscm_breakpoint_expression (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  char *str;
+  struct watchpoint *wp;
+
+  if (!is_watchpoint (bp_smob->bp))
+    return SCM_BOOL_F;
+
+  wp = (struct watchpoint *) bp_smob->bp;
+
+  str = wp->exp_string;
+  if (! str)
+    str = "";
+
+  return gdbscm_scm_from_c_string (str);
+}
+
+/* (breakpoint-condition <gdb:breakpoint>) -> string */
+
+static SCM
+gdbscm_breakpoint_condition (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  char *str;
+
+  str = bp_smob->bp->cond_string;
+  if (! str)
+    return SCM_BOOL_F;
+
+  return gdbscm_scm_from_c_string (str);
+}
+
+/* (set-breakpoint-condition! <gdb:breakpoint> string|#f)
+   -> unspecified */
+
+static SCM
+gdbscm_set_breakpoint_condition_x (SCM self, SCM newvalue)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  char *exp;
+  volatile struct gdb_exception except;
+
+  SCM_ASSERT_TYPE (scm_is_string (newvalue) || gdbscm_is_false (newvalue),
+		   newvalue, SCM_ARG2, FUNC_NAME,
+		   _("string or #f"));
+
+  if (gdbscm_is_false (newvalue))
+    exp = NULL;
+  else
+    exp = gdbscm_scm_to_c_string (newvalue);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      set_breakpoint_condition (bp_smob->bp, exp ? exp : "", 0);
+    }
+  xfree (exp);
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (breakpoint-stop <gdb:breakpoint>) -> procedure or #f */
+
+static SCM
+gdbscm_breakpoint_stop (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return bp_smob->stop;
+}
+
+/* (set-breakpoint-stop! <gdb:breakpoint> procedure|#f)
+   -> unspecified */
+
+static SCM
+gdbscm_set_breakpoint_stop_x (SCM self, SCM newvalue)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct extension_language_defn *extlang = NULL;
+
+  SCM_ASSERT_TYPE (gdbscm_is_procedure (newvalue)
+		   || gdbscm_is_false (newvalue),
+		   newvalue, SCM_ARG2, FUNC_NAME,
+		   _("procedure or #f"));
+
+  if (bp_smob->bp->cond_string != NULL)
+    extlang = get_ext_lang_defn (EXT_LANG_GDB);
+  if (extlang == NULL)
+    extlang = get_breakpoint_cond_ext_lang (bp_smob->bp, EXT_LANG_GUILE);
+  if (extlang != NULL)
+    {
+      char *error_text
+	= xstrprintf (_("Only one stop condition allowed.  There is"
+			" currently a %s stop condition defined for"
+			" this breakpoint."),
+		      ext_lang_capitalized_name (extlang));
+
+      scm_dynwind_begin (0);
+      gdbscm_dynwind_xfree (error_text);
+      gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, error_text);
+      /* The following line, while unnecessary, is present for completeness
+	 sake.  */
+      scm_dynwind_end ();
+    }
+
+  bp_smob->stop = newvalue;
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (breakpoint-commands <gdb:breakpoint>) -> string */
+
+static SCM
+gdbscm_breakpoint_commands (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct breakpoint *bp;
+  long length;
+  volatile struct gdb_exception except;
+  struct ui_file *string_file;
+  struct cleanup *chain;
+  SCM result;
+  char *cmdstr;
+
+  bp = bp_smob->bp;
+
+  if (bp->commands == NULL)
+    return SCM_BOOL_F;
+
+  string_file = mem_fileopen ();
+  chain = make_cleanup_ui_file_delete (string_file);
+
+  ui_out_redirect (current_uiout, string_file);
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      print_command_lines (current_uiout, breakpoint_commands (bp), 0);
+    }
+  ui_out_redirect (current_uiout, NULL);
+  if (except.reason < 0)
+    {
+      do_cleanups (chain);
+      gdbscm_throw_gdb_exception (except);
+    }
+
+  cmdstr = ui_file_xstrdup (string_file, &length);
+  make_cleanup (xfree, cmdstr);
+  result = gdbscm_scm_from_c_string (cmdstr);
+
+  do_cleanups (chain);
+  return result;
+}
+
+/* (breakpoint-type <gdb:breakpoint>) -> integer */
+
+static SCM
+gdbscm_breakpoint_type (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_long (bp_smob->bp->type);
+}
+
+/* (breakpoint-visible? <gdb:breakpoint>) -> boolean */
+
+static SCM
+gdbscm_breakpoint_visible (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (bp_smob->bp->number >= 0);
+}
+
+/* (breakpoint-number <gdb:breakpoint>) -> integer */
+
+static SCM
+gdbscm_breakpoint_number (SCM self)
+{
+  breakpoint_smob *bp_smob
+    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_long (bp_smob->number);
+}
+
+/* Return TRUE if "stop" has been set for this breakpoint.
+
+   This is the extension_language_ops.breakpoint_has_cond "method".  */
+
+int
+gdbscm_breakpoint_has_cond (const struct extension_language_defn *extlang,
+			    struct breakpoint *b)
+{
+  breakpoint_smob *bp_smob = b->scm_bp_object;
+
+  if (bp_smob == NULL)
+    return 0;
+
+  return gdbscm_is_procedure (bp_smob->stop);
+}
+
+/* Call the "stop" method in the breakpoint class.
+   This must only be called if gdbscm_breakpoint_has_cond returns true.
+   If the stop method returns #t, the inferior will be stopped at the
+   breakpoint.  Otherwise the inferior will be allowed to continue
+   (assuming other conditions don't indicate "stop").
+
+   This is the extension_language_ops.breakpoint_cond_says_stop "method".  */
+
+enum ext_lang_bp_stop
+gdbscm_breakpoint_cond_says_stop
+  (const struct extension_language_defn *extlang, struct breakpoint *b)
+{
+  breakpoint_smob *bp_smob = b->scm_bp_object;
+  SCM predicate_result;
+  int stop;
+
+  if (bp_smob == NULL)
+    return EXT_LANG_BP_STOP_UNSET;
+  if (!gdbscm_is_procedure (bp_smob->stop))
+    return EXT_LANG_BP_STOP_UNSET;
+
+  stop = 1;
+
+  predicate_result
+    = gdbscm_safe_call_1 (bp_smob->stop, bp_smob->containing_scm, NULL);
+
+  if (gdbscm_is_exception (predicate_result))
+    ; /* Exception already printed.  */
+  /* If the "stop" function returns #f that means
+     the Scheme breakpoint wants GDB to continue.  */
+  else if (gdbscm_is_false (predicate_result))
+    stop = 0;
+
+  return stop ? EXT_LANG_BP_STOP_YES : EXT_LANG_BP_STOP_NO;
+}
+
+/* Event callback functions.  */
+
+/* Callback that is used when a breakpoint is created.
+   For breakpoints created by Scheme, i.e., gdbscm_create_breakpoint_x, finish
+   object creation by connecting the Scheme wrapper to the gdb object.
+   We ignore breakpoints created from gdb or python here, we create the
+   Scheme wrapper for those when there's a need to, e.g.,
+   gdbscm_breakpoints.  */
+
+static void
+bpscm_breakpoint_created (struct breakpoint *bp)
+{
+  SCM bp_scm;
+
+  if (gdbscm_is_false (pending_breakpoint_scm))
+    return;
+
+  /* Verify our caller error checked the user's request.  */
+  gdb_assert (bpscm_want_scm_wrapper_p (bp, 1));
+
+  bp_scm = pending_breakpoint_scm;
+  pending_breakpoint_scm = SCM_BOOL_F;
+
+  bpscm_attach_scm_to_breakpoint (bp, bp_scm);
+}
+
+/* Callback that is used when a breakpoint is deleted.  This will
+   invalidate the corresponding Scheme object.  */
+
+static void
+bpscm_breakpoint_deleted (struct breakpoint *b)
+{
+  int num = b->number;
+  struct breakpoint *bp;
+
+  /* TODO: Why the lookup?  We have B.  */
+
+  bp = get_breakpoint (num);
+  if (bp)
+    {
+      breakpoint_smob *bp_smob = bp->scm_bp_object;
+
+      if (bp_smob)
+	{
+	  bp_smob->bp = NULL;
+	  scm_gc_unprotect_object (bp_smob->containing_scm);
+	}
+    }
+}
+
+/* Initialize the Scheme breakpoint code.  */
+
+static const scheme_integer_constant breakpoint_integer_constants[] =
+{
+  { "BP_NONE", bp_none },
+  { "BP_BREAKPOINT", bp_breakpoint },
+  { "BP_WATCHPOINT", bp_watchpoint },
+  { "BP_HARDWARE_WATCHPOINT", bp_hardware_watchpoint },
+  { "BP_READ_WATCHPOINT", bp_read_watchpoint },
+  { "BP_ACCESS_WATCHPOINT", bp_access_watchpoint },
+
+  { "WP_READ", hw_read },
+  { "WP_WRITE", hw_write },
+  { "WP_ACCESS", hw_access },
+
+  END_INTEGER_CONSTANTS
+};
+
+static const scheme_function breakpoint_functions[] =
+{
+  { "create-breakpoint!", 1, 0, 1, gdbscm_create_breakpoint_x,
+    "\
+Create and install a GDB breakpoint object.\n\
+\n\
+  Arguments:\n\
+     location [#:type <type>] [#:wp-class <wp-class>] [#:internal <bool>]" },
+
+  { "breakpoint-delete!", 1, 0, 0, gdbscm_breakpoint_delete_x,
+    "\
+Delete the breakpoint from GDB." },
+
+  { "breakpoints", 0, 0, 0, gdbscm_breakpoints,
+    "\
+Return a list of all GDB breakpoints.\n\
+\n\
+  Arguments: none" },
+
+  { "breakpoint?", 1, 0, 0, gdbscm_breakpoint_p,
+    "\
+Return #t if the object is a <gdb:breakpoint> object." },
+
+  { "breakpoint-valid?", 1, 0, 0, gdbscm_breakpoint_valid_p,
+    "\
+Return #t if the breakpoint has not been deleted from GDB." },
+
+  { "breakpoint-number", 1, 0, 0, gdbscm_breakpoint_number,
+    "\
+Return the breakpoint's number." },
+
+  { "breakpoint-type", 1, 0, 0, gdbscm_breakpoint_type,
+    "\
+Return the type of the breakpoint." },
+
+  { "breakpoint-visible?", 1, 0, 0, gdbscm_breakpoint_visible,
+    "\
+Return #t if the breakpoint is visible to the user." },
+
+  { "breakpoint-location", 1, 0, 0, gdbscm_breakpoint_location,
+    "\
+Return the location of the breakpoint as specified by the user." },
+
+  { "breakpoint-expression", 1, 0, 0, gdbscm_breakpoint_expression,
+    "\
+Return the expression of the breakpoint as specified by the user.\n\
+Valid for watchpoints only, returns #f for non-watchpoints." },
+
+  { "breakpoint-enabled?", 1, 0, 0, gdbscm_breakpoint_enabled_p,
+    "\
+Return #t if the breakpoint is enabled." },
+
+  { "set-breakpoint-enabled!", 2, 0, 0, gdbscm_set_breakpoint_enabled_x,
+    "\
+Set the breakpoint's enabled state.\n\
+\n\
+  Arguments: <gdb:breakpoint boolean" },
+
+  { "breakpoint-silent?", 1, 0, 0, gdbscm_breakpoint_silent_p,
+    "\
+Return #t if the breakpoint is silent." },
+
+  { "set-breakpoint-silent!", 2, 0, 0, gdbscm_set_breakpoint_silent_x,
+    "\
+Set the breakpoint's silent state.\n\
+\n\
+  Arguments: <gdb:breakpoint> boolean" },
+
+  { "breakpoint-ignore-count", 1, 0, 0, gdbscm_breakpoint_ignore_count,
+    "\
+Return the breakpoint's \"ignore\" count." },
+
+  { "set-breakpoint-ignore-count!", 2, 0, 0,
+    gdbscm_set_breakpoint_ignore_count_x,
+    "\
+Set the breakpoint's \"ignore\" count.\n\
+\n\
+  Arguments: <gdb:breakpoint> count" },
+
+  { "breakpoint-hit-count", 1, 0, 0, gdbscm_breakpoint_hit_count,
+    "\
+Return the breakpoint's \"hit\" count." },
+
+  { "set-breakpoint-hit-count!", 2, 0, 0, gdbscm_set_breakpoint_hit_count_x,
+    "\
+Set the breakpoint's \"hit\" count.  The value must be zero.\n\
+\n\
+  Arguments: <gdb:breakpoint> 0" },
+
+  { "breakpoint-thread", 1, 0, 0, gdbscm_breakpoint_thread,
+    "\
+Return the breakpoint's thread id or #f if there isn't one." },
+
+  { "set-breakpoint-thread!", 2, 0, 0, gdbscm_set_breakpoint_thread_x,
+    "\
+Set the thread id for this breakpoint.\n\
+\n\
+  Arguments: <gdb:breakpoint> thread-id" },
+
+  { "breakpoint-task", 1, 0, 0, gdbscm_breakpoint_task,
+    "\
+Return the breakpoint's Ada task-id or #f if there isn't one." },
+
+  { "set-breakpoint-task!", 2, 0, 0, gdbscm_set_breakpoint_task_x,
+    "\
+Set the breakpoint's Ada task-id.\n\
+\n\
+  Arguments: <gdb:breakpoint> task-id" },
+
+  { "breakpoint-condition", 1, 0, 0, gdbscm_breakpoint_condition,
+    "\
+Return the breakpoint's condition as specified by the user.\n\
+Return #f if there isn't one." },
+
+  { "set-breakpoint-condition!", 2, 0, 0, gdbscm_set_breakpoint_condition_x,
+    "\
+Set the breakpoint's condition.\n\
+\n\
+  Arguments: <gdb:breakpoint> condition\n\
+    condition: a string" },
+
+  { "breakpoint-stop", 1, 0, 0, gdbscm_breakpoint_stop,
+    "\
+Return the breakpoint's stop predicate.\n\
+Return #f if there isn't one." },
+
+  { "set-breakpoint-stop!", 2, 0, 0, gdbscm_set_breakpoint_stop_x,
+    "\
+Set the breakpoint's stop predicate.\n\
+\n\
+  Arguments: <gdb:breakpoint> procedure\n\
+    procedure: A procedure of one argument, the breakpoint.\n\
+      Its result is true if program execution should stop." },
+
+  { "breakpoint-commands", 1, 0, 0, gdbscm_breakpoint_commands,
+    "\
+Return the breakpoint's commands." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_breakpoints (void)
+{
+  breakpoint_smob_tag
+    = gdbscm_make_smob_type (breakpoint_smob_name, sizeof (breakpoint_smob));
+  scm_set_smob_mark (breakpoint_smob_tag, bpscm_mark_breakpoint_smob);
+  scm_set_smob_free (breakpoint_smob_tag, bpscm_free_breakpoint_smob);
+  scm_set_smob_print (breakpoint_smob_tag, bpscm_print_breakpoint_smob);
+
+  observer_attach_breakpoint_created (bpscm_breakpoint_created);
+  observer_attach_breakpoint_deleted (bpscm_breakpoint_deleted);
+
+  gdbscm_define_integer_constants (breakpoint_integer_constants, 1);
+  gdbscm_define_functions (breakpoint_functions, 1);
+
+  type_keyword = scm_from_latin1_keyword ("type");
+  wp_class_keyword = scm_from_latin1_keyword ("wp-class");
+  internal_keyword = scm_from_latin1_keyword ("internal");
+}
diff --git a/gdb/guile/scm-disasm.c b/gdb/guile/scm-disasm.c
new file mode 100644
index 0000000..dc76b98
--- /dev/null
+++ b/gdb/guile/scm-disasm.c
@@ -0,0 +1,355 @@
+/* Scheme interface to architecture.
+
+   Copyright (C) 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 "disasm.h"
+#include "dis-asm.h"
+#include "gdbarch.h"
+#include "gdbcore.h" /* Why is memory_error here? */
+#include "guile-internal.h"
+
+static SCM port_keyword;
+static SCM offset_keyword;
+static SCM size_keyword;
+static SCM count_keyword;
+
+static SCM address_symbol;
+static SCM asm_symbol;
+static SCM length_symbol;
+
+/* Struct used to pass "application data" in disassemble_info.  */
+
+struct gdbscm_disasm_data
+{
+  struct gdbarch *gdbarch;
+  SCM port;
+  /* The offset of the address of the first instruction in PORT.  */
+  ULONGEST offset;
+};
+
+/* Struct used to pass data from gdbscm_disasm_read_memory to
+   gdbscm_disasm_read_memory_worker.  */
+
+struct gdbscm_disasm_read_data
+{
+  bfd_vma memaddr;
+  bfd_byte *myaddr;
+  unsigned int length;
+  struct disassemble_info *dinfo;
+};
+
+/* Subroutine of gdbscm_arch_disassemble to simplify it.
+   Return the result for one instruction.  */
+
+static SCM
+dascm_make_insn (CORE_ADDR pc, const char *assembly, int insn_len)
+{
+  return scm_list_3 (scm_cons (address_symbol,
+			       gdbscm_scm_from_ulongest (pc)),
+		     scm_cons (asm_symbol,
+			       gdbscm_scm_from_c_string (assembly)),
+		     scm_cons (length_symbol,
+			       scm_from_int (insn_len)));
+}
+
+/* Helper function for gdbscm_disasm_read_memory to safely read from a
+   Scheme port.  Called via gdbscm_call_guile.
+   The result is a statically allocated error message or NULL if success.  */
+
+static void *
+gdbscm_disasm_read_memory_worker (void *datap)
+{
+  struct gdbscm_disasm_read_data *data = datap;
+  struct disassemble_info *dinfo = data->dinfo;
+  struct gdbscm_disasm_data *disasm_data = dinfo->application_data;
+  SCM seekto, newpos, port = disasm_data->port;
+  size_t bytes_read;
+
+  seekto = gdbscm_scm_from_ulongest (data->memaddr - disasm_data->offset);
+  newpos = scm_seek (port, seekto, scm_from_int (SEEK_SET));
+  if (!scm_is_eq (seekto, newpos))
+    return "seek error";
+
+  bytes_read = scm_c_read (port, data->myaddr, data->length);
+
+  if (bytes_read != data->length)
+    return "short read";
+
+  /* If we get here the read succeeded.  */
+  return NULL;
+}
+
+/* disassemble_info.read_memory_func for gdbscm_print_insn_from_port.  */
+
+static int
+gdbscm_disasm_read_memory (bfd_vma memaddr, bfd_byte *myaddr,
+			   unsigned int length,
+			   struct disassemble_info *dinfo)
+{
+  struct gdbscm_disasm_read_data data;
+  void *status;
+
+  data.memaddr = memaddr;
+  data.myaddr = myaddr;
+  data.length = length;
+  data.dinfo = dinfo;
+
+  status = gdbscm_with_guile (gdbscm_disasm_read_memory_worker, &data);
+
+  /* TODO: IWBN to distinguish problems reading target memory versus problems
+     with the port (e.g., EOF).
+     We return TARGET_XFER_E_IO here as that's what memory_error looks for.  */
+  return status != NULL ? TARGET_XFER_E_IO : 0;
+}
+
+/* disassemble_info.memory_error_func for gdbscm_print_insn_from_port.
+   Technically speaking, we don't need our own memory_error_func,
+   but to not provide one would leave a subtle dependency in the code.
+   This function exists to keep a clear boundary.  */
+
+static void
+gdbscm_disasm_memory_error (int status, bfd_vma memaddr,
+			    struct disassemble_info *info)
+{
+  memory_error (status, memaddr);
+}
+
+/* disassemble_info.print_address_func for gdbscm_print_insn_from_port.
+   Since we need to use our own application_data value, we need to supply
+   this routine as well.  */
+
+static void
+gdbscm_disasm_print_address (bfd_vma addr, struct disassemble_info *info)
+{
+  struct gdbscm_disasm_data *data = info->application_data;
+  struct gdbarch *gdbarch = data->gdbarch;
+
+  print_address (gdbarch, addr, info->stream);
+}
+
+/* Subroutine of gdbscm_arch_disassemble to simplify it.
+   Call gdbarch_print_insn using a port for input.
+   PORT must be seekable.
+   OFFSET is the offset in PORT from which addresses begin.
+   For example, when printing from a bytevector, addresses passed to the
+   bv seek routines must be in the range [0,size).  However, the bytevector
+   may represent an instruction at address 0x1234.  To handle this case pass
+   0x1234 for OFFSET.
+   This is based on gdb_print_insn, see it for details.  */
+
+static int
+gdbscm_print_insn_from_port (struct gdbarch *gdbarch,
+			     SCM port, ULONGEST offset, CORE_ADDR memaddr,
+			     struct ui_file *stream, int *branch_delay_insns)
+{
+  struct disassemble_info di;
+  int length;
+  struct gdbscm_disasm_data data;
+
+  di = gdb_disassemble_info (gdbarch, stream);
+  data.gdbarch = gdbarch;
+  data.port = port;
+  data.offset = offset;
+  di.application_data = &data;
+  di.read_memory_func = gdbscm_disasm_read_memory;
+  di.memory_error_func = gdbscm_disasm_memory_error;
+  di.print_address_func = gdbscm_disasm_print_address;
+
+  length = gdbarch_print_insn (gdbarch, memaddr, &di);
+
+  if (branch_delay_insns)
+    {
+      if (di.insn_info_valid)
+	*branch_delay_insns = di.branch_delay_insns;
+      else
+	*branch_delay_insns = 0;
+    }
+
+  return length;
+}
+
+/* (arch-disassemble <gdb:arch> address
+     [#:port port] [#:offset address] [#:size integer] [#:count integer])
+     -> list
+
+   Returns a list of disassembled instructions.
+   If PORT is provided, read bytes from it.  Otherwise read target memory.
+   If PORT is #f, read target memory.
+   PORT must be seekable.  IWBN to remove this restriction, and a future
+   release may.  For now the restriction is in place because it's not clear
+   all disassemblers are strictly sequential.
+   If SIZE is provided, limit the number of bytes read to this amount.
+   If COUNT is provided, limit the number of instructions to this amount.
+
+   Each instruction in the result is an alist:
+   (('address . address) ('asm . disassembly) ('length . length)).
+   We could use a hash table (dictionary) but there aren't that many fields. */
+
+static SCM
+gdbscm_arch_disassemble (SCM self, SCM start_scm, SCM rest)
+{
+  arch_smob *a_smob
+    = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct gdbarch *gdbarch = arscm_get_gdbarch (a_smob);
+  const SCM keywords[] = {
+    port_keyword, offset_keyword, size_keyword, count_keyword, SCM_BOOL_F
+  };
+  int port_arg_pos = -1, offset_arg_pos = -1;
+  int size_arg_pos = -1, count_arg_pos = -1;
+  SCM port = SCM_BOOL_F;
+  ULONGEST offset = 0;
+  unsigned int count = 1;
+  unsigned int size;
+  ULONGEST start_arg;
+  CORE_ADDR start, end;
+  CORE_ADDR pc;
+  unsigned int i;
+  int using_port;
+  SCM result;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "U#OUuu",
+			      start_scm, &start_arg, rest,
+			      &port_arg_pos, &port,
+			      &offset_arg_pos, &offset,
+			      &size_arg_pos, &size,
+			      &count_arg_pos, &count);
+  /* START is first stored in a ULONGEST because we don't have a format char
+     for CORE_ADDR, and it's not really worth it to have one yet.  */
+  start = start_arg;
+
+  if (port_arg_pos > 0)
+    {
+      SCM_ASSERT_TYPE (gdbscm_is_false (port)
+		       || gdbscm_is_true (scm_input_port_p (port)),
+		       port, port_arg_pos, FUNC_NAME, _("input port"));
+    }
+  using_port = gdbscm_is_true (port);
+
+  if (offset_arg_pos > 0
+      && (port_arg_pos < 0
+	  || gdbscm_is_false (port)))
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, offset_arg_pos,
+				 gdbscm_scm_from_ulongest (offset),
+				 _("offset provided but port is missing"));
+    }
+
+  if (size_arg_pos > 0)
+    {
+      if (size == 0)
+	return SCM_EOL;
+      /* For now be strict about start+size overflowing.  If it becomes
+	 a nuisance we can relax things later.  */
+      if (start + size < start)
+	{
+	  gdbscm_out_of_range_error (FUNC_NAME, 0,
+				scm_list_2 (gdbscm_scm_from_ulongest (start),
+					    gdbscm_scm_from_ulongest (size)),
+				     _("start+size overflows"));
+	}
+      end = start + size - 1;
+    }
+  else
+    end = ~(CORE_ADDR) 0;
+
+  if (count == 0)
+    return SCM_EOL;
+
+  result = SCM_EOL;
+
+  for (pc = start, i = 0; pc <= end && i < count; )
+    {
+      int insn_len = 0;
+      char *as = NULL;
+      struct ui_file *memfile = mem_fileopen ();
+      struct cleanup *cleanups = make_cleanup_ui_file_delete (memfile);
+      volatile struct gdb_exception except;
+
+      TRY_CATCH (except, RETURN_MASK_ALL)
+	{
+	  if (using_port)
+	    {
+	      insn_len = gdbscm_print_insn_from_port (gdbarch, port, offset,
+						      pc, memfile, NULL);
+	    }
+	  else
+	    insn_len = gdb_print_insn (gdbarch, pc, memfile, NULL);
+	}
+      GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+
+      as = ui_file_xstrdup (memfile, NULL);
+
+      result = scm_cons (dascm_make_insn (pc, as, insn_len),
+			 result);
+
+      pc += insn_len;
+      i++;
+      do_cleanups (cleanups);
+      xfree (as);
+    }
+
+  return scm_reverse_x (result, SCM_EOL);
+}
+
+/* Initialize the Scheme architecture support.  */
+
+static const scheme_function disasm_functions[] =
+{
+  { "arch-disassemble", 2, 0, 1, gdbscm_arch_disassemble,
+    "\
+Return list of disassembled instructions in memory.\n\
+\n\
+  Arguments: <gdb:arch> start-address\n\
+      [#:port port] [#:offset address]\n\
+      [#:size <integer>] [#:count <integer>]\n\
+    port: If non-#f, it is an input port to read bytes from.\n\
+    offset: Specifies the address offset of the first byte in the port.\n\
+      This is useful if the input is from something other than memory\n\
+      (e.g., a bytevector) and you want the result to be as if the bytes\n\
+      came from that address.  The value to pass for start-address is\n\
+      then also the desired disassembly address, not the offset in, e.g.,\n\
+      the bytevector.\n\
+    size: Limit the number of bytes read to this amount.\n\
+    count: Limit the number of instructions to this amount.\n\
+\n\
+  Returns:\n\
+    Each instruction in the result is an alist:\n\
+      (('address . address) ('asm . disassembly) ('length . length))." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_disasm (void)
+{
+  gdbscm_define_functions (disasm_functions, 1);
+
+  port_keyword = scm_from_latin1_keyword ("port");
+  offset_keyword = scm_from_latin1_keyword ("offset");
+  size_keyword = scm_from_latin1_keyword ("size");
+  count_keyword = scm_from_latin1_keyword ("count");
+
+  address_symbol = scm_from_latin1_symbol ("address");
+  asm_symbol = scm_from_latin1_symbol ("asm");
+  length_symbol = scm_from_latin1_symbol ("length");
+}
diff --git a/gdb/guile/scm-exception.c b/gdb/guile/scm-exception.c
new file mode 100644
index 0000000..a96a350
--- /dev/null
+++ b/gdb/guile/scm-exception.c
@@ -0,0 +1,691 @@
+/* GDB/Scheme exception support.
+
+   Copyright (C) 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.  */
+
+/* Notes:
+
+   IWBN to support SRFI 34/35.  At the moment we follow Guile's own
+   exception mechanism.
+
+   The non-static functions in this file have prefix gdbscm_ and
+   not exscm_ on purpose.  */
+
+#include "defs.h"
+#include <signal.h>
+#include "gdb_assert.h"
+#include "guile-internal.h"
+
+/* The <gdb:exception> smob.
+   This is used to record and handle Scheme exceptions.
+   One important invariant is that <gdb:exception> smobs are never a valid
+   result of a function, other than to signify an exception occurred.  */
+
+typedef struct
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* The key and args parameters to "throw".  */
+  SCM key;
+  SCM args;
+} exception_smob;
+
+static const char exception_smob_name[] = "gdb:exception";
+
+/* The tag Guile knows the exception smob by.  */
+static scm_t_bits exception_smob_tag;
+
+/* A generic error in struct gdb_exception.
+   I.e., not RETURN_QUIT and not MEMORY_ERROR.  */
+static SCM error_symbol;
+
+/* An error occurred accessing inferior memory.
+   This is not a Scheme programming error.  */
+static SCM memory_error_symbol;
+
+/* User interrupt, e.g., RETURN_QUIT in struct gdb_exception.  */
+static SCM signal_symbol;
+
+/* Printing the stack is done by first capturing the stack and recording it in
+   a <gdb:exception> object with this key and with the ARGS field set to
+   (cons real-key (cons stack real-args)).
+   See gdbscm_make_exception_with_stack.  */
+static SCM with_stack_error_symbol;
+
+/* The key to use for an invalid object exception.  An invalid object is one
+   where the underlying object has been removed from GDB.  */
+SCM gdbscm_invalid_object_error_symbol;
+
+/* Values for "guile print-stack" as symbols.  */
+static SCM none_symbol;
+static SCM message_symbol;
+static SCM full_symbol;
+
+static const char percent_print_exception_message_name[] =
+  "%print-exception-message";
+
+/* Variable containing %print-exception-message.
+   It is not defined until late in initialization, after our init routine
+   has run.  Cope by looking it up lazily.  */
+static SCM percent_print_exception_message_var = SCM_BOOL_F;
+
+static const char percent_print_exception_with_stack_name[] =
+  "%print-exception-with-stack";
+
+/* Variable containing %print-exception-with-stack.
+   It is not defined until late in initialization, after our init routine
+   has run.  Cope by looking it up lazily.  */
+static SCM percent_print_exception_with_stack_var = SCM_BOOL_F;
+
+/* Counter to keep track of the number of times we create a <gdb:exception>
+   object, for performance monitoring purposes.  */
+static unsigned long gdbscm_exception_count = 0;
+
+/* Administrivia for exception smobs.  */
+
+/* The smob "mark" function for <gdb:exception>.  */
+
+static SCM
+exscm_mark_exception_smob (SCM self)
+{
+  exception_smob *e_smob = (exception_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (e_smob->key);
+  scm_gc_mark (e_smob->args);
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&e_smob->base);
+}
+
+/* The smob "print" function for <gdb:exception>.  */
+
+static int
+exscm_print_exception_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  exception_smob *e_smob = (exception_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s ", exception_smob_name);
+  scm_write (e_smob->key, port);
+  scm_puts (" ", port);
+  scm_write (e_smob->args, port);
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* (make-exception key args) -> <gdb:exception> */
+
+SCM
+gdbscm_make_exception (SCM key, SCM args)
+{
+  exception_smob *e_smob = (exception_smob *)
+    scm_gc_malloc (sizeof (exception_smob), exception_smob_name);
+  SCM smob;
+
+  e_smob->key = key;
+  e_smob->args = args;
+  smob = scm_new_smob (exception_smob_tag, (scm_t_bits) e_smob);
+  gdbscm_init_gsmob (&e_smob->base);
+
+  ++gdbscm_exception_count;
+
+  return smob;
+}
+
+/* Return non-zero if SCM is a <gdb:exception> object.  */
+
+int
+gdbscm_is_exception (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (exception_smob_tag, scm);
+}
+
+/* (exception? scm) -> boolean */
+
+static SCM
+gdbscm_exception_p (SCM scm)
+{
+  return scm_from_bool (gdbscm_is_exception (scm));
+}
+
+/* (exception-key <gdb:exception>) -> key */
+
+SCM
+gdbscm_exception_key (SCM self)
+{
+  exception_smob *e_smob;
+
+  SCM_ASSERT_TYPE (gdbscm_is_exception (self), self, SCM_ARG1, FUNC_NAME,
+		   "gdb:exception");
+
+  e_smob = (exception_smob *) SCM_SMOB_DATA (self);
+  return e_smob->key;
+}
+
+/* (exception-args <gdb:exception>) -> arg-list */
+
+SCM
+gdbscm_exception_args (SCM self)
+{
+  exception_smob *e_smob;
+
+  SCM_ASSERT_TYPE (gdbscm_is_exception (self), self, SCM_ARG1, FUNC_NAME,
+		   "gdb:exception");
+
+  e_smob = (exception_smob *) SCM_SMOB_DATA (self);
+  return e_smob->args;
+}
+
+/* Wrap an exception in a <gdb:exception> object that includes STACK.
+   gdbscm_print_exception_with_stack knows how to unwrap it.  */
+
+SCM
+gdbscm_make_exception_with_stack (SCM key, SCM args, SCM stack)
+{
+  return gdbscm_make_exception (with_stack_error_symbol,
+				scm_cons (key, scm_cons (stack, args)));
+}
+
+/* Version of scm_error_scm that creates a gdb:exception object that can later
+   be passed to gdbscm_throw.
+   KEY is a symbol denoting the kind of error.
+   SUBR is either #f or a string marking the function in which the error
+   occurred.
+   MESSAGE is either #f or the error message string.  It may contain ~a and ~s
+   modifiers, provided by ARGS.
+   ARGS is a list of args to MESSAGE.
+   DATA is an arbitrary object, its value depends on KEY.  The value to pass
+   here is a bit underspecified by Guile.  */
+
+SCM
+gdbscm_make_error_scm (SCM key, SCM subr, SCM message, SCM args, SCM data)
+{
+  return gdbscm_make_exception (key, scm_list_4 (subr, message, args, data));
+}
+
+/* Version of scm_error that creates a gdb:exception object that can later
+   be passed to gdbscm_throw.
+   See gdbscm_make_error_scm for a description of the arguments.  */
+
+SCM
+gdbscm_make_error (SCM key, const char *subr, const char *message,
+		   SCM args, SCM data)
+{
+  return gdbscm_make_error_scm
+    (key,
+     subr == NULL ? SCM_BOOL_F : scm_from_latin1_string (subr),
+     message == NULL ? SCM_BOOL_F : scm_from_latin1_string (message),
+     args, data);
+}
+
+/* Version of SCM_ASSERT_TYPE/scm_wrong_type_arg_msg that creates a
+   gdb:exception object that can later be passed to gdbscm_throw.  */
+
+SCM
+gdbscm_make_type_error (const char *subr, int arg_pos, SCM bad_value,
+			const char *expected_type)
+{
+  char *msg;
+  SCM result;
+
+  if (arg_pos > 0)
+    {
+      if (expected_type != NULL)
+	{
+	  msg = xstrprintf (_("Wrong type argument in position %d"
+			      " (expecting %s): ~S"),
+			    arg_pos, expected_type);
+	}
+      else
+	{
+	  msg = xstrprintf (_("Wrong type argument in position %d: ~S"),
+			    arg_pos);
+	}
+    }
+  else
+    {
+      if (expected_type != NULL)
+	{
+	  msg = xstrprintf (_("Wrong type argument (expecting %s): ~S"),
+			    expected_type);
+	}
+      else
+	msg = xstrprintf (_("Wrong type argument: ~S"));
+    }
+
+  result = gdbscm_make_error (scm_arg_type_key, subr, msg,
+			      scm_list_1 (bad_value), scm_list_1 (bad_value));
+  xfree (msg);
+  return result;
+}
+
+/* A variant of gdbscm_make_type_error for non-type argument errors.
+   ERROR_PREFIX and ERROR are combined to build the error message.
+   Care needs to be taken so that the i18n composed form is still
+   reasonable, but no one is going to translate these anyway so we don't
+   worry too much.
+   ERROR_PREFIX may be NULL, ERROR may not be NULL.  */
+
+static SCM
+gdbscm_make_arg_error (SCM key, const char *subr, int arg_pos, SCM bad_value,
+		       const char *error_prefix, const char *error)
+{
+  char *msg;
+  SCM result;
+
+  if (error_prefix != NULL)
+    {
+      if (arg_pos > 0)
+	{
+	  msg = xstrprintf (_("%s %s in position %d: ~S"),
+			    error_prefix, error, arg_pos);
+	}
+      else
+	msg = xstrprintf (_("%s %s: ~S"), error_prefix, error);
+    }
+  else
+    {
+      if (arg_pos > 0)
+	msg = xstrprintf (_("%s in position %d: ~S"), error, arg_pos);
+      else
+	msg = xstrprintf (_("%s: ~S"), error);
+    }
+
+  result = gdbscm_make_error (key, subr, msg,
+			      scm_list_1 (bad_value), scm_list_1 (bad_value));
+  xfree (msg);
+  return result;
+}
+
+/* Make an invalid-object error <gdb:exception> object.
+   OBJECT is the name of the kind of object that is invalid.  */
+
+SCM
+gdbscm_make_invalid_object_error (const char *subr, int arg_pos, SCM bad_value,
+				  const char *object)
+{
+  return gdbscm_make_arg_error (gdbscm_invalid_object_error_symbol,
+				subr, arg_pos, bad_value,
+				_("Invalid object:"), object);
+}
+
+/* Throw an invalid-object error.
+   OBJECT is the name of the kind of object that is invalid.  */
+
+SCM
+gdbscm_invalid_object_error (const char *subr, int arg_pos, SCM bad_value,
+			     const char *object)
+{
+  SCM exception
+    = gdbscm_make_invalid_object_error (subr, arg_pos, bad_value, object);
+
+  gdbscm_throw (exception);
+}
+
+/* Make an out-of-range error <gdb:exception> object.  */
+
+SCM
+gdbscm_make_out_of_range_error (const char *subr, int arg_pos, SCM bad_value,
+				const char *error)
+{
+  return gdbscm_make_arg_error (scm_out_of_range_key,
+				subr, arg_pos, bad_value,
+				_("Out of range:"), error);
+}
+
+/* Throw an out-of-range error.
+   This is the standard Guile out-of-range exception.  */
+
+SCM
+gdbscm_out_of_range_error (const char *subr, int arg_pos, SCM bad_value,
+			   const char *error)
+{
+  SCM exception
+    = gdbscm_make_out_of_range_error (subr, arg_pos, bad_value, error);
+
+  gdbscm_throw (exception);
+}
+
+/* Make a misc-error <gdb:exception> object.  */
+
+SCM
+gdbscm_make_misc_error (const char *subr, int arg_pos, SCM bad_value,
+		       const char *error)
+{
+  return gdbscm_make_arg_error (scm_misc_error_key,
+				subr, arg_pos, bad_value, NULL, error);
+}
+
+/* Return a <gdb:exception> object for gdb:memory-error.  */
+
+SCM
+gdbscm_make_memory_error (const char *subr, const char *msg, SCM args)
+{
+  return gdbscm_make_error (memory_error_symbol, subr, msg, args,
+			    SCM_EOL);
+}
+
+/* Throw a gdb:memory-error exception.  */
+
+SCM
+gdbscm_memory_error (const char *subr, const char *msg, SCM args)
+{
+  SCM exception = gdbscm_make_memory_error (subr, msg, args);
+
+  gdbscm_throw (exception);
+}
+
+/* Return non-zero if KEY is gdb:memory-error.
+   Note: This is an excp_matcher_func function.  */
+
+int
+gdbscm_memory_error_p (SCM key)
+{
+  return scm_is_eq (key, memory_error_symbol);
+}
+
+/* Wrapper around scm_throw to throw a gdb:exception.
+   This function does not return.
+   This function cannot be called from inside TRY_CATCH.  */
+
+void
+gdbscm_throw (SCM exception)
+{
+  scm_throw (gdbscm_exception_key (exception),
+	     gdbscm_exception_args (exception));
+  gdb_assert_not_reached ("scm_throw returned");
+}
+
+/* Convert a GDB exception to a <gdb:exception> object.  */
+
+SCM
+gdbscm_scm_from_gdb_exception (struct gdb_exception exception)
+{
+  SCM key;
+
+  if (exception.reason == RETURN_QUIT)
+    {
+      /* Handle this specially to be consistent with top-repl.scm.  */
+      return gdbscm_make_error (signal_symbol, NULL, _("User interrupt"),
+				SCM_EOL, scm_list_1 (scm_from_int (SIGINT)));
+    }
+
+  if (exception.error == MEMORY_ERROR)
+    key = memory_error_symbol;
+  else
+    key = error_symbol;
+
+  return gdbscm_make_error (key, NULL, "~A",
+			    scm_list_1 (gdbscm_scm_from_c_string
+					(exception.message)),
+			    SCM_BOOL_F);
+}
+
+/* Convert a GDB exception to the appropriate Scheme exception and throw it.
+   This function does not return.  */
+
+void
+gdbscm_throw_gdb_exception (struct gdb_exception exception)
+{
+  gdbscm_throw (gdbscm_scm_from_gdb_exception (exception));
+}
+
+/* Print the error message portion of an exception.
+   If PORT is #f, use the standard error port.
+   KEY cannot be gdb:with-stack.
+
+   Basically this function is just a wrapper around calling
+   %print-exception-message.  */
+
+static void
+gdbscm_print_exception_message (SCM port, SCM frame, SCM key, SCM args)
+{
+  SCM printer, status;
+
+  if (gdbscm_is_false (port))
+    port = scm_current_error_port ();
+
+  gdb_assert (!scm_is_eq (key, with_stack_error_symbol));
+
+  /* This does not use scm_print_exception because we tweak the output a bit.
+     Compare Guile's print-exception with our %print-exception-message for
+     details.  */
+  if (gdbscm_is_false (percent_print_exception_message_var))
+    {
+      percent_print_exception_message_var
+	= scm_c_private_variable (gdbscm_init_module_name,
+				  percent_print_exception_message_name);
+      /* If we can't find %print-exception-message, there's a problem on the
+	 Scheme side.  Don't kill GDB, just flag an error and leave it at
+	 that.  */
+      if (gdbscm_is_false (percent_print_exception_message_var))
+	{
+	  gdbscm_printf (port, _("Error in Scheme exception printing,"
+				 " can't find %s.\n"),
+			 percent_print_exception_message_name);
+	  return;
+	}
+    }
+  printer = scm_variable_ref (percent_print_exception_message_var);
+
+  status = gdbscm_safe_call_4 (printer, port, frame, key, args, NULL);
+
+  /* If that failed still tell the user something.
+     But don't use the exception printing machinery!  */
+  if (gdbscm_is_exception (status))
+    {
+      gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
+      scm_display (status, port);
+      scm_newline (port);
+    }
+}
+
+/* Print the description of exception KEY, ARGS to PORT, according to the
+   setting of "set guile print-stack".
+   If PORT is #f, use the standard error port.
+   If STACK is #f, never print the stack, regardless of whether printing it
+   is enabled.  If STACK is #t, then print it if it is contained in ARGS
+   (i.e., KEY is gdb:with-stack).  Otherwise STACK is the result of calling
+   scm_make_stack (which will be ignored in favor of the stack in ARGS if
+   KEY is gdb:with-stack).
+   KEY, ARGS are the standard arguments to scm_throw, et.al.
+
+   Basically this function is just a wrapper around calling
+   %print-exception-with-args.  */
+
+void
+gdbscm_print_exception_with_stack (SCM port, SCM stack, SCM key, SCM args)
+{
+  SCM printer, status;
+
+  if (gdbscm_is_false (port))
+    port = scm_current_error_port ();
+
+  if (gdbscm_is_false (percent_print_exception_with_stack_var))
+    {
+      percent_print_exception_with_stack_var
+	= scm_c_private_variable (gdbscm_init_module_name,
+				  percent_print_exception_with_stack_name);
+      /* If we can't find %print-exception-with-args, there's a problem on the
+	 Scheme side.  Don't kill GDB, just flag an error and leave it at
+	 that.  */
+      if (gdbscm_is_false (percent_print_exception_with_stack_var))
+	{
+	  gdbscm_printf (port, _("Error in Scheme exception printing,"
+				 " can't find %s.\n"),
+			 percent_print_exception_with_stack_name);
+	  return;
+	}
+    }
+  printer = scm_variable_ref (percent_print_exception_with_stack_var);
+
+  status = gdbscm_safe_call_4 (printer, port, stack, key, args, NULL);
+
+  /* If that failed still tell the user something.
+     But don't use the exception printing machinery!  */
+  if (gdbscm_is_exception (status))
+    {
+      gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
+      scm_display (status, port);
+      scm_newline (port);
+    }
+}
+
+/* Print EXCEPTION, a <gdb:exception> object, to PORT.
+   If PORT is #f, use the standard error port.  */
+
+void
+gdbscm_print_gdb_exception (SCM port, SCM exception)
+{
+  gdb_assert (gdbscm_is_exception (exception));
+
+  gdbscm_print_exception_with_stack (port, SCM_BOOL_T,
+				     gdbscm_exception_key (exception),
+				     gdbscm_exception_args (exception));
+}
+
+/* Return a string description of <gdb:exception> EXCEPTION.
+   If EXCEPTION is a gdb:with-stack exception, unwrap it, a backtrace
+   is never returned as part of the result.
+
+   Space for the result is malloc'd, the caller must free.  */
+
+char *
+gdbscm_exception_message_to_string (SCM exception)
+{
+  SCM port = scm_open_output_string ();
+  SCM key, args;
+  char *result;
+
+  gdb_assert (gdbscm_is_exception (exception));
+
+  key = gdbscm_exception_key (exception);
+  args = gdbscm_exception_args (exception);
+
+  if (scm_is_eq (key, with_stack_error_symbol)
+      /* Don't crash on a badly generated gdb:with-stack exception.  */
+      && scm_is_pair (args)
+      && scm_is_pair (scm_cdr (args)))
+    {
+      key = scm_car (args);
+      args = scm_cddr (args);
+    }
+
+  gdbscm_print_exception_message (port, SCM_BOOL_F, key, args);
+  result = gdbscm_scm_to_c_string (scm_get_output_string (port));
+  scm_close_port (port);
+
+  return result;
+}
+
+/* Return the value of the "guile print-stack" option as one of:
+   'none, 'message, 'full.  */
+
+static SCM
+gdbscm_percent_exception_print_style (void)
+{
+  if (gdbscm_print_excp == gdbscm_print_excp_none)
+    return none_symbol;
+  if (gdbscm_print_excp == gdbscm_print_excp_message)
+    return message_symbol;
+  if (gdbscm_print_excp == gdbscm_print_excp_full)
+    return full_symbol;
+  gdb_assert_not_reached ("bad value for \"guile print-stack\"");
+}
+
+/* Return the current <gdb:exception> counter.
+   This is for debugging purposes.  */
+
+static SCM
+gdbscm_percent_exception_count (void)
+{
+  return scm_from_ulong (gdbscm_exception_count);
+}
+
+/* Initialize the Scheme exception support.  */
+
+static const scheme_function exception_functions[] =
+{
+  { "make-exception", 2, 0, 0, gdbscm_make_exception,
+    "\
+Create a <gdb:exception> object.\n\
+\n\
+  Arguments: key args\n\
+    These are the standard key,args arguments of \"throw\"." },
+
+  { "exception?", 1, 0, 0, gdbscm_exception_p,
+    "\
+Return #t if the object is a <gdb:exception> object." },
+
+  { "exception-key", 1, 0, 0, gdbscm_exception_key,
+    "\
+Return the exception's key." },
+
+  { "exception-args", 1, 0, 0, gdbscm_exception_args,
+    "\
+Return the exception's arg list." },
+
+  END_FUNCTIONS
+};
+
+static const scheme_function private_exception_functions[] =
+{
+  { "%exception-print-style", 0, 0, 0, gdbscm_percent_exception_print_style,
+    "\
+Return the value of the \"guile print-stack\" option." },
+
+  { "%exception-count", 0, 0, 0, gdbscm_percent_exception_count,
+    "\
+Return a count of the number of <gdb:exception> objects created.\n\
+This is for debugging purposes." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_exceptions (void)
+{
+  exception_smob_tag = gdbscm_make_smob_type (exception_smob_name,
+					      sizeof (exception_smob));
+  scm_set_smob_mark (exception_smob_tag, exscm_mark_exception_smob);
+  scm_set_smob_print (exception_smob_tag, exscm_print_exception_smob);
+
+  gdbscm_define_functions (exception_functions, 1);
+  gdbscm_define_functions (private_exception_functions, 0);
+
+  error_symbol = scm_from_latin1_symbol ("gdb:error");
+
+  memory_error_symbol = scm_from_latin1_symbol ("gdb:memory-error");
+
+  gdbscm_invalid_object_error_symbol
+    = scm_from_latin1_symbol ("gdb:invalid-object-error");
+
+  with_stack_error_symbol = scm_from_latin1_symbol ("gdb:with-stack");
+
+  /* The text of this symbol is taken from Guile's top-repl.scm.  */
+  signal_symbol = scm_from_latin1_symbol ("signal");
+
+  none_symbol = scm_from_latin1_symbol ("none");
+  message_symbol = scm_from_latin1_symbol ("message");
+  full_symbol = scm_from_latin1_symbol ("full");
+}
diff --git a/gdb/guile/scm-frame.c b/gdb/guile/scm-frame.c
new file mode 100644
index 0000000..a46d1e3
--- /dev/null
+++ b/gdb/guile/scm-frame.c
@@ -0,0 +1,1077 @@
+/* Scheme interface to stack frames.
+
+   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 "block.h"
+#include "frame.h"
+#include "exceptions.h"
+#include "inferior.h"
+#include "objfiles.h"
+#include "symfile.h"
+#include "symtab.h"
+#include "stack.h"
+#include "value.h"
+#include "guile-internal.h"
+
+/* The <gdb:frame> smob.
+   The typedef for this struct is in guile-internal.h.  */
+
+struct _frame_smob
+{
+  /* This always appears first.  */
+  eqable_gdb_smob base;
+
+  struct frame_id frame_id;
+  struct gdbarch *gdbarch;
+
+  /* Frames are tracked by inferior.
+     We need some place to put the eq?-able hash table, and this feels as
+     good a place as any.  Frames in one inferior shouldn't be considered
+     equal to frames in a different inferior.  The frame becomes invalid if
+     this becomes NULL (the inferior has been deleted from gdb).
+     It's easier to relax restrictions than impose them after the fact.
+     N.B. It is an outstanding question whether a frame survives reruns of
+     the inferior.  Intuitively the answer is "No", but currently a frame
+     also survives, e.g., multiple invocations of the same function from
+     the same point.  Even different threads can have the same frame, e.g.,
+     if a thread dies and a new thread gets the same stack.  */
+  struct inferior *inferior;
+
+  /* Marks that the FRAME_ID member actually holds the ID of the frame next
+     to this, and not this frame's ID itself.  This is a hack to permit Scheme
+     frame objects which represent invalid frames (i.e., the last frame_info
+     in a corrupt stack).  The problem arises from the fact that this code
+     relies on FRAME_ID to uniquely identify a frame, which is not always true
+     for the last "frame" in a corrupt stack (it can have a null ID, or the
+     same ID as the  previous frame).  Whenever get_prev_frame returns NULL, we
+     record the frame_id of the next frame and set FRAME_ID_IS_NEXT to 1.  */
+  int frame_id_is_next;
+};
+
+static const char frame_smob_name[] = "gdb:frame";
+
+/* The tag Guile knows the frame smob by.  */
+static scm_t_bits frame_smob_tag;
+
+/* Keywords used in argument passing.  */
+static SCM block_keyword;
+
+static const struct inferior_data *frscm_inferior_data_key;
+
+/* Administrivia for frame smobs.  */
+
+/* Helper function to hash a frame_smob.  */
+
+static hashval_t
+frscm_hash_frame_smob (const void *p)
+{
+  const frame_smob *f_smob = p;
+  const struct frame_id *fid = &f_smob->frame_id;
+  hashval_t hash = htab_hash_pointer (f_smob->inferior);
+
+  if (fid->stack_status == FID_STACK_VALID)
+    hash = iterative_hash (&fid->stack_addr, sizeof (fid->stack_addr), hash);
+  if (fid->code_addr_p)
+    hash = iterative_hash (&fid->code_addr, sizeof (fid->code_addr), hash);
+  if (fid->special_addr_p)
+    hash = iterative_hash (&fid->special_addr, sizeof (fid->special_addr),
+			   hash);
+
+  return hash;
+}
+
+/* Helper function to compute equality of frame_smobs.  */
+
+static int
+frscm_eq_frame_smob (const void *ap, const void *bp)
+{
+  const frame_smob *a = ap;
+  const frame_smob *b = bp;
+
+  return (frame_id_eq (a->frame_id, b->frame_id)
+	  && a->inferior == b->inferior
+	  && a->inferior != NULL);
+}
+
+/* Return the frame -> SCM mapping table.
+   It is created if necessary.  */
+
+static htab_t
+frscm_inferior_frame_map (struct inferior *inferior)
+{
+  htab_t htab = inferior_data (inferior, frscm_inferior_data_key);
+
+  if (htab == NULL)
+    {
+      htab = gdbscm_create_eqable_gsmob_ptr_map (frscm_hash_frame_smob,
+						 frscm_eq_frame_smob);
+      set_inferior_data (inferior, frscm_inferior_data_key, htab);
+    }
+
+  return htab;
+}
+
+/* The smob "mark" function for <gdb:frame>.  */
+
+static SCM
+frscm_mark_frame_smob (SCM self)
+{
+  frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self);
+
+  /* Do this last.  */
+  return gdbscm_mark_eqable_gsmob (&f_smob->base);
+}
+
+/* The smob "free" function for <gdb:frame>.  */
+
+static size_t
+frscm_free_frame_smob (SCM self)
+{
+  frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self);
+
+  if (f_smob->inferior != NULL)
+    {
+      htab_t htab = frscm_inferior_frame_map (f_smob->inferior);
+
+      gdbscm_clear_eqable_gsmob_ptr_slot (htab, &f_smob->base);
+    }
+
+  /* Not necessary, done to catch bugs.  */
+  f_smob->inferior = NULL;
+
+  return 0;
+}
+
+/* The smob "print" function for <gdb:frame>.  */
+
+static int
+frscm_print_frame_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self);
+  struct ui_file *strfile;
+  char *s;
+
+  gdbscm_printf (port, "#<%s ", frame_smob_name);
+
+  strfile = mem_fileopen ();
+  fprint_frame_id (strfile, f_smob->frame_id);
+  s = ui_file_xstrdup (strfile, NULL);
+  gdbscm_printf (port, "%s", s);
+  ui_file_delete (strfile);
+  xfree (s);
+
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:frame> object.  */
+
+static SCM
+frscm_make_frame_smob (void)
+{
+  frame_smob *f_smob = (frame_smob *)
+    scm_gc_malloc (sizeof (frame_smob), frame_smob_name);
+  SCM f_scm;
+
+  f_smob->frame_id = null_frame_id;
+  f_smob->gdbarch = NULL;
+  f_smob->inferior = NULL;
+  f_smob->frame_id_is_next = 0;
+  f_scm = scm_new_smob (frame_smob_tag, (scm_t_bits) f_smob);
+  gdbscm_init_eqable_gsmob (&f_smob->base);
+
+  return f_scm;
+}
+
+/* Return non-zero if SCM is a <gdb:frame> object.  */
+
+int
+frscm_is_frame (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (frame_smob_tag, scm);
+}
+
+/* (frame? object) -> boolean */
+
+static SCM
+gdbscm_frame_p (SCM scm)
+{
+  return scm_from_bool (frscm_is_frame (scm));
+}
+
+/* Create a new <gdb:frame> object that encapsulates FRAME.
+   Returns a <gdb:exception> object if there is an error.  */
+
+static SCM
+frscm_scm_from_frame (struct frame_info *frame, struct inferior *inferior)
+{
+  frame_smob *f_smob, f_smob_for_lookup;
+  SCM f_scm;
+  htab_t htab;
+  eqable_gdb_smob **slot;
+  volatile struct gdb_exception except;
+  struct frame_id frame_id = null_frame_id;
+  struct gdbarch *gdbarch = NULL;
+  int frame_id_is_next = 0;
+
+  /* If we've already created a gsmob for this frame, return it.
+     This makes frames eq?-able.  */
+  htab = frscm_inferior_frame_map (inferior);
+  f_smob_for_lookup.frame_id = get_frame_id (frame);
+  f_smob_for_lookup.inferior = inferior;
+  slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &f_smob_for_lookup.base);
+  if (*slot != NULL)
+    return (*slot)->containing_scm;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      /* Try to get the previous frame, to determine if this is the last frame
+	 in a corrupt stack.  If so, we need to store the frame_id of the next
+	 frame and not of this one (which is possibly invalid).  */
+      if (get_prev_frame (frame) == NULL
+	  && get_frame_unwind_stop_reason (frame) != UNWIND_NO_REASON
+	  && get_next_frame (frame) != NULL)
+	{
+	  frame_id = get_frame_id (get_next_frame (frame));
+	  frame_id_is_next = 1;
+	}
+      else
+	{
+	  frame_id = get_frame_id (frame);
+	  frame_id_is_next = 0;
+	}
+      gdbarch = get_frame_arch (frame);
+    }
+  if (except.reason < 0)
+    return gdbscm_scm_from_gdb_exception (except);
+
+  f_scm = frscm_make_frame_smob ();
+  f_smob = (frame_smob *) SCM_SMOB_DATA (f_scm);
+  f_smob->frame_id = frame_id;
+  f_smob->gdbarch = gdbarch;
+  f_smob->inferior = inferior;
+  f_smob->frame_id_is_next = frame_id_is_next;
+
+  gdbscm_fill_eqable_gsmob_ptr_slot (slot, &f_smob->base, f_scm);
+
+  return f_scm;
+}
+
+/* Create a new <gdb:frame> object that encapsulates FRAME.
+   A Scheme exception is thrown if there is an error.  */
+
+static SCM
+frscm_scm_from_frame_unsafe (struct frame_info *frame,
+			     struct inferior *inferior)
+{
+  SCM f_scm = frscm_scm_from_frame (frame, inferior);
+
+  if (gdbscm_is_exception (f_scm))
+    gdbscm_throw (f_scm);
+
+  return f_scm;
+}
+
+/* Returns the <gdb:frame> object in SELF.
+   Throws an exception if SELF is not a <gdb:frame> object.  */
+
+static SCM
+frscm_get_frame_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (frscm_is_frame (self), self, arg_pos, func_name,
+		   frame_smob_name);
+
+  return self;
+}
+
+/* There is no gdbscm_scm_to_frame function because translating
+   a frame SCM object to a struct frame_info * can throw a GDB error.
+   Thus code working with frames has to handle both Scheme errors (e.g., the
+   object is not a frame) and GDB errors (e.g., the frame lookup failed).
+
+   To help keep things clear we split gdbscm_scm_to_frame into two:
+
+   gdbscm_get_frame_smob_arg_unsafe
+     - throws a Scheme error if object is not a frame,
+       or if the inferior is gone or is no longer current
+
+   gdbscm_frame_smob_to_frame
+     - may throw a gdb error if the conversion fails
+     - it's not clear when it will and won't throw a GDB error,
+       but for robustness' sake we assume that whenever we call out to GDB
+       a GDB error may get thrown (and thus the call must be wrapped in a
+       TRY_CATCH)  */
+
+/* Returns the frame_smob for the object wrapped by FRAME_SCM.
+   A Scheme error is thrown if FRAME_SCM is not a frame.  */
+
+frame_smob *
+frscm_get_frame_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM f_scm = frscm_get_frame_arg_unsafe (self, arg_pos, func_name);
+  frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (f_scm);
+
+  if (f_smob->inferior == NULL)
+    {
+      gdbscm_invalid_object_error (func_name, arg_pos, self,
+				   _("inferior"));
+    }
+  if (f_smob->inferior != current_inferior ())
+    scm_misc_error (func_name, _("inferior has changed"), SCM_EOL);
+
+  return f_smob;
+}
+
+/* Returns the frame_info object wrapped by F_SMOB.
+   If the frame doesn't exist anymore (the frame id doesn't
+   correspond to any frame in the inferior), returns NULL.
+   This function calls GDB routines, so don't assume a GDB error will
+   not be thrown.  */
+
+struct frame_info *
+frscm_frame_smob_to_frame (frame_smob *f_smob)
+{
+  struct frame_info *frame;
+
+  frame = frame_find_by_id (f_smob->frame_id);
+  if (frame == NULL)
+    return NULL;
+
+  if (f_smob->frame_id_is_next)
+    frame = get_prev_frame (frame);
+
+  return frame;
+}
+
+/* Helper function for frscm_del_inferior_frames to mark the frame
+   as invalid.  */
+
+static int
+frscm_mark_frame_invalid (void **slot, void *info)
+{
+  frame_smob *f_smob = (frame_smob *) *slot;
+
+  f_smob->inferior = NULL;
+  return 1;
+}
+
+/* This function is called when an inferior is about to be freed.
+   Invalidate the frame as further actions on the frame could result
+   in bad data.  All access to the frame should be gated by
+   frscm_get_frame_smob_arg_unsafe which will raise an exception on
+   invalid frames.  */
+
+static void
+frscm_del_inferior_frames (struct inferior *inferior, void *datum)
+{
+  htab_t htab = datum;
+
+  if (htab != NULL)
+    {
+      htab_traverse_noresize (htab, frscm_mark_frame_invalid, NULL);
+      htab_delete (htab);
+    }
+}
+
+/* Frame methods.  */
+
+/* (frame-valid? <gdb:frame>) -> bool
+   Returns #t if the frame corresponding to the frame_id of this
+   object still exists in the inferior.  */
+
+static SCM
+gdbscm_frame_valid_p (SCM self)
+{
+  frame_smob *f_smob;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return scm_from_bool (frame != NULL);
+}
+
+/* (frame-name <gdb:frame>) -> string
+   Returns the name of the function corresponding to this frame,
+   or #f if there is no function.  */
+
+static SCM
+gdbscm_frame_name (SCM self)
+{
+  frame_smob *f_smob;
+  char *name = NULL;
+  enum language lang = language_minimal;
+  struct frame_info *frame = NULL;
+  SCM result;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	find_frame_funname (frame, &name, &lang, NULL);
+    }
+  if (except.reason < 0)
+    xfree (name);
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  if (name != NULL)
+    {
+      result = gdbscm_scm_from_c_string (name);
+      xfree (name);
+    }
+  else
+    result = SCM_BOOL_F;
+
+  return result;
+}
+
+/* (frame-type <gdb:frame>) -> integer
+   Returns the frame type, namely one of the gdb:*_FRAME constants.  */
+
+static SCM
+gdbscm_frame_type (SCM self)
+{
+  frame_smob *f_smob;
+  enum frame_type type = NORMAL_FRAME;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	type = get_frame_type (frame);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  return scm_from_int (type);
+}
+
+/* (frame-arch <gdb:frame>) -> <gdb:architecture>
+   Returns the frame's architecture as a gdb:architecture object.  */
+
+static SCM
+gdbscm_frame_arch (SCM self)
+{
+  frame_smob *f_smob;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  return arscm_scm_from_arch (f_smob->gdbarch);
+}
+
+/* (frame-unwind-stop-reason <gdb:frame>) -> integer
+   Returns one of the gdb:FRAME_UNWIND_* constants.  */
+
+static SCM
+gdbscm_frame_unwind_stop_reason (SCM self)
+{
+  frame_smob *f_smob;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+  enum unwind_stop_reason stop_reason;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  stop_reason = get_frame_unwind_stop_reason (frame);
+
+  return scm_from_int (stop_reason);
+}
+
+/* (frame-pc <gdb:frame>) -> integer
+   Returns the frame's resume address.  */
+
+static SCM
+gdbscm_frame_pc (SCM self)
+{
+  frame_smob *f_smob;
+  CORE_ADDR pc = 0;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	pc = get_frame_pc (frame);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  return gdbscm_scm_from_ulongest (pc);
+}
+
+/* (frame-block <gdb:frame>) -> <gdb:block>
+   Returns the frame's code block, or #f if one cannot be found.  */
+
+static SCM
+gdbscm_frame_block (SCM self)
+{
+  frame_smob *f_smob;
+  struct block *block = NULL, *fn_block;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	block = get_frame_block (frame, NULL);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  for (fn_block = block;
+       fn_block != NULL && BLOCK_FUNCTION (fn_block) == NULL;
+       fn_block = BLOCK_SUPERBLOCK (fn_block))
+    continue;
+
+  if (block == NULL || fn_block == NULL || BLOCK_FUNCTION (fn_block) == NULL)
+    {
+      scm_misc_error (FUNC_NAME, _("cannot find block for frame"),
+		      scm_list_1 (self));
+    }
+
+  if (block != NULL)
+    {
+      struct symtab *st;
+      SCM block_scm;
+
+      st = SYMBOL_SYMTAB (BLOCK_FUNCTION (fn_block));
+      return bkscm_scm_from_block (block, st->objfile);
+    }
+
+  return SCM_BOOL_F;
+}
+
+/* (frame-function <gdb:frame>) -> <gdb:symbol>
+   Returns the symbol for the function corresponding to this frame,
+   or #f if there isn't one.  */
+
+static SCM
+gdbscm_frame_function (SCM self)
+{
+  frame_smob *f_smob;
+  struct symbol *sym = NULL;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	sym = find_pc_function (get_frame_address_in_block (frame));
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  if (sym != NULL)
+    return syscm_scm_from_symbol (sym);
+
+  return SCM_BOOL_F;
+}
+
+/* (frame-older <gdb:frame>) -> <gdb:frame>
+   Returns the frame immediately older (outer) to this frame,
+   or #f if there isn't one.  */
+
+static SCM
+gdbscm_frame_older (SCM self)
+{
+  frame_smob *f_smob;
+  struct frame_info *prev = NULL;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	prev = get_prev_frame (frame);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  if (prev != NULL)
+    return frscm_scm_from_frame_unsafe (prev, f_smob->inferior);
+
+  return SCM_BOOL_F;
+}
+
+/* (frame-newer <gdb:frame>) -> <gdb:frame>
+   Returns the frame immediately newer (inner) to this frame,
+   or #f if there isn't one.  */
+
+static SCM
+gdbscm_frame_newer (SCM self)
+{
+  frame_smob *f_smob;
+  struct frame_info *next = NULL;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	next = get_next_frame (frame);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  if (next != NULL)
+    return frscm_scm_from_frame_unsafe (next, f_smob->inferior);
+
+  return SCM_BOOL_F;
+}
+
+/* (frame-sal <gdb:frame>) -> <gdb:sal>
+   Returns the frame's symtab and line.  */
+
+static SCM
+gdbscm_frame_sal (SCM self)
+{
+  frame_smob *f_smob;
+  struct symtab_and_line sal;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	find_frame_sal (frame, &sal);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  return stscm_scm_from_sal (sal);
+}
+
+/* (frame-read-var <gdb:frame> <gdb:symbol>) -> <gdb:value>
+   (frame-read-var <gdb:frame> string [#:block <gdb:block>]) -> <gdb:value>
+   If the optional block argument is provided start the search from that block,
+   otherwise search from the frame's current block (determined by examining
+   the resume address of the frame).  The variable argument must be a string
+   or an instance of a <gdb:symbol>.  The block argument must be an instance of
+   <gdb:block>.  */
+
+static SCM
+gdbscm_frame_read_var (SCM self, SCM symbol_scm, SCM rest)
+{
+  SCM keywords[] = { block_keyword, SCM_BOOL_F };
+  int rc;
+  frame_smob *f_smob;
+  int block_arg_pos = -1;
+  SCM block_scm = SCM_UNDEFINED;
+  struct frame_info *frame = NULL;
+  struct symbol *var = NULL;
+  struct value *value = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG3, keywords, "#O",
+			      rest, &block_arg_pos, &block_scm);
+
+  if (syscm_is_symbol (symbol_scm))
+    {
+      var = syscm_get_valid_symbol_arg_unsafe (symbol_scm, SCM_ARG2,
+					       FUNC_NAME);
+      SCM_ASSERT (SCM_UNBNDP (block_scm), block_scm, SCM_ARG3, FUNC_NAME);
+    }
+  else if (scm_is_string (symbol_scm))
+    {
+      char *var_name;
+      const struct block *block = NULL;
+      struct cleanup *cleanup;
+      volatile struct gdb_exception except;
+
+      if (! SCM_UNBNDP (block_scm))
+	{
+	  SCM except_scm;
+
+	  gdb_assert (block_arg_pos > 0);
+	  block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
+				      &except_scm);
+	  if (block == NULL)
+	    gdbscm_throw (except_scm);
+	}
+
+      var_name = gdbscm_scm_to_c_string (symbol_scm);
+      cleanup = make_cleanup (xfree, var_name);
+      /* N.B. Between here and the call to do_cleanups, don't do anything
+	 to cause a Scheme exception without performing the cleanup.  */
+
+      TRY_CATCH (except, RETURN_MASK_ALL)
+	{
+	  if (block == NULL)
+	    block = get_frame_block (frame, NULL);
+	  var = lookup_symbol (var_name, block, VAR_DOMAIN, NULL);
+	}
+      if (except.reason < 0)
+	do_cleanups (cleanup);
+      GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+      if (var == NULL)
+	{
+	  do_cleanups (cleanup);
+	  gdbscm_out_of_range_error (FUNC_NAME, 0, symbol_scm,
+				     _("variable not found"));
+	}
+
+      do_cleanups (cleanup);
+    }
+  else
+    {
+      /* Use SCM_ASSERT_TYPE for more consistent error messages.  */
+      SCM_ASSERT_TYPE (0, symbol_scm, SCM_ARG1, FUNC_NAME,
+		       _("gdb:symbol or string"));
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      value = read_var_value (var, frame);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return vlscm_scm_from_value (value);
+}
+
+/* (frame-select <gdb:frame>) -> unspecified
+   Select this frame.  */
+
+static SCM
+gdbscm_frame_select (SCM self)
+{
+  frame_smob *f_smob;
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = frscm_frame_smob_to_frame (f_smob);
+      if (frame != NULL)
+	select_frame (frame);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (frame == NULL)
+    {
+      gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+				   _("<gdb:frame>"));
+    }
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (newest-frame) -> <gdb:frame>
+   Returns the newest frame.  */
+
+static SCM
+gdbscm_newest_frame (void)
+{
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = get_current_frame ();
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return frscm_scm_from_frame_unsafe (frame, current_inferior ());
+}
+
+/* (selected-frame) -> <gdb:frame>
+   Returns the selected frame.  */
+
+static SCM
+gdbscm_selected_frame (void)
+{
+  struct frame_info *frame = NULL;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      frame = get_selected_frame (_("No frame is currently selected"));
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return frscm_scm_from_frame_unsafe (frame, current_inferior ());
+}
+
+/* (unwind-stop-reason-string integer) -> string
+   Return a string explaining the unwind stop reason.  */
+
+static SCM
+gdbscm_unwind_stop_reason_string (SCM reason_scm)
+{
+  int reason;
+  const char *str;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i",
+			      reason_scm, &reason);
+
+  if (reason < UNWIND_FIRST || reason > UNWIND_LAST)
+    scm_out_of_range (FUNC_NAME, reason_scm);
+
+  str = frame_stop_reason_string (reason);
+  return gdbscm_scm_from_c_string (str);
+}
+
+/* Initialize the Scheme frame support.  */
+
+static const scheme_integer_constant frame_integer_constants[] =
+{
+#define ENTRY(X) { #X, X }
+
+  ENTRY (NORMAL_FRAME),
+  ENTRY (DUMMY_FRAME),
+  ENTRY (INLINE_FRAME),
+  ENTRY (TAILCALL_FRAME),
+  ENTRY (SIGTRAMP_FRAME),
+  ENTRY (ARCH_FRAME),
+  ENTRY (SENTINEL_FRAME),
+
+#undef ENTRY
+
+#define SET(name, description) \
+  { "FRAME_" #name, name },
+#include "unwind_stop_reasons.def"
+#undef SET
+
+  END_INTEGER_CONSTANTS
+};
+
+static const scheme_function frame_functions[] =
+{
+  { "frame?", 1, 0, 0, gdbscm_frame_p,
+    "\
+Return #t if the object is a <gdb:frame> object." },
+
+  { "frame-valid?", 1, 0, 0, gdbscm_frame_valid_p,
+    "\
+Return #t if the object is a valid <gdb:frame> object.\n\
+Frames become invalid when the inferior returns to its caller." },
+
+  { "frame-name", 1, 0, 0, gdbscm_frame_name,
+    "\
+Return the name of the function corresponding to this frame,\n\
+or #f if there is no function." },
+
+  { "frame-arch", 1, 0, 0, gdbscm_frame_arch,
+    "\
+Return the frame's architecture as a <gdb:arch> object." },
+
+  { "frame-type", 1, 0, 0, gdbscm_frame_type,
+    "\
+Return the frame type, namely one of the gdb:*_FRAME constants." },
+
+  { "frame-unwind-stop-reason", 1, 0, 0, gdbscm_frame_unwind_stop_reason,
+    "\
+Return one of the gdb:FRAME_UNWIND_* constants explaining why\n\
+it's not possible to find frames older than this." },
+
+  { "frame-pc", 1, 0, 0, gdbscm_frame_pc,
+    "\
+Return the frame's resume address." },
+
+  { "frame-block", 1, 0, 0, gdbscm_frame_block,
+    "\
+Return the frame's code block, or #f if one cannot be found." },
+
+  { "frame-function", 1, 0, 0, gdbscm_frame_function,
+    "\
+Return the <gdb:symbol> for the function corresponding to this frame,\n\
+or #f if there isn't one." },
+
+  { "frame-older", 1, 0, 0, gdbscm_frame_older,
+    "\
+Return the frame immediately older (outer) to this frame,\n\
+or #f if there isn't one." },
+
+  { "frame-newer", 1, 0, 0, gdbscm_frame_newer,
+    "\
+Return the frame immediately newer (inner) to this frame,\n\
+or #f if there isn't one." },
+
+  { "frame-sal", 1, 0, 0, gdbscm_frame_sal,
+    "\
+Return the frame's symtab-and-line <gdb:sal> object." },
+
+  { "frame-read-var", 2, 0, 1, gdbscm_frame_read_var,
+    "\
+Return the value of the symbol in the frame.\n\
+\n\
+  Arguments: <gdb:frame> <gdb:symbol>\n\
+         Or: <gdb:frame> string [#:block <gdb:block>]" },
+
+  { "frame-select", 1, 0, 0, gdbscm_frame_select,
+    "\
+Select this frame." },
+
+  { "newest-frame", 0, 0, 0, gdbscm_newest_frame,
+    "\
+Return the newest frame." },
+
+  { "selected-frame", 0, 0, 0, gdbscm_selected_frame,
+    "\
+Return the selected frame." },
+
+  { "unwind-stop-reason-string", 1, 0, 0, gdbscm_unwind_stop_reason_string,
+    "\
+Return a string explaining the unwind stop reason.\n\
+\n\
+  Arguments: integer (the result of frame-unwind-stop-reason)" },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_frames (void)
+{
+  frame_smob_tag
+    = gdbscm_make_smob_type (frame_smob_name, sizeof (frame_smob));
+  scm_set_smob_mark (frame_smob_tag, frscm_mark_frame_smob);
+  scm_set_smob_free (frame_smob_tag, frscm_free_frame_smob);
+  scm_set_smob_print (frame_smob_tag, frscm_print_frame_smob);
+
+  gdbscm_define_integer_constants (frame_integer_constants, 1);
+  gdbscm_define_functions (frame_functions, 1);
+
+  block_keyword = scm_from_latin1_keyword ("block");
+
+  /* Register an inferior "free" callback so we can properly
+     invalidate frames when an inferior file is about to be deleted.  */
+  frscm_inferior_data_key
+    = register_inferior_data_with_cleanup (NULL, frscm_del_inferior_frames);
+}
diff --git a/gdb/guile/scm-gsmob.c b/gdb/guile/scm-gsmob.c
new file mode 100644
index 0000000..5f9e856
--- /dev/null
+++ b/gdb/guile/scm-gsmob.c
@@ -0,0 +1,486 @@
+/* GDB/Scheme smobs (gsmob is pronounced "jee smob")
+
+   Copyright (C) 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.  */
+
+/* Smobs are Guile's "small object".
+   They are used to export C structs to Scheme.
+
+   Note: There's only room in the encoding space for 256, and while we won't
+   come close to that, mixed with other libraries maybe someday we could.
+   We don't worry about it now, except to be aware of the issue.
+   We could allocate just a few smobs and use the unused smob flags field to
+   specify the gdb smob kind, that is left for another day if it ever is
+   needed.
+
+   We want the objects we export to Scheme to be extensible by the user.
+   A gsmob (gdb smob) adds a simple API on top of smobs to support this.
+   This allows GDB objects to be easily extendable in a useful manner.
+   To that end, all smobs in gdb have gdb_smob as the first member.
+
+   On top of gsmobs there are "chained gsmobs".  They are used to assist with
+   life-time tracking of GDB objects vs Scheme objects.  Gsmobs can "subclass"
+   chained_gdb_smob, which contains a doubly-linked list to assist with
+   life-time tracking.
+
+   On top of gsmobs there are also "eqable gsmobs".  Gsmobs can "subclass"
+   eqable_gdb_smob instead of gdb_smob, and is used to make gsmobs eq?-able.
+   This is done by recording all gsmobs in a hash table and before creating a
+   gsmob first seeing if it's already in the table.  Eqable gsmobs can also be
+   used where lifetime-tracking is required.
+
+   Gsmobs (and chained/eqable gsmobs) add an extra field that is used to
+   record extra data: "properties".  It is a table of key/value pairs
+   that can be set with set-gsmob-property!, gsmob-property.  */
+
+#include "defs.h"
+#include "hashtab.h"
+#include "gdb_assert.h"
+#include "objfiles.h"
+#include "guile-internal.h"
+
+/* We need to call this.  Undo our hack to prevent others from calling it.  */
+#undef scm_make_smob_type
+
+static htab_t registered_gsmobs;
+
+/* Gsmob properties are initialize stored as an alist to minimize space
+   usage: GDB can be used to debug some really big programs, and property
+   lists generally have very few elements.  Once the list grows to this
+   many elements then we switch to a hash table.
+   The smallest Guile hashtable in 2.0 uses a vector of 31 elements.
+   The value we use here is large enough to hold several expected uses,
+   without being so large that we might as well just use a hashtable.  */
+#define SMOB_PROP_HTAB_THRESHOLD 7
+
+/* Hash function for registered_gsmobs hash table.  */
+
+static hashval_t
+hash_scm_t_bits (const void *item)
+{
+  uintptr_t v = (uintptr_t) item;
+
+  return v;
+}
+
+/* Equality function for registered_gsmobs hash table.  */
+
+static int
+eq_scm_t_bits (const void *item_lhs, const void *item_rhs)
+{
+  return item_lhs == item_rhs;
+}
+
+/* Record GSMOB_CODE as being a gdb smob.
+   GSMOB_CODE is the result of scm_make_smob_type.  */
+
+static void
+register_gsmob (scm_t_bits gsmob_code)
+{
+  void **slot;
+
+  slot = htab_find_slot (registered_gsmobs, (void *) gsmob_code, INSERT);
+  gdb_assert (*slot == NULL);
+  *slot = (void *) gsmob_code;
+}
+
+/* Return non-zero if SCM is any registered gdb smob object.  */
+
+static int
+gdbscm_is_gsmob (SCM scm)
+{
+  void **slot;
+
+  if (SCM_IMP (scm))
+    return 0;
+  slot = htab_find_slot (registered_gsmobs, (void *) SCM_TYP16 (scm),
+			 NO_INSERT);
+  return slot != NULL;
+}
+
+/* Call this to register a smob, instead of scm_make_smob_type.  */
+
+scm_t_bits
+gdbscm_make_smob_type (const char *name, size_t size)
+{
+  scm_t_bits result = scm_make_smob_type (name, size);
+
+  register_gsmob (result);
+  return result;
+}
+
+/* Initialize a gsmob.  */
+
+void
+gdbscm_init_gsmob (gdb_smob *base)
+{
+  base->properties = SCM_EOL;
+}
+
+/* Initialize a chained_gdb_smob.
+   This is the same as gdbscm_init_gsmob except that it also sets prev,next
+   to NULL.  */
+
+void
+gdbscm_init_chained_gsmob (chained_gdb_smob *base)
+{
+  gdbscm_init_gsmob ((gdb_smob *) base);
+  base->prev = NULL;
+  base->next = NULL;
+}
+
+/* Initialize an eqable_gdb_smob.
+   This is the same as gdbscm_init_gsmob except that it also sets
+   containing_scm to #f.  */
+
+void
+gdbscm_init_eqable_gsmob (eqable_gdb_smob *base)
+{
+  gdbscm_init_gsmob ((gdb_smob *) base);
+  base->containing_scm = SCM_BOOL_F;
+}
+
+/* Call this from each smob's "mark" routine.
+   In general, this should be called as:
+   return gdbscm_mark_gsmob (base);  */
+
+SCM
+gdbscm_mark_gsmob (gdb_smob *base)
+{
+  /* Return the last one to mark as an optimization.
+     The marking infrastructure will mark it for us.  */
+  return base->properties;
+}
+
+/* Call this from each smob's "mark" routine.
+   In general, this should be called as:
+   return gdbscm_mark_chained_gsmob (base);  */
+
+SCM
+gdbscm_mark_chained_gsmob (chained_gdb_smob *base)
+{
+  /* Return the last one to mark as an optimization.
+     The marking infrastructure will mark it for us.  */
+  return base->properties;
+}
+
+/* Call this from each smob's "mark" routine.
+   In general, this should be called as:
+   return gdbscm_mark_eqable_gsmob (base);  */
+
+SCM
+gdbscm_mark_eqable_gsmob (eqable_gdb_smob *base)
+{
+  /* There's no need to mark containing_scm.
+     Any references to it either come from Scheme in which case it will be
+     marked through them, or there's a reference to the smob from gdb in
+     which case the smob is GC-protected.  */
+
+  /* Return the last one to mark as an optimization.
+     The marking infrastructure will mark it for us.  */
+  return base->properties;
+}
+
+/* gsmob accessors */
+
+/* Return the gsmob in SELF.
+   Throws an exception if SELF is not a gsmob.  */
+
+static SCM
+gsscm_get_gsmob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (gdbscm_is_gsmob (self), self, arg_pos, func_name,
+		   _("any gdb smob"));
+
+  return self;
+}
+
+/* (gsmob-kind gsmob) -> symbol
+
+   Note: While one might want to name this gsmob-class-name, it is named
+   "-kind" because smobs aren't real GOOPS classes.  */
+
+static SCM
+gdbscm_gsmob_kind (SCM self)
+{
+  SCM smob, result;
+  scm_t_bits smobnum;
+  const char *name;
+  char *kind;
+
+  smob = gsscm_get_gsmob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  smobnum = SCM_SMOBNUM (smob);
+  name = SCM_SMOBNAME (smobnum);
+  kind = xstrprintf ("<%s>", name);
+  result = scm_from_latin1_symbol (kind);
+  xfree (kind);
+
+  return result;
+}
+
+/* (gsmob-property gsmob property) -> object
+   If property isn't present then #f is returned.  */
+
+static SCM
+gdbscm_gsmob_property (SCM self, SCM property)
+{
+  SCM smob;
+  gdb_smob *base;
+
+  smob = gsscm_get_gsmob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  base = (gdb_smob *) SCM_SMOB_DATA (self);
+
+  /* Have we switched to a hash table?  */
+  if (gdbscm_is_true (scm_hash_table_p (base->properties)))
+    return scm_hashq_ref (base->properties, property, SCM_BOOL_F);
+
+  return scm_assq_ref (base->properties, property);
+}
+
+/* (set-gsmob-property! gsmob property new-value) -> unspecified */
+
+static SCM
+gdbscm_set_gsmob_property_x (SCM self, SCM property, SCM new_value)
+{
+  SCM smob, alist;
+  gdb_smob *base;
+
+  smob = gsscm_get_gsmob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  base = (gdb_smob *) SCM_SMOB_DATA (self);
+
+  /* Have we switched to a hash table?  */
+  if (gdbscm_is_true (scm_hash_table_p (base->properties)))
+    {
+      scm_hashq_set_x (base->properties, property, new_value);
+      return SCM_UNSPECIFIED;
+    }
+
+  alist = scm_assq_set_x (base->properties, property, new_value);
+
+  /* Did we grow the list?  */
+  if (!scm_is_eq (alist, base->properties))
+    {
+      /* If we grew the list beyond a threshold in size,
+	 switch to a hash table.  */
+      if (scm_ilength (alist) >= SMOB_PROP_HTAB_THRESHOLD)
+	{
+	  SCM elm, htab;
+
+	  htab = scm_c_make_hash_table (SMOB_PROP_HTAB_THRESHOLD);
+	  for (elm = alist; elm != SCM_EOL; elm = scm_cdr (elm))
+	    scm_hashq_set_x (htab, scm_caar (elm), scm_cdar (elm));
+	  base->properties = htab;
+	  return SCM_UNSPECIFIED;
+	}
+    }
+
+  base->properties = alist;
+  return SCM_UNSPECIFIED;
+}
+
+/* (gsmob-has-property? gsmob property) -> boolean */
+
+static SCM
+gdbscm_gsmob_has_property_p (SCM self, SCM property)
+{
+  SCM smob, handle;
+  gdb_smob *base;
+
+  smob = gsscm_get_gsmob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  base = (gdb_smob *) SCM_SMOB_DATA (self);
+
+  if (gdbscm_is_true (scm_hash_table_p (base->properties)))
+    handle = scm_hashq_get_handle (base->properties, property);
+  else
+    handle = scm_assq (property, base->properties);
+
+  return scm_from_bool (gdbscm_is_true (handle));
+}
+
+/* Helper function for gdbscm_gsmob_properties.  */
+
+static SCM
+add_property_name (void *closure, SCM handle)
+{
+  SCM *resultp = closure;
+
+  *resultp = scm_cons (scm_car (handle), *resultp);
+  return SCM_UNSPECIFIED;
+}
+
+/* (gsmob-properties gsmob) -> list
+   The list is unsorted.  */
+
+static SCM
+gdbscm_gsmob_properties (SCM self)
+{
+  SCM smob, handle, result;
+  gdb_smob *base;
+
+  smob = gsscm_get_gsmob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  base = (gdb_smob *) SCM_SMOB_DATA (self);
+
+  result = SCM_EOL;
+  if (gdbscm_is_true (scm_hash_table_p (base->properties)))
+    {
+      scm_internal_hash_for_each_handle (add_property_name, &result,
+					 base->properties);
+    }
+  else
+    {
+      SCM elm;
+
+      for (elm = base->properties; elm != SCM_EOL; elm = scm_cdr (elm))
+	result = scm_cons (scm_caar (elm), result);
+    }
+
+  return result;
+}
+
+/* When underlying gdb data structures are deleted, we need to update any
+   smobs with references to them.  There are several smobs that reference
+   objfile-based data, so we provide helpers to manage this.  */
+
+/* Add G_SMOB to the reference chain for OBJFILE specified by DATA_KEY.
+   OBJFILE may be NULL, in which case just set prev,next to NULL.  */
+
+void
+gdbscm_add_objfile_ref (struct objfile *objfile,
+			const struct objfile_data *data_key,
+			chained_gdb_smob *g_smob)
+{
+  g_smob->prev = NULL;
+  if (objfile != NULL)
+    {
+      g_smob->next = objfile_data (objfile, data_key);
+      if (g_smob->next)
+	g_smob->next->prev = g_smob;
+      set_objfile_data (objfile, data_key, g_smob);
+    }
+  else
+    g_smob->next = NULL;
+}
+
+/* Remove G_SMOB from the reference chain for OBJFILE specified
+   by DATA_KEY.  OBJFILE may be NULL.  */
+
+void
+gdbscm_remove_objfile_ref (struct objfile *objfile,
+			   const struct objfile_data *data_key,
+			   chained_gdb_smob *g_smob)
+{
+  if (g_smob->prev)
+    g_smob->prev->next = g_smob->next;
+  else if (objfile != NULL)
+    set_objfile_data (objfile, data_key, g_smob->next);
+  if (g_smob->next)
+    g_smob->next->prev = g_smob->prev;
+}
+
+/* Create a hash table for mapping a pointer to a gdb data structure to the
+   gsmob that wraps it.  */
+
+htab_t
+gdbscm_create_eqable_gsmob_ptr_map (htab_hash hash_fn, htab_eq eq_fn)
+{
+  htab_t htab = htab_create_alloc (7, hash_fn, eq_fn,
+				   NULL, xcalloc, xfree);
+
+  return htab;
+}
+
+/* Return a pointer to the htab entry for the eq?-able gsmob BASE.
+   If the entry is found, *SLOT is non-NULL.
+   Otherwise *slot is NULL.  */
+
+eqable_gdb_smob **
+gdbscm_find_eqable_gsmob_ptr_slot (htab_t htab, eqable_gdb_smob *base)
+{
+  void **slot = htab_find_slot (htab, base, INSERT);
+
+  return (eqable_gdb_smob **) slot;
+}
+
+/* Record CONTAINING_SCM as the object containing BASE, and record it in
+   SLOT.  SLOT must be the result of calling gdbscm_find_eqable_gsmob_ptr_slot
+   on BASE (or equivalent for lookup).  */
+
+void
+gdbscm_fill_eqable_gsmob_ptr_slot (eqable_gdb_smob **slot,
+				   eqable_gdb_smob *base,
+				   SCM containing_scm)
+{
+  base->containing_scm = containing_scm;
+  *slot = base;
+}
+
+/* Remove BASE from HTAB.
+   BASE is a pointer to a gsmob that wraps a pointer to a GDB datum.
+   This is used, for example, when an object is freed.
+
+   It is an error to call this if PTR is not in HTAB (only because it allows
+   for some consistency checking).  */
+
+void
+gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab, eqable_gdb_smob *base)
+{
+  void **slot = htab_find_slot (htab, base, NO_INSERT);
+
+  gdb_assert (slot != NULL);
+  htab_clear_slot (htab, slot);
+}
+
+/* Initialize the Scheme gsmobs code.  */
+
+static const scheme_function gsmob_functions[] =
+{
+  { "gsmob-kind", 1, 0, 0, gdbscm_gsmob_kind,
+    "\
+Return the kind of the smob, e.g., <gdb:breakpoint>, as a symbol." },
+
+  { "gsmob-property", 2, 0, 0, gdbscm_gsmob_property,
+    "\
+Return the specified property of the gsmob." },
+
+  { "set-gsmob-property!", 3, 0, 0, gdbscm_set_gsmob_property_x,
+    "\
+Set the specified property of the gsmob." },
+
+  { "gsmob-has-property?", 2, 0, 0, gdbscm_gsmob_has_property_p,
+    "\
+Return #t if the specified property is present." },
+
+  { "gsmob-properties", 1, 0, 0, gdbscm_gsmob_properties,
+    "\
+Return an unsorted list of names of properties." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_smobs (void)
+{
+  registered_gsmobs = htab_create_alloc (10,
+					 hash_scm_t_bits, eq_scm_t_bits,
+					 NULL, xcalloc, xfree);
+
+  gdbscm_define_functions (gsmob_functions, 1);
+}
diff --git a/gdb/guile/scm-iterator.c b/gdb/guile/scm-iterator.c
new file mode 100644
index 0000000..a6deb84
--- /dev/null
+++ b/gdb/guile/scm-iterator.c
@@ -0,0 +1,375 @@
+/* Simple iterators for GDB/Scheme.
+
+   Copyright (C) 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.  */
+
+/* These are *simple* iterators, used to implement iterating over a collection
+   of objects.  They are implemented as a smob containing three objects:
+
+   1) the object being iterated over,
+   2) an object to record the progress of the iteration,
+   3) a procedure of one argument (the iterator object) that returns the next
+      object in the iteration or a pre-determined end marker.
+
+   Simple example:
+
+   (define-public (make-list-iterator l end-marker)
+     "Return a <gdb:iterator> object for a list."
+     (let ((next! (lambda (iter)
+		    (let ((l (iterator-progress iter)))
+		      (if (eq? l '())
+		          end-marker
+		          (begin
+			    (set-iterator-progress! iter (cdr l))
+			    (car l)))))))
+       (make-iterator l l next!)))
+
+   (define l '(1 2))
+   (define i (make-list-iterator l #:eoi))
+   (iterator-next! i) -> 1
+   (iterator-next! i) -> 2
+   (iterator-next! i) -> #:eoi
+
+   There is SRFI 41, Streams.  We might support that too eventually (not with
+   this interface of course).  */
+
+#include "defs.h"
+#include "guile-internal.h"
+
+/* A smob for iterating over something.
+   Typically this is used when computing a list of everything is
+   too expensive.
+   The typedef for this struct is in guile-internal.h.  */
+
+struct _iterator_smob
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* The object being iterated over.  */
+  SCM object;
+
+  /* An arbitrary object describing the progress of the iteration.
+     This is used by next_x to track progress.  */
+  SCM progress;
+
+  /* A procedure of one argument, the iterator.
+     It returns the next object in the iteration.
+     How to signal "end of iteration" is up to next_x.  */
+  SCM next_x;
+};
+
+static const char iterator_smob_name[] = "gdb:iterator";
+
+/* The tag Guile knows the iterator smob by.  */
+static scm_t_bits iterator_smob_tag;
+
+/* A unique-enough marker to denote "end of iteration".  */
+static SCM end_of_iteration;
+
+const char *
+itscm_iterator_smob_name (void)
+{
+  return iterator_smob_name;
+}
+
+SCM
+itscm_iterator_smob_object (iterator_smob *i_smob)
+{
+  return i_smob->object;
+}
+
+SCM
+itscm_iterator_smob_progress (iterator_smob *i_smob)
+{
+  return i_smob->progress;
+}
+
+void
+itscm_set_iterator_smob_progress_x (iterator_smob *i_smob, SCM progress)
+{
+  i_smob->progress = progress;
+}
+
+/* Administrivia for iterator smobs.  */
+
+/* The smob "mark" function for <gdb:iterator>.  */
+
+static SCM
+itscm_mark_iterator_smob (SCM self)
+{
+  iterator_smob *i_smob = (iterator_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (i_smob->object);
+  scm_gc_mark (i_smob->progress);
+  scm_gc_mark (i_smob->next_x);
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&i_smob->base);
+}
+
+/* The smob "print" function for <gdb:iterator>.  */
+
+static int
+itscm_print_iterator_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  iterator_smob *i_smob = (iterator_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s ", iterator_smob_name);
+  scm_write (i_smob->object, port);
+  scm_puts (" ", port);
+  scm_write (i_smob->progress, port);
+  scm_puts (" ", port);
+  scm_write (i_smob->next_x, port);
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to make a <gdb:iterator> object.
+   Caller must verify correctness of arguments.
+   No exceptions are thrown.  */
+
+static SCM
+itscm_make_iterator_smob (SCM object, SCM progress, SCM next)
+{
+  iterator_smob *i_smob = (iterator_smob *)
+    scm_gc_malloc (sizeof (iterator_smob), iterator_smob_name);
+  SCM i_scm;
+
+  i_smob->object = object;
+  i_smob->progress = progress;
+  i_smob->next_x = next;
+  i_scm = scm_new_smob (iterator_smob_tag, (scm_t_bits) i_smob);
+  gdbscm_init_gsmob (&i_smob->base);
+
+  return i_scm;
+}
+
+/* (make-iterator object object procedure) -> <gdb:iterator> */
+
+SCM
+gdbscm_make_iterator (SCM object, SCM progress, SCM next)
+{
+  SCM i_scm;
+
+  SCM_ASSERT_TYPE (gdbscm_is_procedure (next), next, SCM_ARG3, FUNC_NAME,
+		   _("procedure"));
+
+  i_scm = itscm_make_iterator_smob (object, progress, next);
+
+  return i_scm;
+}
+
+/* Return non-zero if SCM is a <gdb:iterator> object.  */
+
+int
+itscm_is_iterator (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (iterator_smob_tag, scm);
+}
+
+/* (iterator? object) -> boolean */
+
+static SCM
+gdbscm_iterator_p (SCM scm)
+{
+  return scm_from_bool (itscm_is_iterator (scm));
+}
+
+/* (end-of-iteration) -> an "end-of-iteration" marker
+   We rely on this not being used as a data result of an iterator.  */
+
+SCM
+gdbscm_end_of_iteration (void)
+{
+  return end_of_iteration;
+}
+
+/* Return non-zero if OBJ is the end-of-iteration marker.  */
+
+int
+itscm_is_end_of_iteration (SCM obj)
+{
+  return scm_is_eq (obj, end_of_iteration);
+}
+
+/* (end-of-iteration? obj) -> boolean */
+
+static SCM
+gdbscm_end_of_iteration_p (SCM obj)
+{
+  return scm_from_bool (itscm_is_end_of_iteration (obj));
+}
+
+/* Call the next! method on ITER, which must be a <gdb:iterator> object.
+   Returns a <gdb:exception> object if an exception is thrown.
+   OK_EXCPS is passed to gdbscm_safe_call_1.  */
+
+SCM
+itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps)
+{
+  iterator_smob *i_smob;
+
+  gdb_assert (itscm_is_iterator (iter));
+
+  i_smob = (iterator_smob *) SCM_SMOB_DATA (iter);
+  return gdbscm_safe_call_1 (i_smob->next_x, iter, ok_excps);
+}
+
+/* Iterator methods.  */
+
+/* Returns the <gdb:iterator> smob in SELF.
+   Throws an exception if SELF is not an iterator smob.  */
+
+SCM
+itscm_get_iterator_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (itscm_is_iterator (self), self, arg_pos, func_name,
+		   iterator_smob_name);
+
+  return self;
+}
+
+/* (iterator-object <gdb:iterator>) -> object */
+
+static SCM
+gdbscm_iterator_object (SCM self)
+{
+  SCM i_scm;
+  iterator_smob *i_smob;
+
+  i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
+
+  return i_smob->object;
+}
+
+/* (iterator-progress <gdb:iterator>) -> object */
+
+static SCM
+gdbscm_iterator_progress (SCM self)
+{
+  SCM i_scm;
+  iterator_smob *i_smob;
+
+  i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
+
+  return i_smob->progress;
+}
+
+/* (set-iterator-progress! <gdb:iterator> object) -> unspecified */
+
+static SCM
+gdbscm_set_iterator_progress_x (SCM self, SCM value)
+{
+  SCM i_scm;
+  iterator_smob *i_smob;
+
+  i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
+
+  i_smob->progress = value;
+  return SCM_UNSPECIFIED;
+}
+
+/* (iterator-next! <gdb:iterator>) -> object
+   The result is the next value in the iteration or some "end" marker.
+   It is up to each iterator's next! function to specify what its end
+   marker is.  */
+
+static SCM
+gdbscm_iterator_next_x (SCM self)
+{
+  SCM i_scm;
+  iterator_smob *i_smob;
+
+  i_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  i_smob = (iterator_smob *) SCM_SMOB_DATA (i_scm);
+  /* We leave type-checking of the procedure to gdbscm_safe_call_1.  */
+
+  return gdbscm_safe_call_1 (i_smob->next_x, self, NULL);
+}
+
+/* Initialize the Scheme iterator code.  */
+
+static const scheme_function iterator_functions[] =
+{
+  { "make-iterator", 3, 0, 0, gdbscm_make_iterator,
+    "\
+Create a <gdb:iterator> object.\n\
+\n\
+  Arguments: object progress next!\n\
+    object:   The object to iterate over.\n\
+    progress: An object to use to track progress of the iteration.\n\
+    next!:    A procedure of one argument, the iterator.\n\
+      Returns the next element in the iteration or an implementation-chosen\n\
+      value to signify iteration is complete.\n\
+      By convention end-of-iteration should be marked with (end-of-iteration)\n\
+      from module (gdb iterator)." },
+
+  { "iterator?", 1, 0, 0, gdbscm_iterator_p,
+    "\
+Return #t if the object is a <gdb:iterator> object." },
+
+  { "iterator-object", 1, 0, 0, gdbscm_iterator_object,
+    "\
+Return the object being iterated over." },
+
+  { "iterator-progress", 1, 0, 0, gdbscm_iterator_progress,
+    "\
+Return the progress object of the iterator." },
+
+  { "set-iterator-progress!", 2, 0, 0, gdbscm_set_iterator_progress_x,
+    "\
+Set the progress object of the iterator." },
+
+  { "iterator-next!", 1, 0, 0, gdbscm_iterator_next_x,
+    "\
+Invoke the next! procedure of the iterator and return its result." },
+
+  { "end-of-iteration", 0, 0, 0, gdbscm_end_of_iteration,
+    "\
+Return the end-of-iteration marker." },
+
+  { "end-of-iteration?", 1, 0, 0, gdbscm_end_of_iteration_p,
+    "\
+Return #t if the object is the end-of-iteration marker." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_iterators (void)
+{
+  iterator_smob_tag = gdbscm_make_smob_type (iterator_smob_name,
+					     sizeof (iterator_smob));
+  scm_set_smob_mark (iterator_smob_tag, itscm_mark_iterator_smob);
+  scm_set_smob_print (iterator_smob_tag, itscm_print_iterator_smob);
+
+  gdbscm_define_functions (iterator_functions, 1);
+
+  /* We can make this more unique if it's necessary,
+     but this is good enough for now.  */
+  end_of_iteration = scm_from_latin1_keyword ("end-of-iteration");
+}
diff --git a/gdb/guile/scm-lazy-string.c b/gdb/guile/scm-lazy-string.c
new file mode 100644
index 0000000..e965d01
--- /dev/null
+++ b/gdb/guile/scm-lazy-string.c
@@ -0,0 +1,373 @@
+/* Scheme interface to lazy strings.
+
+   Copyright (C) 2010-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 "charset.h"
+#include "value.h"
+#include "exceptions.h"
+#include "valprint.h"
+#include "language.h"
+#include "gdb_assert.h"
+#include "guile-internal.h"
+
+/* The <gdb:lazy-string> smob.  */
+
+typedef struct
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /*  Holds the address of the lazy string.  */
+  CORE_ADDR address;
+
+  /*  Holds the encoding that will be applied to the string when the string
+      is printed by GDB.  If the encoding is set to NULL then GDB will select
+      the most appropriate encoding when the sting is printed.
+      Space for this is malloc'd and will be freed when the object is
+      freed.  */
+  char *encoding;
+
+  /* Holds the length of the string in characters.  If the length is -1,
+     then the string will be fetched and encoded up to the first null of
+     appropriate width.  */
+  int length;
+
+  /*  This attribute holds the type that is represented by the lazy
+      string's type.  */
+  struct type *type;
+} lazy_string_smob;
+
+static const char lazy_string_smob_name[] = "gdb:lazy-string";
+
+/* The tag Guile knows the lazy string smob by.  */
+static scm_t_bits lazy_string_smob_tag;
+
+/* Administrivia for lazy string smobs.  */
+
+/* The smob "mark" function for <gdb:lazy-string>.  */
+
+static SCM
+lsscm_mark_lazy_string_smob (SCM self)
+{
+  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (self);
+
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&ls_smob->base);
+}
+
+/* The smob "free" function for <gdb:lazy-string>.  */
+
+static size_t
+lsscm_free_lazy_string_smob (SCM self)
+{
+  lazy_string_smob *v_smob = (lazy_string_smob *) SCM_SMOB_DATA (self);
+
+  xfree (v_smob->encoding);
+
+  return 0;
+}
+
+/* The smob "print" function for <gdb:lazy-string>.  */
+
+static int
+lsscm_print_lazy_string_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s", lazy_string_smob_name);
+  gdbscm_printf (port, " @%s", hex_string (ls_smob->address));
+  if (ls_smob->length >= 0)
+    gdbscm_printf (port, " length %d", ls_smob->length);
+  if (ls_smob->encoding != NULL)
+    gdbscm_printf (port, " encoding %s", ls_smob->encoding);
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:lazy-string> object.
+   The caller must verify !(address == 0 && length != 0).  */
+
+static SCM
+lsscm_make_lazy_string_smob (CORE_ADDR address, int length,
+			     const char *encoding, struct type *type)
+{
+  lazy_string_smob *ls_smob = (lazy_string_smob *)
+    scm_gc_malloc (sizeof (lazy_string_smob), lazy_string_smob_name);
+  SCM ls_scm;
+
+  /* Caller must verify this.  */
+  gdb_assert (!(address == 0 && length != 0));
+  gdb_assert (type != NULL);
+
+  ls_smob->address = address;
+  /* Coerce all values < 0 to -1.  */
+  ls_smob->length = length < 0 ? -1 : length;
+  if (encoding == NULL || strcmp (encoding, "") == 0)
+    ls_smob->encoding = NULL;
+  else
+    ls_smob->encoding = xstrdup (encoding);
+  ls_smob->type = type;
+
+  ls_scm = scm_new_smob (lazy_string_smob_tag, (scm_t_bits) ls_smob);
+  gdbscm_init_gsmob (&ls_smob->base);
+
+  return ls_scm;
+}
+
+/* Return non-zero if SCM is a <gdb:lazy-string> object.  */
+
+int
+lsscm_is_lazy_string (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (lazy_string_smob_tag, scm);
+}
+
+/* (lazy-string? object) -> boolean */
+
+static SCM
+gdbscm_lazy_string_p (SCM scm)
+{
+  return scm_from_bool (lsscm_is_lazy_string (scm));
+}
+
+/* Main entry point to create a <gdb:lazy-string> object.
+   If there's an error a <gdb:exception> object is returned.  */
+
+SCM
+lsscm_make_lazy_string (CORE_ADDR address, int length,
+			const char *encoding, struct type *type)
+{
+  if (address == 0 && length != 0)
+    {
+      return gdbscm_make_out_of_range_error
+	(NULL, 0, scm_from_int (length),
+	 _("cannot create a lazy string with address 0x0"
+	   " and a non-zero length"));
+    }
+
+  if (type == NULL)
+    {
+      return gdbscm_make_out_of_range_error
+	(NULL, 0, scm_from_int (0), _("a lazy string's type cannot be NULL"));
+    }
+
+  return lsscm_make_lazy_string_smob (address, length, encoding, type);
+}
+
+/* Returns the <gdb:lazy-string> smob in SELF.
+   Throws an exception if SELF is not a <gdb:lazy-string> object.  */
+
+static SCM
+lsscm_get_lazy_string_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (lsscm_is_lazy_string (self), self, arg_pos, func_name,
+		   lazy_string_smob_name);
+
+  return self;
+}
+
+/* Lazy string methods.  */
+
+/* (lazy-string-address <gdb:lazy-string>) -> address */
+
+static SCM
+gdbscm_lazy_string_address (SCM self)
+{
+  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
+
+  return gdbscm_scm_from_ulongest (ls_smob->address);
+}
+
+/* (lazy-string-length <gdb:lazy-string>) -> integer */
+
+static SCM
+gdbscm_lazy_string_length (SCM self)
+{
+  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
+
+  return scm_from_int (ls_smob->length);
+}
+
+/* (lazy-string-encoding <gdb:lazy-string>) -> string */
+
+static SCM
+gdbscm_lazy_string_encoding (SCM self)
+{
+  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
+
+  /* An encoding can be set to NULL by the user, so check first.
+     If NULL return #f.  */
+  if (ls_smob != NULL)
+    return gdbscm_scm_from_c_string (ls_smob->encoding);
+  return SCM_BOOL_F;
+}
+
+/* (lazy-string-type <gdb:lazy-string>) -> <gdb:type> */
+
+static SCM
+gdbscm_lazy_string_type (SCM self)
+{
+  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
+
+  return tyscm_scm_from_type (ls_smob->type);
+}
+
+/* (lazy-string->value <gdb:lazy-string>) -> <gdb:value> */
+
+static SCM
+gdbscm_lazy_string_to_value (SCM self)
+{
+  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
+  struct value *value = NULL;
+  volatile struct gdb_exception except;
+
+  if (ls_smob->address == 0)
+    {
+      gdbscm_throw (gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
+				_("cannot create a value from NULL")));
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      value = value_at_lazy (ls_smob->type, ls_smob->address);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return vlscm_scm_from_value (value);
+}
+
+/* A "safe" version of gdbscm_lazy_string_to_value for use by
+   vlscm_convert_typed_value_from_scheme.
+   The result, upon success, is the value of <gdb:lazy-string> STRING.
+   ARG_POS is the argument position of STRING in the original Scheme
+   function call, used in exception text.
+   If there's an error, NULL is returned and a <gdb:exception> object
+   is stored in *except_scmp.
+
+   Note: The result is still "lazy".  The caller must call value_fetch_lazy
+   to actually fetch the value.  */
+
+struct value *
+lsscm_safe_lazy_string_to_value (SCM string, int arg_pos,
+				 const char *func_name, SCM *except_scmp)
+{
+  lazy_string_smob *ls_smob;
+  struct value *value = NULL;
+  volatile struct gdb_exception except;
+
+  gdb_assert (lsscm_is_lazy_string (string));
+
+  ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
+  *except_scmp = SCM_BOOL_F;
+
+  if (ls_smob->address == 0)
+    {
+      *except_scmp
+	= gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, string,
+					 _("cannot create a value from NULL"));
+      return NULL;
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      value = value_at_lazy (ls_smob->type, ls_smob->address);
+    }
+  if (except.reason < 0)
+    {
+      *except_scmp = gdbscm_scm_from_gdb_exception (except);
+      return NULL;
+    }
+
+  return value;
+}
+
+/* Print a lazy string to STREAM using val_print_string.
+   STRING must be a <gdb:lazy-string> object.  */
+
+void
+lsscm_val_print_lazy_string (SCM string, struct ui_file *stream,
+			     const struct value_print_options *options)
+{
+  lazy_string_smob *ls_smob;
+
+  gdb_assert (lsscm_is_lazy_string (string));
+
+  ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
+
+  val_print_string (ls_smob->type, ls_smob->encoding,
+		    ls_smob->address, ls_smob->length,
+		    stream, options);
+}
+
+/* Initialize the Scheme lazy-strings code.  */
+
+static const scheme_function lazy_string_functions[] =
+{
+  { "lazy-string?", 1, 0, 0, gdbscm_lazy_string_p,
+    "\
+Return #t if the object is a <gdb:lazy-string> object." },
+
+  { "lazy-string-address", 1, 0, 0, gdbscm_lazy_string_address,
+    "\
+Return the address of the lazy-string." },
+
+  { "lazy-string-length", 1, 0, 0, gdbscm_lazy_string_length,
+    "\
+Return the length of the lazy-string.\n\
+If the length is -1 then the length is determined by the first null\n\
+of appropriate width." },
+
+  { "lazy-string-encoding", 1, 0, 0, gdbscm_lazy_string_encoding,
+    "\
+Return the encoding of the lazy-string." },
+
+  { "lazy-string-type", 1, 0, 0, gdbscm_lazy_string_type,
+    "\
+Return the <gdb:type> of the lazy-string." },
+
+  { "lazy-string->value", 1, 0, 0, gdbscm_lazy_string_to_value,
+    "\
+Return the <gdb:value> representation of the lazy-string." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_lazy_strings (void)
+{
+  lazy_string_smob_tag = gdbscm_make_smob_type (lazy_string_smob_name,
+						sizeof (lazy_string_smob));
+  scm_set_smob_mark (lazy_string_smob_tag, lsscm_mark_lazy_string_smob);
+  scm_set_smob_free (lazy_string_smob_tag, lsscm_free_lazy_string_smob);
+  scm_set_smob_print (lazy_string_smob_tag, lsscm_print_lazy_string_smob);
+
+  gdbscm_define_functions (lazy_string_functions, 1);
+}
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);
+}
diff --git a/gdb/guile/scm-objfile.c b/gdb/guile/scm-objfile.c
new file mode 100644
index 0000000..9a20dc7
--- /dev/null
+++ b/gdb/guile/scm-objfile.c
@@ -0,0 +1,413 @@
+/* Scheme interface to objfiles.
+
+   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 "objfiles.h"
+#include "language.h"
+#include "guile-internal.h"
+
+/* The <gdb:objfile> smob.
+   The typedef for this struct is in guile-internal.h.  */
+
+struct _objfile_smob
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* The corresponding objfile.  */
+  struct objfile *objfile;
+
+  /* The pretty-printer list of functions.  */
+  SCM pretty_printers;
+
+  /* The <gdb:objfile> object we are contained in, needed to protect/unprotect
+     the object since a reference to it comes from non-gc-managed space
+     (the objfile).  */
+  SCM containing_scm;
+};
+
+static const char objfile_smob_name[] = "gdb:objfile";
+
+/* The tag Guile knows the objfile smob by.  */
+static scm_t_bits objfile_smob_tag;
+
+static const struct objfile_data *ofscm_objfile_data_key;
+
+/* Return the list of pretty-printers registered with O_SMOB.  */
+
+SCM
+ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob)
+{
+  return o_smob->pretty_printers;
+}
+
+/* Administrivia for objfile smobs.  */
+
+/* The smob "mark" function for <gdb:objfile>.  */
+
+static SCM
+ofscm_mark_objfile_smob (SCM self)
+{
+  objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (o_smob->pretty_printers);
+
+  /* We don't mark containing_scm here.  It is just a backlink to our
+     container, and is gc'protected until the objfile is deleted.  */
+
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&o_smob->base);
+}
+
+/* The smob "print" function for <gdb:objfile>.  */
+
+static int
+ofscm_print_objfile_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s ", objfile_smob_name);
+  gdbscm_printf (port, "%s",
+		 o_smob->objfile != NULL
+		 ? objfile_name (o_smob->objfile)
+		 : "{invalid}");
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:objfile> object.
+   It's empty in the sense that an OBJFILE still needs to be associated
+   with it.  */
+
+static SCM
+ofscm_make_objfile_smob (void)
+{
+  objfile_smob *o_smob = (objfile_smob *)
+    scm_gc_malloc (sizeof (objfile_smob), objfile_smob_name);
+  SCM o_scm;
+
+  o_smob->objfile = NULL;
+  o_smob->pretty_printers = SCM_EOL;
+  o_scm = scm_new_smob (objfile_smob_tag, (scm_t_bits) o_smob);
+  o_smob->containing_scm = o_scm;
+  gdbscm_init_gsmob (&o_smob->base);
+
+  return o_scm;
+}
+
+/* Clear the OBJFILE pointer in O_SMOB and unprotect the object from GC.  */
+
+static void
+ofscm_release_objfile (objfile_smob *o_smob)
+{
+  o_smob->objfile = NULL;
+  scm_gc_unprotect_object (o_smob->containing_scm);
+}
+
+/* Objfile registry cleanup handler for when an objfile is deleted.  */
+
+static void
+ofscm_handle_objfile_deleted (struct objfile *objfile, void *datum)
+{
+  objfile_smob *o_smob = datum;
+
+  gdb_assert (o_smob->objfile == objfile);
+
+  ofscm_release_objfile (o_smob);
+}
+
+/* Return non-zero if SCM is a <gdb:objfile> object.  */
+
+static int
+ofscm_is_objfile (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (objfile_smob_tag, scm);
+}
+
+/* (objfile? object) -> boolean */
+
+static SCM
+gdbscm_objfile_p (SCM scm)
+{
+  return scm_from_bool (ofscm_is_objfile (scm));
+}
+
+/* Return a pointer to the objfile_smob that encapsulates OBJFILE,
+   creating one if necessary.
+   The result is cached so that we have only one copy per objfile.  */
+
+objfile_smob *
+ofscm_objfile_smob_from_objfile (struct objfile *objfile)
+{
+  objfile_smob *o_smob;
+
+  o_smob = objfile_data (objfile, ofscm_objfile_data_key);
+  if (o_smob == NULL)
+    {
+      SCM o_scm = ofscm_make_objfile_smob ();
+
+      o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
+      o_smob->objfile = objfile;
+
+      set_objfile_data (objfile, ofscm_objfile_data_key, o_smob);
+      scm_gc_protect_object (o_smob->containing_scm);
+    }
+
+  return o_smob;
+}
+
+/* Return the <gdb:objfile> object that encapsulates OBJFILE.  */
+
+SCM
+ofscm_scm_from_objfile (struct objfile *objfile)
+{
+  objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
+
+  return o_smob->containing_scm;
+}
+
+/* Returns the <gdb:objfile> object in SELF.
+   Throws an exception if SELF is not a <gdb:objfile> object.  */
+
+static SCM
+ofscm_get_objfile_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (ofscm_is_objfile (self), self, arg_pos, func_name,
+		   objfile_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the objfile smob of SELF.
+   Throws an exception if SELF is not a <gdb:objfile> object.  */
+
+static objfile_smob *
+ofscm_get_objfile_smob_arg_unsafe (SCM self, int arg_pos,
+				   const char *func_name)
+{
+  SCM o_scm = ofscm_get_objfile_arg_unsafe (self, arg_pos, func_name);
+  objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
+
+  return o_smob;
+}
+
+/* Return non-zero if objfile O_SMOB is valid.  */
+
+static int
+ofscm_is_valid (objfile_smob *o_smob)
+{
+  return o_smob->objfile != NULL;
+}
+
+/* Return the objfile smob in SELF, verifying it's valid.
+   Throws an exception if SELF is not a <gdb:objfile> object or is invalid.  */
+
+static objfile_smob *
+ofscm_get_valid_objfile_smob_arg_unsafe (SCM self, int arg_pos,
+					 const char *func_name)
+{
+  objfile_smob *o_smob
+    = ofscm_get_objfile_smob_arg_unsafe (self, arg_pos, func_name);
+
+  if (!ofscm_is_valid (o_smob))
+    {
+      gdbscm_invalid_object_error (func_name, arg_pos, self,
+				   _("<gdb:objfile>"));
+    }
+
+  return o_smob;
+}
+
+/* Objfile methods.  */
+
+/* (objfile-valid? <gdb:objfile>) -> boolean
+   Returns #t if this object file still exists in GDB.  */
+
+static SCM
+gdbscm_objfile_valid_p (SCM self)
+{
+  objfile_smob *o_smob
+    = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (o_smob->objfile != NULL);
+}
+
+/* (objfile-filename <gdb:objfile>) -> string
+   Returns the objfile's file name.
+   Throw's an exception if the underlying objfile is invalid.  */
+
+static SCM
+gdbscm_objfile_filename (SCM self)
+{
+  objfile_smob *o_smob
+    = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile));
+}
+
+/* (objfile-pretty-printers <gdb:objfile>) -> list
+   Returns the list of pretty-printers for this objfile.  */
+
+static SCM
+gdbscm_objfile_pretty_printers (SCM self)
+{
+  objfile_smob *o_smob
+    = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return o_smob->pretty_printers;
+}
+
+/* (set-objfile-pretty-printers! <gdb:objfile> list) -> unspecified
+   Set the pretty-printers for this objfile.  */
+
+static SCM
+gdbscm_set_objfile_pretty_printers_x (SCM self, SCM printers)
+{
+  objfile_smob *o_smob
+    = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
+		   SCM_ARG2, FUNC_NAME, _("list"));
+
+  o_smob->pretty_printers = printers;
+
+  return SCM_UNSPECIFIED;
+}
+
+/* The "current" objfile.  This is set when gdb detects that a new
+   objfile has been loaded.  It is only set for the duration of a call to
+   gdbscm_source_objfile_script; it is NULL at other times.  */
+static struct objfile *ofscm_current_objfile;
+
+/* Set the current objfile to OBJFILE and then read FILE named FILENAME
+   as Guile code.  This does not throw any errors.  If an exception
+   occurs Guile will print the backtrace.
+   This is the extension_language_script_ops.objfile_script_sourcer
+   "method".  */
+
+void
+gdbscm_source_objfile_script (const struct extension_language_defn *extlang,
+			      struct objfile *objfile, FILE *file,
+			      const char *filename)
+{
+  char *msg;
+
+  ofscm_current_objfile = objfile;
+
+  msg = gdbscm_safe_source_script (filename);
+  if (msg != NULL)
+    {
+      fprintf_filtered (gdb_stderr, "%s", msg);
+      xfree (msg);
+    }
+
+  ofscm_current_objfile = NULL;
+}
+
+/* (current-objfile) -> <gdb:obfjile>
+   Return the current objfile, or #f if there isn't one.
+   Ideally this would be named ofscm_current_objfile, but that name is
+   taken by the variable recording the current objfile.  */
+
+static SCM
+gdbscm_get_current_objfile (void)
+{
+  if (ofscm_current_objfile == NULL)
+    return SCM_BOOL_F;
+
+  return ofscm_scm_from_objfile (ofscm_current_objfile);
+}
+
+/* (objfiles) -> list
+   Return a list of all objfiles in the current program space.  */
+
+static SCM
+gdbscm_objfiles (void)
+{
+  struct objfile *objf;
+  SCM result;
+
+  result = SCM_EOL;
+
+  ALL_OBJFILES (objf)
+  {
+    SCM item = ofscm_scm_from_objfile (objf);
+
+    result = scm_cons (item, result);
+  }
+
+  return scm_reverse_x (result, SCM_EOL);
+}
+
+/* Initialize the Scheme objfile support.  */
+
+static const scheme_function objfile_functions[] =
+{
+  { "objfile?", 1, 0, 0, gdbscm_objfile_p,
+    "\
+Return #t if the object is a <gdb:objfile> object." },
+
+  { "objfile-valid?", 1, 0, 0, gdbscm_objfile_valid_p,
+    "\
+Return #t if the objfile is valid (hasn't been deleted from gdb)." },
+
+  { "objfile-filename", 1, 0, 0, gdbscm_objfile_filename,
+    "\
+Return the file name of the objfile." },
+
+  { "objfile-pretty-printers", 1, 0, 0, gdbscm_objfile_pretty_printers,
+    "\
+Return a list of pretty-printers of the objfile." },
+
+  { "set-objfile-pretty-printers!", 2, 0, 0,
+    gdbscm_set_objfile_pretty_printers_x,
+    "\
+Set the list of pretty-printers of the objfile." },
+
+  { "current-objfile", 0, 0, 0, gdbscm_get_current_objfile,
+    "\
+Return the current objfile if there is one or #f if there isn't one." },
+
+  { "objfiles", 0, 0, 0, gdbscm_objfiles,
+    "\
+Return a list of all objfiles in the current program space." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_objfiles (void)
+{
+  objfile_smob_tag
+    = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob));
+  scm_set_smob_mark (objfile_smob_tag, ofscm_mark_objfile_smob);
+  scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob);
+
+  gdbscm_define_functions (objfile_functions, 1);
+
+  ofscm_objfile_data_key
+    = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted);
+}
diff --git a/gdb/guile/scm-ports.c b/gdb/guile/scm-ports.c
new file mode 100644
index 0000000..30bbc97
--- /dev/null
+++ b/gdb/guile/scm-ports.c
@@ -0,0 +1,1372 @@
+/* Support for connecting Guile's stdio to GDB's.
+   as well as r/w memory via ports.
+
+   Copyright (C) 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 "gdb_select.h"
+#include "interps.h"
+#include "target.h"
+#include "guile-internal.h"
+
+#ifdef HAVE_POLL
+#if defined (HAVE_POLL_H)
+#include <poll.h>
+#elif defined (HAVE_SYS_POLL_H)
+#include <sys/poll.h>
+#endif
+#endif
+
+/* A ui-file for sending output to Guile.  */
+
+typedef struct
+{
+  int *magic;
+  SCM port;
+} ioscm_file_port;
+
+/* Data for a memory port.  */
+
+typedef struct
+{
+  /* Bounds of memory range this port is allowed to access, inclusive.
+     To simplify overflow handling, an END of 0xff..ff is not allowed.
+     This also means a start address of 0xff..ff is also not allowed.
+     I can live with that.  */
+  CORE_ADDR start, end;
+
+  /* (end - start + 1), recorded for convenience.  */
+  ULONGEST size;
+
+  /* Think of this as the lseek value maintained by the kernel.
+     This value is always in the range [0, size].  */
+  ULONGEST current;
+
+  /* The size of the internal r/w buffers.
+     Scheme ports aren't a straightforward mapping to memory r/w.
+     Generally the user specifies how much to r/w and all access is
+     unbuffered.  We don't try to provide equivalent access, but we allow
+     the user to specify these values to help get something similar.  */
+  unsigned read_buf_size, write_buf_size;
+} ioscm_memory_port;
+
+/* Copies of the original system input/output/error ports.
+   These are recorded for debugging purposes.  */
+static SCM orig_input_port_scm;
+static SCM orig_output_port_scm;
+static SCM orig_error_port_scm;
+
+/* This is the stdio port descriptor, scm_ptob_descriptor.  */
+static scm_t_bits stdio_port_desc;
+
+/* Note: scm_make_port_type takes a char * instead of a const char *.  */
+static /*const*/ char stdio_port_desc_name[] = "gdb:stdio-port";
+
+/* Names of each gdb port.  */
+static const char input_port_name[] = "gdb:stdin";
+static const char output_port_name[] = "gdb:stdout";
+static const char error_port_name[] = "gdb:stderr";
+
+/* This is the actual port used from Guile.
+   We don't expose these to the user though, to ensure they're not
+   overwritten.  */
+static SCM input_port_scm;
+static SCM output_port_scm;
+static SCM error_port_scm;
+
+/* Magic number to identify port ui-files.
+   Actually, the address of this variable is the magic number.  */
+static int file_port_magic;
+
+/* Internal enum for specifying output port.  */
+enum oport { GDB_STDOUT, GDB_STDERR };
+
+/* This is the memory port descriptor, scm_ptob_descriptor.  */
+static scm_t_bits memory_port_desc;
+
+/* Note: scm_make_port_type takes a char * instead of a const char *.  */
+static /*const*/ char memory_port_desc_name[] = "gdb:memory-port";
+
+/* The default amount of memory to fetch for each read/write request.
+   Scheme ports don't provide a way to specify the size of a read,
+   which is important to us to minimize the number of inferior interactions,
+   which over a remote link can be important.  To compensate we augment the
+   port API with a new function that let's the user specify how much the next
+   read request should fetch.  This is the initial value for each new port.  */
+static const unsigned default_read_buf_size = 16;
+static const unsigned default_write_buf_size = 16;
+
+/* Arbitrarily limit memory port buffers to 1 byte to 4K.  */
+static const unsigned min_memory_port_buf_size = 1;
+static const unsigned max_memory_port_buf_size = 4096;
+
+/* "out of range" error message for buf sizes.  */
+static char *out_of_range_buf_size;
+
+/* Keywords used by open-memory.  */
+static SCM mode_keyword;
+static SCM start_keyword;
+static SCM size_keyword;
+
+/* Helper to do the low level work of opening a port.
+   Newer versions of Guile (2.1.x) have scm_c_make_port.  */
+
+static SCM
+ioscm_open_port (scm_t_bits port_type, long mode_bits)
+{
+  SCM port;
+
+#if 0 /* TODO: Guile doesn't export this.  What to do?  */
+  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+#endif
+
+  port = scm_new_port_table_entry (port_type);
+
+  SCM_SET_CELL_TYPE (port, port_type | mode_bits);
+
+#if 0 /* TODO: Guile doesn't export this.  What to do?  */
+  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+#endif
+
+  return port;
+}
+
+/* Support for connecting Guile's stdio ports to GDB's stdio ports.  */
+
+/* The scm_t_ptob_descriptor.input_waiting "method".
+   Return a lower bound on the number of bytes available for input.  */
+
+static int
+ioscm_input_waiting (SCM port)
+{
+  int fdes = 0;
+
+  if (! scm_is_eq (port, input_port_scm))
+    return 0;
+
+#ifdef HAVE_POLL
+  {
+    /* This is copied from libguile/fports.c.  */
+    struct pollfd pollfd = { fdes, POLLIN, 0 };
+    static int use_poll = -1;
+
+    if (use_poll < 0)
+      {
+	/* This is copied from event-loop.c: poll cannot be used for stdin on
+	   m68k-motorola-sysv.  */
+	struct pollfd test_pollfd = { fdes, POLLIN, 0 };
+
+	if (poll (&test_pollfd, 1, 0) == 1 && (test_pollfd.revents & POLLNVAL))
+	  use_poll = 0;
+	else
+	  use_poll = 1;
+      }
+
+    if (use_poll)
+      {
+	/* Guile doesn't export SIGINT hooks like Python does.
+	   For now pass EINTR to scm_syserror, that's what fports.c does.  */
+	if (poll (&pollfd, 1, 0) < 0)
+	  scm_syserror (FUNC_NAME);
+
+	return pollfd.revents & POLLIN ? 1 : 0;
+      }
+  }
+  /* Fall through.  */
+#endif
+
+  {
+    struct timeval timeout;
+    fd_set input_fds;
+    int num_fds = fdes + 1;
+    int num_found;
+
+    memset (&timeout, 0, sizeof (timeout));
+    FD_ZERO (&input_fds);
+    FD_SET (fdes, &input_fds);
+
+    num_found = gdb_select (num_fds, &input_fds, NULL, NULL, &timeout);
+    if (num_found < 0)
+      {
+	/* Guile doesn't export SIGINT hooks like Python does.
+	   For now pass EINTR to scm_syserror, that's what fports.c does.  */
+        scm_syserror (FUNC_NAME);
+      }
+    return num_found > 0 && FD_ISSET (fdes, &input_fds);
+  }
+}
+
+/* The scm_t_ptob_descriptor.fill_input "method".  */
+
+static int
+ioscm_fill_input (SCM port)
+{
+  /* Borrowed from libguile/fports.c.  */
+  long count;
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+  /* If we're called on stdout,stderr, punt.  */
+  if (! scm_is_eq (port, input_port_scm))
+    return (scm_t_wchar) EOF; /* Set errno and return -1?  */
+
+  gdb_flush (gdb_stdout);
+  gdb_flush (gdb_stderr);
+
+  count = ui_file_read (gdb_stdin, (char *) pt->read_buf, pt->read_buf_size);
+  if (count == -1)
+    scm_syserror (FUNC_NAME);
+  if (count == 0)
+    return (scm_t_wchar) EOF;
+
+  pt->read_pos = pt->read_buf;
+  pt->read_end = pt->read_buf + count;
+  return *pt->read_buf;
+}
+
+/* Like fputstrn_filtered, but don't escape characters, except nul.
+   Also like fputs_filtered, but a length is specified.  */
+
+static void
+fputsn_filtered (const char *s, size_t size, struct ui_file *stream)
+{
+  size_t i;
+
+  for (i = 0; i < size; ++i)
+    {
+      if (s[i] == '\0')
+	fputs_filtered ("\\000", stream);
+      else
+	fputc_filtered (s[i], stream);
+    }
+}
+
+/* Write to gdb's stdout or stderr.  */
+
+static void
+ioscm_write (SCM port, const void *data, size_t size)
+{
+  volatile struct gdb_exception except;
+
+  /* If we're called on stdin, punt.  */
+  if (scm_is_eq (port, input_port_scm))
+    return;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (scm_is_eq (port, error_port_scm))
+	fputsn_filtered (data, size, gdb_stderr);
+      else
+	fputsn_filtered (data, size, gdb_stdout);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+}
+
+/* Flush gdb's stdout or stderr.  */
+
+static void
+ioscm_flush (SCM port)
+{
+  /* If we're called on stdin, punt.  */
+  if (scm_is_eq (port, input_port_scm))
+    return;
+
+  if (scm_is_eq (port, error_port_scm))
+    gdb_flush (gdb_stderr);
+  else
+    gdb_flush (gdb_stdout);
+}
+
+/* Initialize the gdb stdio port type.
+
+   N.B. isatty? will fail on these ports, it is only supported for file
+   ports.  IWBN if we could "subclass" file ports.  */
+
+static void
+ioscm_init_gdb_stdio_port (void)
+{
+  stdio_port_desc = scm_make_port_type (stdio_port_desc_name,
+					ioscm_fill_input, ioscm_write);
+
+  scm_set_port_input_waiting (stdio_port_desc, ioscm_input_waiting);
+  scm_set_port_flush (stdio_port_desc, ioscm_flush);
+}
+
+/* Subroutine of ioscm_make_gdb_stdio_port to simplify it.
+   Set up the buffers of port PORT.
+   MODE_BITS are the mode bits of PORT.  */
+
+static void
+ioscm_init_stdio_buffers (SCM port, long mode_bits)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+#define GDB_STDIO_BUFFER_DEFAULT_SIZE 1024
+  int size = mode_bits & SCM_BUF0 ? 0 : GDB_STDIO_BUFFER_DEFAULT_SIZE;
+  int writing = (mode_bits & SCM_WRTNG) != 0;
+
+  /* This is heavily copied from scm_fport_buffer_add.  */
+
+  if (!writing && size > 0)
+    {
+      pt->read_buf = scm_gc_malloc_pointerless (size, "port buffer");
+      pt->read_pos = pt->read_end = pt->read_buf;
+      pt->read_buf_size = size;
+    }
+  else
+    {
+      pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf;
+      pt->read_buf_size = 1;
+    }
+
+  if (writing && size > 0)
+    {
+      pt->write_buf = scm_gc_malloc_pointerless (size, "port buffer");
+      pt->write_pos = pt->write_buf;
+      pt->write_buf_size = size;
+    }
+  else
+    {
+      pt->write_buf = pt->write_pos = &pt->shortbuf;
+      pt->write_buf_size = 1;
+    }
+  pt->write_end = pt->write_buf + pt->write_buf_size;
+}
+
+/* Create a gdb stdio port.  */
+
+static SCM
+ioscm_make_gdb_stdio_port (int fd)
+{
+  int is_a_tty = isatty (fd);
+  const char *name;
+  long mode_bits;
+  SCM port;
+
+  switch (fd)
+    {
+    case 0:
+      name = input_port_name;
+      mode_bits = scm_mode_bits (is_a_tty ? "r0" : "r");
+      break;
+    case 1:
+      name = output_port_name;
+      mode_bits = scm_mode_bits (is_a_tty ? "w0" : "w");
+      break;
+    case 2:
+      name = error_port_name;
+      mode_bits = scm_mode_bits (is_a_tty ? "w0" : "w");
+      break;
+    default:
+      gdb_assert_not_reached ("bad stdio file descriptor");
+    }
+
+  port = ioscm_open_port (stdio_port_desc, mode_bits);
+
+  scm_set_port_filename_x (port, gdbscm_scm_from_c_string (name));
+
+  ioscm_init_stdio_buffers (port, mode_bits);
+
+  return port;
+}
+
+/* (stdio-port? object) -> boolean */
+
+static SCM
+gdbscm_stdio_port_p (SCM scm)
+{
+  /* This is copied from SCM_FPORTP.  */
+  return scm_from_bool (!SCM_IMP (scm)
+			&& (SCM_TYP16 (scm) == stdio_port_desc));
+}
+
+/* GDB's ports are accessed via functions to keep them read-only.  */
+
+/* (input-port) -> port */
+
+static SCM
+gdbscm_input_port (void)
+{
+  return input_port_scm;
+}
+
+/* (output-port) -> port */
+
+static SCM
+gdbscm_output_port (void)
+{
+  return output_port_scm;
+}
+
+/* (error-port) -> port */
+
+static SCM
+gdbscm_error_port (void)
+{
+  return error_port_scm;
+}
+
+/* Support for sending GDB I/O to Guile ports.  */
+
+static void
+ioscm_file_port_delete (struct ui_file *file)
+{
+  ioscm_file_port *stream = ui_file_data (file);
+
+  if (stream->magic != &file_port_magic)
+    internal_error (__FILE__, __LINE__,
+		    _("ioscm_file_port_delete: bad magic number"));
+  xfree (stream);
+}
+
+static void
+ioscm_file_port_rewind (struct ui_file *file)
+{
+  ioscm_file_port *stream = ui_file_data (file);
+
+  if (stream->magic != &file_port_magic)
+    internal_error (__FILE__, __LINE__,
+		    _("ioscm_file_port_rewind: bad magic number"));
+
+  scm_truncate_file (stream->port, 0);
+}
+
+static void
+ioscm_file_port_put (struct ui_file *file,
+		     ui_file_put_method_ftype *write,
+		     void *dest)
+{
+  ioscm_file_port *stream = ui_file_data (file);
+
+  if (stream->magic != &file_port_magic)
+    internal_error (__FILE__, __LINE__,
+		    _("ioscm_file_port_put: bad magic number"));
+
+  /* This function doesn't meld with ports very well.  */
+}
+
+static void
+ioscm_file_port_write (struct ui_file *file,
+		       const char *buffer,
+		       long length_buffer)
+{
+  ioscm_file_port *stream = ui_file_data (file);
+
+  if (stream->magic != &file_port_magic)
+    internal_error (__FILE__, __LINE__,
+		    _("ioscm_pot_file_write: bad magic number"));
+
+  scm_c_write (stream->port, buffer, length_buffer);
+}
+
+/* Return a ui_file that writes to PORT.  */
+
+static struct ui_file *
+ioscm_file_port_new (SCM port)
+{
+  ioscm_file_port *stream = XCNEW (ioscm_file_port);
+  struct ui_file *file = ui_file_new ();
+
+  set_ui_file_data (file, stream, ioscm_file_port_delete);
+  set_ui_file_rewind (file, ioscm_file_port_rewind);
+  set_ui_file_put (file, ioscm_file_port_put);
+  set_ui_file_write (file, ioscm_file_port_write);
+  stream->magic = &file_port_magic;
+  stream->port = port;
+
+  return file;
+}
+
+/* Helper routine for with-{output,error}-to-port.  */
+
+static SCM
+ioscm_with_output_to_port_worker (SCM port, SCM thunk, enum oport oport,
+				  const char *func_name)
+{
+  struct ui_file *port_file;
+  struct cleanup *cleanups;
+  SCM result;
+
+  SCM_ASSERT_TYPE (gdbscm_is_true (scm_output_port_p (port)), port,
+		   SCM_ARG1, func_name, _("output port"));
+  SCM_ASSERT_TYPE (gdbscm_is_true (scm_thunk_p (thunk)), thunk,
+		   SCM_ARG2, func_name, _("thunk"));
+
+  cleanups = set_batch_flag_and_make_cleanup_restore_page_info ();
+
+  make_cleanup_restore_integer (&interpreter_async);
+  interpreter_async = 0;
+
+  port_file = ioscm_file_port_new (port);
+
+  make_cleanup_ui_file_delete (port_file);
+
+  if (oport == GDB_STDERR)
+    {
+      make_cleanup_restore_ui_file (&gdb_stderr);
+      gdb_stderr = port_file;
+    }
+  else
+    {
+      make_cleanup_restore_ui_file (&gdb_stdout);
+
+      if (ui_out_redirect (current_uiout, port_file) < 0)
+	warning (_("Current output protocol does not support redirection"));
+      else
+	make_cleanup_ui_out_redirect_pop (current_uiout);
+
+      gdb_stdout = port_file;
+    }
+
+  result = gdbscm_safe_call_0 (thunk, NULL);
+
+  do_cleanups (cleanups);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+
+  return result;
+}
+
+/* (%with-gdb-output-to-port port thunk) -> object
+   This function is experimental.
+   IWBN to not include "gdb" in the name, but it would collide with a standard
+   procedure, and it's common to import the gdb module without a prefix.
+   There are ways around this, but they're more cumbersome.
+
+   This has % in the name because it's experimental, and we want the
+   user-visible version to come from module (gdb experimental).  */
+
+static SCM
+gdbscm_percent_with_gdb_output_to_port (SCM port, SCM thunk)
+{
+  return ioscm_with_output_to_port_worker (port, thunk, GDB_STDOUT, FUNC_NAME);
+}
+
+/* (%with-gdb-error-to-port port thunk) -> object
+   This function is experimental.
+   IWBN to not include "gdb" in the name, but it would collide with a standard
+   procedure, and it's common to import the gdb module without a prefix.
+   There are ways around this, but they're more cumbersome.
+
+   This has % in the name because it's experimental, and we want the
+   user-visible version to come from module (gdb experimental).  */
+
+static SCM
+gdbscm_percent_with_gdb_error_to_port (SCM port, SCM thunk)
+{
+  return ioscm_with_output_to_port_worker (port, thunk, GDB_STDERR, FUNC_NAME);
+}
+
+/* Support for r/w memory via ports.  */
+
+/* Perform an "lseek" to OFFSET,WHENCE on memory port IOMEM.
+   OFFSET must be in the range [0,size].
+   The result is non-zero for success, zero for failure.  */
+
+static int
+ioscm_lseek_address (ioscm_memory_port *iomem, LONGEST offset, int whence)
+{
+  CORE_ADDR new_current;
+
+  gdb_assert (iomem->current <= iomem->size);
+
+  switch (whence)
+    {
+    case SEEK_CUR:
+      /* Catch over/underflow.  */
+      if ((offset < 0 && iomem->current + offset > iomem->current)
+	  || (offset >= 0 && iomem->current + offset < iomem->current))
+	return 0;
+      new_current = iomem->current + offset;
+      break;
+    case SEEK_SET:
+      new_current = offset;
+      break;
+    case SEEK_END:
+      if (offset == 0)
+	{
+	  new_current = iomem->size;
+	  break;
+	}
+      /* TODO: Not supported yet.  */
+      return 0;
+    default:
+      return 0;
+    }
+
+  if (new_current > iomem->size)
+    return 0;
+  iomem->current = new_current;
+  return 1;
+}
+
+/* "fill_input" method for memory ports.  */
+
+static int
+gdbscm_memory_port_fill_input (SCM port)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  size_t to_read;
+
+  /* "current" is the offset of the first byte we want to read.  */
+  if (iomem->current >= iomem->size)
+    return EOF;
+
+  /* Don't read outside the allowed memory range.  */
+  to_read = pt->read_buf_size;
+  if (to_read > iomem->size - iomem->current)
+    to_read = iomem->size - iomem->current;
+
+  if (target_read_memory (iomem->start + iomem->current, pt->read_buf,
+			  to_read) != 0)
+    gdbscm_memory_error (FUNC_NAME, _("error reading memory"), SCM_EOL);
+
+  pt->read_pos = pt->read_buf;
+  pt->read_end = pt->read_buf + to_read;
+  iomem->current += to_read;
+  return *pt->read_buf;
+}
+
+/* "end_input" method for memory ports.
+   Clear the read buffer and adjust the file position for unread bytes.  */
+
+static void
+gdbscm_memory_port_end_input (SCM port, int offset)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  size_t remaining = pt->read_end - pt->read_pos;
+
+  /* Note: Use of "int offset" is specified by Guile ports API.  */
+  if ((offset < 0 && remaining + offset > remaining)
+      || (offset > 0 && remaining + offset < remaining))
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset),
+				 _("overflow in offset calculation"));
+    }
+  offset += remaining;
+
+  if (offset > 0)
+    {
+      pt->read_pos = pt->read_end;
+      /* Throw error if unread-char used at beginning of file
+	 then attempting to write.  Seems correct.  */
+      if (!ioscm_lseek_address (iomem, -offset, SEEK_CUR))
+	{
+	  gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset),
+				     _("bad offset"));
+	}
+    }
+
+  pt->rw_active = SCM_PORT_NEITHER;
+}
+
+/* "flush" method for memory ports.  */
+
+static void
+gdbscm_memory_port_flush (SCM port)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  size_t to_write = pt->write_pos - pt->write_buf;
+
+  if (to_write == 0)
+    return;
+
+  /* There's no way to indicate a short write, so if the request goes past
+     the end of the port's memory range, flag an error.  */
+  if (to_write > iomem->size - iomem->current)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, 0,
+				 gdbscm_scm_from_ulongest (to_write),
+				 _("writing beyond end of memory range"));
+    }
+
+  if (target_write_memory (iomem->start + iomem->current, pt->write_buf,
+			   to_write) != 0)
+    gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
+
+  iomem->current += to_write;
+  pt->write_pos = pt->write_buf;
+  pt->rw_active = SCM_PORT_NEITHER;
+}
+
+/* "write" method for memory ports.  */
+
+static void
+gdbscm_memory_port_write (SCM port, const void *data, size_t size)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  const char *input = (char *) data;
+
+  /* We could get fancy here, and try to buffer the request since we're
+     buffering anyway.  But there's currently no need.  */
+
+  /* First flush what's currently buffered.  */
+  gdbscm_memory_port_flush (port);
+
+  /* There's no way to indicate a short write, so if the request goes past
+     the end of the port's memory range, flag an error.  */
+  if (size > iomem->size - iomem->current)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, 0, gdbscm_scm_from_ulongest (size),
+				 _("writing beyond end of memory range"));
+    }
+
+  if (target_write_memory (iomem->start + iomem->current, data, size) != 0)
+    gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
+
+  iomem->current += size;
+}
+
+/* "seek" method for memory ports.  */
+
+static scm_t_off
+gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  CORE_ADDR result;
+  int rc;
+
+  if (pt->rw_active == SCM_PORT_WRITE)
+    {
+      if (offset != 0 || whence != SEEK_CUR)
+	{
+	  gdbscm_memory_port_flush (port);
+	  rc = ioscm_lseek_address (iomem, offset, whence);
+	  result = iomem->current;
+	}
+      else
+	{
+	  /* Read current position without disturbing the buffer,
+	     but flag an error if what's in the buffer goes outside the
+	     allowed range.  */
+	  CORE_ADDR current = iomem->current;
+	  size_t delta = pt->write_pos - pt->write_buf;
+
+	  if (current + delta < current
+	      || current + delta > iomem->size + 1)
+	    rc = 0;
+	  else
+	    {
+	      result = current + delta;
+	      rc = 1;
+	    }
+	}
+    }
+  else if (pt->rw_active == SCM_PORT_READ)
+    {
+      if (offset != 0 || whence != SEEK_CUR)
+	{
+	  scm_end_input (port);
+	  rc = ioscm_lseek_address (iomem, offset, whence);
+	  result = iomem->current;
+	}
+      else
+	{
+	  /* Read current position without disturbing the buffer
+	     (particularly the unread-char buffer).  */
+	  CORE_ADDR current = iomem->current;
+	  size_t remaining = pt->read_end - pt->read_pos;
+
+	  if (current - remaining > current
+	      || current - remaining < iomem->start)
+	    rc = 0;
+	  else
+	    {
+	      result = current - remaining;
+	      rc = 1;
+	    }
+
+	  if (rc != 0 && pt->read_buf == pt->putback_buf)
+	    {
+	      size_t saved_remaining = pt->saved_read_end - pt->saved_read_pos;
+
+	      if (result - saved_remaining > result
+		  || result - saved_remaining < iomem->start)
+		rc = 0;
+	      else
+		result -= saved_remaining;
+	    }
+	}
+    }
+  else /* SCM_PORT_NEITHER */
+    {
+      rc = ioscm_lseek_address (iomem, offset, whence);
+      result = iomem->current;
+    }
+
+  if (rc == 0)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, 0,
+				 gdbscm_scm_from_longest (offset),
+				 _("bad seek"));
+    }
+
+  /* TODO: The Guile API doesn't support 32x64.  We can't fix that here,
+     and there's no need to throw an error if the new address can't be
+     represented in a scm_t_off.  But we could return something less
+     clumsy.  */
+  return result;
+}
+
+/* "close" method for memory ports.  */
+
+static int
+gdbscm_memory_port_close (SCM port)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+
+  gdbscm_memory_port_flush (port);
+
+  if (pt->read_buf == pt->putback_buf)
+    pt->read_buf = pt->saved_read_buf;
+  xfree (pt->read_buf);
+  xfree (pt->write_buf);
+  scm_gc_free (iomem, sizeof (*iomem), "memory port");
+
+  return 0;
+}
+
+/* "free" method for memory ports.  */
+
+static size_t
+gdbscm_memory_port_free (SCM port)
+{
+  gdbscm_memory_port_close (port);
+
+  return 0;
+}
+
+/* "print" method for memory ports.  */
+
+static int
+gdbscm_memory_port_print (SCM exp, SCM port, scm_print_state *pstate)
+{
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (exp);
+  char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp));
+
+  scm_puts ("#<", port);
+  scm_print_port_mode (exp, port);
+  /* scm_print_port_mode includes a trailing space.  */
+  gdbscm_printf (port, "%s %s-%s", type,
+		 hex_string (iomem->start), hex_string (iomem->end));
+  scm_putc ('>', port);
+  return 1;
+}
+
+/* Create the port type used for memory.  */
+
+static void
+ioscm_init_memory_port_type (void)
+{
+  memory_port_desc = scm_make_port_type (memory_port_desc_name,
+					 gdbscm_memory_port_fill_input,
+					 gdbscm_memory_port_write);
+
+  scm_set_port_end_input (memory_port_desc, gdbscm_memory_port_end_input);
+  scm_set_port_flush (memory_port_desc, gdbscm_memory_port_flush);
+  scm_set_port_seek (memory_port_desc, gdbscm_memory_port_seek);
+  scm_set_port_close (memory_port_desc, gdbscm_memory_port_close);
+  scm_set_port_free (memory_port_desc, gdbscm_memory_port_free);
+  scm_set_port_print (memory_port_desc, gdbscm_memory_port_print);
+}
+
+/* Helper for gdbscm_open_memory to parse the mode bits.
+   An exception is thrown if MODE is invalid.  */
+
+static long
+ioscm_parse_mode_bits (const char *func_name, const char *mode)
+{
+  const char *p;
+  long mode_bits;
+
+  if (*mode != 'r' && *mode != 'w')
+    {
+      gdbscm_out_of_range_error (func_name, 0,
+				 gdbscm_scm_from_c_string (mode),
+				 _("bad mode string"));
+    }
+  for (p = mode + 1; *p != '\0'; ++p)
+    {
+      switch (*p)
+	{
+	case 'b':
+	case '+':
+	  break;
+	default:
+	  gdbscm_out_of_range_error (func_name, 0,
+				     gdbscm_scm_from_c_string (mode),
+				     _("bad mode string"));
+	}
+    }
+
+  /* Kinda awkward to convert the mode from SCM -> string only to have Guile
+     convert it back to SCM, but that's the API we have to work with.  */
+  mode_bits = scm_mode_bits ((char *) mode);
+
+  return mode_bits;
+}
+
+/* Helper for gdbscm_open_memory to finish initializing the port.
+   The port has address range [start,end].
+   To simplify overflow handling, an END of 0xff..ff is not allowed.
+   This also means a start address of 0xff..f is also not allowed.
+   I can live with that.  */
+
+static void
+ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
+{
+  scm_t_port *pt;
+  ioscm_memory_port *iomem;
+
+  gdb_assert (start <= end);
+  gdb_assert (end < ~(CORE_ADDR) 0);
+
+  iomem = (ioscm_memory_port *) scm_gc_malloc_pointerless (sizeof (*iomem),
+							   "memory port");
+
+  iomem->start = start;
+  iomem->end = end;
+  iomem->size = end - start + 1;
+  iomem->current = 0;
+  iomem->read_buf_size = default_read_buf_size;
+  iomem->write_buf_size = default_write_buf_size;
+
+  pt = SCM_PTAB_ENTRY (port);
+  /* Match the expectation of `binary-port?'.  */
+  pt->encoding = NULL;
+  pt->rw_random = 1;
+  pt->read_buf_size = iomem->read_buf_size;
+  pt->read_buf = xmalloc (pt->read_buf_size);
+  pt->read_pos = pt->read_end = pt->read_buf;
+  pt->write_buf_size = iomem->write_buf_size;
+  pt->write_buf = xmalloc (pt->write_buf_size);
+  pt->write_pos = pt->write_buf;
+  pt->write_end = pt->write_buf + pt->write_buf_size;
+
+  SCM_SETSTREAM (port, iomem);
+}
+
+/* Re-initialize a memory port, updating its read/write buffer sizes.
+   An exception is thrown if data is still buffered, except in the case
+   where the buffer size isn't changing (since that's just a nop).  */
+
+static void
+ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
+			  size_t write_buf_size, const char *func_name)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
+
+  gdb_assert (read_buf_size >= min_memory_port_buf_size
+	      && read_buf_size <= max_memory_port_buf_size);
+  gdb_assert (write_buf_size >= min_memory_port_buf_size
+	      && write_buf_size <= max_memory_port_buf_size);
+
+  /* First check if anything is buffered.  */
+
+  if (read_buf_size != pt->read_buf_size
+      && pt->read_end != pt->read_buf)
+    {
+      scm_misc_error (func_name, _("read buffer not empty: ~a"),
+		      scm_list_1 (port));
+    }
+
+  if (write_buf_size != pt->write_buf_size
+      && pt->write_pos != pt->write_buf)
+    {
+      scm_misc_error (func_name, _("write buffer not empty: ~a"),
+		      scm_list_1 (port));
+    }
+
+  /* Now we can update the buffer sizes, but only if the size has changed.  */
+
+  if (read_buf_size != pt->read_buf_size)
+    {
+      iomem->read_buf_size = read_buf_size;
+      pt->read_buf_size = read_buf_size;
+      xfree (pt->read_buf);
+      pt->read_buf = xmalloc (pt->read_buf_size);
+      pt->read_pos = pt->read_end = pt->read_buf;
+    }
+
+  if (write_buf_size != pt->write_buf_size)
+    {
+      iomem->write_buf_size = write_buf_size;
+      pt->write_buf_size = write_buf_size;
+      xfree (pt->write_buf);
+      pt->write_buf = xmalloc (pt->write_buf_size);
+      pt->write_pos = pt->write_buf;
+      pt->write_end = pt->write_buf + pt->write_buf_size;
+    }
+}
+
+/* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
+   Return a port that can be used for reading and writing memory.
+   MODE is a string, and must be one of "r", "w", or "r+".
+   For compatibility "b" (binary) may also be present, but we ignore it:
+   memory ports are binary only.
+
+   TODO: Support "0" (unbuffered)?  Only support "0" (always unbuffered)?
+
+   The chunk of memory that can be accessed can be bounded.
+   If both START,SIZE are unspecified, all of memory can be accessed.
+   If only START is specified, all of memory from that point on can be
+   accessed.  If only SIZE if specified, all memory in [0,SIZE) can be
+   accessed.  If both are specified, all memory in [START,START+SIZE) can be
+   accessed.
+
+   Note: If it becomes useful enough we can later add #:end as an alternative
+   to #:size.  For now it is left out.
+
+   The result is a Scheme port, and its semantics are a bit odd for accessing
+   memory (e.g., unget), but we don't try to hide this.  It's a port.
+
+   N.B. Seeks on the port must be in the range [0,size).
+   This is for similarity with bytevector ports, and so that one can seek
+   to the first byte.  */
+
+static SCM
+gdbscm_open_memory (SCM rest)
+{
+  const SCM keywords[] = {
+    mode_keyword, start_keyword, size_keyword, SCM_BOOL_F
+  };
+  char *mode = NULL;
+  CORE_ADDR start = 0;
+  CORE_ADDR end;
+  int mode_arg_pos = -1, start_arg_pos = -1, size_arg_pos = -1;
+  ULONGEST size;
+  SCM port;
+  long mode_bits;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "#sUU", rest,
+			      &mode_arg_pos, &mode,
+			      &start_arg_pos, &start,
+			      &size_arg_pos, &size);
+
+  scm_dynwind_begin (0);
+
+  if (mode == NULL)
+    mode = xstrdup ("r");
+  scm_dynwind_free (mode);
+
+  if (start == ~(CORE_ADDR) 0)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, scm_from_int (-1),
+				 _("start address of 0xff..ff not allowed"));
+    }
+
+  if (size_arg_pos > 0)
+    {
+      if (size == 0)
+	{
+	  gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (0),
+				     "zero size");
+	}
+      /* For now be strict about start+size overflowing.  If it becomes
+	 a nuisance we can relax things later.  */
+      if (start + size < start)
+	{
+	  gdbscm_out_of_range_error (FUNC_NAME, 0,
+				scm_list_2 (gdbscm_scm_from_ulongest (start),
+					    gdbscm_scm_from_ulongest (size)),
+				     _("start+size overflows"));
+	}
+      end = start + size - 1;
+      if (end == ~(CORE_ADDR) 0)
+	{
+	  gdbscm_out_of_range_error (FUNC_NAME, 0,
+				scm_list_2 (gdbscm_scm_from_ulongest (start),
+					    gdbscm_scm_from_ulongest (size)),
+				     _("end address of 0xff..ff not allowed"));
+	}
+    }
+  else
+    end = (~(CORE_ADDR) 0) - 1;
+
+  mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode);
+
+  port = ioscm_open_port (memory_port_desc, mode_bits);
+
+  ioscm_init_memory_port (port, start, end);
+
+  scm_dynwind_end ();
+
+  /* TODO: Set the file name as "memory-start-end"?  */
+  return port;
+}
+
+/* Return non-zero if OBJ is a memory port.  */
+
+static int
+gdbscm_is_memory_port (SCM obj)
+{
+  return !SCM_IMP (obj) && (SCM_TYP16 (obj) == memory_port_desc);
+}
+
+/* (memory-port? obj) -> boolean */
+
+static SCM
+gdbscm_memory_port_p (SCM obj)
+{
+  return scm_from_bool (gdbscm_is_memory_port (obj));
+}
+
+/* (memory-port-range port) -> (start end) */
+
+static SCM
+gdbscm_memory_port_range (SCM port)
+{
+  ioscm_memory_port *iomem;
+
+  SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
+		   memory_port_desc_name);
+
+  iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  return scm_list_2 (gdbscm_scm_from_ulongest (iomem->start),
+		     gdbscm_scm_from_ulongest (iomem->end));
+}
+
+/* (memory-port-read-buffer-size port) -> integer */
+
+static SCM
+gdbscm_memory_port_read_buffer_size (SCM port)
+{
+  ioscm_memory_port *iomem;
+
+  SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
+		   memory_port_desc_name);
+
+  iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  return scm_from_uint (iomem->read_buf_size);
+}
+
+/* (set-memory-port-read-buffer-size! port size) -> unspecified
+   An exception is thrown if read data is still buffered.  */
+
+static SCM
+gdbscm_set_memory_port_read_buffer_size_x (SCM port, SCM size)
+{
+  ioscm_memory_port *iomem;
+
+  SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
+		   memory_port_desc_name);
+  SCM_ASSERT_TYPE (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME,
+		   _("integer"));
+
+  if (!scm_is_unsigned_integer (size, min_memory_port_buf_size,
+				max_memory_port_buf_size))
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, size,
+				 out_of_range_buf_size);
+    }
+
+  iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  ioscm_reinit_memory_port (port, scm_to_uint (size), iomem->write_buf_size,
+			    FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (memory-port-write-buffer-size port) -> integer */
+
+static SCM
+gdbscm_memory_port_write_buffer_size (SCM port)
+{
+  ioscm_memory_port *iomem;
+
+  SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
+		   memory_port_desc_name);
+
+  iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  return scm_from_uint (iomem->write_buf_size);
+}
+
+/* (set-memory-port-write-buffer-size! port size) -> unspecified
+   An exception is thrown if write data is still buffered.  */
+
+static SCM
+gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size)
+{
+  ioscm_memory_port *iomem;
+
+  SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
+		   memory_port_desc_name);
+  SCM_ASSERT_TYPE (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME,
+		   _("integer"));
+
+  if (!scm_is_unsigned_integer (size, min_memory_port_buf_size,
+				max_memory_port_buf_size))
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, size,
+				 out_of_range_buf_size);
+    }
+
+  iomem = (ioscm_memory_port *) SCM_STREAM (port);
+  ioscm_reinit_memory_port (port, iomem->read_buf_size, scm_to_uint (size),
+			    FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* Initialize gdb ports.  */
+
+static const scheme_function port_functions[] =
+{
+  { "input-port", 0, 0, 0, gdbscm_input_port,
+    "\
+Return gdb's input port." },
+
+  { "output-port", 0, 0, 0, gdbscm_output_port,
+    "\
+Return gdb's output port." },
+
+  { "error-port", 0, 0, 0, gdbscm_error_port,
+    "\
+Return gdb's error port." },
+
+  { "stdio-port?", 1, 0, 0, gdbscm_stdio_port_p,
+    "\
+Return #t if the object is a gdb:stdio-port." },
+
+  { "open-memory", 0, 0, 1, gdbscm_open_memory,
+    "\
+Return a port that can be used for reading/writing inferior memory.\n\
+\n\
+  Arguments: [#:mode string] [#:start address] [#:size integer]\n\
+  Returns: A port object." },
+
+  { "memory-port?", 1, 0, 0, gdbscm_memory_port_p,
+    "\
+Return #t if the object is a memory port." },
+
+  { "memory-port-range", 1, 0, 0, gdbscm_memory_port_range,
+    "\
+Return the memory range of the port as (start end)." },
+
+  { "memory-port-read-buffer-size", 1, 0, 0,
+    gdbscm_memory_port_read_buffer_size,
+    "\
+Return the size of the read buffer for the memory port." },
+
+  { "set-memory-port-read-buffer-size!", 2, 0, 0,
+    gdbscm_set_memory_port_read_buffer_size_x,
+    "\
+Set the size of the read buffer for the memory port.\n\
+\n\
+  Arguments: port integer\n\
+  Returns: unspecified." },
+
+  { "memory-port-write-buffer-size", 1, 0, 0,
+    gdbscm_memory_port_write_buffer_size,
+    "\
+Return the size of the write buffer for the memory port." },
+
+  { "set-memory-port-write-buffer-size!", 2, 0, 0,
+    gdbscm_set_memory_port_write_buffer_size_x,
+    "\
+Set the size of the write buffer for the memory port.\n\
+\n\
+  Arguments: port integer\n\
+  Returns: unspecified." },
+
+  END_FUNCTIONS
+};
+
+static const scheme_function private_port_functions[] =
+{
+#if 0 /* TODO */
+  { "%with-gdb-input-from-port", 2, 0, 0,
+    gdbscm_percent_with_gdb_input_from_port,
+    "\
+Temporarily set GDB's input port to PORT and then invoke THUNK.\n\
+\n\
+  Arguments: port thunk\n\
+  Returns: The result of calling THUNK.\n\
+\n\
+This procedure is experimental." },
+#endif
+
+  { "%with-gdb-output-to-port", 2, 0, 0,
+    gdbscm_percent_with_gdb_output_to_port,
+    "\
+Temporarily set GDB's output port to PORT and then invoke THUNK.\n\
+\n\
+  Arguments: port thunk\n\
+  Returns: The result of calling THUNK.\n\
+\n\
+This procedure is experimental." },
+
+  { "%with-gdb-error-to-port", 2, 0, 0,
+    gdbscm_percent_with_gdb_error_to_port,
+    "\
+Temporarily set GDB's error port to PORT and then invoke THUNK.\n\
+\n\
+  Arguments: port thunk\n\
+  Returns: The result of calling THUNK.\n\
+\n\
+This procedure is experimental." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_ports (void)
+{
+  /* Save the original stdio ports for debugging purposes.  */
+
+  orig_input_port_scm = scm_current_input_port ();
+  orig_output_port_scm = scm_current_output_port ();
+  orig_error_port_scm = scm_current_error_port ();
+
+  /* Set up the stdio ports.  */
+
+  ioscm_init_gdb_stdio_port ();
+  input_port_scm = ioscm_make_gdb_stdio_port (0);
+  output_port_scm = ioscm_make_gdb_stdio_port (1);
+  error_port_scm = ioscm_make_gdb_stdio_port (2);
+
+  /* Set up memory ports.  */
+
+  ioscm_init_memory_port_type ();
+
+  /* Install the accessor functions.  */
+
+  gdbscm_define_functions (port_functions, 1);
+  gdbscm_define_functions (private_port_functions, 0);
+
+  /* Keyword args for open-memory.  */
+
+  mode_keyword = scm_from_latin1_keyword ("mode");
+  start_keyword = scm_from_latin1_keyword ("start");
+  size_keyword = scm_from_latin1_keyword ("size");
+
+  /* Error message text for "out of range" memory port buffer sizes.  */
+
+  out_of_range_buf_size = xstrprintf ("size not between %u - %u",
+				      min_memory_port_buf_size,
+				      max_memory_port_buf_size);
+}
diff --git a/gdb/guile/scm-pretty-print.c b/gdb/guile/scm-pretty-print.c
new file mode 100644
index 0000000..1b9902f4
--- /dev/null
+++ b/gdb/guile/scm-pretty-print.c
@@ -0,0 +1,1138 @@
+/* GDB/Scheme pretty-printing.
+
+   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 "charset.h"
+#include "gdb_assert.h"
+#include "symtab.h" /* Needed by language.h.  */
+#include "language.h"
+#include "objfiles.h"
+#include "value.h"
+#include "valprint.h"
+#include "guile-internal.h"
+
+/* Return type of print_string_repr.  */
+
+enum string_repr_result
+{
+  /* The string method returned None.  */
+  STRING_REPR_NONE,
+  /* The string method had an error.  */
+  STRING_REPR_ERROR,
+  /* Everything ok.  */
+  STRING_REPR_OK
+};
+
+/* Display hints.  */
+
+enum display_hint
+{
+  /* No display hint.  */
+  HINT_NONE,
+  /* The display hint has a bad value.  */
+  HINT_ERROR,
+  /* Print as an array.  */
+  HINT_ARRAY,
+  /* Print as a map.  */
+  HINT_MAP,
+  /* Print as a string.  */
+  HINT_STRING
+};
+
+/* The <gdb:pretty-printer> smob.  */
+
+typedef struct
+{
+  /* This must appear first.  */
+  gdb_smob base;
+
+  /* A string representing the name of the printer.  */
+  SCM name;
+
+  /* A boolean indicating whether the printer is enabled.  */
+  SCM enabled;
+
+  /* A procedure called to look up the printer for the given value.
+     The procedure is called as (lookup gdb:pretty-printer value).
+     The result should either be a gdb:pretty-printer object that will print
+     the value, or #f if the value is not recognized.  */     
+  SCM lookup;
+
+  /* Note: Attaching subprinters to this smob is left to Scheme.  */
+} pretty_printer_smob;
+
+/* The <gdb:pretty-printer-worker> smob.  */
+
+typedef struct
+{
+  /* This must appear first.  */
+  gdb_smob base;
+
+  /* Either #f or one of the supported display hints: map, array, string.
+     If neither of those then the display hint is ignored (treated as #f).  */
+  SCM display_hint;
+
+  /* A procedure called to pretty-print the value.
+     (lambda (printer) ...) -> string | <gdb:lazy-string> | <gdb:value>  */
+  SCM to_string;
+
+  /* A procedure called to print children of the value.
+     (lambda (printer) ...) -> <gdb:iterator>
+     The iterator returns a pair for each iteration: (name . value),
+     where "value" can have the same types as to_string.  */
+  SCM children;
+} pretty_printer_worker_smob;
+
+static const char pretty_printer_smob_name[] =
+  "gdb:pretty-printer";
+static const char pretty_printer_worker_smob_name[] =
+  "gdb:pretty-printer-worker";
+
+/* The tag Guile knows the pretty-printer smobs by.  */
+static scm_t_bits pretty_printer_smob_tag;
+static scm_t_bits pretty_printer_worker_smob_tag;
+
+/* Global list of pretty-printers.  */
+static const char pretty_printer_list_name[] = "*pretty-printers*";
+
+/* The *pretty-printer* variable.  */
+static SCM pretty_printer_list_var;
+
+/* gdb:pp-type-error.  */
+static SCM pp_type_error_symbol;
+
+/* Pretty-printer display hints are specified by strings.  */
+static SCM ppscm_map_string;
+static SCM ppscm_array_string;
+static SCM ppscm_string_string;
+
+/* Administrivia for pretty-printer matcher smobs.  */
+
+/* The smob "mark" function for <gdb:pretty-printer>.  */
+
+static SCM
+ppscm_mark_pretty_printer_smob (SCM self)
+{
+  pretty_printer_smob *pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (pp_smob->name);
+  scm_gc_mark (pp_smob->enabled);
+  scm_gc_mark (pp_smob->lookup);
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&pp_smob->base);
+}
+
+/* The smob "print" function for <gdb:pretty-printer>.  */
+
+static int
+ppscm_print_pretty_printer_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  pretty_printer_smob *pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s ", pretty_printer_smob_name);
+  scm_write (pp_smob->name, port);
+  scm_puts (gdbscm_is_true (pp_smob->enabled) ? " enabled" : " disabled",
+	    port);
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* (make-pretty-printer string procedure) -> <gdb:pretty-printer> */
+
+static SCM
+gdbscm_make_pretty_printer (SCM name, SCM lookup)
+{
+  pretty_printer_smob *pp_smob = (pretty_printer_smob *)
+    scm_gc_malloc (sizeof (pretty_printer_smob),
+		   pretty_printer_smob_name);
+  SCM smob;
+
+  SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, FUNC_NAME,
+		   _("string"));
+  SCM_ASSERT_TYPE (gdbscm_is_procedure (lookup), lookup, SCM_ARG2, FUNC_NAME,
+		   _("procedure"));
+
+  pp_smob->name = name;
+  pp_smob->lookup = lookup;
+  pp_smob->enabled = SCM_BOOL_T;
+  smob = scm_new_smob (pretty_printer_smob_tag, (scm_t_bits) pp_smob);
+  gdbscm_init_gsmob (&pp_smob->base);
+
+  return smob;
+}
+
+/* Return non-zero if SCM is a <gdb:pretty-printer> object.  */
+
+static int
+ppscm_is_pretty_printer (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (pretty_printer_smob_tag, scm);
+}
+
+/* (pretty-printer? object) -> boolean */
+
+static SCM
+gdbscm_pretty_printer_p (SCM scm)
+{
+  return scm_from_bool (ppscm_is_pretty_printer (scm));
+}
+
+/* Returns the <gdb:pretty-printer> object in SELF.
+   Throws an exception if SELF is not a <gdb:pretty-printer> object.  */
+
+static SCM
+ppscm_get_pretty_printer_arg_unsafe (SCM self, int arg_pos,
+				     const char *func_name)
+{
+  SCM_ASSERT_TYPE (ppscm_is_pretty_printer (self), self, arg_pos, func_name,
+		   pretty_printer_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the pretty-printer smob of SELF.
+   Throws an exception if SELF is not a <gdb:pretty-printer> object.  */
+
+static pretty_printer_smob *
+ppscm_get_pretty_printer_smob_arg_unsafe (SCM self, int arg_pos,
+					  const char *func_name)
+{
+  SCM pp_scm = ppscm_get_pretty_printer_arg_unsafe (self, arg_pos, func_name);
+  pretty_printer_smob *pp_smob
+    = (pretty_printer_smob *) SCM_SMOB_DATA (pp_scm);
+
+  return pp_smob;
+}
+
+/* Pretty-printer methods.  */
+
+/* (pretty-printer-enabled? <gdb:pretty-printer>) -> boolean */
+
+static SCM
+gdbscm_pretty_printer_enabled_p (SCM self)
+{
+  pretty_printer_smob *pp_smob
+    = ppscm_get_pretty_printer_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return pp_smob->enabled;
+}
+
+/* (set-pretty-printer-enabled! <gdb:pretty-printer> boolean)
+     -> unspecified */
+
+static SCM
+gdbscm_set_pretty_printer_enabled_x (SCM self, SCM enabled)
+{
+  pretty_printer_smob *pp_smob
+    = ppscm_get_pretty_printer_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  pp_smob->enabled = scm_from_bool (gdbscm_is_true (enabled));
+
+  return SCM_UNSPECIFIED;
+}
+
+/* Administrivia for pretty-printer-worker smobs.
+   These are created when a matcher recognizes a value.  */
+
+/* The smob "mark" function for <gdb:pretty-printer-worker>.  */
+
+static SCM
+ppscm_mark_pretty_printer_worker_smob (SCM self)
+{
+  pretty_printer_worker_smob *w_smob
+    = (pretty_printer_worker_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (w_smob->display_hint);
+  scm_gc_mark (w_smob->to_string);
+  scm_gc_mark (w_smob->children);
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&w_smob->base);
+}
+
+/* The smob "print" function for <gdb:pretty-printer-worker>.  */
+
+static int
+ppscm_print_pretty_printer_worker_smob (SCM self, SCM port,
+					scm_print_state *pstate)
+{
+  pretty_printer_worker_smob *w_smob
+    = (pretty_printer_worker_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s ", pretty_printer_worker_smob_name);
+  scm_write (w_smob->display_hint, port);
+  scm_puts (" ", port);
+  scm_write (w_smob->to_string, port);
+  scm_puts (" ", port);
+  scm_write (w_smob->children, port);
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* (make-pretty-printer-worker string procedure procedure)
+     -> <gdb:pretty-printer-worker> */
+
+static SCM
+gdbscm_make_pretty_printer_worker (SCM display_hint, SCM to_string,
+				   SCM children)
+{
+  pretty_printer_worker_smob *w_smob = (pretty_printer_worker_smob *)
+    scm_gc_malloc (sizeof (pretty_printer_worker_smob),
+		   pretty_printer_worker_smob_name);
+  SCM w_scm;
+
+  w_smob->display_hint = display_hint;
+  w_smob->to_string = to_string;
+  w_smob->children = children;
+  w_scm = scm_new_smob (pretty_printer_worker_smob_tag, (scm_t_bits) w_smob);
+  gdbscm_init_gsmob (&w_smob->base);
+  return w_scm;
+}
+
+/* Return non-zero if SCM is a <gdb:pretty-printer-worker> object.  */
+
+static int
+ppscm_is_pretty_printer_worker (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (pretty_printer_worker_smob_tag, scm);
+}
+
+/* (pretty-printer-worker? object) -> boolean */
+
+static SCM
+gdbscm_pretty_printer_worker_p (SCM scm)
+{
+  return scm_from_bool (ppscm_is_pretty_printer_worker (scm));
+}
+
+/* Helper function to create a <gdb:exception> object indicating that the
+   type of some value returned from a pretty-printer is invalid.  */
+
+static SCM
+ppscm_make_pp_type_error_exception (const char *message, SCM object)
+{
+  char *msg = xstrprintf ("%s: ~S", message);
+  struct cleanup *cleanup = make_cleanup (xfree, msg);
+  SCM exception
+    = gdbscm_make_error (pp_type_error_symbol,
+			 NULL /* func */, msg,
+			 scm_list_1 (object), scm_list_1 (object));
+
+  do_cleanups (cleanup);
+
+  return exception;
+}
+
+/* Print MESSAGE as an exception (meaning it is controlled by
+   "guile print-stack").
+   Called from the printer code when the Scheme code returns an invalid type
+   for something.  */
+
+static void
+ppscm_print_pp_type_error (const char *message, SCM object)
+{
+  SCM exception = ppscm_make_pp_type_error_exception (message, object);
+
+  gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
+}
+
+/* Helper function for find_pretty_printer which iterates over a list,
+   calls each function and inspects output.  This will return a
+   <gdb:pretty-printer> object if one recognizes VALUE.  If no printer is
+   found, it will return #f.  On error, it will return a <gdb:exception>
+   object.
+
+   Note: This has to be efficient and careful.
+   We don't want to excessively slow down printing of values, but any kind of
+   random crud can appear in the pretty-printer list, and we can't crash
+   because of it.  */
+
+static SCM
+ppscm_search_pp_list (SCM list, SCM value)
+{
+  SCM orig_list = list;
+
+  if (scm_is_null (list))
+    return SCM_BOOL_F;
+  if (gdbscm_is_false (scm_list_p (list))) /* scm_is_pair? */
+    {
+      return ppscm_make_pp_type_error_exception
+	(_("pretty-printer list is not a list"), list);
+    }
+
+  for ( ; scm_is_pair (list); list = scm_cdr (list))
+    {
+      SCM matcher = scm_car (list);
+      SCM worker;
+      pretty_printer_smob *pp_smob;
+      int rc;
+
+      if (!ppscm_is_pretty_printer (matcher))
+	{
+	  return ppscm_make_pp_type_error_exception
+	    (_("pretty-printer list contains non-pretty-printer object"),
+	     matcher);
+	}
+
+      pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (matcher);
+
+      /* Skip if disabled.  */
+      if (gdbscm_is_false (pp_smob->enabled))
+	continue;
+
+      if (!gdbscm_is_procedure (pp_smob->lookup))
+	{
+	  return ppscm_make_pp_type_error_exception
+	    (_("invalid lookup object in pretty-printer matcher"),
+	     pp_smob->lookup);
+	}
+
+      worker = gdbscm_safe_call_2 (pp_smob->lookup, matcher,
+				   value, gdbscm_memory_error_p);
+      if (!gdbscm_is_false (worker))
+	{
+	  if (gdbscm_is_exception (worker))
+	    return worker;
+	  if (ppscm_is_pretty_printer_worker (worker))
+	    return worker;
+	  return ppscm_make_pp_type_error_exception
+	    (_("invalid result from pretty-printer lookup"), worker);
+	}
+    }
+
+  if (!scm_is_null (list))
+    {
+      return ppscm_make_pp_type_error_exception
+	(_("pretty-printer list is not a list"), orig_list);
+    }
+
+  return SCM_BOOL_F;
+}
+
+/* Subroutine of find_pretty_printer to simplify it.
+   Look for a pretty-printer to print VALUE in all objfiles.
+   If there's an error an exception smob is returned.
+   The result is #f, if no pretty-printer was found.
+   Otherwise the result is the pretty-printer smob.  */
+
+static SCM
+ppscm_find_pretty_printer_from_objfiles (SCM value)
+{
+  struct objfile *objfile;
+
+  ALL_OBJFILES (objfile)
+  {
+    objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
+    SCM pp = ppscm_search_pp_list (ofscm_objfile_smob_pretty_printers (o_smob),
+				   value);
+
+    /* Note: This will return if pp is a <gdb:exception> object,
+       which is what we want.  */
+    if (gdbscm_is_true (pp))
+      return pp;
+  }
+
+  return SCM_BOOL_F;
+}
+
+/* Subroutine of find_pretty_printer to simplify it.
+   Look for a pretty-printer to print VALUE in the current program space.
+   If there's an error an exception smob is returned.
+   The result is #f, if no pretty-printer was found.
+   Otherwise the result is the pretty-printer smob.  */
+
+static SCM
+ppscm_find_pretty_printer_from_progspace (SCM value)
+{
+  return SCM_BOOL_F; /*TODO*/
+}
+
+/* Subroutine of find_pretty_printer to simplify it.
+   Look for a pretty-printer to print VALUE in the gdb module.
+   If there's an error a Scheme exception is returned.
+   The result is #f, if no pretty-printer was found.
+   Otherwise the result is the pretty-printer smob.  */
+
+static SCM
+ppscm_find_pretty_printer_from_gdb (SCM value)
+{
+  SCM pp_list, pp;
+
+  /* Fetch the global pretty printer list.  */
+  pp_list = scm_variable_ref (pretty_printer_list_var);
+  pp = ppscm_search_pp_list (pp_list, value);
+  return pp;
+}
+
+/* Find the pretty-printing constructor function for VALUE.  If no
+   pretty-printer exists, return #f.  If one exists, return the
+   gdb:pretty-printer smob that implements it.  On error, an exception smob
+   is returned.
+
+   Note: In the end it may be better to call out to Scheme once, and then
+   do all of the lookup from Scheme.  TBD.  */
+
+static SCM
+ppscm_find_pretty_printer (SCM value)
+{
+  SCM pp;
+
+  /* Look at the pretty-printer list for each objfile
+     in the current program-space.  */
+  pp = ppscm_find_pretty_printer_from_objfiles (value);
+  /* Note: This will return if function is a <gdb:exception> object,
+     which is what we want.  */
+  if (gdbscm_is_true (pp))
+    return pp;
+
+  /* Look at the pretty-printer list for the current program-space.  */
+  pp = ppscm_find_pretty_printer_from_progspace (value);
+  /* Note: This will return if function is a <gdb:exception> object,
+     which is what we want.  */
+  if (gdbscm_is_true (pp))
+    return pp;
+
+  /* Look at the pretty-printer list in the gdb module.  */
+  pp = ppscm_find_pretty_printer_from_gdb (value);
+  return pp;
+}
+
+/* Pretty-print a single value, via the PRINTER, which must be a
+   <gdb:pretty-printer-worker> object.
+   The caller is responsible for ensuring PRINTER is valid.
+   If the function returns a string, an SCM containing the string
+   is returned.  If the function returns #f that means the pretty
+   printer returned #f as a value.  Otherwise, if the function returns a
+   <gdb:value> object, *OUT_VALUE is set to the value and #t is returned.
+   It is an error if the printer returns #t.
+   On error, an exception smob is returned.  */
+
+static SCM
+ppscm_pretty_print_one_value (SCM printer, struct value **out_value,
+			      struct gdbarch *gdbarch,
+			      const struct language_defn *language)
+{
+  volatile struct gdb_exception except;
+  SCM result = SCM_BOOL_F;
+
+  *out_value = NULL;
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      int rc;
+      pretty_printer_worker_smob *w_smob
+	= (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
+
+      result = gdbscm_safe_call_1 (w_smob->to_string, printer,
+				   gdbscm_memory_error_p);
+      if (gdbscm_is_false (result))
+	; /* Done.  */
+      else if (scm_is_string (result)
+	       || lsscm_is_lazy_string (result))
+	; /* Done.  */
+      else if (vlscm_is_value (result))
+	{
+	  SCM except_scm;
+
+	  *out_value
+	    = vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE,
+					       result, &except_scm,
+					       gdbarch, language);
+	  if (*out_value != NULL)
+	    result = SCM_BOOL_T;
+	  else
+	    result = except_scm;
+	}
+      else if (gdbscm_is_exception (result))
+	; /* Done.  */
+      else
+	{
+	  /* Invalid result from to-string.  */
+	  result = ppscm_make_pp_type_error_exception
+	    (_("invalid result from pretty-printer to-string"), result);
+	}
+    }
+
+  return result;
+}
+
+/* Return the display hint for PRINTER as a Scheme object.
+   The caller is responsible for ensuring PRINTER is a
+   <gdb:pretty-printer-worker> object.  */
+ 
+static SCM
+ppscm_get_display_hint_scm (SCM printer)
+{
+  pretty_printer_worker_smob *w_smob
+    = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
+
+  return w_smob->display_hint;
+}
+
+/* Return the display hint for the pretty-printer PRINTER.
+   The caller is responsible for ensuring PRINTER is a
+   <gdb:pretty-printer-worker> object.
+   Returns the display hint or #f if the hint is not a string.  */
+
+static enum display_hint
+ppscm_get_display_hint_enum (SCM printer)
+{
+  SCM hint = ppscm_get_display_hint_scm (printer);
+
+  if (gdbscm_is_false (hint))
+    return HINT_NONE;
+  if (scm_is_string (hint))
+    {
+      if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_array_string)))
+	return HINT_STRING;
+      if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_map_string)))
+	return HINT_STRING;
+      if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_string_string)))
+	return HINT_STRING;
+      return HINT_ERROR;
+    }
+  return HINT_ERROR;
+}
+
+/* A wrapper for gdbscm_print_gdb_exception that ignores memory errors.
+   EXCEPTION is a <gdb:exception> object.  */
+
+static void
+ppscm_print_exception_unless_memory_error (SCM exception,
+					   struct ui_file *stream)
+{
+  if (gdbscm_memory_error_p (gdbscm_exception_key (exception)))
+    {
+      char *msg = gdbscm_exception_message_to_string (exception);
+      struct cleanup *cleanup = make_cleanup (xfree, msg);
+
+      /* This "shouldn't happen", but play it safe.  */
+      if (msg == NULL || *msg == '\0')
+	fprintf_filtered (stream, _("<error reading variable>"));
+      else
+	{
+	  /* Remove the trailing newline.  We could instead call a special
+	     routine for printing memory error messages, but this is easy
+	     enough for now.  */
+	  size_t len = strlen (msg);
+
+	  if (msg[len - 1] == '\n')
+	    msg[len - 1] = '\0';
+	  fprintf_filtered (stream, _("<error reading variable: %s>"), msg);
+	}
+
+      do_cleanups (cleanup);
+    }
+  else
+    gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
+}
+
+/* Helper for gdbscm_apply_val_pretty_printer which calls to_string and
+   formats the result.  */
+
+static enum string_repr_result
+ppscm_print_string_repr (SCM printer, enum display_hint hint,
+			 struct ui_file *stream, int recurse,
+			 const struct value_print_options *options,
+			 struct gdbarch *gdbarch,
+			 const struct language_defn *language)
+{
+  struct value *replacement = NULL;
+  SCM str_scm;
+  enum string_repr_result result = STRING_REPR_ERROR;
+
+  str_scm = ppscm_pretty_print_one_value (printer, &replacement,
+					  gdbarch, language);
+  if (gdbscm_is_false (str_scm))
+    {
+      result = STRING_REPR_NONE;
+    }
+  else if (scm_is_eq (str_scm, SCM_BOOL_T))
+    {
+      struct value_print_options opts = *options;
+
+      gdb_assert (replacement != NULL);
+      opts.addressprint = 0;
+      common_val_print (replacement, stream, recurse, &opts, language);
+      result = STRING_REPR_OK;
+    }
+  else if (scm_is_string (str_scm))
+    {
+      struct cleanup *cleanup;
+      size_t length;
+      char *string
+	= gdbscm_scm_to_string (str_scm, &length,
+				target_charset (gdbarch), 0 /*!strict*/, NULL);
+
+      cleanup = make_cleanup (xfree, string);
+      if (hint == HINT_STRING)
+	{
+	  struct type *type = builtin_type (gdbarch)->builtin_char;
+	  
+	  LA_PRINT_STRING (stream, type, (gdb_byte *) string,
+			   length, NULL, 0, options);
+	}
+      else
+	{
+	  /* Alas scm_to_stringn doesn't nul-terminate the string if we
+	     ask for the length.  */
+	  size_t i;
+
+	  for (i = 0; i < length; ++i)
+	    {
+	      if (string[i] == '\0')
+		fputs_filtered ("\\000", stream);
+	      else
+		fputc_filtered (string[i], stream);
+	    }
+	}
+      result = STRING_REPR_OK;
+      do_cleanups (cleanup);
+    }
+  else if (lsscm_is_lazy_string (str_scm))
+    {
+      struct value_print_options local_opts = *options;
+
+      local_opts.addressprint = 0;
+      lsscm_val_print_lazy_string (str_scm, stream, &local_opts);
+      result = STRING_REPR_OK;
+    }
+  else
+    {
+      gdb_assert (gdbscm_is_exception (str_scm));
+      ppscm_print_exception_unless_memory_error (str_scm, stream);
+      result = STRING_REPR_ERROR;
+    }
+
+  return result;
+}
+
+/* Helper for gdbscm_apply_val_pretty_printer that formats children of the
+   printer, if any exist.
+   The caller is responsible for ensuring PRINTER is a printer smob.
+   If PRINTED_NOTHING is true, then nothing has been printed by to_string,
+   and format output accordingly. */
+
+static void
+ppscm_print_children (SCM printer, enum display_hint hint,
+		      struct ui_file *stream, int recurse,
+		      const struct value_print_options *options,
+		      struct gdbarch *gdbarch,
+		      const struct language_defn *language,
+		      int printed_nothing)
+{
+  pretty_printer_worker_smob *w_smob
+    = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
+  int is_map, is_array, done_flag, pretty;
+  unsigned int i;
+  SCM children, status;
+  SCM iter = SCM_BOOL_F; /* -Wall */
+  struct cleanup *cleanups;
+
+  if (gdbscm_is_false (w_smob->children))
+    return;
+  if (!gdbscm_is_procedure (w_smob->children))
+    {
+      ppscm_print_pp_type_error
+	(_("pretty-printer \"children\" object is not a procedure or #f"),
+	 w_smob->children);
+      return;
+    }
+
+  cleanups = make_cleanup (null_cleanup, NULL);
+
+  /* If we are printing a map or an array, we want special formatting.  */
+  is_map = hint == HINT_MAP;
+  is_array = hint == HINT_ARRAY;
+
+  children = gdbscm_safe_call_1 (w_smob->children, printer,
+				 gdbscm_memory_error_p);
+  if (gdbscm_is_exception (children))
+    {
+      ppscm_print_exception_unless_memory_error (children, stream);
+      goto done;
+    }
+  /* We combine two steps here: get children, make an iterator out of them.
+     This simplifies things because there's no language means of creating
+     iterators, and it's the printer object that knows how it will want its
+     children iterated over.  */
+  if (!itscm_is_iterator (children))
+    {
+      ppscm_print_pp_type_error
+	(_("result of pretty-printer \"children\" procedure is not"
+	   " a <gdb:iterator> object"), children);
+      goto done;
+    }
+  iter = children;
+
+  /* Use the prettyformat_arrays option if we are printing an array,
+     and the pretty option otherwise.  */
+  if (is_array)
+    pretty = options->prettyformat_arrays;
+  else
+    {
+      if (options->prettyformat == Val_prettyformat)
+	pretty = 1;
+      else
+	pretty = options->prettyformat_structs;
+    }
+
+  done_flag = 0;
+  for (i = 0; i < options->print_max; ++i)
+    {
+      int rc;
+      SCM scm_name, v_scm;
+      char *name;
+      SCM item = itscm_safe_call_next_x (iter, gdbscm_memory_error_p);
+      struct cleanup *inner_cleanup = make_cleanup (null_cleanup, NULL);
+
+      if (gdbscm_is_exception (item))
+	{
+	  ppscm_print_exception_unless_memory_error (item, stream);
+	  break;
+	}
+      if (itscm_is_end_of_iteration (item))
+	{
+	  /* Set a flag so we can know whether we printed all the
+	     available elements.  */
+	  done_flag = 1;
+	  break;
+	}
+
+      if (! scm_is_pair (item))
+	{
+	  ppscm_print_pp_type_error
+	    (_("result of pretty-printer children iterator is not a pair"
+	       " or (end-of-iteration)"),
+	     item);
+	  continue;
+	}
+      scm_name = scm_car (item);
+      v_scm = scm_cdr (item);
+      if (!scm_is_string (scm_name))
+	{
+	  ppscm_print_pp_type_error
+	    (_("first element of pretty-printer children iterator is not"
+	       " a string"), item);
+	  continue;
+	}
+      name = gdbscm_scm_to_c_string (scm_name);
+      make_cleanup (xfree, name);
+
+      /* Print initial "{".  For other elements, there are three cases:
+	 1. Maps.  Print a "," after each value element.
+	 2. Arrays.  Always print a ",".
+	 3. Other.  Always print a ",".  */
+      if (i == 0)
+	{
+         if (printed_nothing)
+           fputs_filtered ("{", stream);
+         else
+           fputs_filtered (" = {", stream);
+       }
+
+      else if (! is_map || i % 2 == 0)
+	fputs_filtered (pretty ? "," : ", ", stream);
+
+      /* In summary mode, we just want to print "= {...}" if there is
+	 a value.  */
+      if (options->summary)
+	{
+	  /* This increment tricks the post-loop logic to print what
+	     we want.  */
+	  ++i;
+	  /* Likewise.  */
+	  pretty = 0;
+	  break;
+	}
+
+      if (! is_map || i % 2 == 0)
+	{
+	  if (pretty)
+	    {
+	      fputs_filtered ("\n", stream);
+	      print_spaces_filtered (2 + 2 * recurse, stream);
+	    }
+	  else
+	    wrap_here (n_spaces (2 + 2 *recurse));
+	}
+
+      if (is_map && i % 2 == 0)
+	fputs_filtered ("[", stream);
+      else if (is_array)
+	{
+	  /* We print the index, not whatever the child method
+	     returned as the name.  */
+	  if (options->print_array_indexes)
+	    fprintf_filtered (stream, "[%d] = ", i);
+	}
+      else if (! is_map)
+	{
+	  fputs_filtered (name, stream);
+	  fputs_filtered (" = ", stream);
+	}
+
+      if (lsscm_is_lazy_string (v_scm))
+	{
+	  struct value_print_options local_opts = *options;
+
+	  local_opts.addressprint = 0;
+	  lsscm_val_print_lazy_string (v_scm, stream, &local_opts);
+	}
+      else if (scm_is_string (v_scm))
+	{
+	  char *output = gdbscm_scm_to_c_string (v_scm);
+
+	  fputs_filtered (output, stream);
+	  xfree (output);
+	}
+      else
+	{
+	  SCM except_scm;
+	  struct value *value
+	    = vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE,
+					       v_scm, &except_scm,
+					       gdbarch, language);
+
+	  if (value == NULL)
+	    {
+	      ppscm_print_exception_unless_memory_error (except_scm, stream);
+	      break;
+	    }
+	  common_val_print (value, stream, recurse + 1, options, language);
+	}
+
+      if (is_map && i % 2 == 0)
+	fputs_filtered ("] = ", stream);
+
+      do_cleanups (inner_cleanup);
+    }
+
+  if (i)
+    {
+      if (!done_flag)
+	{
+	  if (pretty)
+	    {
+	      fputs_filtered ("\n", stream);
+	      print_spaces_filtered (2 + 2 * recurse, stream);
+	    }
+	  fputs_filtered ("...", stream);
+	}
+      if (pretty)
+	{
+	  fputs_filtered ("\n", stream);
+	  print_spaces_filtered (2 * recurse, stream);
+	}
+      fputs_filtered ("}", stream);
+    }
+
+ done:
+  do_cleanups (cleanups);
+
+  /* Play it safe, make sure ITER doesn't get GC'd.  */
+  scm_remember_upto_here_1 (iter);
+}
+
+/* This is the extension_language_ops.apply_val_pretty_printer "method".  */
+
+enum ext_lang_rc
+gdbscm_apply_val_pretty_printer (const struct extension_language_defn *extlang,
+				 struct type *type, const gdb_byte *valaddr,
+				 int embedded_offset, CORE_ADDR address,
+				 struct ui_file *stream, int recurse,
+				 const struct value *val,
+				 const struct value_print_options *options,
+				 const struct language_defn *language)
+{
+  struct gdbarch *gdbarch = get_type_arch (type);
+  SCM exception = SCM_BOOL_F;
+  SCM printer = SCM_BOOL_F;
+  SCM val_obj = SCM_BOOL_F;
+  struct value *value;
+  enum display_hint hint;
+  struct cleanup *cleanups;
+  int result = EXT_LANG_RC_NOP;
+  enum string_repr_result print_result;
+
+  /* No pretty-printer support for unavailable values.  */
+  if (!value_bytes_available (val, embedded_offset, TYPE_LENGTH (type)))
+    return EXT_LANG_RC_NOP;
+
+  if (!gdb_scheme_initialized)
+    return EXT_LANG_RC_NOP;
+
+  cleanups = make_cleanup (null_cleanup, NULL);
+
+  /* Instantiate the printer.  */
+  if (valaddr)
+    valaddr += embedded_offset;
+  value = value_from_contents_and_address (type, valaddr,
+					   address + embedded_offset);
+
+  set_value_component_location (value, val);
+  /* set_value_component_location resets the address, so we may
+     need to set it again.  */
+  if (VALUE_LVAL (value) != lval_internalvar
+      && VALUE_LVAL (value) != lval_internalvar_component
+      && VALUE_LVAL (value) != lval_computed)
+    set_value_address (value, address + embedded_offset);
+
+  val_obj = vlscm_scm_from_value (value);
+  if (gdbscm_is_exception (val_obj))
+    {
+      exception = val_obj;
+      result = EXT_LANG_RC_ERROR;
+      goto done;
+    }
+
+  printer = ppscm_find_pretty_printer (val_obj);
+
+  if (gdbscm_is_exception (printer))
+    {
+      exception = printer;
+      result = EXT_LANG_RC_ERROR;
+      goto done;
+    }
+  if (gdbscm_is_false (printer))
+    {
+      result = EXT_LANG_RC_NOP;
+      goto done;
+    }
+  gdb_assert (ppscm_is_pretty_printer_worker (printer));
+
+  /* If we are printing a map, we want some special formatting.  */
+  hint = ppscm_get_display_hint_enum (printer);
+  if (hint == HINT_ERROR)
+    {
+      /* Print the error as an exception for consistency.  */
+      SCM hint_scm = ppscm_get_display_hint_scm (printer);
+
+      ppscm_print_pp_type_error ("Invalid display hint", hint_scm);
+      /* Fall through.  A bad hint doesn't stop pretty-printing.  */
+      hint = HINT_NONE;
+    }
+
+  /* Print the section.  */
+  print_result = ppscm_print_string_repr (printer, hint, stream, recurse,
+					  options, gdbarch, language);
+  if (print_result != STRING_REPR_ERROR)
+    {
+      ppscm_print_children (printer, hint, stream, recurse, options,
+			    gdbarch, language,
+			    print_result == STRING_REPR_NONE);
+    }
+
+  result = EXT_LANG_RC_OK;
+
+ done:
+  if (gdbscm_is_exception (exception))
+    ppscm_print_exception_unless_memory_error (exception, stream);
+  do_cleanups (cleanups);
+  return result;
+}
+
+/* Initialize the Scheme pretty-printer code.  */
+
+static const scheme_function pretty_printer_functions[] =
+{
+  { "make-pretty-printer", 2, 0, 0, gdbscm_make_pretty_printer,
+    "\
+Create a <gdb:pretty-printer> object.\n\
+\n\
+  Arguments: name lookup\n\
+    name:   a string naming the matcher\n\
+    lookup: a procedure:\n\
+      (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
+
+  { "pretty-printer?", 1, 0, 0, gdbscm_pretty_printer_p,
+    "\
+Return #t if the object is a <gdb:pretty-printer> object." },
+
+  { "pretty-printer-enabled?", 1, 0, 0, gdbscm_pretty_printer_enabled_p,
+    "\
+Return #t if the pretty-printer is enabled." },
+
+  { "set-pretty-printer-enabled!", 2, 0, 0,
+    gdbscm_set_pretty_printer_enabled_x,
+    "\
+Set the enabled flag of the pretty-printer.\n\
+Returns \"unspecified\"." },
+
+  { "make-pretty-printer-worker", 3, 0, 0, gdbscm_make_pretty_printer_worker,
+    "\
+Create a <gdb:pretty-printer-worker> object.\n\
+\n\
+  Arguments: display-hint to-string children\n\
+    display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
+    to-string:    a procedure:\n\
+      (pretty-printer) -> string | #f | <gdb:value>\n\
+    children:     either #f or a procedure:\n\
+      (pretty-printer) -> <gdb:iterator>" },
+
+  { "pretty-printer-worker?", 1, 0, 0, gdbscm_pretty_printer_worker_p,
+    "\
+Return #t if the object is a <gdb:pretty-printer-worker> object." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_pretty_printers (void)
+{
+  pretty_printer_smob_tag
+    = gdbscm_make_smob_type (pretty_printer_smob_name,
+			     sizeof (pretty_printer_smob));
+  scm_set_smob_mark (pretty_printer_smob_tag,
+		     ppscm_mark_pretty_printer_smob);
+  scm_set_smob_print (pretty_printer_smob_tag,
+		      ppscm_print_pretty_printer_smob);
+
+  pretty_printer_worker_smob_tag
+    = gdbscm_make_smob_type (pretty_printer_worker_smob_name,
+			     sizeof (pretty_printer_worker_smob));
+  scm_set_smob_mark (pretty_printer_worker_smob_tag,
+		     ppscm_mark_pretty_printer_worker_smob);
+  scm_set_smob_print (pretty_printer_worker_smob_tag,
+		      ppscm_print_pretty_printer_worker_smob);
+
+  gdbscm_define_functions (pretty_printer_functions, 1);
+
+  scm_c_define (pretty_printer_list_name, SCM_EOL);
+
+  pretty_printer_list_var
+    = scm_c_private_variable (gdbscm_module_name,
+			      pretty_printer_list_name);
+  gdb_assert (!gdbscm_is_false (pretty_printer_list_var));
+
+  pp_type_error_symbol = scm_from_latin1_symbol ("gdb:pp-type-error");
+
+  ppscm_map_string = scm_from_latin1_string ("map");
+  ppscm_array_string = scm_from_latin1_string ("array");
+  ppscm_string_string = scm_from_latin1_string ("string");
+}
diff --git a/gdb/guile/scm-safe-call.c b/gdb/guile/scm-safe-call.c
new file mode 100644
index 0000000..147d7f5
--- /dev/null
+++ b/gdb/guile/scm-safe-call.c
@@ -0,0 +1,464 @@
+/* GDB/Scheme support for safe calls into the Guile interpreter.
+
+   Copyright (C) 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 "filenames.h"
+#include "gdb_assert.h"
+#include "guile-internal.h"
+
+/* Struct to marshall args to scscm_safe_call_body.  */
+
+struct c_data
+{
+  void *(*func) (void *);
+  void *data;
+  /* An error message or NULL for success.  */
+  void *result;
+};
+
+/* Struct to marshall args through gdbscm_with_catch.  */
+
+struct with_catch_data
+{
+  scm_t_catch_body func;
+  void *data;
+  scm_t_catch_handler unwind_handler;
+  scm_t_catch_handler pre_unwind_handler;
+
+  /* If EXCP_MATCHER is non-NULL, it is an excp_matcher_func function.
+     If the exception is recognized by it, the exception is recorded as is,
+     without wrapping it in gdb:with-stack.  */
+  excp_matcher_func *excp_matcher;
+
+  SCM stack;
+  SCM catch_result;
+};
+
+/* The "body" argument to scm_i_with_continuation_barrier.
+   Invoke the user-supplied function.  */
+
+static SCM
+scscm_safe_call_body (void *d)
+{
+  struct c_data *data = (struct c_data *) d;
+
+  data->result = data->func (data->data);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* A "pre-unwind handler" to scm_c_catch that prints the exception
+   according to "set guile print-stack".  */
+
+static SCM
+scscm_printing_pre_unwind_handler (void *data, SCM key, SCM args)
+{
+  SCM stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
+
+  gdbscm_print_exception_with_stack (SCM_BOOL_F, stack, key, args);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* A no-op unwind handler.  */
+
+static SCM
+scscm_nop_unwind_handler (void *data, SCM key, SCM args)
+{
+  return SCM_UNSPECIFIED;
+}
+
+/* The "pre-unwind handler" to scm_c_catch that records the exception
+   for possible later printing.  We do this in the pre-unwind handler because
+   we want the stack to include point where the exception occurred.
+
+   If DATA is non-NULL, it is an excp_matcher_func function.
+   If the exception is recognized by it, the exception is recorded as is,
+   without wrapping it in gdb:with-stack.  */
+
+static SCM
+scscm_recording_pre_unwind_handler (void *datap, SCM key, SCM args)
+{
+  struct with_catch_data *data = datap;
+  excp_matcher_func *matcher = data->excp_matcher;
+
+  if (matcher != NULL && matcher (key))
+    return SCM_UNSPECIFIED;
+
+  /* There's no need to record the whole stack if we're not going to print it.
+     However, convention is to still print the stack frame in which the
+     exception occurred, even if we're not going to print a full backtrace.
+     For now, keep it simple.  */
+
+  data->stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
+
+  /* IWBN if we could return the <gdb:exception> here and skip the unwind
+     handler, but it doesn't work that way.  If we want to return a
+     <gdb:exception> object from the catch it needs to come from the unwind
+     handler.  So what we do is save the stack for later use by the unwind
+     handler.  */
+
+  return SCM_UNSPECIFIED;
+}
+
+/* Part two of the recording unwind handler.
+   Here we take the stack saved from the pre-unwind handler and create
+   the <gdb:exception> object.  */
+
+static SCM
+scscm_recording_unwind_handler (void *datap, SCM key, SCM args)
+{
+  struct with_catch_data *data = datap;
+
+  /* We need to record the stack in the exception since we're about to
+     throw and lose the location that got the exception.  We do this by
+     wrapping the exception + stack in a new exception.  */
+
+  if (gdbscm_is_true (data->stack))
+    return gdbscm_make_exception_with_stack (key, args, data->stack);
+
+  return gdbscm_make_exception (key, args);
+}
+
+/* Ugh. :-(
+   Guile doesn't export scm_i_with_continuation_barrier which is exactly
+   what we need.  To cope, have our own wrapper around scm_c_catch and
+   pass this as the "body" argument to scm_c_with_continuation_barrier.
+   Darn darn darn.  */
+
+static void *
+gdbscm_with_catch (void *data)
+{
+  struct with_catch_data *d = data;
+
+  d->catch_result
+    = scm_c_catch (SCM_BOOL_T,
+		   d->func, d->data,
+		   d->unwind_handler, d,
+		   d->pre_unwind_handler, d);
+
+  return NULL;
+}
+
+/* A wrapper around scm_with_guile that prints backtraces and exceptions
+   according to "set guile print-stack".
+   The result if NULL if no exception occurred, otherwise it is a statically
+   allocated error message (caller must *not* free).  */
+
+void *
+gdbscm_with_guile (void *(*func) (void *), void *data)
+{
+  struct c_data c_data;
+  struct with_catch_data catch_data;
+
+  c_data.func = func;
+  c_data.data = data;
+  /* Set this now in case an exception is thrown.  */
+  c_data.result = _("Error while executing Scheme code.");
+
+  catch_data.func = scscm_safe_call_body;
+  catch_data.data = &c_data;
+  catch_data.unwind_handler = scscm_nop_unwind_handler;
+  catch_data.pre_unwind_handler = scscm_printing_pre_unwind_handler;
+  catch_data.excp_matcher = NULL;
+  catch_data.stack = SCM_BOOL_F;
+  catch_data.catch_result = SCM_UNSPECIFIED;
+
+  scm_with_guile (gdbscm_with_catch, &catch_data);
+
+  return c_data.result;
+}
+
+/* Another wrapper of scm_with_guile for use by the safe call/apply routines
+   in this file, as well as for general purpose calling other functions safely.
+   For these we want to record the exception, but leave the possible printing
+   of it to later.  */
+
+SCM
+gdbscm_call_guile (SCM (*func) (void *), void *data,
+		   excp_matcher_func *ok_excps)
+{
+  struct with_catch_data catch_data;
+
+  catch_data.func = func;
+  catch_data.data = data;
+  catch_data.unwind_handler = scscm_recording_unwind_handler;
+  catch_data.pre_unwind_handler = scscm_recording_pre_unwind_handler;
+  catch_data.excp_matcher = ok_excps;
+  catch_data.stack = SCM_BOOL_F;
+  catch_data.catch_result = SCM_UNSPECIFIED;
+
+#if 0
+  scm_c_with_continuation_barrier (gdbscm_with_catch, &catch_data);
+#else
+  scm_with_guile (gdbscm_with_catch, &catch_data);
+#endif
+
+  return catch_data.catch_result;
+}
+
+/* Utilities to safely call Scheme code, catching all exceptions, and
+   preventing continuation capture.
+   The result is the result of calling the function, or if an exception occurs
+   then the result is a <gdb:exception> smob, which can be tested for with
+   gdbscm_is_exception.  */
+
+/* Helper for gdbscm_safe_call_0.  */
+
+static SCM
+scscm_call_0_body (void *argsp)
+{
+  SCM *args = argsp;
+
+  return scm_call_0 (args[0]);
+}
+
+SCM
+gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps)
+{
+  SCM args[] = { proc };
+
+  return gdbscm_call_guile (scscm_call_0_body, args, ok_excps);
+}
+
+/* Helper for gdbscm_safe_call_1.  */
+
+static SCM
+scscm_call_1_body (void *argsp)
+{
+  SCM *args = argsp;
+
+  return scm_call_1 (args[0], args[1]);
+}
+
+SCM
+gdbscm_safe_call_1 (SCM proc, SCM arg0, excp_matcher_func *ok_excps)
+{
+  SCM args[] = { proc, arg0 };
+
+  return gdbscm_call_guile (scscm_call_1_body, args, ok_excps);
+}
+
+/* Helper for gdbscm_safe_call_2.  */
+
+static SCM
+scscm_call_2_body (void *argsp)
+{
+  SCM *args = argsp;
+
+  return scm_call_2 (args[0], args[1], args[2]);
+}
+
+SCM
+gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps)
+{
+  SCM args[] = { proc, arg0, arg1 };
+
+  return gdbscm_call_guile (scscm_call_2_body, args, ok_excps);
+}
+
+/* Helper for gdbscm_safe_call_3.  */
+
+static SCM
+scscm_call_3_body (void *argsp)
+{
+  SCM *args = argsp;
+
+  return scm_call_3 (args[0], args[1], args[2], args[3]);
+}
+
+SCM
+gdbscm_safe_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3,
+		    excp_matcher_func *ok_excps)
+{
+  SCM args[] = { proc, arg1, arg2, arg3 };
+
+  return gdbscm_call_guile (scscm_call_3_body, args, ok_excps);
+}
+
+/* Helper for gdbscm_safe_call_4.  */
+
+static SCM
+scscm_call_4_body (void *argsp)
+{
+  SCM *args = argsp;
+
+  return scm_call_4 (args[0], args[1], args[2], args[3], args[4]);
+}
+
+SCM
+gdbscm_safe_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4,
+		    excp_matcher_func *ok_excps)
+{
+  SCM args[] = { proc, arg1, arg2, arg3, arg4 };
+
+  return gdbscm_call_guile (scscm_call_4_body, args, ok_excps);
+}
+
+/* Helper for gdbscm_safe_apply_1.  */
+
+static SCM
+scscm_apply_1_body (void *argsp)
+{
+  SCM *args = argsp;
+
+  return scm_apply_1 (args[0], args[1], args[2]);
+}
+
+SCM
+gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM rest, excp_matcher_func *ok_excps)
+{
+  SCM args[] = { proc, arg0, rest };
+
+  return gdbscm_call_guile (scscm_apply_1_body, args, ok_excps);
+}
+
+/* Utilities to call Scheme code, not catching exceptions, and
+   not preventing continuation capture.
+   The result is the result of calling the function.
+   If an exception occurs then Guile is left to handle the exception,
+   unwinding the stack as appropriate.
+
+   USE THESE WITH CARE.
+   Typically these are called from functions that implement Scheme procedures,
+   and we don't want to catch the exception; otherwise it will get printed
+   twice: once when first caught and once if it ends up being rethrown and the
+   rethrow reaches the top repl, which will confuse the user.
+
+   While these calls just pass the call off to the corresponding Guile
+   procedure, all such calls are routed through these ones to:
+   a) provide a place to put hooks or whatnot in if we need to,
+   b) add "unsafe" to the name to alert the reader.  */
+
+SCM
+gdbscm_unsafe_call_1 (SCM proc, SCM arg0)
+{
+  return scm_call_1 (proc, arg0);
+}
+
+/* Utilities for safely evaluating a Scheme expression string.  */
+
+struct eval_scheme_string_data
+{
+  const char *string;
+  int display_result;
+};
+
+/* Wrapper to eval a C string in the Guile interpreter.
+   This is passed to scm_with_guile.  */
+
+static void *
+scscm_eval_scheme_string (void *datap)
+{
+  struct eval_scheme_string_data *data = datap;
+  SCM result = scm_c_eval_string (data->string);
+
+  if (data->display_result && !scm_is_eq (result, SCM_UNSPECIFIED))
+    {
+      SCM port = scm_current_output_port ();
+
+      scm_write (result, port);
+      scm_newline (port);
+    }
+
+  /* If we get here the eval succeeded.  */
+  return NULL;
+}
+
+/* Evaluate EXPR in the Guile interpreter, catching all exceptions
+   and preventing continuation capture.
+   The result is NULL if no exception occurred.  Otherwise, the exception is
+   printed according to "set guile print-stack" and the result is an error
+   message allocated with malloc, caller must free.  */
+
+char *
+gdbscm_safe_eval_string (const char *string, int display_result)
+{
+  struct eval_scheme_string_data data = { string, display_result };
+  void *result;
+
+  result = gdbscm_with_guile (scscm_eval_scheme_string, (void *) &data);
+
+  if (result != NULL)
+    return xstrdup (result);
+  return NULL;
+}
+
+/* Utilities for safely loading Scheme scripts.  */
+
+/* Helper function for gdbscm_safe_source_scheme_script.  */
+
+static void *
+scscm_source_scheme_script (void *data)
+{
+  const char *filename = data;
+
+  /* The Guile docs don't specify what the result is.
+     Maybe it's SCM_UNSPECIFIED, but the docs should specify that. :-) */
+  scm_c_primitive_load_path (filename);
+
+  /* If we get here the load succeeded.  */
+  return NULL;
+}
+
+/* Try to load a script, catching all exceptions,
+   and preventing continuation capture.
+   The result is NULL if the load succeeded.  Otherwise, the exception is
+   printed according to "set guile print-stack" and the result is an error
+   message allocated with malloc, caller must free.  */
+
+char *
+gdbscm_safe_source_script (const char *filename)
+{
+  /* scm_c_primitive_load_path only looks in %load-path for files with
+     relative paths.  An alternative could be to temporarily add "." to
+     %load-path, but we don't want %load-path to be searched.  At least not
+     by default.  This function is invoked by the "source" GDB command which
+     already has its own path search support.  */
+  char *abs_filename = NULL;
+  void *result;
+
+  if (!IS_ABSOLUTE_PATH (filename))
+    {
+      abs_filename = gdb_realpath (filename);
+      filename = abs_filename;
+    }
+
+  result = gdbscm_with_guile (scscm_source_scheme_script,
+			      (void *) filename);
+
+  xfree (abs_filename);
+  if (result != NULL)
+    return xstrdup (result);
+  return NULL;
+}
+
+/* Utility for entering an interactive Guile repl.  */
+
+void
+gdbscm_enter_repl (void)
+{
+  /* It's unfortunate to have to resort to something like this, but
+     scm_shell doesn't return.  :-(  I found this code on guile-user@.  */
+  gdbscm_safe_call_1 (scm_c_public_ref ("system repl repl", "start-repl"),
+		      scm_from_latin1_symbol ("scheme"), NULL);
+}
diff --git a/gdb/guile/scm-string.c b/gdb/guile/scm-string.c
new file mode 100644
index 0000000..87ecabf
--- /dev/null
+++ b/gdb/guile/scm-string.c
@@ -0,0 +1,246 @@
+/* GDB/Scheme charset interface.
+
+   Copyright (C) 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 <stdarg.h>
+#include "charset.h"
+#include "guile-internal.h"
+
+/* Convert a C (latin1) string to an SCM string.
+   "latin1" is chosen because Guile won't throw an exception.  */
+
+SCM
+gdbscm_scm_from_c_string (const char *string)
+{
+  return scm_from_latin1_string (string);
+}
+
+/* Convert an SCM string to a C (latin1) string.
+   "latin1" is chosen because Guile won't throw an exception.
+   Space for the result is allocated with malloc, caller must free.
+   It is an error to call this if STRING is not a string.  */
+
+char *
+gdbscm_scm_to_c_string (SCM string)
+{
+  return scm_to_latin1_string (string);
+}
+
+/* Use printf to construct a Scheme string.  */
+
+SCM
+gdbscm_scm_from_printf (const char *format, ...)
+{
+  va_list args;
+  char *string;
+  SCM result;
+
+  va_start (args, format);
+  string = xstrvprintf (format, args);
+  va_end (args);
+  result = scm_from_latin1_string (string);
+  xfree (string);
+
+  return result;
+}
+
+/* Struct to pass data from gdbscm_scm_to_string to
+   gdbscm_call_scm_to_stringn.  */
+
+struct scm_to_stringn_data
+{
+  SCM string;
+  size_t *lenp;
+  const char *charset;
+  int conversion_kind;
+  char *result;
+};
+
+/* Helper for gdbscm_scm_to_string to call scm_to_stringn
+   from within scm_c_catch.  */
+
+static SCM
+gdbscm_call_scm_to_stringn (void *datap)
+{
+  struct scm_to_stringn_data *data = datap;
+
+  data->result = scm_to_stringn (data->string, data->lenp, data->charset,
+				 data->conversion_kind);
+  return SCM_BOOL_F;
+}
+
+/* Convert an SCM string to a string in charset CHARSET.
+   This function is guaranteed to not throw an exception.
+   If STRICT is non-zero, and there's a conversion error, then a
+   <gdb:exception> object is stored in *EXCEPT_SCMP, and NULL is returned.
+   If STRICT is zero, then escape sequences are used for characters that
+   can't be converted, and EXCEPT_SCMP may be passed as NULL.
+   Space for the result is allocated with malloc, caller must free.
+   It is an error to call this if STRING is not a string.  */
+
+char *
+gdbscm_scm_to_string (SCM string, size_t *lenp,
+		      const char *charset, int strict, SCM *except_scmp)
+{
+  struct scm_to_stringn_data data;
+  SCM scm_result;
+
+  data.string = string;
+  data.lenp = lenp;
+  data.charset = charset;
+  data.conversion_kind = (strict
+			  ? SCM_FAILED_CONVERSION_ERROR
+			  : SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
+  data.result = NULL;
+
+  scm_result = gdbscm_call_guile (gdbscm_call_scm_to_stringn, &data, NULL);
+
+  if (gdbscm_is_false (scm_result))
+    {
+      gdb_assert (data.result != NULL);
+      return data.result;
+    }
+  gdb_assert (gdbscm_is_exception (scm_result));
+  *except_scmp = scm_result;
+  return NULL;
+}
+
+/* Struct to pass data from gdbscm_scm_from_string to
+   gdbscm_call_scm_from_stringn.  */
+
+struct scm_from_stringn_data
+{
+  const char *string;
+  size_t len;
+  const char *charset;
+  int conversion_kind;
+  SCM result;
+};
+
+/* Helper for gdbscm_scm_from_string to call scm_from_stringn
+   from within scm_c_catch.  */
+
+static SCM
+gdbscm_call_scm_from_stringn (void *datap)
+{
+  struct scm_from_stringn_data *data = datap;
+
+  data->result = scm_from_stringn (data->string, data->len, data->charset,
+				   data->conversion_kind);
+  return SCM_BOOL_F;
+}
+
+/* Convert STRING to a Scheme string in charset CHARSET.
+   This function is guaranteed to not throw an exception.
+   If STRICT is non-zero, and there's a conversion error, then a
+   <gdb:exception> object is returned.
+   If STRICT is zero, then question marks are used for characters that
+   can't be converted (limitation of underlying Guile conversion support).  */
+
+SCM
+gdbscm_scm_from_string (const char *string, size_t len,
+			const char *charset, int strict)
+{
+  struct scm_from_stringn_data data;
+  SCM scm_result;
+
+  data.string = string;
+  data.len = len;
+  data.charset = charset;
+  /* The use of SCM_FAILED_CONVERSION_QUESTION_MARK is specified by Guile.  */
+  data.conversion_kind = (strict
+			  ? SCM_FAILED_CONVERSION_ERROR
+			  : SCM_FAILED_CONVERSION_QUESTION_MARK);
+  data.result = SCM_UNDEFINED;
+
+  scm_result = gdbscm_call_guile (gdbscm_call_scm_from_stringn, &data, NULL);
+
+  if (gdbscm_is_false (scm_result))
+    {
+      gdb_assert (!SCM_UNBNDP (data.result));
+      return data.result;
+    }
+  gdb_assert (gdbscm_is_exception (scm_result));
+  return scm_result;
+}
+
+/* Convert an SCM string to a target string.
+   This function will thrown a conversion error if there's a problem.
+   Space for the result is allocated with malloc, caller must free.
+   It is an error to call this if STRING is not a string.  */
+
+char *
+gdbscm_scm_to_target_string_unsafe (SCM string, size_t *lenp,
+				    struct gdbarch *gdbarch)
+{
+  return scm_to_stringn (string, lenp, target_charset (gdbarch),
+			 SCM_FAILED_CONVERSION_ERROR);
+}
+
+/* (string->argv string) -> list
+   Return list of strings split up according to GDB's argv parsing rules.
+   This is useful when writing GDB commands in Scheme.  */
+
+static SCM
+gdbscm_string_to_argv (SCM string_scm)
+{
+  char *string;
+  char **c_argv;
+  int i;
+  SCM result = SCM_EOL;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
+			      string_scm, &string);
+
+  if (string == NULL || *string == '\0')
+    {
+      xfree (string);
+      return SCM_EOL;
+    }
+
+  c_argv = gdb_buildargv (string);
+  for (i = 0; c_argv[i] != NULL; ++i)
+    result = scm_cons (gdbscm_scm_from_c_string (c_argv[i]), result);
+
+  freeargv (c_argv);
+  xfree (string);
+
+  return scm_reverse_x (result, SCM_EOL);
+}
+
+/* Initialize the Scheme charset interface to GDB.  */
+
+static const scheme_function string_functions[] =
+{
+  { "string->argv", 1, 0, 0, gdbscm_string_to_argv,
+  "\
+Convert a string to a list of strings split up according to\n\
+gdb's argv parsing rules." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_strings (void)
+{
+  gdbscm_define_functions (string_functions, 1);
+}
diff --git a/gdb/guile/scm-symbol.c b/gdb/guile/scm-symbol.c
new file mode 100644
index 0000000..53cc272
--- /dev/null
+++ b/gdb/guile/scm-symbol.c
@@ -0,0 +1,777 @@
+/* Scheme interface to symbols.
+
+   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 "block.h"
+#include "exceptions.h"
+#include "frame.h"
+#include "symtab.h"
+#include "objfiles.h"
+#include "value.h"
+#include "guile-internal.h"
+
+/* The <gdb:symbol> smob.  */
+
+typedef struct
+{
+  /* This always appears first.  */
+  eqable_gdb_smob base;
+
+  /* The GDB symbol structure this smob is wrapping.  */
+  struct symbol *symbol;
+} symbol_smob;
+
+static const char symbol_smob_name[] = "gdb:symbol";
+
+/* The tag Guile knows the symbol smob by.  */
+static scm_t_bits symbol_smob_tag;
+
+/* Keywords used in argument passing.  */
+static SCM block_keyword;
+static SCM domain_keyword;
+static SCM frame_keyword;
+
+static const struct objfile_data *syscm_objfile_data_key;
+
+/* Administrivia for symbol smobs.  */
+
+/* Helper function to hash a symbol_smob.  */
+
+static hashval_t
+syscm_hash_symbol_smob (const void *p)
+{
+  const symbol_smob *s_smob = p;
+
+  return htab_hash_pointer (s_smob->symbol);
+}
+
+/* Helper function to compute equality of symbol_smobs.  */
+
+static int
+syscm_eq_symbol_smob (const void *ap, const void *bp)
+{
+  const symbol_smob *a = ap;
+  const symbol_smob *b = bp;
+
+  return (a->symbol == b->symbol
+	  && a->symbol != NULL);
+}
+
+/* Return the struct symbol pointer -> SCM mapping table.
+   It is created if necessary.  */
+
+static htab_t
+syscm_objfile_symbol_map (struct symbol *symbol)
+{
+  struct objfile *objfile = SYMBOL_SYMTAB (symbol)->objfile;
+  htab_t htab = objfile_data (objfile, syscm_objfile_data_key);
+
+  if (htab == NULL)
+    {
+      htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob,
+						 syscm_eq_symbol_smob);
+      set_objfile_data (objfile, syscm_objfile_data_key, htab);
+    }
+
+  return htab;
+}
+
+/* The smob "mark" function for <gdb:symbol>.  */
+
+static SCM
+syscm_mark_symbol_smob (SCM self)
+{
+  symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
+
+  /* Do this last.  */
+  return gdbscm_mark_eqable_gsmob (&s_smob->base);
+}
+
+/* The smob "free" function for <gdb:symbol>.  */
+
+static size_t
+syscm_free_symbol_smob (SCM self)
+{
+  symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
+
+  if (s_smob->symbol != NULL)
+    {
+      htab_t htab = syscm_objfile_symbol_map (s_smob->symbol);
+
+      gdbscm_clear_eqable_gsmob_ptr_slot (htab, &s_smob->base);
+    }
+
+  /* Not necessary, done to catch bugs.  */
+  s_smob->symbol = NULL;
+
+  return 0;
+}
+
+/* The smob "print" function for <gdb:symbol>.  */
+
+static int
+syscm_print_symbol_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
+
+  if (pstate->writingp)
+    gdbscm_printf (port, "#<%s ", symbol_smob_name);
+  gdbscm_printf (port, "%s",
+		 s_smob->symbol != NULL
+		 ? SYMBOL_PRINT_NAME (s_smob->symbol)
+		 : "<invalid>");
+  if (pstate->writingp)
+    scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:symbol> object.  */
+
+static SCM
+syscm_make_symbol_smob (void)
+{
+  symbol_smob *s_smob = (symbol_smob *)
+    scm_gc_malloc (sizeof (symbol_smob), symbol_smob_name);
+  SCM s_scm;
+
+  s_smob->symbol = NULL;
+  s_scm = scm_new_smob (symbol_smob_tag, (scm_t_bits) s_smob);
+  gdbscm_init_eqable_gsmob (&s_smob->base);
+
+  return s_scm;
+}
+
+/* Return non-zero if SCM is a symbol smob.  */
+
+int
+syscm_is_symbol (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (symbol_smob_tag, scm);
+}
+
+/* (symbol? object) -> boolean */
+
+static SCM
+gdbscm_symbol_p (SCM scm)
+{
+  return scm_from_bool (syscm_is_symbol (scm));
+}
+
+/* Return the existing object that encapsulates SYMBOL, or create a new
+   <gdb:symbol> object.  */
+
+SCM
+syscm_scm_from_symbol (struct symbol *symbol)
+{
+  htab_t htab;
+  eqable_gdb_smob **slot;
+  symbol_smob *s_smob, s_smob_for_lookup;
+  SCM s_scm;
+
+  /* If we've already created a gsmob for this symbol, return it.
+     This makes symbols eq?-able.  */
+  htab = syscm_objfile_symbol_map (symbol);
+  s_smob_for_lookup.symbol = symbol;
+  slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &s_smob_for_lookup.base);
+  if (*slot != NULL)
+    return (*slot)->containing_scm;
+
+  s_scm = syscm_make_symbol_smob ();
+  s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm);
+  s_smob->symbol = symbol;
+  gdbscm_fill_eqable_gsmob_ptr_slot (slot, &s_smob->base, s_scm);
+
+  return s_scm;
+}
+
+/* Returns the <gdb:symbol> object in SELF.
+   Throws an exception if SELF is not a <gdb:symbol> object.  */
+
+static SCM
+syscm_get_symbol_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (syscm_is_symbol (self), self, arg_pos, func_name,
+		   symbol_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the symbol smob of SELF.
+   Throws an exception if SELF is not a <gdb:symbol> object.  */
+
+static symbol_smob *
+syscm_get_symbol_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM s_scm = syscm_get_symbol_arg_unsafe (self, arg_pos, func_name);
+  symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm);
+
+  return s_smob;
+}
+
+/* Return non-zero if symbol S_SMOB is valid.  */
+
+static int
+syscm_is_valid (symbol_smob *s_smob)
+{
+  return s_smob->symbol != NULL;
+}
+
+/* Throw a Scheme error if SELF is not a valid symbol smob.
+   Otherwise return a pointer to the symbol smob.  */
+
+static symbol_smob *
+syscm_get_valid_symbol_smob_arg_unsafe (SCM self, int arg_pos,
+					const char *func_name)
+{
+  symbol_smob *s_smob
+    = syscm_get_symbol_smob_arg_unsafe (self, arg_pos, func_name);
+
+  if (!syscm_is_valid (s_smob))
+    {
+      gdbscm_invalid_object_error (func_name, arg_pos, self,
+				   _("<gdb:symbol>"));
+    }
+
+  return s_smob;
+}
+
+/* Throw a Scheme error if SELF is not a valid symbol smob.
+   Otherwise return a pointer to the symbol struct.  */
+
+struct symbol *
+syscm_get_valid_symbol_arg_unsafe (SCM self, int arg_pos,
+				   const char *func_name)
+{
+  symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, arg_pos,
+								func_name);
+
+  return s_smob->symbol;
+}
+
+/* Helper function for syscm_del_objfile_symbols to mark the symbol
+   as invalid.  */
+
+static int
+syscm_mark_symbol_invalid (void **slot, void *info)
+{
+  symbol_smob *s_smob = (symbol_smob *) *slot;
+
+  s_smob->symbol = NULL;
+  return 1;
+}
+
+/* This function is called when an objfile is about to be freed.
+   Invalidate the symbol as further actions on the symbol would result
+   in bad data.  All access to s_smob->symbol should be gated by
+   syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on
+   invalid symbols.  */
+
+static void
+syscm_del_objfile_symbols (struct objfile *objfile, void *datum)
+{
+  htab_t htab = datum;
+
+  if (htab != NULL)
+    {
+      htab_traverse_noresize (htab, syscm_mark_symbol_invalid, NULL);
+      htab_delete (htab);
+    }
+}
+
+/* Symbol methods.  */
+
+/* (symbol-valid? <gdb:symbol>) -> boolean
+   Returns #t if SELF still exists in GDB.  */
+
+static SCM
+gdbscm_symbol_valid_p (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (syscm_is_valid (s_smob));
+}
+
+/* (symbol-type <gdb:symbol>) -> <gdb:type>
+   Return the type of SELF, or #f if SELF has no type.  */
+
+static SCM
+gdbscm_symbol_type (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+
+  if (SYMBOL_TYPE (symbol) == NULL)
+    return SCM_BOOL_F;
+
+  return tyscm_scm_from_type (SYMBOL_TYPE (symbol));
+}
+
+/* (symbol-symtab <gdb:symbol>) -> <gdb:symtab>
+   Return the symbol table of SELF.  */
+
+static SCM
+gdbscm_symbol_symtab (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+
+  return stscm_scm_from_symtab (SYMBOL_SYMTAB (symbol));
+}
+
+/* (symbol-name <gdb:symbol>) -> string */
+
+static SCM
+gdbscm_symbol_name (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+
+  return gdbscm_scm_from_c_string (SYMBOL_NATURAL_NAME (symbol));
+}
+
+/* (symbol-linkage-name <gdb:symbol>) -> string */
+
+static SCM
+gdbscm_symbol_linkage_name (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+
+  return gdbscm_scm_from_c_string (SYMBOL_LINKAGE_NAME (symbol));
+}
+
+/* (symbol-print-name <gdb:symbol>) -> string */
+
+static SCM
+gdbscm_symbol_print_name (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+
+  return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol));
+}
+
+/* (symbol-addr-class <gdb:symbol>) -> integer */
+
+static SCM
+gdbscm_symbol_addr_class (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+
+  return scm_from_int (SYMBOL_CLASS (symbol));
+}
+
+/* (symbol-argument? <gdb:symbol>) -> boolean */
+
+static SCM
+gdbscm_symbol_argument_p (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+
+  return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol));
+}
+
+/* (symbol-constant? <gdb:symbol>) -> boolean */
+
+static SCM
+gdbscm_symbol_constant_p (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+  enum address_class class;
+
+  class = SYMBOL_CLASS (symbol);
+
+  return scm_from_bool (class == LOC_CONST || class == LOC_CONST_BYTES);
+}
+
+/* (symbol-function? <gdb:symbol>) -> boolean */
+
+static SCM
+gdbscm_symbol_function_p (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+  enum address_class class;
+
+  class = SYMBOL_CLASS (symbol);
+
+  return scm_from_bool (class == LOC_BLOCK);
+}
+
+/* (symbol-variable? <gdb:symbol>) -> boolean */
+
+static SCM
+gdbscm_symbol_variable_p (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+  enum address_class class;
+
+  class = SYMBOL_CLASS (symbol);
+
+  return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol)
+			&& (class == LOC_LOCAL || class == LOC_REGISTER
+			    || class == LOC_STATIC || class == LOC_COMPUTED
+			    || class == LOC_OPTIMIZED_OUT));
+}
+
+/* (symbol-needs-frame? <gdb:symbol>) -> boolean
+   Return #t if the symbol needs a frame for evaluation.  */
+
+static SCM
+gdbscm_symbol_needs_frame_p (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct symbol *symbol = s_smob->symbol;
+  volatile struct gdb_exception except;
+  int result = 0;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      result = symbol_read_needs_frame (symbol);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return scm_from_bool (result);
+}
+
+/* (symbol-line <gdb:symbol>) -> integer
+   Return the line number at which the symbol was defined.  */
+
+static SCM
+gdbscm_symbol_line (SCM self)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symbol *symbol = s_smob->symbol;
+
+  return scm_from_int (SYMBOL_LINE (symbol));
+}
+
+/* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
+   Return the value of the symbol, or an error in various circumstances.  */
+
+static SCM
+gdbscm_symbol_value (SCM self, SCM rest)
+{
+  symbol_smob *s_smob
+    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct symbol *symbol = s_smob->symbol;
+  SCM keywords[] = { frame_keyword, SCM_BOOL_F };
+  int frame_pos = -1;
+  SCM frame_scm = SCM_BOOL_F;
+  frame_smob *f_smob = NULL;
+  struct frame_info *frame_info = NULL;
+  struct value *value = NULL;
+  volatile struct gdb_exception except;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O",
+			      rest, &frame_pos, &frame_scm);
+  if (!gdbscm_is_false (frame_scm))
+    f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME);
+
+  if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
+				 _("cannot get the value of a typedef"));
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (f_smob != NULL)
+	{
+	  frame_info = frscm_frame_smob_to_frame (f_smob);
+	  if (frame_info == NULL)
+	    error (_("Invalid frame"));
+	}
+      
+      if (symbol_read_needs_frame (symbol) && frame_info == NULL)
+	error (_("Symbol requires a frame to compute its value"));
+
+      value = read_var_value (symbol, frame_info);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return vlscm_scm_from_value (value);
+}
+
+/* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
+     -> (<gdb:symbol> field-of-this?)
+   The result is #f if the symbol is not found.
+   See comment in lookup_symbol_in_language for field-of-this?.  */
+
+static SCM
+gdbscm_lookup_symbol (SCM name_scm, SCM rest)
+{
+  char *name;
+  SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F };
+  const struct block *block = NULL;
+  SCM block_scm = SCM_BOOL_F;
+  int domain = VAR_DOMAIN;
+  int block_arg_pos = -1, domain_arg_pos = -1;
+  struct field_of_this_result is_a_field_of_this;
+  struct symbol *symbol = NULL;
+  volatile struct gdb_exception except;
+  struct cleanup *cleanups;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
+			      name_scm, &name, rest,
+			      &block_arg_pos, &block_scm,
+			      &domain_arg_pos, &domain);
+
+  cleanups = make_cleanup (xfree, name);
+
+  if (block_arg_pos >= 0)
+    {
+      SCM except_scm;
+
+      block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
+				  &except_scm);
+      if (block == NULL)
+	{
+	  do_cleanups (cleanups);
+	  gdbscm_throw (except_scm);
+	}
+    }
+  else
+    {
+      struct frame_info *selected_frame;
+
+      TRY_CATCH (except, RETURN_MASK_ALL)
+	{
+	  selected_frame = get_selected_frame (_("no frame selected"));
+	  block = get_frame_block (selected_frame, NULL);
+	}
+      GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      symbol = lookup_symbol (name, block, domain, &is_a_field_of_this);
+    }
+  do_cleanups (cleanups);
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (symbol == NULL)
+    return SCM_BOOL_F;
+
+  return scm_list_2 (syscm_scm_from_symbol (symbol),
+		     scm_from_bool (is_a_field_of_this.type != NULL));
+}
+
+/* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol>
+   The result is #f if the symbol is not found.  */
+
+static SCM
+gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
+{
+  char *name;
+  SCM keywords[] = { domain_keyword, SCM_BOOL_F };
+  int domain_arg_pos = -1;
+  int domain = VAR_DOMAIN;
+  struct symbol *symbol = NULL;
+  volatile struct gdb_exception except;
+  struct cleanup *cleanups;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
+			      name_scm, &name, rest,
+			      &domain_arg_pos, &domain);
+
+  cleanups = make_cleanup (xfree, name);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      symbol = lookup_symbol_global (name, NULL, domain);
+    }
+  do_cleanups (cleanups);
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (symbol == NULL)
+    return SCM_BOOL_F;
+
+  return syscm_scm_from_symbol (symbol);
+}
+
+/* Initialize the Scheme symbol support.  */
+
+/* Note: The SYMBOL_ prefix on the integer constants here is present for
+   compatibility with the Python support.  */
+
+static const scheme_integer_constant symbol_integer_constants[] =
+{
+#define X(SYM) { "SYMBOL_" #SYM, SYM }
+  X (LOC_UNDEF),
+  X (LOC_CONST),
+  X (LOC_STATIC),
+  X (LOC_REGISTER),
+  X (LOC_ARG),
+  X (LOC_REF_ARG),
+  X (LOC_LOCAL),
+  X (LOC_TYPEDEF),
+  X (LOC_LABEL),
+  X (LOC_BLOCK),
+  X (LOC_CONST_BYTES),
+  X (LOC_UNRESOLVED),
+  X (LOC_OPTIMIZED_OUT),
+  X (LOC_COMPUTED),
+  X (LOC_REGPARM_ADDR),
+
+  X (UNDEF_DOMAIN),
+  X (VAR_DOMAIN),
+  X (STRUCT_DOMAIN),
+  X (LABEL_DOMAIN),
+  X (VARIABLES_DOMAIN),
+  X (FUNCTIONS_DOMAIN),
+  X (TYPES_DOMAIN),
+#undef X
+
+  END_INTEGER_CONSTANTS
+};
+
+static const scheme_function symbol_functions[] =
+{
+  { "symbol?", 1, 0, 0, gdbscm_symbol_p,
+    "\
+Return #t if the object is a <gdb:symbol> object." },
+
+  { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p,
+    "\
+Return #t if object is a valid <gdb:symbol> object.\n\
+A valid symbol is a symbol that has not been freed.\n\
+Symbols are freed when the objfile they come from is freed." },
+
+  { "symbol-type", 1, 0, 0, gdbscm_symbol_type,
+    "\
+Return the type of symbol." },
+
+  { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab,
+    "\
+Return the symbol table (<gdb:symtab>) containing symbol." },
+
+  { "symbol-line", 1, 0, 0, gdbscm_symbol_line,
+    "\
+Return the line number at which the symbol was defined." },
+
+  { "symbol-name", 1, 0, 0, gdbscm_symbol_name,
+    "\
+Return the name of the symbol as a string." },
+
+  { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name,
+    "\
+Return the linkage name of the symbol as a string." },
+
+  { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name,
+    "\
+Return the print name of the symbol as a string.\n\
+This is either name or linkage-name, depending on whether the user\n\
+asked GDB to display demangled or mangled names." },
+
+  { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class,
+    "\
+Return the address class of the symbol." },
+
+  { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p,
+    "\
+Return #t if the symbol needs a frame to compute its value." },
+
+  { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p,
+    "\
+Return #t if the symbol is a function argument." },
+
+  { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p,
+    "\
+Return #t if the symbol is a constant." },
+
+  { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p,
+    "\
+Return #t if the symbol is a function." },
+
+  { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p,
+    "\
+Return #t if the symbol is a variable." },
+
+  { "symbol-value", 1, 0, 1, gdbscm_symbol_value,
+    "\
+Return the value of the symbol.\n\
+\n\
+  Arguments: <gdb:symbol> [#:frame frame]" },
+
+  { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol,
+    "\
+Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
+\n\
+  Arguments: name [#:block block] [#:domain domain]\n\
+    name:   a string containing the name of the symbol to lookup\n\
+    block:  a <gdb:block> object\n\
+    domain: a SYMBOL_*_DOMAIN value" },
+
+  { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol,
+    "\
+Return <gdb:symbol> if found, otherwise #f.\n\
+\n\
+  Arguments: name [#:domain domain]\n\
+    name:   a string containing the name of the symbol to lookup\n\
+    domain: a SYMBOL_*_DOMAIN value" },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_symbols (void)
+{
+  symbol_smob_tag
+    = gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob));
+  scm_set_smob_mark (symbol_smob_tag, syscm_mark_symbol_smob);
+  scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob);
+  scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob);
+
+  gdbscm_define_integer_constants (symbol_integer_constants, 1);
+  gdbscm_define_functions (symbol_functions, 1);
+
+  block_keyword = scm_from_latin1_keyword ("block");
+  domain_keyword = scm_from_latin1_keyword ("domain");
+  frame_keyword = scm_from_latin1_keyword ("frame");
+
+  /* Register an objfile "free" callback so we can properly
+     invalidate symbols when an object file is about to be deleted.  */
+  syscm_objfile_data_key
+    = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols);
+}
diff --git a/gdb/guile/scm-symtab.c b/gdb/guile/scm-symtab.c
new file mode 100644
index 0000000..910d8b7
--- /dev/null
+++ b/gdb/guile/scm-symtab.c
@@ -0,0 +1,735 @@
+/* Scheme interface to symbol tables.
+
+   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 "symtab.h"
+#include "source.h"
+#include "objfiles.h"
+#include "block.h"
+#include "guile-internal.h"
+
+/* A <gdb:symtab> smob.  */
+
+typedef struct
+{
+  /* This always appears first.
+     eqable_gdb_smob is used so that symtabs are eq?-able.
+     Also, a symtab object is associated with an objfile.  eqable_gdb_smob
+     lets us track the lifetime of all symtabs associated with an objfile.
+     When an objfile is deleted we need to invalidate the symtab object.  */
+  eqable_gdb_smob base;
+
+  /* The GDB symbol table structure.
+     If this is NULL the symtab is invalid.  This can happen when the
+     underlying objfile is freed.  */
+  struct symtab *symtab;
+} symtab_smob;
+
+/* A <gdb:sal> smob.
+   A smob describing a gdb symtab-and-line object.
+   A sal is associated with an objfile.  All access must be gated by checking
+   the validity of symtab_scm.
+   TODO: Sals are not eq?-able at the moment, or even comparable.  */
+
+typedef struct
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* The <gdb:symtab> object of the symtab.
+     We store this instead of a pointer to the symtab_smob because it's not
+     clear GC will know the symtab_smob is referenced by us otherwise, and we
+     need quick access to symtab_smob->symtab to know if this sal is valid.  */
+  SCM symtab_scm;
+
+  /* The GDB symbol table and line structure.
+     This object is ephemeral in GDB, so keep our own copy.
+     The symtab pointer in this struct is not usable: If the symtab is deleted
+     this pointer will not be updated.  Use symtab_scm instead to determine
+     if this sal is valid.  */
+  struct symtab_and_line sal;
+} sal_smob;
+
+static const char symtab_smob_name[] = "gdb:symtab";
+/* "symtab-and-line" is pretty long, and "sal" is short and unique.  */
+static const char sal_smob_name[] = "gdb:sal";
+
+/* The tags Guile knows the symbol table smobs by.  */
+static scm_t_bits symtab_smob_tag;
+static scm_t_bits sal_smob_tag;
+
+static const struct objfile_data *stscm_objfile_data_key;
+
+/* Administrivia for symtab smobs.  */
+
+/* Helper function to hash a symbol_smob.  */
+
+static hashval_t
+stscm_hash_symtab_smob (const void *p)
+{
+  const symtab_smob *st_smob = p;
+
+  return htab_hash_pointer (st_smob->symtab);
+}
+
+/* Helper function to compute equality of symtab_smobs.  */
+
+static int
+stscm_eq_symtab_smob (const void *ap, const void *bp)
+{
+  const symtab_smob *a = ap;
+  const symtab_smob *b = bp;
+
+  return (a->symtab == b->symtab
+	  && a->symtab != NULL);
+}
+
+/* Return the struct symtab pointer -> SCM mapping table.
+   It is created if necessary.  */
+
+static htab_t
+stscm_objfile_symtab_map (struct symtab *symtab)
+{
+  struct objfile *objfile = symtab->objfile;
+  htab_t htab = objfile_data (objfile, stscm_objfile_data_key);
+
+  if (htab == NULL)
+    {
+      htab = gdbscm_create_eqable_gsmob_ptr_map (stscm_hash_symtab_smob,
+						 stscm_eq_symtab_smob);
+      set_objfile_data (objfile, stscm_objfile_data_key, htab);
+    }
+
+  return htab;
+}
+
+/* The smob "mark" function for <gdb:symtab>.  */
+
+static SCM
+stscm_mark_symtab_smob (SCM self)
+{
+  symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self);
+
+  /* Do this last.  */
+  return gdbscm_mark_eqable_gsmob (&st_smob->base);
+}
+
+/* The smob "free" function for <gdb:symtab>.  */
+
+static size_t
+stscm_free_symtab_smob (SCM self)
+{
+  symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self);
+
+  if (st_smob->symtab != NULL)
+    {
+      htab_t htab = stscm_objfile_symtab_map (st_smob->symtab);
+
+      gdbscm_clear_eqable_gsmob_ptr_slot (htab, &st_smob->base);
+    }
+
+  /* Not necessary, done to catch bugs.  */
+  st_smob->symtab = NULL;
+
+  return 0;
+}
+
+/* The smob "print" function for <gdb:symtab>.  */
+
+static int
+stscm_print_symtab_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s ", symtab_smob_name);
+  gdbscm_printf (port, "%s",
+		 st_smob->symtab != NULL
+		 ? symtab_to_filename_for_display (st_smob->symtab)
+		 : "<invalid>");
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:symtab> object.  */
+
+static SCM
+stscm_make_symtab_smob (void)
+{
+  symtab_smob *st_smob = (symtab_smob *)
+    scm_gc_malloc (sizeof (symtab_smob), symtab_smob_name);
+  SCM st_scm;
+
+  st_smob->symtab = NULL;
+  st_scm = scm_new_smob (symtab_smob_tag, (scm_t_bits) st_smob);
+  gdbscm_init_eqable_gsmob (&st_smob->base);
+
+  return st_scm;
+}
+
+/* Return non-zero if SCM is a symbol table smob.  */
+
+static int
+stscm_is_symtab (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (symtab_smob_tag, scm);
+}
+
+/* (symtab? object) -> boolean */
+
+static SCM
+gdbscm_symtab_p (SCM scm)
+{
+  return scm_from_bool (stscm_is_symtab (scm));
+}
+
+/* Create a new <gdb:symtab> object that encapsulates SYMTAB.  */
+
+SCM
+stscm_scm_from_symtab (struct symtab *symtab)
+{
+  htab_t htab;
+  eqable_gdb_smob **slot;
+  symtab_smob *st_smob, st_smob_for_lookup;
+  SCM st_scm;
+
+  /* If we've already created a gsmob for this symtab, return it.
+     This makes symtabs eq?-able.  */
+  htab = stscm_objfile_symtab_map (symtab);
+  st_smob_for_lookup.symtab = symtab;
+  slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &st_smob_for_lookup.base);
+  if (*slot != NULL)
+    return (*slot)->containing_scm;
+
+  st_scm = stscm_make_symtab_smob ();
+  st_smob = (symtab_smob *) SCM_SMOB_DATA (st_scm);
+  st_smob->symtab = symtab;
+  gdbscm_fill_eqable_gsmob_ptr_slot (slot, &st_smob->base, st_scm);
+ 
+  return st_scm;
+}
+
+/* Returns the <gdb:symtab> object in SELF.
+   Throws an exception if SELF is not a <gdb:symtab> object.  */
+
+static SCM
+stscm_get_symtab_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (stscm_is_symtab (self), self, arg_pos, func_name,
+		   symtab_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the symtab smob of SELF.
+   Throws an exception if SELF is not a <gdb:symtab> object.  */
+
+static symtab_smob *
+stscm_get_symtab_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM st_scm = stscm_get_symtab_arg_unsafe (self, arg_pos, func_name);
+  symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (st_scm);
+
+  return st_smob;
+}
+
+/* Return non-zero if symtab ST_SMOB is valid.  */
+
+static int
+stscm_is_valid (symtab_smob *st_smob)
+{
+  return st_smob->symtab != NULL;
+}
+
+/* Throw a Scheme error if SELF is not a valid symtab smob.
+   Otherwise return a pointer to the symtab_smob object.  */
+
+static symtab_smob *
+stscm_get_valid_symtab_smob_arg_unsafe (SCM self, int arg_pos,
+					const char *func_name)
+{
+  symtab_smob *st_smob
+    = stscm_get_symtab_smob_arg_unsafe (self, arg_pos, func_name);
+
+  if (!stscm_is_valid (st_smob))
+    {
+      gdbscm_invalid_object_error (func_name, arg_pos, self,
+				   _("<gdb:symtab>"));
+    }
+
+  return st_smob;
+}
+
+/* Helper function for stscm_del_objfile_symtabs to mark the symtab
+   as invalid.  */
+
+static int
+stscm_mark_symtab_invalid (void **slot, void *info)
+{
+  symtab_smob *st_smob = (symtab_smob *) *slot;
+
+  st_smob->symtab = NULL;
+  return 1;
+}
+
+/* This function is called when an objfile is about to be freed.
+   Invalidate the symbol table as further actions on the symbol table
+   would result in bad data.  All access to st_smob->symtab should be
+   gated by stscm_get_valid_symtab_smob_arg_unsafe which will raise an
+   exception on invalid symbol tables.  */
+
+static void
+stscm_del_objfile_symtabs (struct objfile *objfile, void *datum)
+{
+  htab_t htab = datum;
+
+  if (htab != NULL)
+    {
+      htab_traverse_noresize (htab, stscm_mark_symtab_invalid, NULL);
+      htab_delete (htab);
+    }
+}
+
+/* Symbol table methods.  */
+
+/* (symtab-valid? <gdb:symtab>) -> boolean
+   Returns #t if SELF still exists in GDB.  */
+
+static SCM
+gdbscm_symtab_valid_p (SCM self)
+{
+  symtab_smob *st_smob
+    = stscm_get_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (stscm_is_valid (st_smob));
+}
+
+/* (symtab-filename <gdb:symtab>) -> string */
+
+static SCM
+gdbscm_symtab_filename (SCM self)
+{
+  symtab_smob *st_smob
+    = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct symtab *symtab = st_smob->symtab;
+
+  return gdbscm_scm_from_c_string (symtab_to_filename_for_display (symtab));
+}
+
+/* (symtab-fullname <gdb:symtab>) -> string */
+
+static SCM
+gdbscm_symtab_fullname (SCM self)
+{
+  symtab_smob *st_smob
+    = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct symtab *symtab = st_smob->symtab;
+
+  return gdbscm_scm_from_c_string (symtab_to_fullname (symtab));
+}
+
+/* (symtab-objfile <gdb:symtab>) -> <gdb:objfile> */
+
+static SCM
+gdbscm_symtab_objfile (SCM self)
+{
+  symtab_smob *st_smob
+    = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symtab *symtab = st_smob->symtab;
+
+  return ofscm_scm_from_objfile (symtab->objfile);
+}
+
+/* (symtab-global-block <gdb:symtab>) -> <gdb:block>
+   Return the GLOBAL_BLOCK of the underlying symtab.  */
+
+static SCM
+gdbscm_symtab_global_block (SCM self)
+{
+  symtab_smob *st_smob
+    = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symtab *symtab = st_smob->symtab;
+  const struct blockvector *blockvector;
+  const struct block *block;
+
+  blockvector = BLOCKVECTOR (symtab);
+  block = BLOCKVECTOR_BLOCK (blockvector, GLOBAL_BLOCK);
+
+  return bkscm_scm_from_block (block, symtab->objfile);
+}
+
+/* (symtab-static-block <gdb:symtab>) -> <gdb:block>
+   Return the STATIC_BLOCK of the underlying symtab.  */
+
+static SCM
+gdbscm_symtab_static_block (SCM self)
+{
+  symtab_smob *st_smob
+    = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  const struct symtab *symtab = st_smob->symtab;
+  const struct blockvector *blockvector;
+  const struct block *block;
+
+  blockvector = BLOCKVECTOR (symtab);
+  block = BLOCKVECTOR_BLOCK (blockvector, STATIC_BLOCK);
+
+  return bkscm_scm_from_block (block, symtab->objfile);
+}
+
+/* Administrivia for sal (symtab-and-line) smobs.  */
+
+/* The smob "mark" function for <gdb:sal>.  */
+
+static SCM
+stscm_mark_sal_smob (SCM self)
+{
+  sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (s_smob->symtab_scm);
+
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&s_smob->base);
+}
+
+/* The smob "free" function for <gdb:sal>.  */
+
+static size_t
+stscm_free_sal_smob (SCM self)
+{
+  sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (self);
+
+  /* Not necessary, done to catch bugs.  */
+  s_smob->symtab_scm = SCM_UNDEFINED;
+
+  return 0;
+}
+
+/* The smob "print" function for <gdb:sal>.  */
+
+static int
+stscm_print_sal_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (self);
+  symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (s_smob->symtab_scm);
+
+  gdbscm_printf (port, "#<%s ", symtab_smob_name);
+  scm_write (s_smob->symtab_scm, port);
+  if (s_smob->sal.line != 0)
+    gdbscm_printf (port, " line %d", s_smob->sal.line);
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:sal> object.  */
+
+static SCM
+stscm_make_sal_smob (void)
+{
+  sal_smob *s_smob
+    = (sal_smob *) scm_gc_malloc (sizeof (sal_smob), sal_smob_name);
+  SCM s_scm;
+
+  s_smob->symtab_scm = SCM_BOOL_F;
+  memset (&s_smob->sal, 0, sizeof (s_smob->sal));
+  s_scm = scm_new_smob (sal_smob_tag, (scm_t_bits) s_smob);
+  gdbscm_init_gsmob (&s_smob->base);
+
+  return s_scm;
+}
+
+/* Return non-zero if SCM is a <gdb:sal> object.  */
+
+static int
+stscm_is_sal (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (sal_smob_tag, scm);
+}
+
+/* (sal? object) -> boolean */
+
+static SCM
+gdbscm_sal_p (SCM scm)
+{
+  return scm_from_bool (stscm_is_sal (scm));
+}
+
+/* Create a new <gdb:sal> object that encapsulates SAL.  */
+
+SCM
+stscm_scm_from_sal (struct symtab_and_line sal)
+{
+  SCM st_scm, s_scm;
+  sal_smob *s_smob;
+
+  st_scm = SCM_BOOL_F;
+  if (sal.symtab != NULL)
+    st_scm = stscm_scm_from_symtab (sal.symtab);
+
+  s_scm = stscm_make_sal_smob ();
+  s_smob = (sal_smob *) SCM_SMOB_DATA (s_scm);
+  s_smob->symtab_scm = st_scm;
+  s_smob->sal = sal;
+
+  return s_scm;
+}
+
+/* Returns the <gdb:sal> object in SELF.
+   Throws an exception if SELF is not a <gdb:sal> object.  */
+
+static SCM
+stscm_get_sal_arg (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (stscm_is_sal (self), self, arg_pos, func_name,
+		   sal_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the sal smob of SELF.
+   Throws an exception if SELF is not a <gdb:sal> object.  */
+
+static sal_smob *
+stscm_get_sal_smob_arg (SCM self, int arg_pos, const char *func_name)
+{
+  SCM s_scm = stscm_get_sal_arg (self, arg_pos, func_name);
+  sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (s_scm);
+
+  return s_smob;
+}
+
+/* Return non-zero if the symtab in S_SMOB is valid.  */
+
+static int
+stscm_sal_is_valid (sal_smob *s_smob)
+{
+  symtab_smob *st_smob;
+
+  /* If there's no symtab that's ok, the sal is still valid.  */
+  if (gdbscm_is_false (s_smob->symtab_scm))
+    return 1;
+
+  st_smob = (symtab_smob *) SCM_SMOB_DATA (s_smob->symtab_scm);
+
+  return st_smob->symtab != NULL;
+}
+
+/* Throw a Scheme error if SELF is not a valid sal smob.
+   Otherwise return a pointer to the sal_smob object.  */
+
+static sal_smob *
+stscm_get_valid_sal_smob_arg (SCM self, int arg_pos, const char *func_name)
+{
+  sal_smob *s_smob = stscm_get_sal_smob_arg (self, arg_pos, func_name);
+
+  if (!stscm_sal_is_valid (s_smob))
+    {
+      gdbscm_invalid_object_error (func_name, arg_pos, self,
+				   _("<gdb:sal>"));
+    }
+
+  return s_smob;
+}
+
+/* sal methods */
+
+/* (sal-valid? <gdb:sal>) -> boolean
+   Returns #t if the symtab for SELF still exists in GDB.  */
+
+static SCM
+gdbscm_sal_valid_p (SCM self)
+{
+  sal_smob *s_smob = stscm_get_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (stscm_sal_is_valid (s_smob));
+}
+
+/* (sal-pc <gdb:sal>) -> address */
+
+static SCM
+gdbscm_sal_pc (SCM self)
+{
+  sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
+  const struct symtab_and_line *sal = &s_smob->sal;
+
+  return gdbscm_scm_from_ulongest (sal->pc);
+}
+
+/* (sal-last <gdb:sal>) -> address
+   Returns #f if no ending address is recorded.  */
+
+static SCM
+gdbscm_sal_last (SCM self)
+{
+  sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
+  const struct symtab_and_line *sal = &s_smob->sal;
+
+  if (sal->end > 0)
+    return gdbscm_scm_from_ulongest (sal->end - 1);
+  return SCM_BOOL_F;
+}
+
+/* (sal-line <gdb:sal>) -> integer
+   Returns #f if no line number is recorded.  */
+
+static SCM
+gdbscm_sal_line (SCM self)
+{
+  sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
+  const struct symtab_and_line *sal = &s_smob->sal;
+
+  if (sal->line > 0)
+    return scm_from_int (sal->line);
+  return SCM_BOOL_F;
+}
+
+/* (sal-symtab <gdb:sal>) -> <gdb:symtab>
+   Returns #f if no symtab is recorded.  */
+
+static SCM
+gdbscm_sal_symtab (SCM self)
+{
+  sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
+  const struct symtab_and_line *sal = &s_smob->sal;
+
+  return s_smob->symtab_scm;
+}
+
+/* (find-pc-line address) -> <gdb:sal> */
+
+static SCM
+gdbscm_find_pc_line (SCM pc_scm)
+{
+  ULONGEST pc_ull;
+  struct symtab_and_line sal;
+  volatile struct gdb_exception except;
+
+  init_sal (&sal); /* -Wall */
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc_ull);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      CORE_ADDR pc = (CORE_ADDR) pc_ull;
+
+      sal = find_pc_line (pc, 0);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return stscm_scm_from_sal (sal);
+}
+
+/* Initialize the Scheme symbol support.  */
+
+static const scheme_function symtab_functions[] =
+{
+  { "symtab?", 1, 0, 0, gdbscm_symtab_p,
+    "\
+Return #t if the object is a <gdb:symtab> object." },
+
+  { "symtab-valid?", 1, 0, 0, gdbscm_symtab_valid_p,
+    "\
+Return #t if the symtab still exists in GDB.\n\
+Symtabs are deleted when the corresponding objfile is freed." },
+
+  { "symtab-filename", 1, 0, 0, gdbscm_symtab_filename,
+    "\
+Return the symtab's source file name." },
+
+  { "symtab-fullname", 1, 0, 0, gdbscm_symtab_fullname,
+    "\
+Return the symtab's full source file name." },
+
+  { "symtab-objfile", 1, 0, 0, gdbscm_symtab_objfile,
+    "\
+Return the symtab's objfile." },
+
+  { "symtab-global-block", 1, 0, 0, gdbscm_symtab_global_block,
+    "\
+Return the symtab's global block." },
+
+  { "symtab-static-block", 1, 0, 0, gdbscm_symtab_static_block,
+    "\
+Return the symtab's static block." },
+
+  { "sal?", 1, 0, 0, gdbscm_sal_p,
+    "\
+Return #t if the object is a <gdb:sal> (symtab-and-line) object." },
+
+  { "sal-valid?", 1, 0, 0, gdbscm_sal_valid_p,
+    "\
+Return #t if the symtab for the sal still exists in GDB.\n\
+Symtabs are deleted when the corresponding objfile is freed." },
+
+  { "sal-symtab", 1, 0, 0, gdbscm_sal_symtab,
+    "\
+Return the sal's symtab." },
+
+  { "sal-line", 1, 0, 0, gdbscm_sal_line,
+    "\
+Return the sal's line number, or #f if there is none." },
+
+  { "sal-pc", 1, 0, 0, gdbscm_sal_pc,
+    "\
+Return the sal's address." },
+
+  { "sal-last", 1, 0, 0, gdbscm_sal_last,
+    "\
+Return the last address specified by the sal, or #f if there is none." },
+
+  { "find-pc-line", 1, 0, 0, gdbscm_find_pc_line,
+    "\
+Return the sal corresponding to the address, or #f if there isn't one.\n\
+\n\
+  Arguments: address" },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_symtabs (void)
+{
+  symtab_smob_tag
+    = gdbscm_make_smob_type (symtab_smob_name, sizeof (symtab_smob));
+  scm_set_smob_mark (symtab_smob_tag, stscm_mark_symtab_smob);
+  scm_set_smob_free (symtab_smob_tag, stscm_free_symtab_smob);
+  scm_set_smob_print (symtab_smob_tag, stscm_print_symtab_smob);
+
+  sal_smob_tag = gdbscm_make_smob_type (sal_smob_name, sizeof (sal_smob));
+  scm_set_smob_mark (sal_smob_tag, stscm_mark_sal_smob);
+  scm_set_smob_free (sal_smob_tag, stscm_free_sal_smob);
+  scm_set_smob_print (sal_smob_tag, stscm_print_sal_smob);
+
+  gdbscm_define_functions (symtab_functions, 1);
+
+  /* Register an objfile "free" callback so we can properly
+     invalidate symbol tables, and symbol table and line data
+     structures when an object file that is about to be deleted.  */
+  stscm_objfile_data_key
+    = register_objfile_data_with_cleanup (NULL, stscm_del_objfile_symtabs);
+}
diff --git a/gdb/guile/scm-type.c b/gdb/guile/scm-type.c
new file mode 100644
index 0000000..36cba79
--- /dev/null
+++ b/gdb/guile/scm-type.c
@@ -0,0 +1,1495 @@
+/* Scheme interface to types.
+
+   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 "value.h"
+#include "exceptions.h"
+#include "gdbtypes.h"
+#include "objfiles.h"
+#include "language.h"
+#include "vec.h"
+#include "bcache.h"
+#include "dwarf2loc.h"
+#include "typeprint.h"
+#include "guile-internal.h"
+
+/* The <gdb:type> smob.
+   The type is chained with all types associated with its objfile, if any.
+   This lets us copy the underlying struct type when the objfile is
+   deleted.  */
+
+typedef struct _type_smob
+{
+  /* This always appears first.
+     eqable_gdb_smob is used so that types are eq?-able.
+     Also, a type object can be associated with an objfile.  eqable_gdb_smob
+     lets us track the lifetime of all types associated with an objfile.
+     When an objfile is deleted we need to invalidate the type object.  */
+  eqable_gdb_smob base;
+
+  /* The GDB type structure this smob is wrapping.  */
+  struct type *type;
+} type_smob;
+
+/* A field smob.  */
+
+typedef struct
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* Backlink to the containing <gdb:type> object.  */
+  SCM type_scm;
+
+  /* The field number in TYPE_SCM.  */
+  int field_num;
+} field_smob;
+
+static const char type_smob_name[] = "gdb:type";
+static const char field_smob_name[] = "gdb:field";
+
+static const char not_composite_error[] =
+  N_("type is not a structure, union, or enum type");
+
+/* The tag Guile knows the type smob by.  */
+static scm_t_bits type_smob_tag;
+
+/* The tag Guile knows the field smob by.  */
+static scm_t_bits field_smob_tag;
+
+/* The "next" procedure for field iterators.  */
+static SCM tyscm_next_field_x_proc;
+
+/* Keywords used in argument passing.  */
+static SCM block_keyword;
+
+static const struct objfile_data *tyscm_objfile_data_key;
+
+/* Hash table to uniquify global (non-objfile-owned) types.  */
+static htab_t global_types_map;
+
+static struct type *tyscm_get_composite (struct type *type);
+
+/* Return the type field of T_SMOB.
+   This exists so that we don't have to export the struct's contents.  */
+
+struct type *
+tyscm_type_smob_type (type_smob *t_smob)
+{
+  return t_smob->type;
+}
+
+/* Return the name of TYPE in expanded form.
+   Space for the result is malloc'd, caller must free.
+   If there's an error computing the name, the result is NULL and the
+   exception is stored in *EXCP.  */
+
+static char *
+tyscm_type_name (struct type *type, SCM *excp)
+{
+  char *name = NULL;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct cleanup *old_chain;
+      struct ui_file *stb;
+
+      stb = mem_fileopen ();
+      old_chain = make_cleanup_ui_file_delete (stb);
+
+      LA_PRINT_TYPE (type, "", stb, -1, 0, &type_print_raw_options);
+
+      name = ui_file_xstrdup (stb, NULL);
+      do_cleanups (old_chain);
+    }
+  if (except.reason < 0)
+    {
+      *excp = gdbscm_scm_from_gdb_exception (except);
+      return NULL;
+    }
+
+  return name;
+}
+
+/* Administrivia for type smobs.  */
+
+/* Helper function to hash a type_smob.  */
+
+static hashval_t
+tyscm_hash_type_smob (const void *p)
+{
+  const type_smob *t_smob = p;
+
+  return htab_hash_pointer (t_smob->type);
+}
+
+/* Helper function to compute equality of type_smobs.  */
+
+static int
+tyscm_eq_type_smob (const void *ap, const void *bp)
+{
+  const type_smob *a = ap;
+  const type_smob *b = bp;
+
+  return (a->type == b->type
+	  && a->type != NULL);
+}
+
+/* Return the struct type pointer -> SCM mapping table.
+   If type is owned by an objfile, the mapping table is created if necessary.
+   Otherwise, type is not owned by an objfile, and we use
+   global_types_map.  */
+
+static htab_t
+tyscm_type_map (struct type *type)
+{
+  struct objfile *objfile = TYPE_OBJFILE (type);
+  htab_t htab;
+
+  if (objfile == NULL)
+    return global_types_map;
+
+  htab = objfile_data (objfile, tyscm_objfile_data_key);
+  if (htab == NULL)
+    {
+      htab = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob,
+						 tyscm_eq_type_smob);
+      set_objfile_data (objfile, tyscm_objfile_data_key, htab);
+    }
+
+  return htab;
+}
+
+/* The smob "mark" function for <gdb:type>.  */
+
+static SCM
+tyscm_mark_type_smob (SCM self)
+{
+  type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self);
+
+  /* Do this last.  */
+  return gdbscm_mark_eqable_gsmob (&t_smob->base);
+}
+
+/* The smob "free" function for <gdb:type>.  */
+
+static size_t
+tyscm_free_type_smob (SCM self)
+{
+  type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self);
+
+  if (t_smob->type != NULL)
+    {
+      htab_t htab = tyscm_type_map (t_smob->type);
+
+      gdbscm_clear_eqable_gsmob_ptr_slot (htab, &t_smob->base);
+    }
+
+  /* Not necessary, done to catch bugs.  */
+  t_smob->type = NULL;
+
+  return 0;
+}
+
+/* The smob "print" function for <gdb:type>.  */
+
+static int
+tyscm_print_type_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self);
+  SCM exception;
+  char *name = tyscm_type_name (t_smob->type, &exception);
+
+  if (name == NULL)
+    gdbscm_throw (exception);
+
+  /* pstate->writingp = zero if invoked by display/~A, and nonzero if
+     invoked by write/~S.  What to do here may need to evolve.
+     IWBN if we could pass an argument to format that would we could use
+     instead of writingp.  */
+  if (pstate->writingp)
+    gdbscm_printf (port, "#<%s ", type_smob_name);
+
+  scm_puts (name, port);
+
+  if (pstate->writingp)
+    scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* The smob "equal?" function for <gdb:type>.  */
+
+static SCM
+tyscm_equal_p_type_smob (SCM type1_scm, SCM type2_scm)
+{
+  type_smob *type1_smob, *type2_smob;
+  struct type *type1, *type2;
+  int result = 0;
+  volatile struct gdb_exception except;
+
+  SCM_ASSERT_TYPE (tyscm_is_type (type1_scm), type1_scm, SCM_ARG1, FUNC_NAME,
+		   type_smob_name);
+  SCM_ASSERT_TYPE (tyscm_is_type (type2_scm), type2_scm, SCM_ARG2, FUNC_NAME,
+		   type_smob_name);
+  type1_smob = (type_smob *) SCM_SMOB_DATA (type1_scm);
+  type2_smob = (type_smob *) SCM_SMOB_DATA (type2_scm);
+  type1 = type1_smob->type;
+  type2 = type2_smob->type;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      result = types_deeply_equal (type1, type2);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return scm_from_bool (result);
+}
+
+/* Low level routine to create a <gdb:type> object.  */
+
+static SCM
+tyscm_make_type_smob (void)
+{
+  type_smob *t_smob = (type_smob *)
+    scm_gc_malloc (sizeof (type_smob), type_smob_name);
+  SCM t_scm;
+
+  /* This must be filled in by the caller.  */
+  t_smob->type = NULL;
+
+  t_scm = scm_new_smob (type_smob_tag, (scm_t_bits) t_smob);
+  gdbscm_init_eqable_gsmob (&t_smob->base);
+
+  return t_scm;
+}
+
+/* Return non-zero if SCM is a <gdb:type> object.  */
+
+int
+tyscm_is_type (SCM self)
+{
+  return SCM_SMOB_PREDICATE (type_smob_tag, self);
+}
+
+/* (type? object) -> boolean */
+
+static SCM
+gdbscm_type_p (SCM self)
+{
+  return scm_from_bool (tyscm_is_type (self));
+}
+
+/* Return the existing object that encapsulates TYPE, or create a new
+   <gdb:type> object.  */
+
+SCM
+tyscm_scm_from_type (struct type *type)
+{
+  htab_t htab;
+  eqable_gdb_smob **slot;
+  type_smob *t_smob, t_smob_for_lookup;
+  SCM t_scm;
+
+  /* If we've already created a gsmob for this type, return it.
+     This makes types eq?-able.  */
+  htab = tyscm_type_map (type);
+  t_smob_for_lookup.type = type;
+  slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &t_smob_for_lookup.base);
+  if (*slot != NULL)
+    return (*slot)->containing_scm;
+
+  t_scm = tyscm_make_type_smob ();
+  t_smob = (type_smob *) SCM_SMOB_DATA (t_scm);
+  t_smob->type = type;
+  gdbscm_fill_eqable_gsmob_ptr_slot (slot, &t_smob->base, t_scm);
+
+  return t_scm;
+}
+
+/* Returns the <gdb:type> object in SELF.
+   Throws an exception if SELF is not a <gdb:type> object.  */
+
+static SCM
+tyscm_get_type_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (tyscm_is_type (self), self, arg_pos, func_name,
+		   type_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the type smob of SELF.
+   Throws an exception if SELF is not a <gdb:type> object.  */
+
+type_smob *
+tyscm_get_type_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM t_scm = tyscm_get_type_arg_unsafe (self, arg_pos, func_name);
+  type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (t_scm);
+
+  return t_smob;
+}
+
+/* Helper function for save_objfile_types to make a deep copy of the type.  */
+
+static int
+tyscm_copy_type_recursive (void **slot, void *info)
+{
+  type_smob *t_smob = (type_smob *) *slot;
+  htab_t copied_types = info;
+  struct objfile *objfile = TYPE_OBJFILE (t_smob->type);
+
+  gdb_assert (objfile != NULL);
+
+  htab_empty (copied_types);
+  t_smob->type = copy_type_recursive (objfile, t_smob->type, copied_types);
+  return 1;
+}
+
+/* Called when OBJFILE is about to be deleted.
+   Make a copy of all types associated with OBJFILE.  */
+
+static void
+save_objfile_types (struct objfile *objfile, void *datum)
+{
+  htab_t htab = datum;
+  htab_t copied_types;
+
+  if (!gdb_scheme_initialized)
+    return;
+
+  copied_types = create_copied_types_hash (objfile);
+
+  if (htab != NULL)
+    {
+      htab_traverse_noresize (htab, tyscm_copy_type_recursive, copied_types);
+      htab_delete (htab);
+    }
+
+  htab_delete (copied_types);
+}
+
+/* Administrivia for field smobs.  */
+
+/* The smob "mark" function for <gdb:field>.  */
+
+static SCM
+tyscm_mark_field_smob (SCM self)
+{
+  field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (f_smob->type_scm);
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&f_smob->base);
+}
+
+/* The smob "print" function for <gdb:field>.  */
+
+static int
+tyscm_print_field_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s ", field_smob_name);
+  scm_write (f_smob->type_scm, port);
+  gdbscm_printf (port, " %d", f_smob->field_num);
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:field> object for field FIELD_NUM
+   of type TYPE_SCM.  */
+
+static SCM
+tyscm_make_field_smob (SCM type_scm, int field_num)
+{
+  field_smob *f_smob = (field_smob *)
+    scm_gc_malloc (sizeof (field_smob), field_smob_name);
+  SCM result;
+
+  f_smob->type_scm = type_scm;
+  f_smob->field_num = field_num;
+  result = scm_new_smob (field_smob_tag, (scm_t_bits) f_smob);
+  gdbscm_init_gsmob (&f_smob->base);
+
+  return result;
+}
+
+/* Return non-zero if SCM is a <gdb:field> object.  */
+
+static int
+tyscm_is_field (SCM self)
+{
+  return SCM_SMOB_PREDICATE (field_smob_tag, self);
+}
+
+/* (field? object) -> boolean */
+
+static SCM
+gdbscm_field_p (SCM self)
+{
+  return scm_from_bool (tyscm_is_field (self));
+}
+
+/* Create a new <gdb:field> object that encapsulates field FIELD_NUM
+   in type TYPE_SCM.  */
+
+SCM
+tyscm_scm_from_field (SCM type_scm, int field_num)
+{
+  return tyscm_make_field_smob (type_scm, field_num);
+}
+
+/* Returns the <gdb:field> object in SELF.
+   Throws an exception if SELF is not a <gdb:field> object.  */
+
+static SCM
+tyscm_get_field_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (tyscm_is_field (self), self, arg_pos, func_name,
+		   field_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the field smob of SELF.
+   Throws an exception if SELF is not a <gdb:field> object.  */
+
+static field_smob *
+tyscm_get_field_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM f_scm = tyscm_get_field_arg_unsafe (self, arg_pos, func_name);
+  field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (f_scm);
+
+  return f_smob;
+}
+
+/* Returns a pointer to the type struct in F_SMOB
+   (the type the field is in).  */
+
+static struct type *
+tyscm_field_smob_containing_type (field_smob *f_smob)
+{
+  type_smob *t_smob;
+
+  gdb_assert (tyscm_is_type (f_smob->type_scm));
+  t_smob = (type_smob *) SCM_SMOB_DATA (f_smob->type_scm);
+
+  return t_smob->type;
+}
+
+/* Returns a pointer to the field struct of F_SMOB.  */
+
+static struct field *
+tyscm_field_smob_to_field (field_smob *f_smob)
+{
+  struct type *type = tyscm_field_smob_containing_type (f_smob);
+
+  /* This should be non-NULL by construction.  */
+  gdb_assert (TYPE_FIELDS (type) != NULL);
+
+  return &TYPE_FIELD (type, f_smob->field_num);
+}
+
+/* Type smob accessors.  */
+
+/* (type-code <gdb:type>) -> integer
+   Return the code for this type.  */
+
+static SCM
+gdbscm_type_code (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+
+  return scm_from_int (TYPE_CODE (type));
+}
+
+/* (type-fields <gdb:type>) -> list
+   Return a list of all fields.  Each element is a <gdb:field> object.
+   This also supports arrays, we return a field list of one element,
+   the range type.  */
+
+static SCM
+gdbscm_type_fields (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  struct type *containing_type;
+  SCM containing_type_scm, result;
+  int i;
+
+  containing_type = tyscm_get_composite (type);
+  if (containing_type == NULL)
+    gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
+			       _(not_composite_error));
+
+  /* If SELF is a typedef or reference, we want the underlying type,
+     which is what tyscm_get_composite returns.  */
+  if (containing_type == type)
+    containing_type_scm = self;
+  else
+    containing_type_scm = tyscm_scm_from_type (containing_type);
+
+  result = SCM_EOL;
+  for (i = 0; i < TYPE_NFIELDS (containing_type); ++i)
+    result = scm_cons (tyscm_make_field_smob (containing_type_scm, i), result);
+
+  return scm_reverse_x (result, SCM_EOL);
+}
+
+/* (type-tag <gdb:type>) -> string
+   Return the type's tag, or #f.  */
+
+static SCM
+gdbscm_type_tag (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+
+  if (!TYPE_TAG_NAME (type))
+    return SCM_BOOL_F;
+  return gdbscm_scm_from_c_string (TYPE_TAG_NAME (type));
+}
+
+/* (type-name <gdb:type>) -> string
+   Return the type's name, or #f.  */
+
+static SCM
+gdbscm_type_name (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+
+  if (!TYPE_NAME (type))
+    return SCM_BOOL_F;
+  return gdbscm_scm_from_c_string (TYPE_NAME (type));
+}
+
+/* (type-print-name <gdb:type>) -> string
+   Return the print name of type.
+   TODO: template support elided for now.  */
+
+static SCM
+gdbscm_type_print_name (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  char *thetype;
+  SCM exception, result;
+
+  thetype = tyscm_type_name (type, &exception);
+
+  if (thetype == NULL)
+    gdbscm_throw (exception);
+
+  result = gdbscm_scm_from_c_string (thetype);
+  xfree (thetype);
+
+  return result;
+}
+
+/* (type-sizeof <gdb:type>) -> integer
+   Return the size of the type represented by SELF, in bytes.  */
+
+static SCM
+gdbscm_type_sizeof (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      check_typedef (type);
+    }
+  /* Ignore exceptions.  */
+
+  return scm_from_long (TYPE_LENGTH (type));
+}
+
+/* (type-strip-typedefs <gdb:type>) -> <gdb:type>
+   Return the type, stripped of typedefs. */
+
+static SCM
+gdbscm_type_strip_typedefs (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      type = check_typedef (type);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return tyscm_scm_from_type (type);
+}
+
+/* Strip typedefs and pointers/reference from a type.  Then check that
+   it is a struct, union, or enum type.  If not, return NULL.  */
+
+static struct type *
+tyscm_get_composite (struct type *type)
+{
+  volatile struct gdb_exception except;
+
+  for (;;)
+    {
+      TRY_CATCH (except, RETURN_MASK_ALL)
+	{
+	  type = check_typedef (type);
+	}
+      GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+      if (TYPE_CODE (type) != TYPE_CODE_PTR
+	  && TYPE_CODE (type) != TYPE_CODE_REF)
+	break;
+      type = TYPE_TARGET_TYPE (type);
+    }
+
+  /* If this is not a struct, union, or enum type, raise TypeError
+     exception.  */
+  if (TYPE_CODE (type) != TYPE_CODE_STRUCT
+      && TYPE_CODE (type) != TYPE_CODE_UNION
+      && TYPE_CODE (type) != TYPE_CODE_ENUM)
+    return NULL;
+
+  return type;
+}
+
+/* Helper for tyscm_array and tyscm_vector.  */
+
+static SCM
+tyscm_array_1 (SCM self, SCM n1_scm, SCM n2_scm, int is_vector,
+	       const char *func_name)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, func_name);
+  struct type *type = t_smob->type;
+  long n1, n2 = 0;
+  struct type *array = NULL;
+  volatile struct gdb_exception except;
+
+  gdbscm_parse_function_args (func_name, SCM_ARG2, NULL, "l|l",
+			      n1_scm, &n1, n2_scm, &n2);
+
+  if (SCM_UNBNDP (n2_scm))
+    {
+      n2 = n1;
+      n1 = 0;
+    }
+
+  if (n2 < n1)
+    {
+      gdbscm_out_of_range_error (func_name, SCM_ARG3,
+				 scm_cons (scm_from_long (n1),
+					   scm_from_long (n2)),
+				 _("Array length must not be negative"));
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      array = lookup_array_range_type (type, n1, n2);
+      if (is_vector)
+	make_vector_type (array);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return tyscm_scm_from_type (array);
+}
+
+/* (type-array <gdb:type> [low-bound] high-bound) -> <gdb:type>
+   The array has indices [low-bound,high-bound].
+   If low-bound is not provided zero is used.
+   Return an array type.
+
+   IWBN if the one argument version specified a size, not the high bound.
+   It's too easy to pass one argument thinking it is the size of the array.
+   The current semantics are for compatibility with the Python version.
+   Later we can add #:size.  */
+
+static SCM
+gdbscm_type_array (SCM self, SCM n1, SCM n2)
+{
+  return tyscm_array_1 (self, n1, n2, 0, FUNC_NAME);
+}
+
+/* (type-vector <gdb:type> [low-bound] high-bound) -> <gdb:type>
+   The array has indices [low-bound,high-bound].
+   If low-bound is not provided zero is used.
+   Return a vector type.
+
+   IWBN if the one argument version specified a size, not the high bound.
+   It's too easy to pass one argument thinking it is the size of the array.
+   The current semantics are for compatibility with the Python version.
+   Later we can add #:size.  */
+
+static SCM
+gdbscm_type_vector (SCM self, SCM n1, SCM n2)
+{
+  return tyscm_array_1 (self, n1, n2, 1, FUNC_NAME);
+}
+
+/* (type-pointer <gdb:type>) -> <gdb:type>
+   Return a <gdb:type> object which represents a pointer to SELF.  */
+
+static SCM
+gdbscm_type_pointer (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      type = lookup_pointer_type (type);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (type-range <gdb:type>) -> (low high)
+   Return the range of a type represented by SELF.  The return type is
+   a list.  The first element is the low bound, and the second element
+   is the high bound.  */
+
+static SCM
+gdbscm_type_range (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  SCM low_scm, high_scm;
+  /* Initialize these to appease GCC warnings.  */
+  LONGEST low = 0, high = 0;
+
+  SCM_ASSERT_TYPE (TYPE_CODE (type) == TYPE_CODE_ARRAY
+		   || TYPE_CODE (type) == TYPE_CODE_STRING
+		   || TYPE_CODE (type) == TYPE_CODE_RANGE,
+		   self, SCM_ARG1, FUNC_NAME, _("ranged type"));
+
+  switch (TYPE_CODE (type))
+    {
+    case TYPE_CODE_ARRAY:
+    case TYPE_CODE_STRING:
+      low = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (type));
+      high = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (type));
+      break;
+    case TYPE_CODE_RANGE:
+      low = TYPE_LOW_BOUND (type);
+      high = TYPE_HIGH_BOUND (type);
+      break;
+    }
+
+  low_scm = gdbscm_scm_from_longest (low);
+  high_scm = gdbscm_scm_from_longest (high);
+
+  return scm_list_2 (low_scm, high_scm);
+}
+
+/* (type-reference <gdb:type>) -> <gdb:type>
+   Return a <gdb:type> object which represents a reference to SELF.  */
+
+static SCM
+gdbscm_type_reference (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      type = lookup_reference_type (type);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (type-target <gdb:type>) -> <gdb:type>
+   Return a <gdb:type> object which represents the target type of SELF.  */
+
+static SCM
+gdbscm_type_target (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+
+  SCM_ASSERT (TYPE_TARGET_TYPE (type), self, SCM_ARG1, FUNC_NAME);
+
+  return tyscm_scm_from_type (TYPE_TARGET_TYPE (type));
+}
+
+/* (type-const <gdb:type>) -> <gdb:type>
+   Return a const-qualified type variant.  */
+
+static SCM
+gdbscm_type_const (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      type = make_cv_type (1, 0, type, NULL);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (type-volatile <gdb:type>) -> <gdb:type>
+   Return a volatile-qualified type variant.  */
+
+static SCM
+gdbscm_type_volatile (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      type = make_cv_type (0, 1, type, NULL);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return tyscm_scm_from_type (type);
+}
+
+/* (type-unqualified <gdb:type>) -> <gdb:type>
+   Return an unqualified type variant.  */
+
+static SCM
+gdbscm_type_unqualified (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      type = make_cv_type (0, 0, type, NULL);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return tyscm_scm_from_type (type);
+}
+
+/* Field related accessors of types.  */
+
+/* (type-num-fields <gdb:type>) -> integer
+   Return number of fields.  */
+
+static SCM
+gdbscm_type_num_fields (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+
+  type = tyscm_get_composite (type);
+  if (type == NULL)
+    gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
+			       _(not_composite_error));
+
+  return scm_from_long (TYPE_NFIELDS (type));
+}
+
+/* (type-field <gdb:type> string) -> <gdb:field>
+   Return the <gdb:field> object for the field named by the argument.  */
+
+static SCM
+gdbscm_type_field (SCM self, SCM field_scm)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  char *field;
+  int i;
+  struct cleanup *cleanups;
+
+  SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
+		   _("string"));
+
+  /* We want just fields of this type, not of base types, so instead of
+     using lookup_struct_elt_type, portions of that function are
+     copied here.  */
+
+  type = tyscm_get_composite (type);
+  if (type == NULL)
+    gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
+			       _(not_composite_error));
+
+  field = gdbscm_scm_to_c_string (field_scm);
+  cleanups = make_cleanup (xfree, field);
+
+  for (i = 0; i < TYPE_NFIELDS (type); i++)
+    {
+      const char *t_field_name = TYPE_FIELD_NAME (type, i);
+
+      if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
+	{
+	    do_cleanups (cleanups);
+	    return tyscm_make_field_smob (self, i);
+	}
+    }
+
+  do_cleanups (cleanups);
+
+  gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, field_scm,
+			     _("Unknown field"));
+}
+
+/* (type-has-field? <gdb:type> string) -> boolean
+   Return boolean indicating if type SELF has FIELD_SCM (a string).  */
+
+static SCM
+gdbscm_type_has_field_p (SCM self, SCM field_scm)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  char *field;
+  int i;
+  struct cleanup *cleanups;
+
+  SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
+		   _("string"));
+
+  /* We want just fields of this type, not of base types, so instead of
+     using lookup_struct_elt_type, portions of that function are
+     copied here.  */
+
+  type = tyscm_get_composite (type);
+  if (type == NULL)
+    gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
+			       _(not_composite_error));
+
+  field = gdbscm_scm_to_c_string (field_scm);
+  cleanups = make_cleanup (xfree, field);
+
+  for (i = 0; i < TYPE_NFIELDS (type); i++)
+    {
+      const char *t_field_name = TYPE_FIELD_NAME (type, i);
+
+      if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
+	{
+	    do_cleanups (cleanups);
+	    return SCM_BOOL_T;
+	}
+    }
+
+  do_cleanups (cleanups);
+
+  return SCM_BOOL_F;
+}
+
+/* (make-field-iterator <gdb:type>) -> <gdb:iterator>
+   Make a field iterator object.  */
+
+static SCM
+gdbscm_make_field_iterator (SCM self)
+{
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct type *type = t_smob->type;
+  struct type *containing_type;
+  SCM containing_type_scm;
+
+  containing_type = tyscm_get_composite (type);
+  if (containing_type == NULL)
+    gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
+			       _(not_composite_error));
+
+  /* If SELF is a typedef or reference, we want the underlying type,
+     which is what tyscm_get_composite returns.  */
+  if (containing_type == type)
+    containing_type_scm = self;
+  else
+    containing_type_scm = tyscm_scm_from_type (containing_type);
+
+  return gdbscm_make_iterator (containing_type_scm, scm_from_int (0),
+			       tyscm_next_field_x_proc);
+}
+
+/* (type-next-field! <gdb:iterator>) -> <gdb:field>
+   Return the next field in the iteration through the list of fields of the
+   type, or (end-of-iteration).
+   SELF is a <gdb:iterator> object created by gdbscm_make_field_iterator.
+   This is the next! <gdb:iterator> function, not exported to the user.  */
+
+static SCM
+gdbscm_type_next_field_x (SCM self)
+{
+  iterator_smob *i_smob;
+  type_smob *t_smob;
+  struct type *type;
+  SCM it_scm, result, progress, object;
+  int field, rc;
+
+  it_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  i_smob = (iterator_smob *) SCM_SMOB_DATA (it_scm);
+  object = itscm_iterator_smob_object (i_smob);
+  progress = itscm_iterator_smob_progress (i_smob);
+
+  SCM_ASSERT_TYPE (tyscm_is_type (object), object,
+		   SCM_ARG1, FUNC_NAME, type_smob_name);
+  t_smob = (type_smob *) SCM_SMOB_DATA (object);
+  type = t_smob->type;
+
+  SCM_ASSERT_TYPE (scm_is_signed_integer (progress,
+					  0, TYPE_NFIELDS (type)),
+		   progress, SCM_ARG1, FUNC_NAME, _("integer"));
+  field = scm_to_int (progress);
+
+  if (field < TYPE_NFIELDS (type))
+    {
+      result = tyscm_make_field_smob (object, field);
+      itscm_set_iterator_smob_progress_x (i_smob, scm_from_int (field + 1));
+      return result;
+    }
+
+  return gdbscm_end_of_iteration ();
+}
+
+/* Field smob accessors.  */
+
+/* (field-name <gdb:field>) -> string
+   Return the name of this field or #f if there isn't one.  */
+
+static SCM
+gdbscm_field_name (SCM self)
+{
+  field_smob *f_smob
+    = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct field *field = tyscm_field_smob_to_field (f_smob);
+
+  if (FIELD_NAME (*field))
+    return gdbscm_scm_from_c_string (FIELD_NAME (*field));
+  return SCM_BOOL_F;
+}
+
+/* (field-type <gdb:field>) -> <gdb:type>
+   Return the <gdb:type> object of the field or #f if there isn't one.  */
+
+static SCM
+gdbscm_field_type (SCM self)
+{
+  field_smob *f_smob
+    = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct field *field = tyscm_field_smob_to_field (f_smob);
+
+  /* A field can have a NULL type in some situations.  */
+  if (FIELD_TYPE (*field))
+    return tyscm_scm_from_type (FIELD_TYPE (*field));
+  return SCM_BOOL_F;
+}
+
+/* (field-enumval <gdb:field>) -> integer
+   For enum values, return its value as an integer.  */
+
+static SCM
+gdbscm_field_enumval (SCM self)
+{
+  field_smob *f_smob
+    = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct field *field = tyscm_field_smob_to_field (f_smob);
+  struct type *type = tyscm_field_smob_containing_type (f_smob);
+
+  SCM_ASSERT_TYPE (TYPE_CODE (type) == TYPE_CODE_ENUM,
+		   self, SCM_ARG1, FUNC_NAME, _("enum type"));
+
+  return scm_from_long (FIELD_ENUMVAL (*field));
+}
+
+/* (field-bitpos <gdb:field>) -> integer
+   For bitfields, return its offset in bits.  */
+
+static SCM
+gdbscm_field_bitpos (SCM self)
+{
+  field_smob *f_smob
+    = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct field *field = tyscm_field_smob_to_field (f_smob);
+  struct type *type = tyscm_field_smob_containing_type (f_smob);
+
+  SCM_ASSERT_TYPE (TYPE_CODE (type) != TYPE_CODE_ENUM,
+		   self, SCM_ARG1, FUNC_NAME, _("non-enum type"));
+
+  return scm_from_long (FIELD_BITPOS (*field));
+}
+
+/* (field-bitsize <gdb:field>) -> integer
+   Return the size of the field in bits.  */
+
+static SCM
+gdbscm_field_bitsize (SCM self)
+{
+  field_smob *f_smob
+    = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct field *field = tyscm_field_smob_to_field (f_smob);
+
+  return scm_from_long (FIELD_BITPOS (*field));
+}
+
+/* (field-artificial? <gdb:field>) -> boolean
+   Return #t if field is artificial.  */
+
+static SCM
+gdbscm_field_artificial_p (SCM self)
+{
+  field_smob *f_smob
+    = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct field *field = tyscm_field_smob_to_field (f_smob);
+
+  return scm_from_bool (FIELD_ARTIFICIAL (*field));
+}
+
+/* (field-baseclass? <gdb:field>) -> boolean
+   Return #t if field is a baseclass.  */
+
+static SCM
+gdbscm_field_baseclass_p (SCM self)
+{
+  field_smob *f_smob
+    = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct field *field = tyscm_field_smob_to_field (f_smob);
+  struct type *type = tyscm_field_smob_containing_type (f_smob);
+
+  if (TYPE_CODE (type) == TYPE_CODE_CLASS)
+    return scm_from_bool (f_smob->field_num < TYPE_N_BASECLASSES (type));
+  return SCM_BOOL_F;
+}
+
+/* Return the type named TYPE_NAME in BLOCK.
+   Returns NULL if not found.
+   This routine does not throw an error.  */
+
+static struct type *
+tyscm_lookup_typename (const char *type_name, const struct block *block)
+{
+  struct type *type = NULL;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (!strncmp (type_name, "struct ", 7))
+	type = lookup_struct (type_name + 7, NULL);
+      else if (!strncmp (type_name, "union ", 6))
+	type = lookup_union (type_name + 6, NULL);
+      else if (!strncmp (type_name, "enum ", 5))
+	type = lookup_enum (type_name + 5, NULL);
+      else
+	type = lookup_typename (current_language, get_current_arch (),
+				type_name, block, 0);
+    }
+  if (except.reason < 0)
+    return NULL;
+
+  return type;
+}
+
+/* (lookup-type name [#:block <gdb:block>]) -> <gdb:type>
+   TODO: legacy template support left out until needed.  */
+
+static SCM
+gdbscm_lookup_type (SCM name_scm, SCM rest)
+{
+  SCM keywords[] = { block_keyword, SCM_BOOL_F };
+  char *name;
+  SCM block_scm = SCM_BOOL_F;
+  int block_arg_pos = -1;
+  const struct block *block = NULL;
+  struct type *type;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#O",
+			      name_scm, &name,
+			      rest, &block_arg_pos, &block_scm);
+
+  if (block_arg_pos != -1)
+    {
+      SCM exception;
+
+      block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
+				  &exception);
+      if (block == NULL)
+	{
+	  xfree (name);
+	  gdbscm_throw (exception);
+	}
+    }
+  type = tyscm_lookup_typename (name, block);
+  xfree (name);
+
+  if (type != NULL)
+    return tyscm_scm_from_type (type);
+  return SCM_BOOL_F;
+}
+
+/* Initialize the Scheme type code.  */
+
+
+static const scheme_integer_constant type_integer_constants[] =
+{
+#define X(SYM) { #SYM, SYM }
+  X (TYPE_CODE_BITSTRING),
+  X (TYPE_CODE_PTR),
+  X (TYPE_CODE_ARRAY),
+  X (TYPE_CODE_STRUCT),
+  X (TYPE_CODE_UNION),
+  X (TYPE_CODE_ENUM),
+  X (TYPE_CODE_FLAGS),
+  X (TYPE_CODE_FUNC),
+  X (TYPE_CODE_INT),
+  X (TYPE_CODE_FLT),
+  X (TYPE_CODE_VOID),
+  X (TYPE_CODE_SET),
+  X (TYPE_CODE_RANGE),
+  X (TYPE_CODE_STRING),
+  X (TYPE_CODE_ERROR),
+  X (TYPE_CODE_METHOD),
+  X (TYPE_CODE_METHODPTR),
+  X (TYPE_CODE_MEMBERPTR),
+  X (TYPE_CODE_REF),
+  X (TYPE_CODE_CHAR),
+  X (TYPE_CODE_BOOL),
+  X (TYPE_CODE_COMPLEX),
+  X (TYPE_CODE_TYPEDEF),
+  X (TYPE_CODE_NAMESPACE),
+  X (TYPE_CODE_DECFLOAT),
+  X (TYPE_CODE_INTERNAL_FUNCTION),
+#undef X
+
+  END_INTEGER_CONSTANTS
+};
+
+static const scheme_function type_functions[] =
+{
+  { "type?", 1, 0, 0, gdbscm_type_p,
+    "\
+Return #t if the object is a <gdb:type> object." },
+
+  { "lookup-type", 1, 0, 1, gdbscm_lookup_type,
+    "\
+Return the <gdb:type> object representing string or #f if not found.\n\
+If block is given then the type is looked for in that block.\n\
+\n\
+  Arguments: string [#:block <gdb:block>]" },
+
+  { "type-code", 1, 0, 0, gdbscm_type_code,
+    "\
+Return the code of the type" },
+
+  { "type-tag", 1, 0, 0, gdbscm_type_tag,
+    "\
+Return the tag name of the type, or #f if there isn't one." },
+
+  { "type-name", 1, 0, 0, gdbscm_type_name,
+    "\
+Return the name of the type as a string, or #f if there isn't one." },
+
+  { "type-print-name", 1, 0, 0, gdbscm_type_print_name,
+    "\
+Return the print name of the type as a string." },
+
+  { "type-sizeof", 1, 0, 0, gdbscm_type_sizeof,
+    "\
+Return the size of the type, in bytes." },
+
+  { "type-strip-typedefs", 1, 0, 0, gdbscm_type_strip_typedefs,
+    "\
+Return a type formed by stripping the type of all typedefs." },
+
+  { "type-array", 2, 1, 0, gdbscm_type_array,
+    "\
+Return a type representing an array of objects of the type.\n\
+\n\
+  Arguments: <gdb:type> [low-bound] high-bound\n\
+    If low-bound is not provided zero is used.\n\
+    N.B. If only the high-bound parameter is specified, it is not\n\
+    the array size.\n\
+    Valid bounds for array indices are [low-bound,high-bound]." },
+
+  { "type-vector", 2, 1, 0, gdbscm_type_vector,
+    "\
+Return a type representing a vector of objects of the type.\n\
+Vectors differ from arrays in that if the current language has C-style\n\
+arrays, vectors don't decay to a pointer to the first element.\n\
+They are first class values.\n\
+\n\
+  Arguments: <gdb:type> [low-bound] high-bound\n\
+    If low-bound is not provided zero is used.\n\
+    N.B. If only the high-bound parameter is specified, it is not\n\
+    the array size.\n\
+    Valid bounds for array indices are [low-bound,high-bound]." },
+
+  { "type-pointer", 1, 0, 0, gdbscm_type_pointer,
+    "\
+Return a type of pointer to the type." },
+
+  { "type-range", 1, 0, 0, gdbscm_type_range,
+    "\
+Return (low high) representing the range for the type." },
+
+  { "type-reference", 1, 0, 0, gdbscm_type_reference,
+    "\
+Return a type of reference to the type." },
+
+  { "type-target", 1, 0, 0, gdbscm_type_target,
+    "\
+Return the target type of the type." },
+
+  { "type-const", 1, 0, 0, gdbscm_type_const,
+    "\
+Return a const variant of the type." },
+
+  { "type-volatile", 1, 0, 0, gdbscm_type_volatile,
+    "\
+Return a volatile variant of the type." },
+
+  { "type-unqualified", 1, 0, 0, gdbscm_type_unqualified,
+    "\
+Return a variant of the type without const or volatile attributes." },
+
+  { "type-num-fields", 1, 0, 0, gdbscm_type_num_fields,
+    "\
+Return the number of fields of the type." },
+
+  { "type-fields", 1, 0, 0, gdbscm_type_fields,
+    "\
+Return the list of <gdb:field> objects of fields of the type." },
+
+  { "make-field-iterator", 1, 0, 0, gdbscm_make_field_iterator,
+    "\
+Return a <gdb:iterator> object for iterating over the fields of the type." },
+
+  { "type-field", 2, 0, 0, gdbscm_type_field,
+    "\
+Return the field named by string of the type.\n\
+\n\
+  Arguments: <gdb:type> string" },
+
+  { "type-has-field?", 2, 0, 0, gdbscm_type_has_field_p,
+    "\
+Return #t if the type has field named string.\n\
+\n\
+  Arguments: <gdb:type> string" },
+
+  { "field?", 1, 0, 0, gdbscm_field_p,
+    "\
+Return #t if the object is a <gdb:field> object." },
+
+  { "field-name", 1, 0, 0, gdbscm_field_name,
+    "\
+Return the name of the field." },
+
+  { "field-type", 1, 0, 0, gdbscm_field_type,
+    "\
+Return the type of the field." },
+
+  { "field-enumval", 1, 0, 0, gdbscm_field_enumval,
+    "\
+Return the enum value represented by the field." },
+
+  { "field-bitpos", 1, 0, 0, gdbscm_field_bitpos,
+    "\
+Return the offset in bits of the field in its containing type." },
+
+  { "field-bitsize", 1, 0, 0, gdbscm_field_bitsize,
+    "\
+Return the size of the field in bits." },
+
+  { "field-artificial?", 1, 0, 0, gdbscm_field_artificial_p,
+    "\
+Return #t if the field is artificial." },
+
+  { "field-baseclass?", 1, 0, 0, gdbscm_field_baseclass_p,
+    "\
+Return #t if the field is a baseclass." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_types (void)
+{
+  type_smob_tag = gdbscm_make_smob_type (type_smob_name, sizeof (type_smob));
+  scm_set_smob_mark (type_smob_tag, tyscm_mark_type_smob);
+  scm_set_smob_free (type_smob_tag, tyscm_free_type_smob);
+  scm_set_smob_print (type_smob_tag, tyscm_print_type_smob);
+  scm_set_smob_equalp (type_smob_tag, tyscm_equal_p_type_smob);
+
+  field_smob_tag = gdbscm_make_smob_type (field_smob_name,
+					  sizeof (field_smob));
+  scm_set_smob_mark (field_smob_tag, tyscm_mark_field_smob);
+  scm_set_smob_print (field_smob_tag, tyscm_print_field_smob);
+
+  gdbscm_define_integer_constants (type_integer_constants, 1);
+  gdbscm_define_functions (type_functions, 1);
+
+  /* This function is "private".  */
+  tyscm_next_field_x_proc
+    = scm_c_define_gsubr ("%type-next-field!", 1, 0, 0,
+			  gdbscm_type_next_field_x);
+  scm_set_procedure_property_x (tyscm_next_field_x_proc,
+				gdbscm_documentation_symbol,
+				gdbscm_scm_from_c_string ("\
+Internal function to assist the type fields iterator."));
+
+  block_keyword = scm_from_latin1_keyword ("block");
+
+  /* Register an objfile "free" callback so we can properly copy types
+     associated with the objfile when it's about to be deleted.  */
+  tyscm_objfile_data_key
+    = register_objfile_data_with_cleanup (save_objfile_types, NULL);
+
+  global_types_map = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob,
+							 tyscm_eq_type_smob);
+}
diff --git a/gdb/guile/scm-utils.c b/gdb/guile/scm-utils.c
new file mode 100644
index 0000000..9e9901d
--- /dev/null
+++ b/gdb/guile/scm-utils.c
@@ -0,0 +1,585 @@
+/* General utility routines for GDB/Scheme code.
+
+   Copyright (C) 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 <stdarg.h>
+#include <stdint.h>
+#include "gdb_assert.h"
+#include "guile-internal.h"
+
+/* Define VARIABLES in the gdb module.  */
+
+void
+gdbscm_define_variables (const scheme_variable *variables, int public)
+{
+  const scheme_variable *sv;
+
+  for (sv = variables; sv->name != NULL; ++sv)
+    {
+      scm_c_define (sv->name, sv->value);
+      if (public)
+	scm_c_export (sv->name, NULL);
+    }
+}
+
+/* Define FUNCTIONS in the gdb module.  */
+
+void
+gdbscm_define_functions (const scheme_function *functions, int public)
+{
+  const scheme_function *sf;
+
+  for (sf = functions; sf->name != NULL; ++sf)
+    {
+      SCM proc = scm_c_define_gsubr (sf->name, sf->required, sf->optional,
+				     sf->rest, sf->func);
+
+      scm_set_procedure_property_x (proc, gdbscm_documentation_symbol,
+				    gdbscm_scm_from_c_string (sf->doc_string));
+      if (public)
+	scm_c_export (sf->name, NULL);
+    }
+}
+
+/* Define CONSTANTS in the gdb module.  */
+
+void
+gdbscm_define_integer_constants (const scheme_integer_constant *constants,
+				 int public)
+{
+  const scheme_integer_constant *sc;
+
+  for (sc = constants; sc->name != NULL; ++sc)
+    {
+      scm_c_define (sc->name, scm_from_int (sc->value));
+      if (public)
+	scm_c_export (sc->name, NULL);
+    }
+}
+
+/* scm_printf, alas it doesn't exist.  */
+
+void
+gdbscm_printf (SCM port, const char *format, ...)
+{
+  va_list args;
+  char *string;
+
+  va_start (args, format);
+  string = xstrvprintf (format, args);
+  va_end (args);
+  scm_puts (string, port);
+  xfree (string);
+}
+
+/* Utility for calling from gdb to "display" an SCM object.  */
+
+void
+gdbscm_debug_display (SCM obj)
+{
+  SCM port = scm_current_output_port ();
+
+  scm_display (obj, port);
+  scm_newline (port);
+  scm_force_output (port);
+}
+
+/* Utility for calling from gdb to "write" an SCM object.  */
+
+void
+gdbscm_debug_write (SCM obj)
+{
+  SCM port = scm_current_output_port ();
+
+  scm_write (obj, port);
+  scm_newline (port);
+  scm_force_output (port);
+}
+
+/* Subroutine of gdbscm_parse_function_args to simplify it.
+   Return the number of keyword arguments.  */
+
+static int
+count_keywords (const SCM *keywords)
+{
+  int i;
+
+  if (keywords == NULL)
+    return 0;
+  for (i = 0; keywords[i] != SCM_BOOL_F; ++i)
+    continue;
+
+  return i;
+}
+
+/* Subroutine of gdbscm_parse_function_args to simplify it.
+   Validate an argument format string.
+   The result is a boolean indicating if "." was seen.  */
+
+static int
+validate_arg_format (const char *format)
+{
+  const char *p;
+  int length = strlen (format);
+  int optional_position = -1;
+  int keyword_position = -1;
+  int dot_seen = 0;
+
+  gdb_assert (length > 0);
+
+  for (p = format; *p != '\0'; ++p)
+    {
+      switch (*p)
+	{
+	case 's':
+	case 't':
+	case 'i':
+	case 'u':
+	case 'l':
+	case 'n':
+	case 'L':
+	case 'U':
+	case 'O':
+	  break;
+	case '|':
+	  gdb_assert (keyword_position < 0);
+	  gdb_assert (optional_position < 0);
+	  optional_position = p - format;
+	  break;
+	case '#':
+	  gdb_assert (keyword_position < 0);
+	  keyword_position = p - format;
+	  break;
+	case '.':
+	  gdb_assert (p[1] == '\0');
+	  dot_seen = 1;
+	  break;
+	default:
+	  gdb_assert_not_reached ("invalid argument format character");
+	}
+    }
+
+  return dot_seen;
+}
+
+/* Our version of SCM_ASSERT_TYPE that calls gdbscm_make_type_error.  */
+#define CHECK_TYPE(ok, arg, position, func_name, expected_type)		\
+  do {									\
+    if (!(ok))								\
+      {									\
+	return gdbscm_make_type_error ((func_name), (position), (arg),	\
+				       (expected_type));		\
+      }									\
+  } while (0)
+
+/* Subroutine of gdbscm_parse_function_args to simplify it.
+   Check the type of ARG against FORMAT_CHAR and extract the value.
+   POSITION is the position of ARG in the argument list.
+   The result is #f upon success or a <gdb:exception> object.  */
+
+static SCM
+extract_arg (char format_char, SCM arg, void *argp,
+	     const char *func_name, int position)
+{
+  switch (format_char)
+    {
+    case 's':
+      {
+	char **arg_ptr = argp;
+
+	CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position,
+		    func_name, _("string"));
+	*arg_ptr = gdbscm_scm_to_c_string (arg);
+	break;
+      }
+    case 't':
+      {
+	int *arg_ptr = argp;
+
+	/* While in Scheme, anything non-#f is "true", we're strict.  */
+	CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name,
+		    _("boolean"));
+	*arg_ptr = gdbscm_is_true (arg);
+	break;
+      }
+    case 'i':
+      {
+	int *arg_ptr = argp;
+
+	CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX),
+		    arg, position, func_name, _("int"));
+	*arg_ptr = scm_to_int (arg);
+	break;
+      }
+    case 'u':
+      {
+	int *arg_ptr = argp;
+
+	CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX),
+		    arg, position, func_name, _("unsigned int"));
+	*arg_ptr = scm_to_uint (arg);
+	break;
+      }
+    case 'l':
+      {
+	long *arg_ptr = argp;
+
+	CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX),
+		    arg, position, func_name, _("long"));
+	*arg_ptr = scm_to_long (arg);
+	break;
+      }
+    case 'n':
+      {
+	unsigned long *arg_ptr = argp;
+
+	CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX),
+		    arg, position, func_name, _("unsigned long"));
+	*arg_ptr = scm_to_ulong (arg);
+	break;
+      }
+    case 'L':
+      {
+	LONGEST *arg_ptr = argp;
+
+	CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX),
+		    arg, position, func_name, _("LONGEST"));
+	*arg_ptr = gdbscm_scm_to_longest (arg);
+	break;
+      }
+    case 'U':
+      {
+	ULONGEST *arg_ptr = argp;
+
+	CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX),
+		    arg, position, func_name, _("ULONGEST"));
+	*arg_ptr = gdbscm_scm_to_ulongest (arg);
+	break;
+      }
+    case 'O':
+      {
+	SCM *arg_ptr = argp;
+
+	*arg_ptr = arg;
+	break;
+      }
+    default:
+      gdb_assert_not_reached ("invalid argument format character");
+    }
+
+  return SCM_BOOL_F;
+}
+
+#undef CHECK_TYPE
+
+/* Look up KEYWORD in KEYWORD_LIST.
+   The result is the index of the keyword in the list or -1 if not found.  */
+
+static int
+lookup_keyword (const SCM *keyword_list, SCM keyword)
+{
+  int i = 0;
+
+  while (keyword_list[i] != SCM_BOOL_F)
+    {
+      if (scm_is_eq (keyword_list[i], keyword))
+	return i;
+      ++i;
+    }
+
+  return -1;
+}
+
+/* Utility to parse required, optional, and keyword arguments to Scheme
+   functions.  Modelled on PyArg_ParseTupleAndKeywords, but no attempt is made
+   at similarity or functionality.
+   There is no result, if there's an error a Scheme exception is thrown.
+
+   Guile provides scm_c_bind_keyword_arguments, and feel free to use it.
+   This is for times when we want a bit more parsing.
+
+   BEGINNING_ARG_POS is the position of the first argument passed to this
+   routine.  It should be one of the SCM_ARGn values.  It could be > SCM_ARG1
+   if the caller chooses not to parse one or more required arguments.
+
+   KEYWORDS may be NULL if there are no keywords.
+
+   FORMAT:
+   s - string -> char *, malloc'd
+   t - boolean (gdb uses "t", for biT?) -> int
+   i - int
+   u - unsigned int
+   l - long
+   n - unsigned long
+   L - longest
+   U - unsigned longest
+   O - random scheme object
+   | - indicates the next set is for optional arguments
+   # - indicates the next set is for keyword arguments (must follow |)
+   . - indicates "rest" arguments are present, this character must appear last
+
+   FORMAT must match the definition from scm_c_{make,define}_gsubr.
+   Required and optional arguments appear in order in the format string.
+   Afterwards, keyword-based arguments are processed.  There must be as many
+   remaining characters in the format string as their are keywords.
+   Except for "|#.", the number of characters in the format string must match
+   #required + #optional + #keywords.
+
+   The function is required to be defined in a compatible manner:
+   #required-args and #optional-arguments must match, and rest-arguments
+   must be specified if keyword args are desired, and/or regular "rest" args.
+
+   Example:  For this function,
+   scm_c_define_gsubr ("execute", 2, 3, 1, foo);
+   the format string + keyword list could be any of:
+   1) "ss|ttt#tt", { "key1", "key2", NULL }
+   2) "ss|ttt.", { NULL }
+   3) "ss|ttt#t.", { "key1", NULL }
+
+   For required and optional args pass the SCM of the argument, and a
+   pointer to the value to hold the parsed result (type depends on format
+   char).  After that pass the SCM containing the "rest" arguments followed
+   by pointers to values to hold parsed keyword arguments, and if specified
+   a pointer to hold the remaining contents of "rest".
+
+   For keyword arguments pass two pointers: the first is a pointer to an int
+   that will contain the position of the argument in the arg list, and the
+   second will contain result of processing the argument.  The int pointed
+   to by the first value should be initialized to -1.  It can then be used
+   to tell whether the keyword was present.
+
+   If both keyword and rest arguments are present, the caller must pass a
+   pointer to contain the new value of rest (after keyword args have been
+   removed).
+
+   There's currently no way, that I know of, to specify default values for
+   optional arguments in C-provided functions.  At the moment they're a
+   work-in-progress.  The caller should test SCM_UNBNDP for each optional
+   argument.  Unbound optional arguments are ignored.  */
+
+void
+gdbscm_parse_function_args (const char *func_name,
+			    int beginning_arg_pos,
+			    const SCM *keywords,
+			    const char *format, ...)
+{
+  va_list args;
+  const char *p;
+  int i, have_rest, num_keywords, length, position;
+  int have_optional = 0;
+  SCM status;
+  SCM rest = SCM_EOL;
+  /* Keep track of malloc'd strings.  We need to free them upon error.  */
+  VEC (char_ptr) *allocated_strings = NULL;
+  char *ptr;
+
+  have_rest = validate_arg_format (format);
+  num_keywords = count_keywords (keywords);
+
+  va_start (args, format);
+
+  p = format;
+  position = beginning_arg_pos;
+
+  /* Process required, optional arguments.  */
+
+  while (*p && *p != '#' && *p != '.')
+    {
+      SCM arg;
+      void *arg_ptr;
+
+      if (*p == '|')
+	{
+	  have_optional = 1;
+	  ++p;
+	  continue;
+	}
+
+      arg = va_arg (args, SCM);
+      if (!have_optional || !SCM_UNBNDP (arg))
+	{
+	  arg_ptr = va_arg (args, void *);
+	  status = extract_arg (*p, arg, arg_ptr, func_name, position);
+	  if (!gdbscm_is_false (status))
+	    goto fail;
+	  if (*p == 's')
+	    VEC_safe_push (char_ptr, allocated_strings, *(char **) arg_ptr);
+	}
+      ++p;
+      ++position;
+    }
+
+  /* Process keyword arguments.  */
+
+  if (have_rest || num_keywords > 0)
+    rest = va_arg (args, SCM);
+
+  if (num_keywords > 0)
+    {
+      SCM *keyword_args = (SCM *) alloca (num_keywords * sizeof (SCM));
+      int *keyword_positions = (int *) alloca (num_keywords * sizeof (int));
+
+      gdb_assert (*p == '#');
+      ++p;
+
+      for (i = 0; i < num_keywords; ++i)
+	{
+	  keyword_args[i] = SCM_UNSPECIFIED;
+	  keyword_positions[i] = -1;
+	}
+
+      while (scm_is_pair (rest)
+	     && scm_is_keyword (scm_car (rest)))
+	{
+	  SCM keyword = scm_car (rest);
+
+	  i = lookup_keyword (keywords, keyword);
+	  if (i < 0)
+	    {
+	      status = gdbscm_make_error (scm_arg_type_key, func_name,
+					  _("Unrecognized keyword: ~a"),
+					  scm_list_1 (keyword), keyword);
+	      goto fail;
+	    }
+	  if (!scm_is_pair (scm_cdr (rest)))
+	    {
+	      status = gdbscm_make_error
+		(scm_arg_type_key, func_name,
+		 _("Missing value for keyword argument"),
+		 scm_list_1 (keyword), keyword);
+	      goto fail;
+	    }
+	  keyword_args[i] = scm_cadr (rest);
+	  keyword_positions[i] = position + 1;
+	  rest = scm_cddr (rest);
+	  position += 2;
+	}
+
+      for (i = 0; i < num_keywords; ++i)
+	{
+	  int *arg_pos_ptr = va_arg (args, int *);
+	  void *arg_ptr = va_arg (args, void *);
+	  SCM arg = keyword_args[i];
+
+	  if (! scm_is_eq (arg, SCM_UNSPECIFIED))
+	    {
+	      *arg_pos_ptr = keyword_positions[i];
+	      status = extract_arg (p[i], arg, arg_ptr, func_name,
+				    keyword_positions[i]);
+	      if (!gdbscm_is_false (status))
+		goto fail;
+	      if (p[i] == 's')
+		{
+		  VEC_safe_push (char_ptr, allocated_strings,
+				 *(char **) arg_ptr);
+		}
+	    }
+	}
+    }
+
+  /* Process "rest" arguments.  */
+
+  if (have_rest)
+    {
+      if (num_keywords > 0)
+	{
+	  SCM *rest_ptr = va_arg (args, SCM *);
+
+	  *rest_ptr = rest;
+	}
+    }
+  else
+    {
+      if (! scm_is_null (rest))
+	{
+	  status = gdbscm_make_error (scm_args_number_key, func_name,
+				      _("Too many arguments"),
+				      SCM_EOL, SCM_BOOL_F);
+	  goto fail;
+	}
+    }
+
+  va_end (args);
+  VEC_free (char_ptr, allocated_strings);
+  return;
+
+ fail:
+  va_end (args);
+  for (i = 0; VEC_iterate (char_ptr, allocated_strings, i, ptr); ++i)
+    xfree (ptr);
+  VEC_free (char_ptr, allocated_strings);
+  gdbscm_throw (status);
+}
+
+/* Return longest L as a scheme object.  */
+
+SCM
+gdbscm_scm_from_longest (LONGEST l)
+{
+  return scm_from_int64 (l);
+}
+
+/* Convert scheme object L to LONGEST.
+   It is an error to call this if L is not an integer in range of LONGEST.
+   (because the underlying Scheme function will thrown an exception,
+   which is not part of our contract with the caller).  */
+
+LONGEST
+gdbscm_scm_to_longest (SCM l)
+{
+  return scm_to_int64 (l);
+}
+
+/* Return unsigned longest L as a scheme object.  */
+
+SCM
+gdbscm_scm_from_ulongest (ULONGEST l)
+{
+  return scm_from_uint64 (l);
+}
+
+/* Convert scheme object U to ULONGEST.
+   It is an error to call this if U is not an integer in range of ULONGEST
+   (because the underlying Scheme function will thrown an exception,
+   which is not part of our contract with the caller).  */
+
+ULONGEST
+gdbscm_scm_to_ulongest (SCM u)
+{
+  return scm_to_uint64 (u);
+}
+
+/* Same as scm_dynwind_free, but uses xfree.  */
+
+void
+gdbscm_dynwind_xfree (void *ptr)
+{
+  scm_dynwind_unwind_handler (xfree, ptr, SCM_F_WIND_EXPLICITLY);
+}
+
+/* Return non-zero if PROC is a procedure.  */
+
+int
+gdbscm_is_procedure (SCM proc)
+{
+  return gdbscm_is_true (scm_procedure_p (proc));
+}
diff --git a/gdb/guile/scm-value.c b/gdb/guile/scm-value.c
new file mode 100644
index 0000000..f7f27cee
--- /dev/null
+++ b/gdb/guile/scm-value.c
@@ -0,0 +1,1485 @@
+/* Scheme interface to 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 "gdb_assert.h"
+#include "infcall.h"
+#include "symtab.h" /* Needed by language.h.  */
+#include "language.h"
+#include "valprint.h"
+#include "value.h"
+#include "guile-internal.h"
+
+/* The <gdb:value> smob.  */
+
+typedef struct _value_smob
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* Doubly linked list of values in values_in_scheme.
+     IWBN to use a chained_gdb_smob instead, which is doable, it just requires
+     a bit more casting than normal.  */
+  struct _value_smob *next;
+  struct _value_smob *prev;
+
+  struct value *value;
+
+  /* These are cached here to avoid making multiple copies of them.
+     Plus computing the dynamic_type can be a bit expensive.
+     We use #f to indicate that the value doesn't exist (e.g. value doesn't
+     have an address), so we need another value to indicate that we haven't
+     computed the value yet.  For this we use SCM_UNDEFINED.  */
+  SCM address;
+  SCM type;
+  SCM dynamic_type;
+} value_smob;
+
+static const char value_smob_name[] = "gdb:value";
+
+/* The tag Guile knows the value smob by.  */
+static scm_t_bits value_smob_tag;
+
+/* List of all values which are currently exposed to Scheme. It is
+   maintained so that when an objfile is discarded, preserve_values
+   can copy the values' types if needed.  */
+static value_smob *values_in_scheme;
+
+/* Keywords used by Scheme procedures in this file.  */
+static SCM type_keyword;
+static SCM encoding_keyword;
+static SCM errors_keyword;
+static SCM length_keyword;
+
+/* Possible #:errors values.  */
+static SCM error_symbol;
+static SCM escape_symbol;
+static SCM substitute_symbol;
+
+/* Administrivia for value smobs.  */
+
+/* Iterate over all the <gdb:value> objects, calling preserve_one_value on
+   each.
+   This is the extension_language_ops.preserve_values "method".  */
+
+void
+gdbscm_preserve_values (const struct extension_language_defn *extlang,
+			struct objfile *objfile, htab_t copied_types)
+{
+  value_smob *iter;
+
+  for (iter = values_in_scheme; iter; iter = iter->next)
+    preserve_one_value (iter->value, objfile, copied_types);
+}
+
+/* Helper to add a value_smob to the global list.  */
+
+static void
+vlscm_remember_scheme_value (value_smob *v_smob)
+{
+  v_smob->next = values_in_scheme;
+  if (v_smob->next)
+    v_smob->next->prev = v_smob;
+  v_smob->prev = NULL;
+  values_in_scheme = v_smob;
+}
+
+/* Helper to remove a value_smob from the global list.  */
+
+static void
+vlscm_forget_value_smob (value_smob *v_smob)
+{
+  /* Remove SELF from the global list.  */
+  if (v_smob->prev)
+    v_smob->prev->next = v_smob->next;
+  else
+    {
+      gdb_assert (values_in_scheme == v_smob);
+      values_in_scheme = v_smob->next;
+    }
+  if (v_smob->next)
+    v_smob->next->prev = v_smob->prev;
+}
+
+/* The smob "mark" function for <gdb:value>.  */
+
+static SCM
+vlscm_mark_value_smob (SCM self)
+{
+  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (v_smob->address);
+  scm_gc_mark (v_smob->type);
+  scm_gc_mark (v_smob->dynamic_type);
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&v_smob->base);
+}
+
+/* The smob "free" function for <gdb:value>.  */
+
+static size_t
+vlscm_free_value_smob (SCM self)
+{
+  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
+
+  vlscm_forget_value_smob (v_smob);
+  value_free (v_smob->value);
+
+  return 0;
+}
+
+/* The smob "print" function for <gdb:value>.  */
+
+static int
+vlscm_print_value_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
+  char *s = NULL;
+  struct value_print_options opts;
+  volatile struct gdb_exception except;
+
+  if (pstate->writingp)
+    gdbscm_printf (port, "#<%s ", value_smob_name);
+
+  get_user_print_options (&opts);
+  opts.deref_ref = 0;
+
+  /* pstate->writingp = zero if invoked by display/~A, and nonzero if
+     invoked by write/~S.  What to do here may need to evolve.
+     IWBN if we could pass an argument to format that would we could use
+     instead of writingp.  */
+  opts.raw = !!pstate->writingp;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct ui_file *stb = mem_fileopen ();
+      struct cleanup *old_chain = make_cleanup_ui_file_delete (stb);
+
+      common_val_print (v_smob->value, stb, 0, &opts, current_language);
+      s = ui_file_xstrdup (stb, NULL);
+
+      do_cleanups (old_chain);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (s != NULL)
+    {
+      scm_puts (s, port);
+      xfree (s);
+    }
+
+  if (pstate->writingp)
+    scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* The smob "equalp" function for <gdb:value>.  */
+
+static SCM
+vlscm_equal_p_value_smob (SCM v1, SCM v2)
+{
+  const value_smob *v1_smob = (value_smob *) SCM_SMOB_DATA (v1);
+  const value_smob *v2_smob = (value_smob *) SCM_SMOB_DATA (v2);
+  int result = 0;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      result = value_equal (v1_smob->value, v2_smob->value);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return scm_from_bool (result);
+}
+
+/* Low level routine to create a <gdb:value> object.  */
+
+static SCM
+vlscm_make_value_smob (void)
+{
+  value_smob *v_smob = (value_smob *)
+    scm_gc_malloc (sizeof (value_smob), value_smob_name);
+  SCM v_scm;
+
+  /* These must be filled in by the caller.  */
+  v_smob->value = NULL;
+  v_smob->prev = NULL;
+  v_smob->next = NULL;
+
+  /* These are lazily computed.  */
+  v_smob->address = SCM_UNDEFINED;
+  v_smob->type = SCM_UNDEFINED;
+  v_smob->dynamic_type = SCM_UNDEFINED;
+
+  v_scm = scm_new_smob (value_smob_tag, (scm_t_bits) v_smob);
+  gdbscm_init_gsmob (&v_smob->base);
+
+  return v_scm;
+}
+
+/* Return non-zero if SCM is a <gdb:value> object.  */
+
+int
+vlscm_is_value (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (value_smob_tag, scm);
+}
+
+/* (value? object) -> boolean */
+
+static SCM
+gdbscm_value_p (SCM scm)
+{
+  return scm_from_bool (vlscm_is_value (scm));
+}
+
+/* Create a new <gdb:value> object that encapsulates VALUE.
+   The value is released from the all_values chain so its lifetime is not
+   bound to the execution of a command.  */
+
+SCM
+vlscm_scm_from_value (struct value *value)
+{
+  /* N.B. It's important to not cause any side-effects until we know the
+     conversion worked.  */
+  SCM v_scm = vlscm_make_value_smob ();
+  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
+
+  v_smob->value = value;
+  release_value_or_incref (value);
+  vlscm_remember_scheme_value (v_smob);
+
+  return v_scm;
+}
+
+/* Returns the <gdb:value> object in SELF.
+   Throws an exception if SELF is not a <gdb:value> object.  */
+
+static SCM
+vlscm_get_value_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM_ASSERT_TYPE (vlscm_is_value (self), self, arg_pos, func_name,
+		   value_smob_name);
+
+  return self;
+}
+
+/* Returns a pointer to the value smob of SELF.
+   Throws an exception if SELF is not a <gdb:value> object.  */
+
+static value_smob *
+vlscm_get_value_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM v_scm = vlscm_get_value_arg_unsafe (self, arg_pos, func_name);
+  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
+
+  return v_smob;
+}
+
+/* Return the value field of V_SCM, an object of type <gdb:value>.
+   This exists so that we don't have to export the struct's contents.  */
+
+struct value *
+vlscm_scm_to_value (SCM v_scm)
+{
+  value_smob *v_smob;
+
+  gdb_assert (vlscm_is_value (v_scm));
+  v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
+  return v_smob->value;
+}
+
+/* Value methods.  */
+
+/* (make-value x [#:type type]) -> <gdb:value> */
+
+static SCM
+gdbscm_make_value (SCM x, SCM rest)
+{
+  struct gdbarch *gdbarch = get_current_arch ();
+  const struct language_defn *language = current_language;
+  const SCM keywords[] = { type_keyword, SCM_BOOL_F };
+  int type_arg_pos = -1;
+  SCM type_scm = SCM_UNDEFINED;
+  SCM except_scm, result;
+  type_smob *t_smob;
+  struct type *type = NULL;
+  struct value *value;
+  struct cleanup *cleanups;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", rest,
+			      &type_arg_pos, &type_scm);
+
+  if (type_arg_pos > 0)
+    {
+      t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, type_arg_pos,
+					       FUNC_NAME);
+      type = tyscm_type_smob_type (t_smob);
+    }
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  value = vlscm_convert_typed_value_from_scheme (FUNC_NAME, SCM_ARG1, x,
+						 type_arg_pos, type_scm, type,
+						 &except_scm,
+						 gdbarch, language);
+  if (value == NULL)
+    {
+      do_cleanups (cleanups);
+      gdbscm_throw (except_scm);
+    }
+
+  result = vlscm_scm_from_value (value);
+
+  do_cleanups (cleanups);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+  return result;
+}
+
+/* (make-lazy-value <gdb:type> address) -> <gdb:value> */
+
+static SCM
+gdbscm_make_lazy_value (SCM type_scm, SCM address_scm)
+{
+  type_smob *t_smob;
+  struct type *type;
+  ULONGEST address;
+  struct value *value = NULL;
+  SCM result;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG1, FUNC_NAME);
+  type = tyscm_type_smob_type (t_smob);
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "U",
+			      address_scm, &address);
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  /* There's no (current) need to wrap this in a TRY_CATCH, but for consistency
+     and future-proofing we do.  */
+  TRY_CATCH (except, RETURN_MASK_ALL)
+  {
+    value = value_from_contents_and_address (type, NULL, address);
+  }
+  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+
+  result = vlscm_scm_from_value (value);
+
+  do_cleanups (cleanups);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+  return result;
+}
+
+/* (value-optimized-out? <gdb:value>) -> boolean */
+
+static SCM
+gdbscm_value_optimized_out_p (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  int opt = 0;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      opt = value_optimized_out (value);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return scm_from_bool (opt);
+}
+
+/* (value-address <gdb:value>) -> integer
+   Returns #f if the value doesn't have one.  */
+
+static SCM
+gdbscm_value_address (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+
+  if (SCM_UNBNDP (v_smob->address))
+    {
+      struct value *res_val = NULL;
+      struct cleanup *cleanup
+	= make_cleanup_value_free_to_mark (value_mark ());
+      SCM address;
+      volatile struct gdb_exception except;
+
+      TRY_CATCH (except, RETURN_MASK_ALL)
+	{
+	  res_val = value_addr (value);
+	}
+      if (except.reason < 0)
+	address = SCM_BOOL_F;
+      else
+	address = vlscm_scm_from_value (res_val);
+
+      do_cleanups (cleanup);
+
+      if (gdbscm_is_exception (address))
+	gdbscm_throw (address);
+
+      v_smob->address = address;
+    }
+
+  return v_smob->address;
+}
+
+/* (value-dereference <gdb:value>) -> <gdb:value>
+   Given a value of a pointer type, apply the C unary * operator to it.  */
+
+static SCM
+gdbscm_value_dereference (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  SCM result;
+  struct value *res_val = NULL;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      res_val = value_ind (value);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+
+  result = vlscm_scm_from_value (res_val);
+
+  do_cleanups (cleanups);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+
+  return result;
+}
+
+/* (value-referenced-value <gdb:value>) -> <gdb:value>
+   Given a value of a reference type, return the value referenced.
+   The difference between this function and gdbscm_value_dereference is that
+   the latter applies * unary operator to a value, which need not always
+   result in the value referenced.
+   For example, for a value which is a reference to an 'int' pointer ('int *'),
+   gdbscm_value_dereference will result in a value of type 'int' while
+   gdbscm_value_referenced_value will result in a value of type 'int *'.  */
+
+static SCM
+gdbscm_value_referenced_value (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  SCM result;
+  struct value *res_val = NULL;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      switch (TYPE_CODE (check_typedef (value_type (value))))
+        {
+        case TYPE_CODE_PTR:
+          res_val = value_ind (value);
+          break;
+        case TYPE_CODE_REF:
+          res_val = coerce_ref (value);
+          break;
+        default:
+          error (_("Trying to get the referenced value from a value which is"
+		   " neither a pointer nor a reference"));
+        }
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+
+  result = vlscm_scm_from_value (res_val);
+
+  do_cleanups (cleanups);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+
+  return result;
+}
+
+/* (value-type <gdb:value>) -> <gdb:type> */
+
+static SCM
+gdbscm_value_type (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+
+  if (SCM_UNBNDP (v_smob->type))
+    v_smob->type = tyscm_scm_from_type (value_type (value));
+
+  return v_smob->type;
+}
+
+/* (value-dynamic-type <gdb:value>) -> <gdb:type> */
+
+static SCM
+gdbscm_value_dynamic_type (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  struct type *type = NULL;
+  volatile struct gdb_exception except;
+
+  if (! SCM_UNBNDP (v_smob->type))
+    return v_smob->dynamic_type;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct cleanup *cleanup
+	= make_cleanup_value_free_to_mark (value_mark ());
+
+      type = value_type (value);
+      CHECK_TYPEDEF (type);
+
+      if (((TYPE_CODE (type) == TYPE_CODE_PTR)
+	   || (TYPE_CODE (type) == TYPE_CODE_REF))
+	  && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
+	{
+	  struct value *target;
+	  int was_pointer = TYPE_CODE (type) == TYPE_CODE_PTR;
+
+	  target = value_ind (value);
+	  type = value_rtti_type (target, NULL, NULL, NULL);
+
+	  if (type)
+	    {
+	      if (was_pointer)
+		type = lookup_pointer_type (type);
+	      else
+		type = lookup_reference_type (type);
+	    }
+	}
+      else if (TYPE_CODE (type) == TYPE_CODE_CLASS)
+	type = value_rtti_type (value, NULL, NULL, NULL);
+      else
+	{
+	  /* Re-use object's static type.  */
+	  type = NULL;
+	}
+
+      do_cleanups (cleanup);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (type == NULL)
+    v_smob->dynamic_type = gdbscm_value_type (self);
+  else
+    v_smob->dynamic_type = tyscm_scm_from_type (type);
+
+  return v_smob->dynamic_type;
+}
+
+/* A helper function that implements the various cast operators.  */
+
+static SCM
+vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
+	       const char *func_name)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  type_smob *t_smob
+    = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG2, FUNC_NAME);
+  struct type *type = tyscm_type_smob_type (t_smob);
+  SCM result;
+  struct value *res_val = NULL;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (op == UNOP_DYNAMIC_CAST)
+	res_val = value_dynamic_cast (type, value);
+      else if (op == UNOP_REINTERPRET_CAST)
+	res_val = value_reinterpret_cast (type, value);
+      else
+	{
+	  gdb_assert (op == UNOP_CAST);
+	  res_val = value_cast (type, value);
+	}
+    }
+  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-cast <gdb:value> <gdb:type>) -> <gdb:value> */
+
+static SCM
+gdbscm_value_cast (SCM self, SCM new_type)
+{
+  return vlscm_do_cast (self, new_type, UNOP_CAST, FUNC_NAME);
+}
+
+/* (value-dynamic-cast <gdb:value> <gdb:type>) -> <gdb:value> */
+
+static SCM
+gdbscm_value_dynamic_cast (SCM self, SCM new_type)
+{
+  return vlscm_do_cast (self, new_type, UNOP_DYNAMIC_CAST, FUNC_NAME);
+}
+
+/* (value-reinterpret-cast <gdb:value> <gdb:type>) -> <gdb:value> */
+
+static SCM
+gdbscm_value_reinterpret_cast (SCM self, SCM new_type)
+{
+  return vlscm_do_cast (self, new_type, UNOP_REINTERPRET_CAST, FUNC_NAME);
+}
+
+/* (value-field <gdb:value> string) -> <gdb:value>
+   Given string name of an element inside structure, return its <gdb:value>
+   object.  */
+
+static SCM
+gdbscm_value_field (SCM self, SCM field_scm)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  char *field = NULL;
+  struct value *res_val = NULL;
+  SCM result;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
+		   _("string"));
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  field = gdbscm_scm_to_c_string (field_scm);
+  make_cleanup (xfree, field);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct value *tmp = value;
+
+      res_val = value_struct_elt (&tmp, NULL, field, NULL, NULL);
+    }
+  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-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
+   Return the specified value in an array.  */
+
+static SCM
+gdbscm_value_subscript (SCM self, SCM index_scm)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  struct value *index = NULL;
+  struct value *res_val = NULL;
+  struct type *type = value_type (value);
+  struct gdbarch *gdbarch;
+  SCM result, except_scm;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  /* The sequencing here, as everywhere else, is important.
+     We can't have existing cleanups when a Scheme exception is thrown.  */
+
+  SCM_ASSERT (type != NULL, self, SCM_ARG2, FUNC_NAME);
+  gdbarch = get_type_arch (type);
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+
+  index = vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
+					   &except_scm,
+					   gdbarch, current_language);
+  if (index == NULL)
+    {
+      do_cleanups (cleanups);
+      gdbscm_throw (except_scm);
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct value *tmp = value;
+
+      /* Assume we are attempting an array access, and let the value code
+	 throw an exception if the index has an invalid type.
+	 Check the value's type is something that can be accessed via
+	 a subscript.  */
+      tmp = coerce_ref (tmp);
+      type = check_typedef (value_type (tmp));
+      if (TYPE_CODE (type) != TYPE_CODE_ARRAY
+	  && TYPE_CODE (type) != TYPE_CODE_PTR)
+	error (_("Cannot subscript requested type"));
+
+      res_val = value_subscript (tmp, value_as_long (index));
+   }
+  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-call <gdb:value> arg-list) -> <gdb:value>
+   Perform an inferior function call on the value.  */
+
+static SCM
+gdbscm_value_call (SCM self, SCM args)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *function = v_smob->value;
+  struct value *mark = value_mark ();
+  struct type *ftype = NULL;
+  long args_count;
+  struct value **vargs = NULL;
+  SCM result = SCM_BOOL_F;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      ftype = check_typedef (value_type (function));
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  SCM_ASSERT_TYPE (TYPE_CODE (ftype) == TYPE_CODE_FUNC, self,
+		   SCM_ARG1, FUNC_NAME,
+		   _("function (value of TYPE_CODE_FUNC)"));
+
+  SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (args)), args,
+		   SCM_ARG2, FUNC_NAME, _("list"));
+
+  args_count = scm_ilength (args);
+  if (args_count > 0)
+    {
+      struct gdbarch *gdbarch = get_current_arch ();
+      const struct language_defn *language = current_language;
+      SCM except_scm;
+      long i;
+
+      vargs = alloca (sizeof (struct value *) * args_count);
+      for (i = 0; i < args_count; i++)
+	{
+	  SCM arg = scm_car (args);
+
+	  vargs[i] = vlscm_convert_value_from_scheme (FUNC_NAME,
+						      GDBSCM_ARG_NONE, arg,
+						      &except_scm,
+						      gdbarch, language);
+	  if (vargs[i] == NULL)
+	    gdbscm_throw (except_scm);
+
+	  args = scm_cdr (args);
+	}
+      gdb_assert (gdbscm_is_true (scm_null_p (args)));
+    }
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct cleanup *cleanup = make_cleanup_value_free_to_mark (mark);
+      struct value *return_value;
+
+      return_value = call_function_by_hand (function, args_count, vargs);
+      result = vlscm_scm_from_value (return_value);
+      do_cleanups (cleanup);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+
+  return result;
+}
+
+/* (value->bytevector <gdb:value>) -> bytevector */
+
+static SCM
+gdbscm_value_to_bytevector (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  struct type *type;
+  size_t length = 0;
+  const gdb_byte *contents = NULL;
+  SCM bv;
+  volatile struct gdb_exception except;
+
+  type = value_type (value);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      CHECK_TYPEDEF (type);
+      length = TYPE_LENGTH (type);
+      contents = value_contents (value);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  bv = scm_c_make_bytevector (length);
+  memcpy (SCM_BYTEVECTOR_CONTENTS (bv), contents, length);
+
+  return bv;
+}
+
+/* Helper function to determine if a type is "int-like".  */
+
+static int
+is_intlike (struct type *type, int ptr_ok)
+{
+  return (TYPE_CODE (type) == TYPE_CODE_INT
+	  || TYPE_CODE (type) == TYPE_CODE_ENUM
+	  || TYPE_CODE (type) == TYPE_CODE_BOOL
+	  || TYPE_CODE (type) == TYPE_CODE_CHAR
+	  || (ptr_ok && TYPE_CODE (type) == TYPE_CODE_PTR));
+}
+
+/* (value->bool <gdb:value>) -> boolean
+   Throws an error if the value is not integer-like.  */
+
+static SCM
+gdbscm_value_to_bool (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  struct type *type;
+  LONGEST l = 0;
+  volatile struct gdb_exception except;
+
+  type = value_type (value);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      CHECK_TYPEDEF (type);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
+		   _("integer-like gdb value"));
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (TYPE_CODE (type) == TYPE_CODE_PTR)
+	l = value_as_address (value);
+      else
+	l = value_as_long (value);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return scm_from_bool (l != 0);
+}
+
+/* (value->integer <gdb:value>) -> integer
+   Throws an error if the value is not integer-like.  */
+
+static SCM
+gdbscm_value_to_integer (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  struct type *type;
+  LONGEST l = 0;
+  volatile struct gdb_exception except;
+
+  type = value_type (value);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      CHECK_TYPEDEF (type);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
+		   _("integer-like gdb value"));
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (TYPE_CODE (type) == TYPE_CODE_PTR)
+	l = value_as_address (value);
+      else
+	l = value_as_long (value);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (TYPE_UNSIGNED (type))
+    return gdbscm_scm_from_ulongest (l);
+  else
+    return gdbscm_scm_from_longest (l);
+}
+
+/* (value->real <gdb:value>) -> real
+   Throws an error if the value is not a number.  */
+
+static SCM
+gdbscm_value_to_real (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  struct type *type;
+  DOUBLEST d = 0;
+  volatile struct gdb_exception except;
+
+  type = value_type (value);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      CHECK_TYPEDEF (type);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  SCM_ASSERT_TYPE (is_intlike (type, 0) || TYPE_CODE (type) == TYPE_CODE_FLT,
+		   self, SCM_ARG1, FUNC_NAME, _("number"));
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      d = value_as_double (value);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  /* TODO: Is there a better way to check if the value fits?  */
+  if (d != (double) d)
+    gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
+			       _("number can't be converted to a double"));
+
+  return scm_from_double (d);
+}
+
+/* (value->string <gdb:value>
+       [#:encoding encoding]
+       [#:errors #f | 'error | 'substitute]
+       [#:length length])
+     -> string
+   Return Unicode string with value's contents, which must be a string.
+
+   If ENCODING is not given, the string is assumed to be encoded in
+   the target's charset.
+
+   ERRORS is one of #f, 'error or 'substitute.
+   An error setting of #f means use the default, which is
+   Guile's %default-port-conversion-strategy.  If the default is not one
+   of 'error or 'substitute, 'substitute is used.
+   An error setting of "error" causes an exception to be thrown if there's
+   a decoding error.  An error setting of "substitute" causes invalid
+   characters to be replaced with "?".
+
+   If LENGTH is provided, only fetch string to the length provided.
+   LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */
+
+static SCM
+gdbscm_value_to_string (SCM self, SCM rest)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  const SCM keywords[] = {
+    encoding_keyword, errors_keyword, length_keyword, SCM_BOOL_F
+  };
+  int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
+  char *encoding = NULL;
+  SCM errors = SCM_BOOL_F;
+  int length = -1;
+  gdb_byte *buffer = NULL;
+  const char *la_encoding = NULL;
+  struct type *char_type = NULL;
+  SCM result;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  /* The sequencing here, as everywhere else, is important.
+     We can't have existing cleanups when a Scheme exception is thrown.  */
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#sOi", rest,
+			      &encoding_arg_pos, &encoding,
+			      &errors_arg_pos, &errors,
+			      &length_arg_pos, &length);
+
+  cleanups = make_cleanup (xfree, encoding);
+
+  if (errors_arg_pos > 0
+      && errors != SCM_BOOL_F
+      && !scm_is_eq (errors, error_symbol)
+      && !scm_is_eq (errors, substitute_symbol))
+    {
+      SCM excp
+	= gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
+					  _("invalid error kind"));
+
+      do_cleanups (cleanups);
+      gdbscm_throw (excp);
+    }
+  if (errors == SCM_BOOL_F)
+    errors = scm_port_conversion_strategy (SCM_BOOL_F);
+  /* We don't assume anything about the result of scm_port_conversion_strategy.
+     From this point on, if errors is not 'errors, use 'substitute.  */
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      LA_GET_STRING (value, &buffer, &length, &char_type, &la_encoding);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+
+  /* If errors is "error" scm_from_stringn may throw a Scheme exception.
+     Make sure we don't leak.  This is done via scm_dynwind_begin, et.al.  */
+  discard_cleanups (cleanups);
+
+  scm_dynwind_begin (0);
+
+  gdbscm_dynwind_xfree (encoding);
+  gdbscm_dynwind_xfree (buffer);
+
+  result = scm_from_stringn ((const char *) buffer,
+			     length * TYPE_LENGTH (char_type),
+			     (encoding != NULL && *encoding != '\0'
+			      ? encoding
+			      : la_encoding),
+			     scm_is_eq (errors, error_symbol)
+			     ? SCM_FAILED_CONVERSION_ERROR
+			     : SCM_FAILED_CONVERSION_QUESTION_MARK);
+
+  scm_dynwind_end ();
+
+  return result;
+}
+
+/* (value->lazy-string <gdb:value> [#:encoding encoding] [#:length length])
+     -> <gdb:lazy-string>
+   Return a Scheme object representing a lazy_string_object type.
+   A lazy string is a pointer to a string with an optional encoding and length.
+   If ENCODING is not given, the target's charset is used.
+   If LENGTH is provided then the length parameter is set to LENGTH, otherwise
+   length will be set to -1 (first null of appropriate with).
+   LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */
+
+static SCM
+gdbscm_value_to_lazy_string (SCM self, SCM rest)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  const SCM keywords[] = { encoding_keyword, length_keyword, SCM_BOOL_F };
+  int encoding_arg_pos = -1, length_arg_pos = -1;
+  char *encoding = NULL;
+  int length = -1;
+  SCM result = SCM_BOOL_F; /* -Wall */
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  /* The sequencing here, as everywhere else, is important.
+     We can't have existing cleanups when a Scheme exception is thrown.  */
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#si", rest,
+			      &encoding_arg_pos, &encoding,
+			      &length_arg_pos, &length);
+
+  cleanups = make_cleanup (xfree, encoding);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct cleanup *inner_cleanup
+	= make_cleanup_value_free_to_mark (value_mark ());
+
+      if (TYPE_CODE (value_type (value)) == TYPE_CODE_PTR)
+	value = value_ind (value);
+
+      result = lsscm_make_lazy_string (value_address (value), length,
+				       encoding, value_type (value));
+
+      do_cleanups (inner_cleanup);
+    }
+  do_cleanups (cleanups);
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  if (gdbscm_is_exception (result))
+    gdbscm_throw (result);
+
+  return result;
+}
+
+/* (value-lazy? <gdb:value>) -> boolean */
+
+static SCM
+gdbscm_value_lazy_p (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+
+  return scm_from_bool (value_lazy (value));
+}
+
+/* (value-fetch-lazy! <gdb:value>) -> unspecified */
+
+static SCM
+gdbscm_value_fetch_lazy_x (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  volatile struct gdb_exception except;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      if (value_lazy (value))
+	value_fetch_lazy (value);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return SCM_UNSPECIFIED;
+}
+
+/* (value-print <gdb:value>) -> string */
+
+static SCM
+gdbscm_value_print (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+  struct value_print_options opts;
+  char *s = NULL;
+  SCM result;
+  volatile struct gdb_exception except;
+
+  get_user_print_options (&opts);
+  opts.deref_ref = 0;
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      struct ui_file *stb = mem_fileopen ();
+      struct cleanup *old_chain = make_cleanup_ui_file_delete (stb);
+
+      common_val_print (value, stb, 0, &opts, current_language);
+      s = ui_file_xstrdup (stb, NULL);
+
+      do_cleanups (old_chain);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  /* Use SCM_FAILED_CONVERSION_QUESTION_MARK to ensure this doesn't
+     throw an error if the encoding fails.
+     IWBN to use scm_take_locale_string here, but we'd have to temporarily
+     override the default port conversion handler because contrary to
+     documentation it doesn't necessarily free the input string.  */
+  result = scm_from_stringn (s, strlen (s), host_charset (),
+			     SCM_FAILED_CONVERSION_QUESTION_MARK);
+  xfree (s);
+
+  return result;
+}
+
+/* (parse-and-eval string) -> <gdb:value>
+   Parse a string and evaluate the string as an expression.  */
+
+static SCM
+gdbscm_parse_and_eval (SCM expr_scm)
+{
+  char *expr_str;
+  struct value *res_val = NULL;
+  SCM result;
+  struct cleanup *cleanups;
+  volatile struct gdb_exception except;
+
+  /* The sequencing here, as everywhere else, is important.
+     We can't have existing cleanups when a Scheme exception is thrown.  */
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
+			      expr_scm, &expr_str);
+
+  cleanups = make_cleanup_value_free_to_mark (value_mark ());
+  make_cleanup (xfree, expr_str);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      res_val = parse_and_eval (expr_str);
+    }
+  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;
+}
+
+/* (history-ref integer) -> <gdb:value>
+   Return the specified value from GDB's value history.  */
+
+static SCM
+gdbscm_history_ref (SCM index)
+{
+  int i;
+  struct value *res_val = NULL; /* Initialize to appease gcc warning.  */
+  volatile struct gdb_exception except;
+
+  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
+
+  TRY_CATCH (except, RETURN_MASK_ALL)
+    {
+      res_val = access_value_history (i);
+    }
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
+
+  return vlscm_scm_from_value (res_val);
+}
+
+/* Initialize the Scheme value code.  */
+
+static const scheme_function value_functions[] =
+{
+  { "value?", 1, 0, 0, gdbscm_value_p,
+    "\
+Return #t if the object is a <gdb:value> object." },
+
+  { "make-value", 1, 0, 1, gdbscm_make_value,
+    "\
+Create a <gdb:value> representing object.\n\
+Typically this is used to convert numbers and strings to\n\
+<gdb:value> objects.\n\
+\n\
+  Arguments: object [#:type <gdb:type>]" },
+
+  { "value-optimized-out?", 1, 0, 0, gdbscm_value_optimized_out_p,
+    "\
+Return #t if the value has been optimizd out." },
+
+  { "value-address", 1, 0, 0, gdbscm_value_address,
+    "\
+Return the address of the value." },
+
+  { "value-type", 1, 0, 0, gdbscm_value_type,
+    "\
+Return the type of the value." },
+
+  { "value-dynamic-type", 1, 0, 0, gdbscm_value_dynamic_type,
+    "\
+Return the dynamic type of the value." },
+
+  { "value-cast", 2, 0, 0, gdbscm_value_cast,
+    "\
+Cast the value to the supplied type.\n\
+\n\
+  Arguments: <gdb:value> <gdb:type>" },
+
+  { "value-dynamic-cast", 2, 0, 0, gdbscm_value_dynamic_cast,
+    "\
+Cast the value to the supplied type, as if by the C++\n\
+dynamic_cast operator.\n\
+\n\
+  Arguments: <gdb:value> <gdb:type>" },
+
+  { "value-reinterpret-cast", 2, 0, 0, gdbscm_value_reinterpret_cast,
+    "\
+Cast the value to the supplied type, as if by the C++\n\
+reinterpret_cast operator.\n\
+\n\
+  Arguments: <gdb:value> <gdb:type>" },
+
+  { "value-dereference", 1, 0, 0, gdbscm_value_dereference,
+    "\
+Return the result of applying the C unary * operator to the value." },
+
+  { "value-referenced-value", 1, 0, 0, gdbscm_value_referenced_value,
+    "\
+Given a value of a reference type, return the value referenced.\n\
+The difference between this function and value-dereference is that\n\
+the latter applies * unary operator to a value, which need not always\n\
+result in the value referenced.\n\
+For example, for a value which is a reference to an 'int' pointer ('int *'),\n\
+value-dereference will result in a value of type 'int' while\n\
+value-referenced-value will result in a value of type 'int *'." },
+
+  { "value-field", 2, 0, 0, gdbscm_value_field,
+    "\
+Return the specified field of the value.\n\
+\n\
+  Arguments: <gdb:value> string" },
+
+  { "value-subscript", 2, 0, 0, gdbscm_value_subscript,
+    "\
+Return the value of the array at the specified index.\n\
+\n\
+  Arguments: <gdb:value> integer" },
+
+  { "value-call", 2, 0, 0, gdbscm_value_call,
+    "\
+Perform an inferior function call taking the value as a pointer to the\n\
+function to call.\n\
+Each element of the argument list must be a <gdb:value> object or an object\n\
+that can be converted to one.\n\
+The result is the value returned by the function.\n\
+\n\
+  Arguments: <gdb:value> arg-list" },
+
+  { "value->bool", 1, 0, 0, gdbscm_value_to_bool,
+    "\
+Return the Scheme boolean representing the GDB value.\n\
+The value must be \"integer like\".  Pointers are ok." },
+
+  { "value->integer", 1, 0, 0, gdbscm_value_to_integer,
+    "\
+Return the Scheme integer representing the GDB value.\n\
+The value must be \"integer like\".  Pointers are ok." },
+
+  { "value->real", 1, 0, 0, gdbscm_value_to_real,
+    "\
+Return the Scheme real number representing the GDB value.\n\
+The value must be a number." },
+
+  { "value->bytevector", 1, 0, 0, gdbscm_value_to_bytevector,
+    "\
+Return a Scheme bytevector with the raw contents of the GDB value.\n\
+No transformation, endian or otherwise, is performed." },
+
+  { "value->string", 1, 0, 1, gdbscm_value_to_string,
+    "\
+Return the Unicode string of the value's contents.\n\
+If ENCODING is not given, the string is assumed to be encoded in\n\
+the target's charset.\n\
+An error setting \"error\" causes an exception to be thrown if there's\n\
+a decoding error.  An error setting of \"substitute\" causes invalid\n\
+characters to be replaced with \"?\".  The default is \"error\".\n\
+If LENGTH is provided, only fetch string to the length provided.\n\
+\n\
+  Arguments: <gdb:value>\n\
+             [#:encoding encoding] [#:errors \"error\"|\"substitute\"]\n\
+             [#:length length]" },
+
+  { "value->lazy-string", 1, 0, 1, gdbscm_value_to_lazy_string,
+    "\
+Return a Scheme object representing a lazily fetched Unicode string\n\
+of the value's contents.\n\
+If ENCODING is not given, the string is assumed to be encoded in\n\
+the target's charset.\n\
+If LENGTH is provided, only fetch string to the length provided.\n\
+\n\
+  Arguments: <gdb:value> [#:encoding encoding] [#:length length]" },
+
+  { "value-lazy?", 1, 0, 0, gdbscm_value_lazy_p,
+    "\
+Return #t if the value is lazy (not fetched yet from the inferior).\n\
+A lazy value is fetched when needed, or when the value-fetch-lazy! function\n\
+is called." },
+
+  { "make-lazy-value", 2, 0, 0, gdbscm_make_lazy_value,
+    "\
+Create a <gdb:value> that will be lazily fetched from the target.\n\
+\n\
+  Arguments: <gdb:type> address" },
+
+  { "value-fetch-lazy!", 1, 0, 0, gdbscm_value_fetch_lazy_x,
+    "\
+Fetch the value from the inferior, if it was lazy.\n\
+The result is \"unspecified\"." },
+
+  { "value-print", 1, 0, 0, gdbscm_value_print,
+    "\
+Return the string representation (print form) of the value." },
+
+  { "parse-and-eval", 1, 0, 0, gdbscm_parse_and_eval,
+    "\
+Evaluates string in gdb and returns the result as a <gdb:value> object." },
+
+  { "history-ref", 1, 0, 0, gdbscm_history_ref,
+    "\
+Return the specified value from GDB's value history." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_values (void)
+{
+  value_smob_tag = gdbscm_make_smob_type (value_smob_name,
+					  sizeof (value_smob));
+  scm_set_smob_mark (value_smob_tag, vlscm_mark_value_smob);
+  scm_set_smob_free (value_smob_tag, vlscm_free_value_smob);
+  scm_set_smob_print (value_smob_tag, vlscm_print_value_smob);
+  scm_set_smob_equalp (value_smob_tag, vlscm_equal_p_value_smob);
+
+  gdbscm_define_functions (value_functions, 1);
+
+  type_keyword = scm_from_latin1_keyword ("type");
+  encoding_keyword = scm_from_latin1_keyword ("encoding");
+  errors_keyword = scm_from_latin1_keyword ("errors");
+  length_keyword = scm_from_latin1_keyword ("length");
+
+  error_symbol = scm_from_latin1_symbol ("error");
+  escape_symbol = scm_from_latin1_symbol ("escape");
+  substitute_symbol = scm_from_latin1_symbol ("substitute");
+}