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.

114 files changed, 27862 insertions, 28 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 1e54611..99eb2fb 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,99 @@
+2014-02-10  Doug Evans  <xdje42@gmail.com>
+
+	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.
+
 2014-02-09  Doug Evans  <xdje42@gmail.com>
 
 	Revert this patch (which I approved, mea culpa).
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index e714550..6c8db6f 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -280,6 +280,58 @@ SUBDIR_TUI_LDFLAGS=
 SUBDIR_TUI_CFLAGS= \
 	-DTUI=1
 
+# Guile sub directory definitons for guile support.
+
+SUBDIR_GUILE_OBS = \
+	guile.o \
+	scm-arch.o \
+	scm-auto-load.o \
+	scm-block.o \
+	scm-breakpoint.o \
+	scm-disasm.o \
+	scm-exception.o \
+	scm-frame.o \
+	scm-iterator.o \
+	scm-lazy-string.o \
+	scm-objfile.o \
+	scm-math.o \
+	scm-ports.o \
+	scm-pretty-print.o \
+	scm-safe-call.o \
+	scm-gsmob.o \
+	scm-string.o \
+	scm-symbol.o \
+	scm-symtab.o \
+	scm-type.o \
+	scm-utils.o \
+	scm-value.o
+SUBDIR_GUILE_SRCS = \
+	guile/guile.c \
+	guile/scm-arch.c \
+	guile/scm-auto-load.c \
+	guile/scm-block.c \
+	guile/scm-breakpoint.c \
+	guile/scm-disasm.c \
+	guile/scm-exception.c \
+	guile/scm-frame.c \
+	guile/scm-iterator.c \
+	guile/scm-lazy-string.c \
+	guile/scm-objfile.c \
+	guile/scm-math.c \
+	guile/scm-ports.c \
+	guile/scm-pretty-print.c \
+	guile/scm-safe-call.c \
+	guile/scm-gsmob.c \
+	guile/scm-string.c \
+	guile/scm-symbol.c \
+	guile/scm-symtab.c \
+	guile/scm-type.c \
+	guile/scm-utils.c \
+	guile/scm-value.c
+SUBDIR_GUILE_DEPS =
+SUBDIR_GUILE_LDFLAGS=
+SUBDIR_GUILE_CFLAGS=
+
 #
 # python sub directory definitons
 #
@@ -460,7 +512,7 @@ CFLAGS = @CFLAGS@
 # are sometimes a little generic, we think that the risk of collision
 # with other header files is high.  If that happens, we try to mitigate
 # a bit the consequences by putting the Python includes last in the list.
-INTERNAL_CPPFLAGS = @CPPFLAGS@ @PYTHON_CPPFLAGS@
+INTERNAL_CPPFLAGS = @CPPFLAGS@ @GUILE_CPPFLAGS@ @PYTHON_CPPFLAGS@
 
 # Need to pass this to testsuite for "make check".  Probably should be
 # consistent with top-level Makefile.in and gdb/testsuite/Makefile.in
@@ -493,7 +545,8 @@ INTERNAL_LDFLAGS = $(CFLAGS) $(GLOBAL_CFLAGS) $(MH_LDFLAGS) $(LDFLAGS) $(CONFIG_
 # XM_CLIBS, defined in *config files, have host-dependent libs.
 # LIBIBERTY appears twice on purpose.
 CLIBS = $(SIM) $(READLINE) $(OPCODES) $(BFD) $(INTL) $(LIBIBERTY) $(LIBDECNUMBER) \
-	$(XM_CLIBS) $(NAT_CLIBS) $(GDBTKLIBS) @LIBS@ @PYTHON_LIBS@ \
+	$(XM_CLIBS) $(NAT_CLIBS) $(GDBTKLIBS) \
+	@LIBS@ @GUILE_LIBS@ @PYTHON_LIBS@ \
 	$(LIBEXPAT) $(LIBLZMA) $(LIBBABELTRACE) \
 	$(LIBIBERTY) $(WIN32LIBS) $(LIBGNU)
 CDEPS = $(XM_CDEPS) $(NAT_CDEPS) $(SIM) $(BFD) $(READLINE_DEPS) \
@@ -1126,6 +1179,9 @@ install-strip:
 	  `test -z '$(STRIP)' || \
 	    echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install-only
 
+install-guile:
+	$(SHELL) $(srcdir)/../mkinstalldirs $(DESTDIR)$(GDB_DATADIR)/guile/gdb
+
 install-python:
 	$(SHELL) $(srcdir)/../mkinstalldirs $(DESTDIR)$(GDB_DATADIR)/python/gdb
 
@@ -2177,7 +2233,99 @@ tui-winsource.o: $(srcdir)/tui/tui-winsource.c
 	$(COMPILE) $(srcdir)/tui/tui-winsource.c
 	$(POSTCOMPILE)
 
+# gdb/guile dependencies
 #
+# Need to explicitly specify the compile rule as make will do nothing
+# or try to compile the object file into the sub-directory.
+
+guile.o: $(srcdir)/guile/guile.c
+	$(COMPILE) $(srcdir)/guile/guile.c
+	$(POSTCOMPILE)
+
+scm-arch.o: $(srcdir)/guile/scm-arch.c
+	$(COMPILE) $(srcdir)/guile/scm-arch.c
+	$(POSTCOMPILE)
+
+scm-auto-load.o: $(srcdir)/guile/scm-auto-load.c
+	$(COMPILE) $(srcdir)/guile/scm-auto-load.c
+	$(POSTCOMPILE)
+
+scm-block.o: $(srcdir)/guile/scm-block.c
+	$(COMPILE) $(srcdir)/guile/scm-block.c
+	$(POSTCOMPILE)
+
+scm-breakpoint.o: $(srcdir)/guile/scm-breakpoint.c
+	$(COMPILE) $(srcdir)/guile/scm-breakpoint.c
+	$(POSTCOMPILE)
+
+scm-disasm.o: $(srcdir)/guile/scm-disasm.c
+	$(COMPILE) $(srcdir)/guile/scm-disasm.c
+	$(POSTCOMPILE)
+
+scm-exception.o: $(srcdir)/guile/scm-exception.c
+	$(COMPILE) $(srcdir)/guile/scm-exception.c
+	$(POSTCOMPILE)
+
+scm-frame.o: $(srcdir)/guile/scm-frame.c
+	$(COMPILE) $(srcdir)/guile/scm-frame.c
+	$(POSTCOMPILE)
+
+scm-iterator.o: $(srcdir)/guile/scm-iterator.c
+	$(COMPILE) $(srcdir)/guile/scm-iterator.c
+	$(POSTCOMPILE)
+
+scm-lazy-string.o: $(srcdir)/guile/scm-lazy-string.c
+	$(COMPILE) $(srcdir)/guile/scm-lazy-string.c
+	$(POSTCOMPILE)
+
+scm-math.o: $(srcdir)/guile/scm-math.c
+	$(COMPILE) $(srcdir)/guile/scm-math.c
+	$(POSTCOMPILE)
+
+scm-objfile.o: $(srcdir)/guile/scm-objfile.c
+	$(COMPILE) $(srcdir)/guile/scm-objfile.c
+	$(POSTCOMPILE)
+
+scm-ports.o: $(srcdir)/guile/scm-ports.c
+	$(COMPILE) $(srcdir)/guile/scm-ports.c
+	$(POSTCOMPILE)
+
+scm-pretty-print.o: $(srcdir)/guile/scm-pretty-print.c
+	$(COMPILE) $(srcdir)/guile/scm-pretty-print.c
+	$(POSTCOMPILE)
+
+scm-safe-call.o: $(srcdir)/guile/scm-safe-call.c
+	$(COMPILE) $(srcdir)/guile/scm-safe-call.c
+	$(POSTCOMPILE)
+
+scm-gsmob.o: $(srcdir)/guile/scm-gsmob.c
+	$(COMPILE) $(srcdir)/guile/scm-gsmob.c
+	$(POSTCOMPILE)
+
+scm-string.o: $(srcdir)/guile/scm-string.c
+	$(COMPILE) $(srcdir)/guile/scm-string.c
+	$(POSTCOMPILE)
+
+scm-symbol.o: $(srcdir)/guile/scm-symbol.c
+	$(COMPILE) $(srcdir)/guile/scm-symbol.c
+	$(POSTCOMPILE)
+
+scm-symtab.o: $(srcdir)/guile/scm-symtab.c
+	$(COMPILE) $(srcdir)/guile/scm-symtab.c
+	$(POSTCOMPILE)
+
+scm-type.o: $(srcdir)/guile/scm-type.c
+	$(COMPILE) $(srcdir)/guile/scm-type.c
+	$(POSTCOMPILE)
+
+scm-utils.o: $(srcdir)/guile/scm-utils.c
+	$(COMPILE) $(srcdir)/guile/scm-utils.c
+	$(POSTCOMPILE)
+
+scm-value.o: $(srcdir)/guile/scm-value.c
+	$(COMPILE) $(srcdir)/guile/scm-value.c
+	$(POSTCOMPILE)
+
 # gdb/python/ dependencies
 #
 # Need to explicitly specify the compile rule as make will do nothing
diff --git a/gdb/NEWS b/gdb/NEWS
index 7d71feb..b54a414 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -3,8 +3,39 @@
 
 *** Changes since GDB 7.7
 
+* Guile scripting
+
+  GDB now has support for scripting using Guile.  Whether this is
+  available is determined at configure time.
+  Guile version 2.0 or greater is required.
+  Guile version 2.0.9 is well tested, earlier 2.0 versions are not.
+
+* New commands (for set/show, see "New options" below)
+
+guile [code]
+gu [code]
+  Invoke CODE by passing it to the Guile interpreter.
+
+guile-repl
+gr
+  Start a Guile interactive prompt (or "repl" for "read-eval-print loop").
+
+info auto-load guile-scripts [regexp]
+  Print the list of automatically loaded Guile scripts.
+
+* The source command is now capable of sourcing Guile scripts.
+  This feature is dependent on the debugger being built with Guile support.
+
 * New options
 
+set guile print-stack (none|message|full)
+show guile print-stack
+  Show a stack trace when an error is encountered in a Guile script.
+
+set auto-load guile-scripts (on|off)
+show auto-load guile-scripts
+  Control auto-loading of Guile script files.
+
 maint ada set ignore-descriptive-types (on|off)
 maint ada show ignore-descriptive-types
   Control whether the debugger should ignore descriptive types in Ada
diff --git a/gdb/auto-load.c b/gdb/auto-load.c
index a2f6fb92..86d4e5e 100644
--- a/gdb/auto-load.c
+++ b/gdb/auto-load.c
@@ -39,7 +39,7 @@
 #include "top.h"
 #include "filestuff.h"
 #include "extension.h"
-#include "python/python.h"
+#include "gdb/section-scripts.h"
 
 /* The section to look in for auto-loaded scripts (in file formats that
    support sections).
@@ -877,18 +877,22 @@ source_section_scripts (struct objfile *objfile, const char *section_name,
       char *full_path;
       int opened, in_hash_table;
       struct cleanup *back_to;
-      /* At the moment we only support python scripts in .debug_gdb_scripts,
-	 but that can change.  */
-      const struct extension_language_defn *language
-	= &extension_language_python;
+      const struct extension_language_defn *language;
       objfile_script_sourcer_func *sourcer;
 
-      if (*p != 1)
+      switch (*p)
 	{
+	case SECTION_SCRIPT_ID_PYTHON_FILE:
+	  language = get_ext_lang_defn (EXT_LANG_PYTHON);
+	  break;
+	case SECTION_SCRIPT_ID_SCHEME_FILE:
+	  language = get_ext_lang_defn (EXT_LANG_GUILE);
+	  break;
+	default:
 	  warning (_("Invalid entry in %s section"), section_name);
 	  /* We could try various heuristics to find the next valid entry,
 	     but it's safer to just punt.  */
-	  break;
+	  return;
 	}
       file = ++p;
 
@@ -1395,6 +1399,8 @@ _initialize_auto_load (void)
 {
   struct cmd_list_element *cmd;
   char *scripts_directory_help, *gdb_name_help, *python_name_help;
+  char *guile_name_help;
+  const char *suffix;
 
   auto_load_pspace_data
     = register_program_space_data_with_cleanup (NULL,
@@ -1439,16 +1445,26 @@ Usage: info auto-load local-gdbinit"),
 
   auto_load_dir = xstrdup (AUTO_LOAD_DIR);
 
+  suffix = ext_lang_auto_load_suffix (get_ext_lang_defn (EXT_LANG_GDB));
   gdb_name_help
     = xstrprintf (_("\
 GDB scripts:    OBJFILE%s\n"),
-		  ext_lang_auto_load_suffix (&extension_language_gdb));
+		  suffix);
   python_name_help = NULL;
 #ifdef HAVE_PYTHON
+  suffix = ext_lang_auto_load_suffix (get_ext_lang_defn (EXT_LANG_PYTHON));
   python_name_help
     = xstrprintf (_("\
 Python scripts: OBJFILE%s\n"),
-		  ext_lang_auto_load_suffix (&extension_language_python));
+		  suffix);
+#endif
+  guile_name_help = NULL;
+#ifdef HAVE_GUILE
+  suffix = ext_lang_auto_load_suffix (get_ext_lang_defn (EXT_LANG_GUILE));
+  guile_name_help
+    = xstrprintf (_("\
+Guile scripts:  OBJFILE%s\n"),
+		  suffix);
 #endif
   scripts_directory_help
     = xstrprintf (_("\
@@ -1456,7 +1472,7 @@ Automatically loaded scripts are located in one of the directories listed\n\
 by this option.\n\
 \n\
 Script names:\n\
-%s%s\
+%s%s%s\
 \n\
 This option is ignored for the kinds of scripts \
 having 'set auto-load ... off'.\n\
@@ -1464,7 +1480,8 @@ Directories listed here need to be present also \
 in the 'set auto-load safe-path'\n\
 option."),
 		  gdb_name_help,
-		  python_name_help ? python_name_help : "");
+		  python_name_help ? python_name_help : "",
+		  guile_name_help ? guile_name_help : "");
 
   add_setshow_optional_filename_cmd ("scripts-directory", class_support,
 				     &auto_load_dir, _("\
@@ -1477,6 +1494,7 @@ Show the list of directories from which to load auto-loaded scripts."),
   xfree (scripts_directory_help);
   xfree (python_name_help);
   xfree (gdb_name_help);
+  xfree (guile_name_help);
 
   auto_load_safe_path = xstrdup (AUTO_LOAD_SAFE_PATH);
   auto_load_safe_path_vec_update ();
diff --git a/gdb/breakpoint.h b/gdb/breakpoint.h
index 8a5c4e8..4be9f23 100644
--- a/gdb/breakpoint.h
+++ b/gdb/breakpoint.h
@@ -29,6 +29,7 @@
 struct value;
 struct block;
 struct gdbpy_breakpoint_object;
+struct gdbscm_breakpoint_object;
 struct get_number_or_range_state;
 struct thread_info;
 struct bpstats;
@@ -739,6 +740,9 @@ struct breakpoint
        can sometimes be NULL for enabled GDBs as not all breakpoint
        types are tracked by the scripting language API.  */
     struct gdbpy_breakpoint_object *py_bp_object;
+
+    /* Same as py_bp_object, but for Scheme.  */
+    struct gdbscm_breakpoint_object *scm_bp_object;
   };
 
 /* An instance of this type is used to represent a watchpoint.  It
diff --git a/gdb/cli/cli-cmds.c b/gdb/cli/cli-cmds.c
index 9374c1d..bfcd975 100644
--- a/gdb/cli/cli-cmds.c
+++ b/gdb/cli/cli-cmds.c
@@ -1225,7 +1225,7 @@ show_user (char *args, int from_tty)
       const char *comname = args;
 
       c = lookup_cmd (&comname, cmdlist, "", 0, 1);
-      /* c->user_commands would be NULL if it's a python command.  */
+      /* c->user_commands would be NULL if it's a python/scheme command.  */
       if (c->class != class_user || !c->user_commands)
 	error (_("Not a user command."));
       show_user_1 (c, "", args, gdb_stdout);
@@ -1831,7 +1831,7 @@ you must type \"disassemble 'foo.c'::bar\" and not \"disassemble foo.c:bar\"."))
 Run the ``make'' program using the rest of the line as arguments."));
   set_cmd_completer (c, filename_completer);
   add_cmd ("user", no_class, show_user, _("\
-Show definitions of non-python user defined commands.\n\
+Show definitions of non-python/scheme user defined commands.\n\
 Argument is the name of the user defined command.\n\
 With no argument, show definitions of all user defined commands."), &showlist);
   add_com ("apropos", class_support, apropos_command,
@@ -1839,8 +1839,8 @@ With no argument, show definitions of all user defined commands."), &showlist);
 
   add_setshow_uinteger_cmd ("max-user-call-depth", no_class,
 			   &max_user_call_depth, _("\
-Set the max call depth for non-python user-defined commands."), _("\
-Show the max call depth for non-python user-defined commands."), NULL,
+Set the max call depth for non-python/scheme user-defined commands."), _("\
+Show the max call depth for non-python/scheme user-defined commands."), NULL,
 			    NULL,
 			    show_max_user_call_depth,
 			    &setlist, &showlist);
diff --git a/gdb/cli/cli-script.c b/gdb/cli/cli-script.c
index 47cad75..246fcc9 100644
--- a/gdb/cli/cli-script.c
+++ b/gdb/cli/cli-script.c
@@ -91,6 +91,7 @@ multi_line_command_p (enum command_control_type type)
     case while_stepping_control:
     case commands_control:
     case python_control:
+    case guile_control:
       return 1;
     default:
       return 0;
@@ -274,6 +275,19 @@ print_command_lines (struct ui_out *uiout, struct command_line *cmd,
 	  continue;
 	}
 
+      if (list->control_type == guile_control)
+	{
+	  ui_out_field_string (uiout, NULL, "guile");
+	  ui_out_text (uiout, "\n");
+	  print_command_lines (uiout, *list->body_list, depth + 1);
+	  if (depth)
+	    ui_out_spaces (uiout, 2 * depth);
+	  ui_out_field_string (uiout, NULL, "end");
+	  ui_out_text (uiout, "\n");
+	  list = list->next;
+	  continue;
+	}
+
       /* Ignore illegal command type and try next.  */
       list = list->next;
     }				/* while (list) */
@@ -589,6 +603,7 @@ execute_control_command (struct command_line *cmd)
       }
 
     case python_control:
+    case guile_control:
       {
 	eval_ext_lang_from_control_command (cmd);
 	ret = simple_control;
@@ -1028,6 +1043,11 @@ process_next_line (char *p, struct command_line **command, int parse_commands,
 	     here.  */
 	  *command = build_command_line (python_control, "");
 	}
+      else if (p_end - p == 5 && !strncmp (p, "guile", 5))
+	{
+	  /* Note that we ignore the inline "guile command" form here.  */
+	  *command = build_command_line (guile_control, "");
+	}
       else if (p_end - p == 10 && !strncmp (p, "loop_break", 10))
 	{
 	  *command = (struct command_line *)
@@ -1115,7 +1135,8 @@ recurse_read_control_structure (char * (*read_next_line_func) (void),
 
       next = NULL;
       val = process_next_line (read_next_line_func (), &next, 
-			       current_cmd->control_type != python_control,
+			       current_cmd->control_type != python_control
+			       && current_cmd->control_type != guile_control,
 			       validator, closure);
 
       /* Just skip blanks and comments.  */
diff --git a/gdb/config.in b/gdb/config.in
index 802127f..5c465679 100644
--- a/gdb/config.in
+++ b/gdb/config.in
@@ -159,6 +159,9 @@
 /* Define if <sys/procfs.h> has gregset_t. */
 #undef HAVE_GREGSET_T
 
+/* Define if Guile interpreter is being linked in. */
+#undef HAVE_GUILE
+
 /* Define if you have the iconv() function. */
 #undef HAVE_ICONV
 
diff --git a/gdb/configure b/gdb/configure
index 8ae2e09..f856cc4 100755
--- a/gdb/configure
+++ b/gdb/configure
@@ -658,6 +658,9 @@ TARGET_SYSTEM_ROOT
 CONFIG_LDFLAGS
 RDYNAMIC
 ALLOCA
+GUILE_LIBS
+GUILE_CPPFLAGS
+pkg_config_prog_path
 PYTHON_LIBS
 PYTHON_CPPFLAGS
 PYTHON_CFLAGS
@@ -813,6 +816,7 @@ with_gnu_ld
 enable_rpath
 with_libexpat_prefix
 with_python
+with_guile
 enable_libmcheck
 with_included_regex
 with_sysroot
@@ -1530,6 +1534,8 @@ Optional Packages:
   --without-libexpat-prefix     don't search for libexpat in includedir and libdir
   --with-python[=PYTHON]  include python support
                           (auto/yes/no/<python-program>)
+  --with-guile[=GUILE]    include guile support
+                          (auto/yes/no/<guile-version>/<pkg-config-program>)
   --without-included-regex
                           don't use included regex; this is the default on
                           systems with version 2 of the GNU C library (use
@@ -8681,6 +8687,414 @@ fi
 
 
 
+# -------------------- #
+# Check for libguile.  #
+# -------------------- #
+
+
+# Extract the first word of "pkg-config", so it can be a program name with args.
+set dummy pkg-config; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_path_pkg_config_prog_path+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  case $pkg_config_prog_path in
+  [\\/]* | ?:[\\/]*)
+  ac_cv_path_pkg_config_prog_path="$pkg_config_prog_path" # Let the user override the test with a path.
+  ;;
+  *)
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_path_pkg_config_prog_path="$as_dir/$ac_word$ac_exec_ext"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+  test -z "$ac_cv_path_pkg_config_prog_path" && ac_cv_path_pkg_config_prog_path="missing"
+  ;;
+esac
+fi
+pkg_config_prog_path=$ac_cv_path_pkg_config_prog_path
+if test -n "$pkg_config_prog_path"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $pkg_config_prog_path" >&5
+$as_echo "$pkg_config_prog_path" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+
+
+
+
+
+
+# Check whether --with-guile was given.
+if test "${with_guile+set}" = set; then :
+  withval=$with_guile;
+else
+  with_guile=auto
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use guile" >&5
+$as_echo_n "checking whether to use guile... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_guile" >&5
+$as_echo "$with_guile" >&6; }
+
+try_guile_versions="guile-2.0"
+have_libguile=no
+case "${with_guile}" in
+no)
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: guile support disabled; some features will be unavailable." >&5
+$as_echo "$as_me: WARNING: guile support disabled; some features will be unavailable." >&2;}
+  ;;
+auto)
+
+  pkg_config=${pkg_config_prog_path}
+  guile_version_list=${try_guile_versions}
+  flag_errors=no
+
+  if test "${pkg_config}" = "missing"; then
+    as_fn_error "pkg-config program not found" "$LINENO" 5
+  fi
+  if test ! -f "${pkg_config}"; then
+    as_fn_error "pkg-config program ${pkg_config} not found" "$LINENO" 5
+  fi
+  found_usable_guile=checking
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable guile from ${pkg_config}" >&5
+$as_echo_n "checking for usable guile from ${pkg_config}... " >&6; }
+  for guile_version in ${guile_version_list}; do
+    ${pkg_config} --exists ${guile_version} 2>/dev/null
+    if test $? != 0; then
+      continue
+    fi
+            new_CPPFLAGS=`${pkg_config} --cflags ${guile_version}`
+    if test $? != 0; then
+      as_fn_error "failure running pkg-config --cflags ${guile_version}" "$LINENO" 5
+    fi
+    new_LIBS=`${pkg_config} --libs ${guile_version}`
+    if test $? != 0; then
+      as_fn_error "failure running pkg-config --libs ${guile_version}" "$LINENO" 5
+    fi
+        found_usable_guile=${guile_version}
+    break
+  done
+  if test "${found_usable_guile}" = "checking"; then
+    if test "${flag_errors}" = "yes"; then
+      as_fn_error "unable to find usable guile version from \"${guile_version_list}\"" "$LINENO" 5
+    else
+      found_usable_guile=no
+    fi
+  fi
+      if test "${found_usable_guile}" != no; then
+    save_CPPFLAGS=$CPPFLAGS
+    save_LIBS=$LIBS
+    CPPFLAGS="$CPPFLAGS $new_CPPFLAGS"
+    LIBS="$LIBS $new_LIBS"
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include "libguile.h"
+int
+main ()
+{
+scm_init_guile ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  have_libguile=yes
+                    GUILE_CPPFLAGS=$new_CPPFLAGS
+                    GUILE_LIBS=$new_LIBS
+else
+  found_usable_guile=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    CPPFLAGS=$save_CPPFLAGS
+    LIBS=$save_LIBS
+    if test "${found_usable_guile}" = no; then
+      if test "${flag_errors}" = yes; then
+        { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "linking guile version ${guile_version} test program failed
+See \`config.log' for more details." "$LINENO" 5; }
+      fi
+    fi
+  fi
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${found_usable_guile}" >&5
+$as_echo "${found_usable_guile}" >&6; }
+
+  ;;
+yes)
+
+  pkg_config=${pkg_config_prog_path}
+  guile_version_list=${try_guile_versions}
+  flag_errors=yes
+
+  if test "${pkg_config}" = "missing"; then
+    as_fn_error "pkg-config program not found" "$LINENO" 5
+  fi
+  if test ! -f "${pkg_config}"; then
+    as_fn_error "pkg-config program ${pkg_config} not found" "$LINENO" 5
+  fi
+  found_usable_guile=checking
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable guile from ${pkg_config}" >&5
+$as_echo_n "checking for usable guile from ${pkg_config}... " >&6; }
+  for guile_version in ${guile_version_list}; do
+    ${pkg_config} --exists ${guile_version} 2>/dev/null
+    if test $? != 0; then
+      continue
+    fi
+            new_CPPFLAGS=`${pkg_config} --cflags ${guile_version}`
+    if test $? != 0; then
+      as_fn_error "failure running pkg-config --cflags ${guile_version}" "$LINENO" 5
+    fi
+    new_LIBS=`${pkg_config} --libs ${guile_version}`
+    if test $? != 0; then
+      as_fn_error "failure running pkg-config --libs ${guile_version}" "$LINENO" 5
+    fi
+        found_usable_guile=${guile_version}
+    break
+  done
+  if test "${found_usable_guile}" = "checking"; then
+    if test "${flag_errors}" = "yes"; then
+      as_fn_error "unable to find usable guile version from \"${guile_version_list}\"" "$LINENO" 5
+    else
+      found_usable_guile=no
+    fi
+  fi
+      if test "${found_usable_guile}" != no; then
+    save_CPPFLAGS=$CPPFLAGS
+    save_LIBS=$LIBS
+    CPPFLAGS="$CPPFLAGS $new_CPPFLAGS"
+    LIBS="$LIBS $new_LIBS"
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include "libguile.h"
+int
+main ()
+{
+scm_init_guile ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  have_libguile=yes
+                    GUILE_CPPFLAGS=$new_CPPFLAGS
+                    GUILE_LIBS=$new_LIBS
+else
+  found_usable_guile=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    CPPFLAGS=$save_CPPFLAGS
+    LIBS=$save_LIBS
+    if test "${found_usable_guile}" = no; then
+      if test "${flag_errors}" = yes; then
+        { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "linking guile version ${guile_version} test program failed
+See \`config.log' for more details." "$LINENO" 5; }
+      fi
+    fi
+  fi
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${found_usable_guile}" >&5
+$as_echo "${found_usable_guile}" >&6; }
+
+  ;;
+[\\/]* | ?:[\\/]*)
+
+  pkg_config=${with_guile}
+  guile_version_list=${try_guile_versions}
+  flag_errors=yes
+
+  if test "${pkg_config}" = "missing"; then
+    as_fn_error "pkg-config program not found" "$LINENO" 5
+  fi
+  if test ! -f "${pkg_config}"; then
+    as_fn_error "pkg-config program ${pkg_config} not found" "$LINENO" 5
+  fi
+  found_usable_guile=checking
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable guile from ${pkg_config}" >&5
+$as_echo_n "checking for usable guile from ${pkg_config}... " >&6; }
+  for guile_version in ${guile_version_list}; do
+    ${pkg_config} --exists ${guile_version} 2>/dev/null
+    if test $? != 0; then
+      continue
+    fi
+            new_CPPFLAGS=`${pkg_config} --cflags ${guile_version}`
+    if test $? != 0; then
+      as_fn_error "failure running pkg-config --cflags ${guile_version}" "$LINENO" 5
+    fi
+    new_LIBS=`${pkg_config} --libs ${guile_version}`
+    if test $? != 0; then
+      as_fn_error "failure running pkg-config --libs ${guile_version}" "$LINENO" 5
+    fi
+        found_usable_guile=${guile_version}
+    break
+  done
+  if test "${found_usable_guile}" = "checking"; then
+    if test "${flag_errors}" = "yes"; then
+      as_fn_error "unable to find usable guile version from \"${guile_version_list}\"" "$LINENO" 5
+    else
+      found_usable_guile=no
+    fi
+  fi
+      if test "${found_usable_guile}" != no; then
+    save_CPPFLAGS=$CPPFLAGS
+    save_LIBS=$LIBS
+    CPPFLAGS="$CPPFLAGS $new_CPPFLAGS"
+    LIBS="$LIBS $new_LIBS"
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include "libguile.h"
+int
+main ()
+{
+scm_init_guile ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  have_libguile=yes
+                    GUILE_CPPFLAGS=$new_CPPFLAGS
+                    GUILE_LIBS=$new_LIBS
+else
+  found_usable_guile=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    CPPFLAGS=$save_CPPFLAGS
+    LIBS=$save_LIBS
+    if test "${found_usable_guile}" = no; then
+      if test "${flag_errors}" = yes; then
+        { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "linking guile version ${guile_version} test program failed
+See \`config.log' for more details." "$LINENO" 5; }
+      fi
+    fi
+  fi
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${found_usable_guile}" >&5
+$as_echo "${found_usable_guile}" >&6; }
+
+  ;;
+"" | */*)
+  # Disallow --with=guile="" and --with-guile=foo/bar.
+  as_fn_error "invalid value for --with-guile" "$LINENO" 5
+  ;;
+*)
+  # A space separate list of guile versions to try, in order.
+
+  pkg_config=${pkg_config_prog_path}
+  guile_version_list=${with_guile}
+  flag_errors=yes
+
+  if test "${pkg_config}" = "missing"; then
+    as_fn_error "pkg-config program not found" "$LINENO" 5
+  fi
+  if test ! -f "${pkg_config}"; then
+    as_fn_error "pkg-config program ${pkg_config} not found" "$LINENO" 5
+  fi
+  found_usable_guile=checking
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable guile from ${pkg_config}" >&5
+$as_echo_n "checking for usable guile from ${pkg_config}... " >&6; }
+  for guile_version in ${guile_version_list}; do
+    ${pkg_config} --exists ${guile_version} 2>/dev/null
+    if test $? != 0; then
+      continue
+    fi
+            new_CPPFLAGS=`${pkg_config} --cflags ${guile_version}`
+    if test $? != 0; then
+      as_fn_error "failure running pkg-config --cflags ${guile_version}" "$LINENO" 5
+    fi
+    new_LIBS=`${pkg_config} --libs ${guile_version}`
+    if test $? != 0; then
+      as_fn_error "failure running pkg-config --libs ${guile_version}" "$LINENO" 5
+    fi
+        found_usable_guile=${guile_version}
+    break
+  done
+  if test "${found_usable_guile}" = "checking"; then
+    if test "${flag_errors}" = "yes"; then
+      as_fn_error "unable to find usable guile version from \"${guile_version_list}\"" "$LINENO" 5
+    else
+      found_usable_guile=no
+    fi
+  fi
+      if test "${found_usable_guile}" != no; then
+    save_CPPFLAGS=$CPPFLAGS
+    save_LIBS=$LIBS
+    CPPFLAGS="$CPPFLAGS $new_CPPFLAGS"
+    LIBS="$LIBS $new_LIBS"
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include "libguile.h"
+int
+main ()
+{
+scm_init_guile ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  have_libguile=yes
+                    GUILE_CPPFLAGS=$new_CPPFLAGS
+                    GUILE_LIBS=$new_LIBS
+else
+  found_usable_guile=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    CPPFLAGS=$save_CPPFLAGS
+    LIBS=$save_LIBS
+    if test "${found_usable_guile}" = no; then
+      if test "${flag_errors}" = yes; then
+        { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "linking guile version ${guile_version} test program failed
+See \`config.log' for more details." "$LINENO" 5; }
+      fi
+    fi
+  fi
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${found_usable_guile}" >&5
+$as_echo "${found_usable_guile}" >&6; }
+
+  ;;
+esac
+
+if test "${have_libguile}" != no; then
+
+$as_echo "#define HAVE_GUILE 1" >>confdefs.h
+
+  CONFIG_OBS="$CONFIG_OBS \$(SUBDIR_GUILE_OBS)"
+  CONFIG_DEPS="$CONFIG_DEPS \$(SUBDIR_GUILE_DEPS)"
+  CONFIG_SRCS="$CONFIG_SRCS \$(SUBDIR_GUILE_SRCS)"
+  CONFIG_INSTALL="$CONFIG_INSTALL install-guile"
+  ENABLE_CFLAGS="$ENABLE_CFLAGS \$(SUBDIR_GUILE_CFLAGS)"
+else
+  # Even if Guile support is not compiled in, we need to have these files
+  # included.
+  CONFIG_OBS="$CONFIG_OBS guile.o"
+  CONFIG_SRCS="$CONFIG_SRCS guile/guile.c"
+fi
+
+
+
 # --------------------- #
 # Check for libmcheck.  #
 # --------------------- #
diff --git a/gdb/configure.ac b/gdb/configure.ac
index feb28f3..73decd0 100644
--- a/gdb/configure.ac
+++ b/gdb/configure.ac
@@ -1054,6 +1054,154 @@ AC_SUBST(PYTHON_CFLAGS)
 AC_SUBST(PYTHON_CPPFLAGS)
 AC_SUBST(PYTHON_LIBS)
 
+# -------------------- #
+# Check for libguile.  #
+# -------------------- #
+
+dnl We check guile with pkg-config.
+
+AC_PATH_PROG(pkg_config_prog_path, pkg-config, missing)
+
+dnl Utility to simplify finding libguile.
+dnl $1 = pkg-config-program
+dnl $2 = space-separate list of guile versions to try
+dnl $3 = yes|no, indicating whether to flag errors or ignore them
+dnl $4 = the shell variable to assign the result to
+dnl      If libguile is found we store "yes" here.
+
+AC_DEFUN([AC_TRY_LIBGUILE],
+[
+  pkg_config=$1
+  guile_version_list=$2
+  flag_errors=$3
+  define([have_libguile_var],$4)
+  if test "${pkg_config}" = "missing"; then
+    AC_ERROR(pkg-config program not found)
+  fi
+  if test ! -f "${pkg_config}"; then
+    AC_ERROR(pkg-config program ${pkg_config} not found)
+  fi
+  found_usable_guile=checking
+  AC_MSG_CHECKING([for usable guile from ${pkg_config}])
+  for guile_version in ${guile_version_list}; do
+    ${pkg_config} --exists ${guile_version} 2>/dev/null
+    if test $? != 0; then
+      continue
+    fi
+    dnl pkg-config says the package exists, so if we get an error now,
+    dnl that's bad.
+    new_CPPFLAGS=`${pkg_config} --cflags ${guile_version}`
+    if test $? != 0; then
+      AC_ERROR(failure running pkg-config --cflags ${guile_version})
+    fi
+    new_LIBS=`${pkg_config} --libs ${guile_version}`
+    if test $? != 0; then
+      AC_ERROR(failure running pkg-config --libs ${guile_version})
+    fi
+    dnl If we get this far, great.
+    found_usable_guile=${guile_version}
+    break
+  done
+  if test "${found_usable_guile}" = "checking"; then
+    if test "${flag_errors}" = "yes"; then
+      AC_ERROR(unable to find usable guile version from "${guile_version_list}")
+    else
+      found_usable_guile=no
+    fi
+  fi
+  dnl One final sanity check.
+  dnl The user could have said --with-guile=python-2.7.
+  if test "${found_usable_guile}" != no; then
+    save_CPPFLAGS=$CPPFLAGS
+    save_LIBS=$LIBS
+    CPPFLAGS="$CPPFLAGS $new_CPPFLAGS"
+    LIBS="$LIBS $new_LIBS"
+    AC_LINK_IFELSE(AC_LANG_PROGRAM([[#include "libguile.h"]],
+                                   [[scm_init_guile ();]]),
+                   [have_libguile_var=yes
+                    GUILE_CPPFLAGS=$new_CPPFLAGS
+                    GUILE_LIBS=$new_LIBS],
+                   [found_usable_guile=no])
+    CPPFLAGS=$save_CPPFLAGS
+    LIBS=$save_LIBS
+    if test "${found_usable_guile}" = no; then
+      if test "${flag_errors}" = yes; then
+        AC_MSG_FAILURE(linking guile version ${guile_version} test program failed)
+      fi
+    fi
+  fi
+  AC_MSG_RESULT([${found_usable_guile}])
+])
+
+dnl There are several different values for --with-guile:
+dnl
+dnl no -   Don't include guile support.
+dnl yes -  Include guile support, error if it's missing.
+dnl        The pkg-config program must be in $PATH.
+dnl auto - Same as "yes", but if guile is missing from the system,
+dnl        fall back to "no".
+dnl guile-version [guile-version-choice-2 ...] -
+dnl        A space-separated list of guile package versions to try.
+dnl        These are passed to pkg-config as-is.
+dnl        E.g., guile-2.0 or guile-2.2-uninstalled
+dnl        This requires making sure PKG_CONFIG_PATH is set appropriately.
+dnl /path/to/pkg-config -
+dnl        Use this pkg-config program.
+dnl        NOTE: This needn't be the "real" pkg-config program.
+dnl        It could be a shell script.  It is invoked as:
+dnl        pkg-config --exists $version
+dnl        pkg-config --cflags $version
+dnl        pkg-config --libs $version
+dnl        $version will be the default guile version (currently guile-2.0),
+dnl        but the program is free to ignore this.
+
+AC_ARG_WITH(guile,
+  AS_HELP_STRING([--with-guile@<:@=GUILE@:>@], [include guile support (auto/yes/no/<guile-version>/<pkg-config-program>)]),
+  [], [with_guile=auto])
+AC_MSG_CHECKING([whether to use guile])
+AC_MSG_RESULT([$with_guile])
+
+try_guile_versions="guile-2.0"
+have_libguile=no
+case "${with_guile}" in
+no)
+  AC_MSG_WARN([guile support disabled; some features will be unavailable.])
+  ;;
+auto)
+  AC_TRY_LIBGUILE(${pkg_config_prog_path}, ${try_guile_versions}, no, have_libguile)
+  ;;
+yes)
+  AC_TRY_LIBGUILE(${pkg_config_prog_path}, ${try_guile_versions}, yes, have_libguile)
+  ;;
+[[\\/]]* | ?:[[\\/]]*)
+  AC_TRY_LIBGUILE(${with_guile}, ${try_guile_versions}, yes, have_libguile)
+  ;;
+"" | */*)
+  # Disallow --with=guile="" and --with-guile=foo/bar.
+  AC_ERROR(invalid value for --with-guile)
+  ;;
+*)
+  # A space separate list of guile versions to try, in order.
+  AC_TRY_LIBGUILE(${pkg_config_prog_path}, ${with_guile}, yes, have_libguile)
+  ;;
+esac
+
+if test "${have_libguile}" != no; then
+  AC_DEFINE(HAVE_GUILE, 1, [Define if Guile interpreter is being linked in.])
+  CONFIG_OBS="$CONFIG_OBS \$(SUBDIR_GUILE_OBS)"
+  CONFIG_DEPS="$CONFIG_DEPS \$(SUBDIR_GUILE_DEPS)"
+  CONFIG_SRCS="$CONFIG_SRCS \$(SUBDIR_GUILE_SRCS)"
+  CONFIG_INSTALL="$CONFIG_INSTALL install-guile"
+  ENABLE_CFLAGS="$ENABLE_CFLAGS \$(SUBDIR_GUILE_CFLAGS)"
+else
+  # Even if Guile support is not compiled in, we need to have these files
+  # included.
+  CONFIG_OBS="$CONFIG_OBS guile.o"
+  CONFIG_SRCS="$CONFIG_SRCS guile/guile.c"
+fi
+AC_SUBST(GUILE_CPPFLAGS)
+AC_SUBST(GUILE_LIBS)
+
 # --------------------- #
 # Check for libmcheck.  #
 # --------------------- #
diff --git a/gdb/data-directory/Makefile.in b/gdb/data-directory/Makefile.in
index 29a48e4..3288e50 100644
--- a/gdb/data-directory/Makefile.in
+++ b/gdb/data-directory/Makefile.in
@@ -19,8 +19,9 @@
 srcdir = @srcdir@
 SYSCALLS_SRCDIR = $(srcdir)/../syscalls
 PYTHON_SRCDIR = $(srcdir)/../python/lib
+GUILE_SRCDIR = $(srcdir)/../guile/lib
 SYSTEM_GDBINIT_SRCDIR = $(srcdir)/../system-gdbinit
-VPATH = $(srcdir):$(SYSCALLS_SRCDIR):$(PYTHON_SRCDIR):$(SYSTEM_GDBINIT_SRCDIR)
+VPATH = $(srcdir):$(SYSCALLS_SRCDIR):$(PYTHON_SRCDIR):$(GUILE_SRCDIR):$(SYSTEM_GDBINIT_SRCDIR)
 
 top_srcdir = @top_srcdir@
 top_builddir = @top_builddir@
@@ -72,6 +73,17 @@ PYTHON_FILES = \
 	gdb/function/__init__.py \
 	gdb/function/strfns.py
 
+GUILE_DIR = guile
+GUILE_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(GUILE_DIR)
+GUILE_FILES = \
+	./gdb.scm \
+	gdb/boot.scm \
+	gdb/experimental.scm \
+	gdb/init.scm \
+	gdb/iterator.scm \
+	gdb/printing.scm \
+	gdb/types.scm
+
 SYSTEM_GDBINIT_DIR = system-gdbinit
 SYSTEM_GDBINIT_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(SYSTEM_GDBINIT_DIR)
 SYSTEM_GDBINIT_FILES = \
@@ -111,7 +123,7 @@ FLAGS_TO_PASS = \
 	"RUNTESTFLAGS=$(RUNTESTFLAGS)"
 
 .PHONY: all
-all: stamp-syscalls stamp-python stamp-system-gdbinit
+all: stamp-syscalls stamp-python stamp-guile stamp-system-gdbinit
 
 # For portability's sake, we need to handle systems that don't have
 # symbolic links.
@@ -195,6 +207,43 @@ uninstall-python:
 	  done \
 	done
 
+stamp-guile: Makefile $(GUILE_FILES)
+	rm -rf ./$(GUILE_DIR)
+	files='$(GUILE_FILES)' ; \
+	for file in $$files ; do \
+	  dir=`echo "$$file" | sed 's,/[^/]*$$,,'` ; \
+	  $(INSTALL_DIR) ./$(GUILE_DIR)/$$dir ; \
+	  $(INSTALL_DATA) $(GUILE_SRCDIR)/$$file ./$(GUILE_DIR)/$$dir ; \
+	done
+	touch $@
+
+.PHONY: clean-guile
+clean-guile:
+	rm -rf $(GUILE_DIR)
+	rm -f stamp-guile
+
+.PHONY: install-guile
+install-guile:
+	files='$(GUILE_FILES)' ; \
+	for file in $$files ; do \
+	  dir=`echo "$$file" | sed 's,/[^/]*$$,,'` ; \
+	  $(INSTALL_DIR) $(GUILE_INSTALL_DIR)/$$dir ; \
+	  $(INSTALL_DATA) ./$(GUILE_DIR)/$$file $(GUILE_INSTALL_DIR)/$$dir ; \
+	done
+
+.PHONY: uninstall-guile
+uninstall-guile:
+	files='$(GUILE_FILES)' ; \
+	for file in $$files ; do \
+	  slashdir=`echo "/$$file" | sed 's,/[^/]*$$,,'` ; \
+	  rm -f $(GUILE_INSTALL_DIR)/$$file ; \
+	  while test "x$$file" != "x$$slashdir" ; do \
+	    rmdir 2>/dev/null "$(GUILE_INSTALL_DIR)$$slashdir" ; \
+	    file="$$slashdir" ; \
+	    slashdir=`echo "$$file" | sed 's,/[^/]*$$,,'` ; \
+	  done \
+	done
+
 stamp-system-gdbinit: Makefile $(SYSTEM_GDBINIT_FILES)
 	rm -rf ./$(SYSTEM_GDBINIT_DIR)
 	mkdir ./$(SYSTEM_GDBINIT_DIR)
@@ -246,13 +295,15 @@ install: all
 	@$(MAKE) $(FLAGS_TO_PASS) install-only
 
 .PHONY: install-only
-install-only: install-syscalls install-python install-system-gdbinit
+install-only: install-syscalls install-python install-guile \
+	install-system-gdbinit
 
 .PHONY: uninstall
-uninstall: uninstall-syscalls uninstall-python uninstall-system-gdbinit
+uninstall: uninstall-syscalls uninstall-python uninstall-guile \
+	uninstall-system-gdbinit
 
 .PHONY: clean
-clean: clean-syscalls clean-python clean-system-gdbinit
+clean: clean-syscalls clean-python clean-guile clean-system-gdbinit
 
 .PHONY: maintainer-clean realclean distclean
 maintainer-clean realclean distclean: clean
diff --git a/gdb/defs.h b/gdb/defs.h
index 8c13e66..a9669cf 100644
--- a/gdb/defs.h
+++ b/gdb/defs.h
@@ -411,6 +411,7 @@ enum command_control_type
     if_control,
     commands_control,
     python_control,
+    guile_control,
     while_stepping_control,
     invalid_control
   };
diff --git a/gdb/disasm.c b/gdb/disasm.c
index 064ae05..d94225b 100644
--- a/gdb/disasm.c
+++ b/gdb/disasm.c
@@ -376,7 +376,7 @@ fprintf_disasm (void *stream, const char *format, ...)
   return 0;
 }
 
-static struct disassemble_info
+struct disassemble_info
 gdb_disassemble_info (struct gdbarch *gdbarch, struct ui_file *file)
 {
   struct disassemble_info di;
diff --git a/gdb/disasm.h b/gdb/disasm.h
index d2d5f51..9c6777c 100644
--- a/gdb/disasm.h
+++ b/gdb/disasm.h
@@ -19,15 +19,23 @@
 #ifndef DISASM_H
 #define DISASM_H
 
+#include "dis-asm.h"
+
 #define DISASSEMBLY_SOURCE	(0x1 << 0)
 #define DISASSEMBLY_RAW_INSN	(0x1 << 1)
 #define DISASSEMBLY_OMIT_FNAME	(0x1 << 2)
 #define DISASSEMBLY_FILENAME	(0x1 << 3)
 #define DISASSEMBLY_OMIT_PC	(0x1 << 4)
 
+struct gdbarch;
 struct ui_out;
 struct ui_file;
 
+/* Return a filled in disassemble_info object for use by gdb.  */
+
+extern struct disassemble_info gdb_disassemble_info (struct gdbarch *gdbarch,
+						     struct ui_file *file);
+
 extern void gdb_disassembly (struct gdbarch *gdbarch, struct ui_out *uiout,
 			     char *file_string, int flags, int how_many,
 			     CORE_ADDR low, CORE_ADDR high);
diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog
index 7ccabc4..1dd7231 100644
--- a/gdb/doc/ChangeLog
+++ b/gdb/doc/ChangeLog
@@ -1,3 +1,14 @@
+2014-02-10  Doug Evans  <xdje42@gmail.com>
+
+	* 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.
+
 2014-01-28  Joel Brobecker  <brobecker@adacore.com>
 
 	* gdb.texinfo (Ada Glitches): Document the new "maint ada set/show
diff --git a/gdb/doc/Makefile.in b/gdb/doc/Makefile.in
index cf63e4a..a578d3a 100644
--- a/gdb/doc/Makefile.in
+++ b/gdb/doc/Makefile.in
@@ -130,6 +130,7 @@ GDB_DOC_BUILD_INCLUDES = \
 	GDBvn.texi
 GDB_DOC_FILES = \
 	$(srcdir)/gdb.texinfo \
+	$(srcdir)/guile.texi \
 	$(GDB_DOC_SOURCE_INCLUDES) \
 	$(GDB_DOC_BUILD_INCLUDES)
 
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index af14286..035573e 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -22324,6 +22324,12 @@ These are @value{GDBN} control commands for the auto-loading:
 @tab Show setting of @value{GDBN} Python scripts.
 @item @xref{info auto-load python-scripts}.
 @tab Show state of @value{GDBN} Python scripts.
+@item @xref{set auto-load guile-scripts}.
+@tab Control for @value{GDBN} Guile scripts.
+@item @xref{show auto-load guile-scripts}.
+@tab Show setting of @value{GDBN} Guile scripts.
+@item @xref{info auto-load guile-scripts}.
+@tab Show state of @value{GDBN} Guile scripts.
 @item @xref{set auto-load scripts-directory}.
 @tab Control for @value{GDBN} auto-loaded scripts location.
 @item @xref{show auto-load scripts-directory}.
@@ -22950,7 +22956,9 @@ being debugged.
 @menu
 * Sequences::                Canned Sequences of @value{GDBN} Commands
 * Python::                   Extending @value{GDBN} using Python
+* Guile::                    Extending @value{GDBN} using Guile
 * Auto-loading extensions::  Automatically loading extensions
+* Multiple Extension Languages:: Working with multiple extension languages
 * Aliases::                  Creating new spellings of existing commands
 @end menu
 
@@ -27953,6 +27961,9 @@ substitute_prompt (``frame: \f,
 @end smallexample
 @end table
 
+@c Guile docs live in a separate file.
+@include guile.texi
+
 @node Auto-loading extensions
 @section Auto-loading extensions
 @cindex auto-loading extensions
@@ -27998,6 +28009,8 @@ where @var{ext} is the file extension for the extension language:
 GDB's own command language
 @item @file{@var{objfile}-gdb.py}
 Python
+@item @file{@var{objfile}-gdb.scm}
+Guile
 @end table
 
 @var{script-name} is formed by ensuring that the file name of @var{objfile}
@@ -28091,6 +28104,7 @@ for example, this GCC macro for Python scripts.
 @end example
 
 @noindent
+For Guile scripts, replace @code{.byte 1} with @code{.byte 3}.
 Then one can reference the macro in a header or source file like this:
 
 @example
@@ -28162,6 +28176,26 @@ cumbersome.  It may be easier to specify the scripts in the
 top of the source tree to the source search path.
 @end itemize
 
+@node Multiple Extension Languages
+@section Multiple Extension Languages
+
+The Guile and Python extension languages do not share any state,
+and generally do not interfere with each other.
+There are some things to be aware of, however.
+
+@subsection Python comes first
+
+Python was @value{GDBN}'s first extension language, and to avoid breaking
+existing behaviour Python comes first.  This is generally solved by the
+``first one wins'' principle.  @value{GDBN} maintains a list of enabled
+extension languages, and when it makes a call to an extension language,
+(say to pretty-print a value), it tries each in turn until an extension
+language indicates it has performed the request (e.g., has returned the
+pretty-printed form of a value).
+This extends to errors while performing such requests: If an error happens
+while, for example, trying to pretty-print an object then the error is
+reported and any following extension languages are not tried.
+
 @node Aliases
 @section Creating new spellings of existing commands
 @cindex aliases for commands
diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi
new file mode 100644
index 0000000..efabea8
--- /dev/null
+++ b/gdb/doc/guile.texi
@@ -0,0 +1,3278 @@
+@c Copyright (C) 2008-2014 Free Software Foundation, Inc.
+@c Permission is granted to copy, distribute and/or modify this document
+@c under the terms of the GNU Free Documentation License, Version 1.3 or
+@c any later version published by the Free Software Foundation; with the
+@c Invariant Sections being ``Free Software'' and ``Free Software Needs
+@c Free Documentation'', with the Front-Cover Texts being ``A GNU Manual,''
+@c and with the Back-Cover Texts as in (a) below.
+@c 
+@c (a) The FSF's Back-Cover Text is: ``You are free to copy and modify
+@c this GNU Manual.  Buying copies from GNU Press supports the FSF in
+@c developing GNU and promoting software freedom.''
+
+@node Guile
+@section Extending @value{GDBN} using Guile
+@cindex guile scripting
+@cindex scripting with guile
+
+You can extend @value{GDBN} using the @uref{http://www.gnu.org/software/guile/,
+Guile implementation of the Scheme programming language}.
+This feature is available only if @value{GDBN} was configured using
+@option{--with-guile}.
+
+@menu
+* Guile Introduction::     Introduction to Guile scripting in @value{GDBN}
+* Guile Commands::         Accessing Guile from @value{GDBN}
+* Guile API::              Accessing @value{GDBN} from Guile
+* Guile Auto-loading::     Automatically loading Guile code
+* Guile Modules::          Guile modules provided by @value{GDBN}
+@end menu
+
+@node Guile Introduction
+@subsection Guile Introduction
+
+Guile is an implementation of the Scheme programming language
+and is the GNU project's official extension language.
+
+Guile support in @value{GDBN} follows the Python support in @value{GDBN}
+reasonably closely, so concepts there should carry over.
+However, some things are done differently where it makes sense.
+
+@value{GDBN} requires Guile version 2.0 or greater.
+Older versions are not supported.
+
+@cindex guile scripts directory
+Guile scripts used by @value{GDBN} should be installed in
+@file{@var{data-directory}/guile}, where @var{data-directory} is
+the data directory as determined at @value{GDBN} startup (@pxref{Data Files}).
+This directory, known as the @dfn{guile directory},
+is automatically added to the Guile Search Path in order to allow
+the Guile interpreter to locate all scripts installed at this location.
+
+@node Guile Commands
+@subsection Guile Commands
+@cindex guile commands
+@cindex commands to access guile
+
+@value{GDBN} provides two commands for accessing the Guile interpreter:
+
+@table @code
+@kindex guile-repl
+@kindex gr
+@item guile-repl
+@itemx gr
+The @code{guile-repl} command can be used to start an interactive
+Guile prompt or @dfn{repl}.  To return to @value{GDBN},
+type @kbd{,q} or the @code{EOF} character (e.g., @kbd{Ctrl-D} on
+an empty prompt).  These commands do not take any arguments.
+
+@kindex guile
+@kindex gu
+@item guile @r{[}@var{scheme-expression}@r{]}
+@itemx gu @r{[}@var{scheme-expression}@r{]}
+The @code{guile} command can be used to evaluate a Scheme expression.
+
+If given an argument, @value{GDBN} will pass the argument to the Guile
+interpreter for evaluation.
+
+@smallexample
+(@value{GDBP}) guile (display (+ 20 3)) (newline)
+23
+@end smallexample
+
+The result of the Scheme expression is displayed using normal Guile rules.
+
+@smallexample
+(@value{GDBP}) guile (+ 20 3)
+23
+@end smallexample
+
+If you do not provide an argument to @code{guile}, it will act as a
+multi-line command, like @code{define}.  In this case, the Guile
+script is made up of subsequent command lines, given after the
+@code{guile} command.  This command list is terminated using a line
+containing @code{end}.  For example:
+
+@smallexample
+(@value{GDBP}) guile
+>(display 23)
+>(newline)
+>end
+23
+@end smallexample
+@end table
+
+It is also possible to execute a Guile script from the @value{GDBN}
+interpreter:
+
+@table @code
+@item source @file{script-name}
+The script name must end with @samp{.scm} and @value{GDBN} must be configured
+to recognize the script language based on filename extension using
+the @code{script-extension} setting.  @xref{Extending GDB, ,Extending GDB}.
+
+@item guile (load "script-name")
+This method uses the @code{load} Guile function.
+It takes a string argument that is the name of the script to load.
+See the Guile documentation for a description of this function.
+(@pxref{Loading,,, guile, GNU Guile Reference Manual}).
+@end table
+
+@node Guile API
+@subsection Guile API
+@cindex guile api
+@cindex programming in guile
+
+You can get quick online help for @value{GDBN}'s Guile API by issuing
+the command @w{@kbd{help guile}}, or by issuing the command @kbd{,help}
+from an interactive Guile session.  Furthermore, most Guile procedures
+provided by @value{GDBN} have doc strings which can be obtained with
+@kbd{,describe @var{procedure-name}} or @kbd{,d @var{procedure-name}}
+from the Guile interactive prompt.
+
+@menu
+* Basic Guile::              Basic Guile Functions
+* Guile Configuration::      Guile configuration variables
+* GDB Scheme Data Types::    Scheme representations of GDB objects
+* Guile Exception Handling:: How Guile exceptions are translated
+* Values From Inferior In Guile:: Guile representation of values
+* Arithmetic In Guile::      Arithmetic in Guile
+* Types In Guile::           Guile representation of types
+* Guile Pretty Printing API:: Pretty-printing values with Guile
+* Selecting Guile Pretty-Printers:: How GDB chooses a pretty-printer
+* Writing a Guile Pretty-Printer:: Writing a pretty-printer
+* Objfiles In Guile::        Object files in Guile
+* Frames In Guile::          Accessing inferior stack frames from Guile
+* Blocks In Guile::          Accessing blocks from Guile
+* Symbols In Guile::         Guile representation of symbols
+* Symbol Tables In Guile::   Guile representation of symbol tables
+* Breakpoints In Guile::     Manipulating breakpoints using Guile
+* Lazy Strings In Guile::    Guile representation of lazy strings
+* Architectures In Guile::   Guile representation of architectures
+* Disassembly In Guile::     Disassembling instructions from Guile
+* I/O Ports in Guile::       GDB I/O ports
+* Memory Ports in Guile::    Accessing memory through ports and bytevectors
+* Iterators In Guile::       Basic iterator support
+@end menu
+
+@node Basic Guile
+@subsubsection Basic Guile
+
+@cindex guile stdout
+@cindex guile pagination
+At startup, @value{GDBN} overrides Guile's @code{current-output-port} and
+@code{current-error-port} to print using @value{GDBN}'s output-paging streams.
+A Guile program which outputs to one of these streams may have its
+output interrupted by the user (@pxref{Screen Size}).  In this
+situation, a Guile @code{signal} exception is thrown with value @code{SIGINT}.
+
+Guile's history mechanism uses the same naming as @value{GDBN}'s,
+namely the user of dollar-variables (e.g., $1, $2, etc.).
+The results of evaluations in Guile and in GDB are counted separately,
+@code{$1} in Guile is not the same value as @code{$1} in @value{GDBN}.
+
+@value{GDBN} is not thread-safe.  If your Guile program uses multiple
+threads, you must be careful to only call @value{GDBN}-specific
+functions in the @value{GDBN} thread.
+
+Some care must be taken when writing Guile code to run in
+@value{GDBN}.  Two things are worth noting in particular:
+
+@itemize @bullet
+@item
+@value{GDBN} installs handlers for @code{SIGCHLD} and @code{SIGINT}.
+Guile code must not override these, or even change the options using
+@code{sigaction}.  If your program changes the handling of these
+signals, @value{GDBN} will most likely stop working correctly.  Note
+that it is unfortunately common for GUI toolkits to install a
+@code{SIGCHLD} handler.
+
+@item
+@value{GDBN} takes care to mark its internal file descriptors as
+close-on-exec.  However, this cannot be done in a thread-safe way on
+all platforms.  Your Guile programs should be aware of this and
+should both create new file descriptors with the close-on-exec flag
+set and arrange to close unneeded file descriptors before starting a
+child process.
+@end itemize
+
+@cindex guile gdb module
+@value{GDBN} introduces a new Guile module, named @code{gdb}.  All
+methods and classes added by @value{GDBN} are placed in this module.
+@value{GDBN} does not automatically @code{import} the @code{gdb} module,
+scripts must do this themselves.  There are various options for how to
+import a module, so @value{GDBN} leaves the choice of how the @code{gdb}
+module is imported to the user.
+To simplify interactive use, it is recommended to add one of the following
+to your ~/.gdbinit.
+
+@smallexample
+guile (use-modules (gdb))
+@end smallexample
+
+@smallexample
+guile (use-modules ((gdb) #:renamer (symbol-prefix-proc 'gdb:)))
+@end smallexample
+
+Which one to choose depends on your preference.
+The second one adds @code{gdb:} as a prefix to all module functions
+and variables.
+
+The rest of this manual assumes the @code{gdb} module has been imported
+without any prefix.  See the Guile documentation for @code{use-modules}
+for more information
+(@pxref{Using Guile Modules,,, guile, GNU Guile Reference Manual}).
+
+Example:
+
+@smallexample
+(gdb) guile (value-type (make-value 1))
+ERROR: Unbound variable: value-type
+Error while executing Scheme code.
+(gdb) guile (use-modules (gdb))
+(gdb) guile (value-type (make-value 1))
+int
+(gdb)
+@end smallexample
+
+The @code{(gdb)} module provides these basic Guile functions.
+
+@c TODO: line length 
+@deffn {Scheme Procedure} execute command @r{[}#:from-tty boolean@r{]}@r{[}#:to-string boolean@r{]}
+Evaluate @var{command}, a string, as a @value{GDBN} CLI command.
+If a @value{GDBN} exception happens while @var{command} runs, it is
+translated as described in
+@ref{Guile Exception Handling,,Guile Exception Handling}.
+
+@var{from-tty} specifies whether @value{GDBN} ought to consider this
+command as having originated from the user invoking it interactively.
+It must be a boolean value.  If omitted, it defaults to @code{#f}.
+
+By default, any output produced by @var{command} is sent to
+@value{GDBN}'s standard output (and to the log output if logging is
+turned on).  If the @var{to-string} parameter is
+@code{#t}, then output will be collected by @code{gdb.execute} and
+returned as a string.  The default is @code{#f}, in which case the
+return value is unspecified.  If @var{to-string} is @code{#t}, the
+@value{GDBN} virtual terminal will be temporarily set to unlimited width
+and height, and its pagination will be disabled; @pxref{Screen Size}.
+@end deffn
+
+@deffn {Scheme Procedure} history-ref number
+Return a value from @value{GDBN}'s value history (@pxref{Value
+History}).  @var{number} indicates which history element to return.
+If @var{number} is negative, then @value{GDBN} will take its absolute value
+and count backward from the last element (i.e., the most recent element) to
+find the value to return.  If @var{number} is zero, then @value{GDBN} will
+return the most recent element.  If the element specified by @var{number}
+doesn't exist in the value history, a @code{gdb:error} exception will be
+raised.
+
+If no exception is raised, the return value is always an instance of
+@code{<gdb:value>} (@pxref{Values From Inferior In Guile}).
+
+@emph{Note:} @value{GDBN}'s value history is independent of Guile's.
+@code{$1} in @value{GDBN}'s value history contains the result of evaluating
+an expression from @value{GDBN}'s command line and @code{$1} from Guile's
+history contains the result of evaluating an expression from Guile's
+command line.
+@end deffn
+
+@deffn {Scheme Procedure} parse-and-eval expression
+Parse @var{expression} as an expression in the current language,
+evaluate it, and return the result as a @code{<gdb:value>}.
+@var{expression} must be a string.
+
+This function is useful when computing values.
+For example, it is the only way to get the value of a
+convenience variable (@pxref{Convenience Vars}) as a @code{<gdb:value>}.
+@end deffn
+
+@deffn {Scheme Procedure} string->argv string
+Convert a string to a list of strings split up according to
+@value{GDBN}'s argv parsing rules.
+@end deffn
+
+@node Guile Configuration
+@subsubsection Guile Configuration
+@cindex guile configuration
+
+@value{GDBN} provides these Scheme functions to access various configuration
+parameters.
+
+@deffn {Scheme Procedure} data-directory
+Return a string containing @value{GDBN}'s data directory.
+This directory contains @value{GDBN}'s ancillary files, including
+the Guile modules provided by @value{GDBN}.
+@end deffn
+
+@deffn {Scheme Procedure} gdb-version
+Return a string containing the @value{GDBN} version.
+@end deffn
+
+@deffn {Scheme Procedure} host-config
+Return a string containing the host configuration.
+This is the string passed to @code{--host} when @value{GDBN} was configured.
+@end deffn
+
+@deffn {Scheme Procedure} target-config
+Return a string containing the target configuration.
+This is the string passed to @code{--target} when @value{GDBN} was configured.
+@end deffn
+
+@node GDB Scheme Data Types
+@subsubsection GDB Scheme Data Types
+@cindex gdb smobs
+
+@value{GDBN} uses Guile's @dfn{smob} (small object)
+data type for all @value{GDBN} objects
+(@pxref{Defining New Types (Smobs),,, guile, GNU Guile Reference Manual}).
+The smobs that @value{GDBN} provides are called @dfn{gsmobs}.
+
+@deffn {Scheme Procedure} gsmob-kind gsmob
+Return the kind of the gsmob, e.g., @code{<gdb:breakpoint>},
+as a symbol.
+@end deffn
+
+Every @code{gsmob} provides a common set of functions for extending
+them in simple ways.  Each @code{gsmob} has a list of properties,
+initially empty.  These properties are akin to Guile's object properties,
+but are stored with the @code{gsmob}
+(@pxref{Object Properties,,, guile, GNU Guile Reference Manual}).
+Property names can be any @code{eq?}-able value, but it is recommended
+that they be symbols.
+
+@deffn {Scheme Procedure} set-gsmob-property! gsmob property-name value
+Set the value of property @code{property-name} to value @code{value}.
+The result is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} gsmob-property gsmob property-name
+Return the value of property @code{property-name}.
+If the property isn't present then @code{#f} is returned.
+@end deffn
+
+@deffn {Scheme Procedure} gsmob-has-property? gsmob property-name
+Return @code{#t} if @code{gsmob} has property @code{property-name}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} gsmob-properties gsmob
+Return an unsorted list of names of properties.
+@end deffn
+
+@value{GDBN} defines the following Scheme smobs:
+
+@table @code
+@item <gdb:arch>
+@xref{Architectures In Guile}.
+
+@item <gdb:block>
+@xref{Blocks In Guile}.
+
+@item <gdb:block-symbols-iterator>
+@xref{Blocks In Guile}.
+
+@item <gdb:breakpoint>
+@xref{Breakpoints In Guile}.
+
+@item <gdb:exception>
+@xref{Guile Exception Handling}.
+
+@item <gdb:frame>
+@xref{Frames In Guile}.
+
+@item <gdb:iterator>
+@xref{Iterators In Guile}.
+
+@item <gdb:lazy-string>
+@xref{Lazy Strings In Guile}.
+
+@item <gdb:objfile>
+@xref{Objfiles In Guile}.
+
+@item <gdb:pretty-printer>
+@xref{Guile Pretty Printing API}.
+
+@item <gdb:pretty-printer-worker>
+@xref{Guile Pretty Printing API}.
+
+@item <gdb:symbol>
+@xref{Symbols In Guile}.
+
+@item <gdb:symtab>
+@xref{Symbol Tables In Guile}.
+
+@item <gdb:sal>
+@xref{Symbol Tables In Guile}.
+
+@item <gdb:type>
+@xref{Types In Guile}.
+
+@item <gdb:field>
+@xref{Types In Guile}.
+
+@item <gdb:value>
+@xref{Values From Inferior In Guile}.
+@end table
+
+The following gsmobs are managed internally so that the Scheme function
+@code{eq?} may be applied to them.
+
+@table @code
+@item <gdb:arch>
+@item <gdb:block>
+@item <gdb:breakpoint>
+@item <gdb:frame>
+@item <gdb:objfile>
+@item <gdb:symbol>
+@item <gdb:symtab>
+@item <gdb:type>
+@end table
+
+@node Guile Exception Handling
+@subsubsection Guile Exception Handling
+@cindex guile exceptions
+@cindex exceptions, guile
+@kindex set guile print-stack
+
+When executing the @code{guile} command, Guile exceptions
+uncaught within the Guile code are translated to calls to the
+@value{GDBN} error-reporting mechanism.  If the command that called
+@code{guile} does not handle the error, @value{GDBN} will
+terminate it and report the error according to the setting of
+the @code{guile print-stack} parameter.
+
+The @code{guile print-stack} parameter has three settings:
+
+@table @code
+@item none
+Nothing is printed.
+
+@item message
+An error message is printed containing the Guile exception name,
+the associated value, and the Guile call stack backtrace at the
+point where the exception was raised.  Example:
+
+@smallexample
+(@value{GDBP}) guile (display foo)
+ERROR: In procedure memoize-variable-access!:
+ERROR: Unbound variable: foo
+Error while executing Scheme code.
+@end smallexample
+
+@item full
+In addition to an error message a full backtrace is printed.
+
+@smallexample
+(@value{GDBP}) set guile print-stack full
+(@value{GDBP}) guile (display foo)
+Guile Backtrace:
+In ice-9/boot-9.scm:
+ 157: 10 [catch #t #<catch-closure 2c76e20> ...]
+In unknown file:
+   ?: 9 [apply-smob/1 #<catch-closure 2c76e20>]
+In ice-9/boot-9.scm:
+ 157: 8 [catch #t #<catch-closure 2c76d20> ...]
+In unknown file:
+   ?: 7 [apply-smob/1 #<catch-closure 2c76d20>]
+   ?: 6 [call-with-input-string "(display foo)" ...]
+In ice-9/boot-9.scm:
+2320: 5 [save-module-excursion #<procedure 2c2dc30 ... ()>]
+In ice-9/eval-string.scm:
+  44: 4 [read-and-eval #<input: string 27cb410> #:lang ...]
+  37: 3 [lp (display foo)]
+In ice-9/eval.scm:
+ 387: 2 [eval # ()]
+ 393: 1 [eval #<memoized foo> ()]
+In unknown file:
+   ?: 0 [memoize-variable-access! #<memoized foo> ...]
+
+ERROR: In procedure memoize-variable-access!:
+ERROR: Unbound variable: foo
+Error while executing Scheme code.
+@end smallexample
+@end table
+
+@value{GDBN} errors that happen in @value{GDBN} commands invoked by
+Guile code are converted to Guile exceptions.  The type of the
+Guile exception depends on the error.
+
+Guile procedures provided by @value{GDBN} can throw the standard
+Guile exceptions like @code{wrong-type-arg} and @code{out-of-range}.
+
+User interrupt (via @kbd{C-c} or by typing @kbd{q} at a pagination
+prompt) is translated to a Guile @code{signal} exception with value
+@code{SIGINT}.
+
+@value{GDBN} Guile procedures can also throw these exceptions:
+
+@vtable @code
+@item gdb:error
+This exception is a catch-all for errors generated from within @value{GDBN}.
+
+@item gdb:invalid-object
+This exception is thrown when accessing Guile objects that wrap underlying
+@value{GDBN} objects have become invalid.  For example, a
+@code{<gdb:breakpoint>} object becomes invalid if the user deletes it
+from the command line.  The object still exists in Guile, but the
+object it represents is gone.  Further operations on this breakpoint
+will throw this exception.
+
+@item gdb:memory-error
+This exception is thrown when an operation tried to access invalid
+memory in the inferior.
+
+@item gdb:pp-type-error
+This exception is thrown when a Guile pretty-printer passes a bad object
+to @value{GDBN}.
+@end vtable
+
+The following exception-related procedures are provided by the
+@code{(gdb)} module.
+
+@deffn {Scheme Procedure} make-exception key args
+Return a @code{<gdb:exception>} object.
+@var{key} and @var{args} are the standard Guile parameters of an exception.
+See the Guile documentation for more information
+(@pxref{Exceptions,,, guile, GNU Guile Reference Manual}).
+@end deffn
+
+@deffn {Scheme Procedure} exception? object
+Return @code{#t} if @var{object} is a @code{<gdb:exception>} object.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} exception-key exception
+Return the @var{args} field of a @code{<gdb:exception>} object.
+@end deffn
+
+@deffn {Scheme Procedure} exception-args exception
+Return the @var{args} field of a @code{<gdb:exception>} object.
+@end deffn
+
+@node Values From Inferior In Guile
+@subsubsection Values From Inferior In Guile
+@cindex values from inferior, in guile
+@cindex guile, working with values from inferior
+
+@tindex @code{<gdb:value>}
+@value{GDBN} provides values it obtains from the inferior program in
+an object of type @code{<gdb:value>}.  @value{GDBN} uses this object
+for its internal bookkeeping of the inferior's values, and for
+fetching values when necessary.
+
+@value{GDBN} does not memoize @code{<gdb:value>} objects.
+@code{make-value} always returns a fresh object.
+
+@smallexample
+(gdb) guile (eq? (make-value 1) (make-value 1))
+$1 = #f
+(gdb) guile (equal? (make-value 1) (make-value 1))
+$1 = #t
+@end smallexample
+
+A @code{<gdb:value>} that represents a function can be executed via
+inferior function call with @code{value-call}.
+Any arguments provided to the call must match the function's prototype,
+and must be provided in the order specified by that prototype.
+
+For example, @code{some-val} is a @code{<gdb:value>} instance
+representing a function that takes two integers as arguments.  To
+execute this function, call it like so:
+
+@smallexample
+(define result (value-call some-val 10 20))
+@end smallexample
+
+Any values returned from a function call are @code{<gdb:value>} objects.
+
+Note: Unlike Python scripting in @value{GDBN},
+inferior values that are simple scalars cannot be used directly in
+Scheme expressions that are valid for the value's data type.
+For example, @code{(+ (parse-and-eval "int_variable") 2)} does not work.
+And inferior values that are structures or instances of some class cannot
+be accessed using any special syntax, instead @code{value-field} must be used.
+
+The following value-related procedures are provided by the
+@code{(gdb)} module.
+
+@deffn {Scheme Procedure} value? object
+Return @code{#t} if @var{object} is a @code{<gdb:value>} object.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} make-value value @r{[}#:type type@r{]}
+Many Scheme values can be converted directly to a @code{<gdb:value>}
+with this procedure.  If @var{type} is specified, the result is a value
+of this type, and if @var{value} can't be represented with this type
+an exception is thrown.  Otherwise the type of the result is determined from
+@var{value} as described below.
+
+@xref{Architectures In Guile}, for a list of the builtin
+types for an architecture.
+
+Here's how Scheme values are converted when @var{type} argument to
+@code{make-value} is not specified:
+
+@table @asis
+@item Scheme boolean
+A Scheme boolean is converted the boolean type for the current language.
+
+@item Scheme integer
+A Scheme integer is converted to the first of a C @code{int},
+@code{unsigned int}, @code{long}, @code{unsigned long},
+@code{long long} or @code{unsigned long long} type
+for the current architecture that can represent the value.
+
+If the Scheme integer cannot be represented as a target integer
+an @code{out-of-range} exception is thrown.
+
+@item Scheme real
+A Scheme real is converted to the C @code{double} type for the
+current architecture.
+
+@item Scheme string
+A Scheme string is converted to a string in the current target
+language using the current target encoding.
+Characters that cannot be represented in the current target encoding
+are replaced with the corresponding escape sequence.  This is Guile's
+@code{SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE} conversion strategy
+(@pxref{Strings,,, guile, GNU Guile Reference Manual}).
+
+Passing @var{type} is not supported in this case,
+if it is provided a @code{wrong-type-arg} exception is thrown.
+
+@item @code{<gdb:lazy-string>}
+If @var{value} is a @code{<gdb:lazy-string>} object (@pxref{Lazy Strings In
+Guile}), then the @code{lazy-string->value} procedure is called, and
+its result is used.
+
+Passing @var{type} is not supported in this case,
+if it is provided a @code{wrong-type-arg} exception is thrown.
+
+@item Scheme bytevector
+If @var{value} is a Scheme bytevector and @var{type} is provided,
+@var{value} must be the same size, in bytes, of values of type @var{type},
+and the result is essentially created by using @code{memcpy}.
+
+If @var{value} is a Scheme bytevector and @var{type} is not provided,
+the result is an array of type @code{uint8} of the same length.
+@end table
+@end deffn
+
+@cindex optimized out value in guile
+@deffn {Scheme Procedure} value-optimized-out? value
+Return @code{#t} if the compiler optimized out @var{value},
+thus it is not available for fetching from the inferior.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} value-address value
+If @var{value} is addressable, returns a
+@code{<gdb:value>} object representing the address.
+Otherwise, @code{#f} is returned.
+@end deffn
+
+@deffn {Scheme Procedure} value-type value
+Return the type of @var{value} as a @code{<gdb:type>} object
+(@pxref{Types In Guile}).
+@end deffn
+
+@deffn {Scheme Procedure} value-dynamic-type value
+Return the dynamic type of @var{value}.  This uses C@t{++} run-time
+type information (@acronym{RTTI}) to determine the dynamic type of the
+value.  If the value is of class type, it will return the class in
+which the value is embedded, if any.  If the value is of pointer or
+reference to a class type, it will compute the dynamic type of the
+referenced object, and return a pointer or reference to that type,
+respectively.  In all other cases, it will return the value's static
+type.
+
+Note that this feature will only work when debugging a C@t{++} program
+that includes @acronym{RTTI} for the object in question.  Otherwise,
+it will just return the static type of the value as in @kbd{ptype foo}.
+@xref{Symbols, ptype}.
+@end deffn
+
+@deffn {Scheme Procedure} value-cast value type
+Return a new instance of @code{<gdb:value>} that is the result of
+casting @var{value} to the type described by @var{type}, which must
+be a @code{<gdb:type>} object.  If the cast cannot be performed for some
+reason, this method throws an exception.
+@end deffn
+
+@deffn {Scheme Procedure} value-dynamic-cast value type
+Like @code{value-cast}, but works as if the C@t{++} @code{dynamic_cast}
+operator were used.  Consult a C@t{++} reference for details.
+@end deffn
+
+@deffn {Scheme Procedure} value-reinterpret-cast value type
+Like @code{value-cast}, but works as if the C@t{++} @code{reinterpret_cast}
+operator were used.  Consult a C@t{++} reference for details.
+@end deffn
+
+@deffn {Scheme Procedure} value-dereference value
+For pointer data types, this method returns a new @code{<gdb:value>} object
+whose contents is the object pointed to by @var{value}.  For example, if
+@code{foo} is a C pointer to an @code{int}, declared in your C program as
+
+@smallexample
+int *foo;
+@end smallexample
+
+@noindent
+then you can use the corresponding @code{<gdb:value>} to access what
+@code{foo} points to like this:
+
+@smallexample
+(define bar (value-dereference foo))
+@end smallexample
+
+The result @code{bar} will be a @code{<gdb:value>} object holding the
+value pointed to by @code{foo}.
+
+A similar function @code{value-referenced-value} exists which also
+returns @code{<gdb:value>} objects corresonding to the values pointed to
+by pointer values (and additionally, values referenced by reference
+values).  However, the behavior of @code{value-dereference}
+differs from @code{value-referenced-value} by the fact that the
+behavior of @code{value-dereference} is identical to applying the C
+unary operator @code{*} on a given value.  For example, consider a
+reference to a pointer @code{ptrref}, declared in your C@t{++} program
+as
+
+@smallexample
+typedef int *intptr;
+...
+int val = 10;
+intptr ptr = &val;
+intptr &ptrref = ptr;
+@end smallexample
+
+Though @code{ptrref} is a reference value, one can apply the method
+@code{value-dereference} to the @code{<gdb:value>} object corresponding
+to it and obtain a @code{<gdb:value>} which is identical to that
+corresponding to @code{val}.  However, if you apply the method
+@code{value-referenced-value}, the result would be a @code{<gdb:value>}
+object identical to that corresponding to @code{ptr}.
+
+@smallexample
+(define scm-ptrref (parse-and-eval "ptrref"))
+(define scm-val (value-dereference scm-ptrref))
+(define scm-ptr (value-referenced-value scm-ptrref))
+@end smallexample
+
+The @code{<gdb:value>} object @code{scm-val} is identical to that
+corresponding to @code{val}, and @code{scm-ptr} is identical to that
+corresponding to @code{ptr}.  In general, @code{value-dereference} can
+be applied whenever the C unary operator @code{*} can be applied
+to the corresponding C value.  For those cases where applying both
+@code{value-dereference} and @code{value-referenced-value} is allowed,
+the results obtained need not be identical (as we have seen in the above
+example).  The results are however identical when applied on
+@code{<gdb:value>} objects corresponding to pointers (@code{<gdb:value>}
+objects with type code @code{TYPE_CODE_PTR}) in a C/C@t{++} program.
+@end deffn
+
+@deffn {Scheme Procedure} value-referenced-value value
+For pointer or reference data types, this method returns a new
+@code{<gdb:value>} object corresponding to the value referenced by the
+pointer/reference value.  For pointer data types,
+@code{value-dereference} and @code{value-referenced-value} produce
+identical results.  The difference between these methods is that
+@code{value-dereference} cannot get the values referenced by reference
+values.  For example, consider a reference to an @code{int}, declared
+in your C@t{++} program as
+
+@smallexample
+int val = 10;
+int &ref = val;
+@end smallexample
+
+@noindent
+then applying @code{value-dereference} to the @code{<gdb:value>} object
+corresponding to @code{ref} will result in an error, while applying
+@code{value-referenced-value} will result in a @code{<gdb:value>} object
+identical to that corresponding to @code{val}.
+
+@smallexample
+(define scm-ref (parse-and-eval "ref"))
+(define err-ref (value-dereference scm-ref))      ;; error
+(define scm-val (value-referenced-value scm-ref)) ;; ok
+@end smallexample
+
+The @code{<gdb:value>} object @code{scm-val} is identical to that
+corresponding to @code{val}.
+@end deffn
+
+@deffn {Scheme Procedure} value-field value field-name
+Return field @var{field-name} from @code{<gdb:value>} object @var{value}.
+@end deffn
+
+@deffn {Scheme Procedure} value-subscript value index
+Return the value of array @var{value} at index @var{index}.
+@var{value} must be a subscriptable @code{<gdb:value>} object.
+@end deffn
+
+@deffn {Scheme Procedure} value-call value arg-list
+Perform an inferior function call, taking @var{value} as a pointer
+to the function to call.
+Each element of list @var{arg-list} must be a <gdb:value> object or an object
+that can be converted to a value.
+The result is the value returned by the function.
+@end deffn
+
+@deffn {Scheme Procedure} value->bool value
+Return the Scheme boolean representing @code{<gdb:value>} @var{value}.
+The value must be ``integer like''.  Pointers are ok.
+@end deffn
+
+@deffn {Scheme Procedure} value->integer
+Return the Scheme integer representing @code{<gdb:value>} @var{value}.
+The value must be ``integer like''.  Pointers are ok.
+@end deffn
+
+@deffn {Scheme Procedure} value->real
+Return the Scheme real number representing @code{<gdb:value>} @var{value}.
+The value must be a number.
+@end deffn
+
+@deffn {Scheme Procedure} value->bytevector
+Return a Scheme bytevector with the raw contents of @code{<gdb:value>}
+@var{value}.  No transformation, endian or otherwise, is performed.
+@end deffn
+
+@c TODO: line length
+@deffn {Scheme Procedure} value->string value @r{[}#:encoding encoding@r{]} @r{[}#:errors errors@r{]} @r{[}#:length length@r{]}
+If @var{value>} represents a string, then this method
+converts the contents to a Guile string.  Otherwise, this method will
+throw an exception.
+
+Values are interpreted as strings according to the rules of the
+current language.  If the optional length argument is given, the
+string will be converted to that length, and will include any embedded
+zeroes that the string may contain.  Otherwise, for languages
+where the string is zero-terminated, the entire string will be
+converted.
+
+For example, in C-like languages, a value is a string if it is a pointer
+to or an array of characters or ints of type @code{wchar_t}, @code{char16_t},
+or @code{char32_t}.
+
+If the optional @var{encoding} argument is given, it must be a string
+naming the encoding of the string in the @code{<gdb:value>}, such as
+@code{"ascii"}, @code{"iso-8859-6"} or @code{"utf-8"}.  It accepts
+the same encodings as the corresponding argument to Guile's
+@code{scm_from_stringn} function, and the Guile codec machinery will be used
+to convert the string.  If @var{encoding} is not given, or if
+@var{encoding} is the empty string, then either the @code{target-charset}
+(@pxref{Character Sets}) will be used, or a language-specific encoding
+will be used, if the current language is able to supply one.
+
+The optional @var{errors} argument is one of @code{#f}, @code{error} or
+@code{substitute}.  @code{error} and @code{substitute} must be symbols.
+If @var{errors} is not specified, or if its value is @code{#f}, then the
+default conversion strategy is used, which is set with the Scheme function
+@code{set-port-conversion-strategy!}.
+If the value is @code{'error} then an exception is thrown if there is any
+conversion error.  If the value is @code{'substitute} then any conversion
+error is replaced with question marks.
+@xref{Strings,,, guile, GNU Guile Reference Manual}.
+
+If the optional @var{length} argument is given, the string will be
+fetched and converted to the given length.
+The length must be a Scheme integer and not a @code{<gdb:value>} integer.
+@end deffn
+
+@c TODO: line length
+@deffn {Scheme Procedure} value->lazy-string value @r{[}#:encoding encoding@r{]} @r{[}#:length length@r{]})
+If this @code{<gdb:value>} represents a string, then this method
+converts @var{value} to a @code{<gdb:lazy-string} (@pxref{Lazy Strings
+In Guile}).  Otherwise, this method will throw an exception.
+
+If the optional @var{encoding} argument is given, it must be a string
+naming the encoding of the @code{<gdb:lazy-string}.  Some examples are:
+@code{"ascii"}, @code{"iso-8859-6"} or @code{"utf-8"}.  If the
+@var{encoding} argument is an encoding that @value{GDBN} does not
+recognize, @value{GDBN} will raise an error.
+
+When a lazy string is printed, the @value{GDBN} encoding machinery is
+used to convert the string during printing.  If the optional
+@var{encoding} argument is not provided, or is an empty string,
+@value{GDBN} will automatically select the encoding most suitable for
+the string type.  For further information on encoding in @value{GDBN}
+please see @ref{Character Sets}.
+
+If the optional @var{length} argument is given, the string will be
+fetched and encoded to the length of characters specified.  If
+the @var{length} argument is not provided, the string will be fetched
+and encoded until a null of appropriate width is found.
+The length must be a Scheme integer and not a @code{<gdb:value>} integer.
+@end deffn
+
+@deffn {Scheme Procedure} value-lazy? value
+Return @code{#t} if @var{value} has not yet been fetched
+from the inferior.  
+Otherwise return @code{#f}.
+@value{GDBN} does not fetch values until necessary, for efficiency.  
+For example:
+
+@smallexample
+(define myval (parse-and-eval "somevar"))
+@end smallexample
+
+The value of @code{somevar} is not fetched at this time.  It will be 
+fetched when the value is needed, or when the @code{fetch-lazy}
+procedure is invoked.  
+@end deffn
+
+@deffn {Scheme Procedure} make-lazy-value type address
+Return a @code{<gdb:value>} that will be lazily fetched from the target.
+@var{type} is an object of type @code{<gdb:type>} and @var{address} is
+a Scheme integer of the address of the object in target memory.
+@end deffn
+
+@deffn {Scheme Procedure} value-fetch-lazy! value
+If @var{value} is a lazy value (@code{(value-lazy? value)} is @code{#t}),
+then the value is fetched from the inferior.
+Any errors that occur in the process will produce a Guile exception.
+
+If @var{value} is not a lazy value, this method has no effect.
+
+The result of this function is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} value-print value
+Return the string representation (print form) of @code{<gdb:value>}
+@var{value}.
+@end deffn
+
+@node Arithmetic In Guile
+@subsubsection Arithmetic In Guile
+
+The @code{(gdb)} module provides several functions for performing
+arithmetic on @code{<gdb:value>} objects.
+The arithmetic is performed as if it were done by the target,
+and therefore has target semantics which are not necessarily
+those of Scheme.  For example operations work with a fixed precision,
+not the arbitrary precision of Scheme.
+
+Wherever a function takes an integer or pointer as an operand,
+@value{GDBN} will convert appropriate Scheme values to perform
+the operation.
+
+@deffn {Scheme Procedure} value-add a b
+@end deffn
+
+@deffn {Scheme Procedure} value-sub a b
+@end deffn
+
+@deffn {Scheme Procedure} value-mul a b
+@end deffn
+
+@deffn {Scheme Procedure} value-div a b
+@end deffn
+
+@deffn {Scheme Procedure} value-rem a b
+@end deffn
+
+@deffn {Scheme Procedure} value-mod a b
+@end deffn
+
+@deffn {Scheme Procedure} value-pow a b
+@end deffn
+
+@deffn {Scheme Procedure} value-not a
+@end deffn
+
+@deffn {Scheme Procedure} value-neg a
+@end deffn
+
+@deffn {Scheme Procedure} value-pos a
+@end deffn
+
+@deffn {Scheme Procedure} value-abs a
+@end deffn
+
+@deffn {Scheme Procedure} value-lsh a b
+@end deffn
+
+@deffn {Scheme Procedure} value-rsh a b
+@end deffn
+
+@deffn {Scheme Procedure} value-min a b
+@end deffn
+
+@deffn {Scheme Procedure} value-max a b
+@end deffn
+
+@deffn {Scheme Procedure} value-lognot a
+@end deffn
+
+@deffn {Scheme Procedure} value-logand a b
+@end deffn
+
+@deffn {Scheme Procedure} value-logior a b
+@end deffn
+
+@deffn {Scheme Procedure} value-logxor a b
+@end deffn
+
+@deffn {Scheme Procedure} value=? a b
+@end deffn
+
+@deffn {Scheme Procedure} value<? a b
+@end deffn
+
+@deffn {Scheme Procedure} value<=? a b
+@end deffn
+
+@deffn {Scheme Procedure} value>? a b
+@end deffn
+
+@deffn {Scheme Procedure} value>=? a b
+@end deffn
+
+Scheme does not provide a @code{not-equal} function,
+and thus Guile support in @value{GDBN} does not either.
+
+@node Types In Guile
+@subsubsection Types In Guile
+@cindex types in guile
+@cindex guile, working with types
+
+@tindex <gdb:type>
+@value{GDBN} represents types from the inferior in objects of type
+@code{<gdb:type>}.
+
+The following type-related procedures are provided by the
+@code{(gdb)} module.
+
+@deffn {Scheme Procedure} type? object
+Return @code{#t} if @var{object} is an object of type @code{<gdb:type>}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} lookup-type name @r{[}#:block block@r{]}
+This function looks up a type by name.  @var{name} is the name of the
+type to look up.  It must be a string.
+
+If @var{block} is given, it is an object of type @code{<gdb:block>},
+and @var{name} is looked up in that scope.
+Otherwise, it is searched for globally.
+
+Ordinarily, this function will return an instance of @code{<gdb:type>}.
+If the named type cannot be found, it will throw an exception.
+@end deffn
+
+@deffn {Scheme Procedure} type-code type
+Return the type code of @var{type}.  The type code will be one of the
+@code{TYPE_CODE_} constants defined below.
+@end deffn
+
+@deffn {Scheme Procedure} type-tag type
+Return the tag name of @var{type}.  The tag name is the name after
+@code{struct}, @code{union}, or @code{enum} in C and C@t{++}; not all
+languages have this concept.  If this type has no tag name, then
+@code{#f} is returned.
+@end deffn
+
+@deffn {Scheme Procedure} type-name type
+Return the name of @var{type}.
+If this type has no name, then @code{#f} is returned.
+@end deffn
+
+@deffn {Scheme Procedure} type-print-name type
+Return the print name of @var{type}.
+This returns something even for anonymous types.
+For example, for an anonymous C struct @code{"struct @{...@}"} is returned.
+@end deffn
+
+@deffn {Scheme Procedure} type-sizeof type
+Return the size of this type, in target @code{char} units.  Usually, a
+target's @code{char} type will be an 8-bit byte.  However, on some
+unusual platforms, this type may have a different size.
+@end deffn
+
+@deffn {Scheme Procedure} type-strip-typedefs type
+Return a new @code{<gdb:type>} that represents the real type of @var{type},
+after removing all layers of typedefs.
+@end deffn
+
+@deffn {Scheme Procedure} type-array type n1 @r{[}n2@r{]}
+Return a new @code{<gdb:type>} object which represents an array of this
+type.  If one argument is given, it is the inclusive upper bound of
+the array; in this case the lower bound is zero.  If two arguments are
+given, the first argument is the lower bound of the array, and the
+second argument is the upper bound of the array.  An array's length
+must not be negative, but the bounds can be.
+@end deffn
+
+@deffn {Scheme Procedure} type-vector type n1 @r{[}n2@r{]}
+Return a new @code{<gdb:type>} object which represents a vector of this
+type.  If one argument is given, it is the inclusive upper bound of
+the vector; in this case the lower bound is zero.  If two arguments are
+given, the first argument is the lower bound of the vector, and the
+second argument is the upper bound of the vector.  A vector's length
+must not be negative, but the bounds can be.
+
+The difference between an @code{array} and a @code{vector} is that
+arrays behave like in C: when used in expressions they decay to a pointer
+to the first element whereas vectors are treated as first class values.
+@end deffn
+
+@deffn {Scheme Procedure} type-pointer type
+Return a new @code{<gdb:type>} object which represents a pointer to
+@var{type}.
+@end deffn
+
+@deffn {Scheme Procedure} type-range type
+Return a list of two elements: the low bound and high bound of @var{type}.
+If @var{type} does not have a range, an exception is thrown.
+@end deffn
+
+@deffn {Scheme Procedure} type-reference type
+Return a new @code{<gdb:type>} object which represents a reference to
+@var{type}.
+@end deffn
+
+@deffn {Scheme Procedure} type-target type
+Return a new @code{<gdb:type>} object which represents the target type
+of @var{type}.
+
+For a pointer type, the target type is the type of the pointed-to
+object.  For an array type (meaning C-like arrays), the target type is
+the type of the elements of the array.  For a function or method type,
+the target type is the type of the return value.  For a complex type,
+the target type is the type of the elements.  For a typedef, the
+target type is the aliased type.
+
+If the type does not have a target, this method will throw an
+exception.
+@end deffn
+
+@deffn {Scheme Procedure} type-const type
+Return a new @code{<gdb:type>} object which represents a
+@code{const}-qualified variant of @var{type}.
+@end deffn
+
+@deffn {Scheme Procedure} type-volatile type
+Return a new @code{<gdb:type>} object which represents a
+@code{volatile}-qualified variant of @var{type}.
+@end deffn
+
+@deffn {Scheme Procedure} type-unqualified type
+Return a new @code{<gdb:type>} object which represents an unqualified
+variant of @var{type}.  That is, the result is neither @code{const} nor
+@code{volatile}.
+@end deffn
+
+@deffn {Scheme Procedure} type-num-fields
+Return the number of fields of @code{<gdb:type>} @var{type}.
+@end deffn
+
+@deffn {Scheme Procedure} type-fields type
+Return the fields of @var{type} as a list.
+For structure and union types, @code{fields} has the usual meaning.
+Range types have two fields, the minimum and maximum values.  Enum types
+have one field per enum constant.  Function and method types have one
+field per parameter.  The base types of C@t{++} classes are also
+represented as fields.  If the type has no fields, or does not fit
+into one of these categories, an empty list will be returned.
+@xref{Fields of a type in Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} make-field-iterator type
+Return the fields of @var{type} as a <gdb:iterator> object.
+@xref{Iterators In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} type-field type field-name
+Return field named @var{field-name} in @var{type}.
+The result is an object of type @code{<gdb:field>}.
+@xref{Fields of a type in Guile}.
+If the type does not have fields, or @var{field-name} is not a field
+of @var{type}, an exception is thrown.
+
+For example, if @code{some-type} is a @code{<gdb:type>} instance holding
+a structure type, you can access its @code{foo} field with:
+
+@smallexample
+(define bar (type-field some-type "foo"))
+@end smallexample
+
+@code{bar} will be a @code{<gdb:field>} object.
+@end deffn
+
+@deffn {Scheme Procedure} type-has-field? type name
+Return @code{#t} if @code{<gdb:type>} @var{type} has field named @var{name}.
+Otherwise return @code{#f}.
+@end deffn
+
+Each type has a code, which indicates what category this type falls
+into.  The available type categories are represented by constants
+defined in the @code{(gdb)} module:
+
+@vtable @code
+@item TYPE_CODE_PTR
+The type is a pointer.
+
+@item TYPE_CODE_ARRAY
+The type is an array.
+
+@item TYPE_CODE_STRUCT
+The type is a structure.
+
+@item TYPE_CODE_UNION
+The type is a union.
+
+@item TYPE_CODE_ENUM
+The type is an enum.
+
+@item TYPE_CODE_FLAGS
+A bit flags type, used for things such as status registers.
+
+@item TYPE_CODE_FUNC
+The type is a function.
+
+@item TYPE_CODE_INT
+The type is an integer type.
+
+@item TYPE_CODE_FLT
+A floating point type.
+
+@item TYPE_CODE_VOID
+The special type @code{void}.
+
+@item TYPE_CODE_SET
+A Pascal set type.
+
+@item TYPE_CODE_RANGE
+A range type, that is, an integer type with bounds.
+
+@item TYPE_CODE_STRING
+A string type.  Note that this is only used for certain languages with
+language-defined string types; C strings are not represented this way.
+
+@item TYPE_CODE_BITSTRING
+A string of bits.  It is deprecated.
+
+@item TYPE_CODE_ERROR
+An unknown or erroneous type.
+
+@item TYPE_CODE_METHOD
+A method type, as found in C@t{++} or Java.
+
+@item TYPE_CODE_METHODPTR
+A pointer-to-member-function.
+
+@item TYPE_CODE_MEMBERPTR
+A pointer-to-member.
+
+@item TYPE_CODE_REF
+A reference type.
+
+@item TYPE_CODE_CHAR
+A character type.
+
+@item TYPE_CODE_BOOL
+A boolean type.
+
+@item TYPE_CODE_COMPLEX
+A complex float type.
+
+@item TYPE_CODE_TYPEDEF
+A typedef to some other type.
+
+@item TYPE_CODE_NAMESPACE
+A C@t{++} namespace.
+
+@item TYPE_CODE_DECFLOAT
+A decimal floating point type.
+
+@item TYPE_CODE_INTERNAL_FUNCTION
+A function internal to @value{GDBN}.  This is the type used to represent
+convenience functions (@pxref{Convenience Funs}).
+@end vtable
+
+Further support for types is provided in the @code{(gdb types)}
+Guile module (@pxref{Guile Types Module}).
+
+@anchor{Fields of a type in Guile}
+Each field is represented as an object of type @code{<gdb:field>}.
+
+The following field-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} field? object
+Return @code{#t} if @var{object} is an object of type @code{<gdb:field>}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} field-name field
+Return the name of the field, or @code{#f} for anonymous fields.
+@end deffn
+
+@deffn {Scheme Procedure} field-type field
+Return the type of the field.  This is usually an instance of
+@code{<gdb:type>}, but it can be @code{#f} in some situations.
+@end deffn
+
+@deffn {Scheme Procedure} field-enumval field
+Return the enum value represented by @code{<gdb:field>} @var{field}.
+@end deffn
+
+@deffn {Scheme Procedure} field-bitpos field
+Return the bit position of @code{<gdb:field>} @var{field}.
+This attribute is not available for @code{static} fields (as in
+C@t{++} or Java).
+@end deffn
+
+@deffn {Scheme Procedure} field-bitsize field
+If the field is packed, or is a bitfield, return the size of
+@code{<gdb:field>} @var{field} in bits.  Otherwise, zero is returned;
+in which case the field's size is given by its type.
+@end deffn
+
+@deffn {Scheme Procedure} field-artificial? field
+Return @code{#t} if the field is artificial, usually meaning that
+it was provided by the compiler and not the user.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} field-base-class? field
+Return @code{#t} if the field represents a base class of a C@t{++}
+structure.
+Otherwise return @code{#f}.
+@end deffn
+
+@node Guile Pretty Printing API
+@subsubsection Guile Pretty Printing API
+@cindex guile pretty printing api
+
+An example output is provided (@pxref{Pretty Printing}).
+
+A pretty-printer is represented by an object of type <gdb:pretty-printer>.
+Pretty-printer objects are created with @code{make-pretty-printer}.
+
+The following pretty-printer-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} make-pretty-printer name lookup-function
+Return a @code{<gdb:pretty-printer>} object named @var{name}.
+
+@var{lookup-function} is a function of one parameter: the value to
+be printed.  If the value is handled by this pretty-printer, then
+@var{lookup-function} returns an object of type
+<gdb:pretty-printer-worker> to perform the actual pretty-printing.
+Otherwise @var{lookup-function} returns @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} pretty-printer? object
+Return @code{#t} if @var{object} is a @code{<gdb:pretty-printer>} object.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} pretty-printer-enabled? pretty-printer
+Return @code{#t} if @var{pretty-printer} is enabled.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} set-pretty-printer-enabled! pretty-printer flag
+Set the enabled flag of @var{pretty-printer} to @var{flag}.
+The value returned in unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} make-pretty-printer-worker display-hint to-string children
+Return an object of type @code{<gdb:pretty-printer-worker>}.
+
+This function takes three parameters:
+
+@table @samp
+@item display-hint
+@var{display-hint} provides a hint to @value{GDBN} or @value{GDBN}
+front end via MI to change the formatting of the value being printed.
+The value must be a string or @code{#f} (meaning there is no hint).
+Several values for @var{display-hint}
+are predefined by @value{GDBN}:
+
+@table @samp
+@item array
+Indicate that the object being printed is ``array-like''.  The CLI
+uses this to respect parameters such as @code{set print elements} and
+@code{set print array}.
+
+@item map
+Indicate that the object being printed is ``map-like'', and that the
+children of this value can be assumed to alternate between keys and
+values.
+
+@item string
+Indicate that the object being printed is ``string-like''.  If the
+printer's @code{to-string} function returns a Guile string of some
+kind, then @value{GDBN} will call its internal language-specific
+string-printing function to format the string.  For the CLI this means
+adding quotation marks, possibly escaping some characters, respecting
+@code{set print elements}, and the like.
+@end table
+
+@item to-string
+@var{to-string} is either a function of one parameter, the
+@code{<gdb:pretty-printer-worker>} object, or @code{#f}.
+
+When printing from the CLI, if the @code{to-string} method exists,
+then @value{GDBN} will prepend its result to the values returned by
+@code{children}.  Exactly how this formatting is done is dependent on
+the display hint, and may change as more hints are added.  Also,
+depending on the print settings (@pxref{Print Settings}), the CLI may
+print just the result of @code{to-string} in a stack trace, omitting
+the result of @code{children}.
+
+If this method returns a string, it is printed verbatim.
+
+Otherwise, if this method returns an instance of @code{<gdb:value>},
+then @value{GDBN} prints this value.  This may result in a call to
+another pretty-printer.
+
+If instead the method returns a Guile value which is convertible to a
+@code{<gdb:value>}, then @value{GDBN} performs the conversion and prints
+the resulting value.  Again, this may result in a call to another
+pretty-printer.  Guile scalars (integers, floats, and booleans) and
+strings are convertible to @code{<gdb:value>}; other types are not.
+
+Finally, if this method returns @code{#f} then no further operations
+are peformed in this method and nothing is printed.
+
+If the result is not one of these types, an exception is raised.
+
+@var{to-string} may also be @code{#f} in which case it is left to
+@var{children} to print the value.
+
+@item children
+@var{children} is either a function of one parameter, the
+@code{<gdb:pretty-printer-worker>} object, or @code{#f}.
+
+@value{GDBN} will call this function on a pretty-printer to compute the
+children of the pretty-printer's value.
+
+This function must return a <gdb:iterator> object.
+Each item returned by the iterator must be a tuple holding
+two elements.  The first element is the ``name'' of the child; the
+second element is the child's value.  The value can be any Guile
+object which is convertible to a @value{GDBN} value.
+
+If @var{children} is @code{#f}, @value{GDBN} will act
+as though the value has no children.
+@end table
+@end deffn
+
+@value{GDBN} provides a function which can be used to look up the
+default pretty-printer for a @code{<gdb:value>}:
+
+@deffn {Scheme Procedure} default-visualizer value
+This function takes a @code{<gdb:value>} object as an argument.  If a
+pretty-printer for this value exists, then it is returned.  If no such
+printer exists, then this returns @code{#f}.
+@end deffn
+
+@node Selecting Guile Pretty-Printers
+@subsubsection Selecting Guile Pretty-Printers
+@cindex selecting guile pretty-printers
+
+The Guile list @code{*pretty-printers*} contains a set of
+@code{<gdb:pretty-printer>} registered objects.
+Printers in this list are called @code{global}
+printers, they're available when debugging any inferior.
+In addition to this, each @code{<gdb:objfile>} object contains its
+own set of pretty-printers (@pxref{Objfiles In Guile}).
+
+Pretty-printer lookup is done by passing the value to be printed to the
+lookup function of each enabled object in turn.
+Lookup stops when a lookup function returns a non-@code{#f} value
+or when the list is exhausted.
+
+@value{GDBN} first checks the result of @code{objfile-pretty-printers}
+of each @code{<gdb:objfile>} in the current program space and iteratively
+calls each enabled lookup function in the list for that @code{<gdb:objfile>}
+until a non-@code{#f} object is returned.
+Lookup functions must return either a @code{<gdb:pretty-printer-worker>}
+object or @code{#f}.  Otherwise an exception is thrown.
+If no pretty-printer is found in the objfile lists, @value{GDBN} then
+searches the global pretty-printer list, calling each enabled function
+until a non-@code{#f} object is returned.
+
+The order in which the objfiles are searched is not specified.  For a
+given list, functions are always invoked from the head of the list,
+and iterated over sequentially until the end of the list, or a
+@code{<gdb:pretty-printer-worker>} object is returned.
+
+For various reasons a pretty-printer may not work.
+For example, the underlying data structure may have changed and
+the pretty-printer is out of date.
+
+The consequences of a broken pretty-printer are severe enough that
+@value{GDBN} provides support for enabling and disabling individual
+printers.  For example, if @code{print frame-arguments} is on,
+a backtrace can become highly illegible if any argument is printed
+with a broken printer.
+
+Pretty-printers are enabled and disabled from Scheme by calling
+@code{set-pretty-printer-enabled!}.
+@xref{Guile Pretty Printing API}.
+
+@node Writing a Guile Pretty-Printer
+@subsubsection Writing a Guile Pretty-Printer
+@cindex writing a Guile pretty-printer
+
+A pretty-printer consists of two basic parts: a lookup function to determine
+if the type is supported, and the printer itself.
+
+Here is an example showing how a @code{std::string} printer might be
+written.  @xref{Guile Pretty Printing API}, for details.
+
+@smallexample
+(define (make-my-string-printer value)
+  "Print a my::string string"
+  (make-pretty-printer-worker
+   "string"
+   (lambda (printer)
+     (value-field value "_data"))
+   #f))
+@end smallexample
+
+And here is an example showing how a lookup function for the printer
+example above might be written.
+
+@smallexample
+(define (string-begins-with str prefix)
+  (= (string-prefix-length str prefix) (string-length prefix)))
+
+(define (str-lookup-function value)
+  (let ((tag (type-tag (value-type value))))
+    (and tag
+         (string-begins-with tag "my::string<")
+         (make-std-string-printer value))))
+@end smallexample
+
+Then to register this printer in the global printer list:
+
+@smallexample
+(append-pretty-printer!
+ (make-pretty-printer "my-string" str-lookup-function))
+@end smallexample
+
+The example lookup function extracts the value's type, and attempts to
+match it to a type that it can pretty-print.  If it is a type the
+printer can pretty-print, it will return a <gdb:pretty-printer-worker> object.
+If not, it returns @code{#f}.
+
+We recommend that you put your core pretty-printers into a Guile
+package.  If your pretty-printers are for use with a library, we
+further recommend embedding a version number into the package name.
+This practice will enable @value{GDBN} to load multiple versions of
+your pretty-printers at the same time, because they will have
+different names.
+
+You should write auto-loaded code (@pxref{Guile Auto-loading}) such that it
+can be evaluated multiple times without changing its meaning.  An
+ideal auto-load file will consist solely of @code{import}s of your
+printer modules, followed by a call to a register pretty-printers with
+the current objfile.
+
+Taken as a whole, this approach will scale nicely to multiple
+inferiors, each potentially using a different library version.
+Embedding a version number in the Guile package name will ensure that
+@value{GDBN} is able to load both sets of printers simultaneously.
+Then, because the search for pretty-printers is done by objfile, and
+because your auto-loaded code took care to register your library's
+printers with a specific objfile, @value{GDBN} will find the correct
+printers for the specific version of the library used by each
+inferior.
+
+To continue the @code{my::string} example,
+this code might appear in @code{(my-project my-library v1)}:
+
+@smallexample
+(use-modules ((gdb)))
+(define (register-printers objfile)
+  (append-objfile-pretty-printer!
+   (make-pretty-printer "my-string" str-lookup-function)))
+@end smallexample
+
+@noindent
+And then the corresponding contents of the auto-load file would be:
+
+@smallexample
+(use-modules ((gdb) (my-project my-library v1)))
+(register-printers (current-objfile))
+@end smallexample
+
+The previous example illustrates a basic pretty-printer.
+There are a few things that can be improved on.
+The printer only handles one type, whereas a library typically has
+several types.  One could install a lookup function for each desired type
+in the library, but one could also have a single lookup function recognize
+several types.  The latter is the conventional way this is handled.
+If a pretty-printer can handle multiple data types, then its
+@dfn{subprinters} are the printers for the individual data types.
+
+The @code{(gdb printing)} module provides a formal way of solving this
+problem (@pxref{Guile Printing Module}).
+Here is another example that handles multiple types.
+
+These are the types we are going to pretty-print:
+
+@smallexample
+struct foo @{ int a, b; @};
+struct bar @{ struct foo x, y; @};
+@end smallexample
+
+Here are the printers:
+
+@smallexample
+(define (make-foo-printer value)
+  "Print a foo object"
+  (make-pretty-printer-worker
+   "foo"
+   (lambda (printer)
+     (format #f "a=<~a> b=<~a>"
+             (value-field value "a") (value-field value "a")))
+   #f))
+
+(define (make-bar-printer value)
+  "Print a bar object"
+  (make-pretty-printer-worker
+   "foo"
+   (lambda (printer)
+     (format #f "x=<~a> y=<~a>"
+             (value-field value "x") (value-field value "y")))
+   #f))
+@end smallexample
+
+This example doesn't need a lookup function, that is handled by the
+@code{(gdb printing)} module.  Instead a function is provided to build up
+the object that handles the lookup.
+
+@smallexample
+(use-modules ((gdb printing)))
+
+(define (build-pretty-printer)
+  (let ((pp (make-pretty-printer-collection "my-library")))
+    (pp-collection-add-tag-printer "foo" make-foo-printer)
+    (pp-collection-add-tag-printer "bar" make-bar-printer)
+    pp))
+@end smallexample
+
+And here is the autoload support:
+
+@smallexample
+(use-modules ((gdb) (my-library)))
+(append-objfile-pretty-printer! (current-objfile) (build-pretty-printer))
+@end smallexample
+
+Finally, when this printer is loaded into @value{GDBN}, here is the
+corresponding output of @samp{info pretty-printer}:
+
+@smallexample
+(gdb) info pretty-printer
+my_library.so:
+  my-library
+    foo
+    bar
+@end smallexample
+
+@node Objfiles In Guile
+@subsubsection Objfiles In Guile
+
+@cindex objfiles in guile
+@tindex <gdb:objfile>
+@value{GDBN} loads symbols for an inferior from various
+symbol-containing files (@pxref{Files}).  These include the primary
+executable file, any shared libraries used by the inferior, and any
+separate debug info files (@pxref{Separate Debug Files}).
+@value{GDBN} calls these symbol-containing files @dfn{objfiles}.
+
+Each objfile is represented as an object of type @code{<gdb:objfile>}.
+
+The following objfile-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} objfile? object
+Return @code{#t} if @var{object} is a @code{<gdb:objfile>} object.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} objfile-valid? objfile
+Return @code{#t} if @var{objfile} is valid, @code{#f} if not.
+A @code{<gdb:objfile>} object can become invalid
+if the object file it refers to is not loaded in @value{GDBN} any
+longer.  All other @code{<gdb:objfile>} procedures will throw an exception
+if it is invalid at the time the procedure is called.
+@end deffn
+
+@deffn {Scheme Procedure} objfile-filename objfile
+Return the file name of @var{objfile} as a string.
+@end deffn
+
+@deffn {Scheme Procedure} objfile-pretty-printers objfile
+Return the list of registered @code{<gdb:pretty-printer>} objects for
+@var{objfile}.  @xref{Guile Pretty Printing API}, for more information.
+@end deffn
+
+@deffn {Scheme Procedure} set-objfile-pretty-printers! objfile printer-list
+Set the list of registered @code{<gdb:pretty-printer>} objects for
+@var{objfile} to @var{printer-list}.
+@var{printer-list} must be a list of @code{<gdb:pretty-printer>} objects.
+@xref{Guile Pretty Printing API}, for more information.
+@end deffn
+
+@deffn {Scheme Procedure} current-objfile
+When auto-loading a Guile script (@pxref{Guile Auto-loading}), @value{GDBN}
+sets the ``current objfile'' to the corresponding objfile.  This
+function returns the current objfile.  If there is no current objfile,
+this function returns @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} objfiles
+Return a list of all the objfiles in the current program space.
+@end deffn
+
+@node Frames In Guile
+@subsubsection Accessing inferior stack frames from Guile.
+
+@cindex frames in guile
+When the debugged program stops, @value{GDBN} is able to analyze its call
+stack (@pxref{Frames,,Stack frames}).  The @code{<gdb:frame>} class
+represents a frame in the stack.  A @code{<gdb:frame>} object is only valid
+while its corresponding frame exists in the inferior's stack.  If you try
+to use an invalid frame object, @value{GDBN} will throw a
+@code{gdb:invalid-object} exception (@pxref{Guile Exception Handling}).
+
+Two @code{<gdb:frame>} objects can be compared for equality with the
+@code{equal?} function, like:
+
+@smallexample
+(@value{GDBP}) guile (equal? (newest-frame) (selected-frame))
+#t
+@end smallexample
+
+The following frame-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} frame? object
+Return @code{#t} if @var{object} is a @code{<gdb:frame>} object.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} frame-valid? frame
+Returns @code{#t} if @var{frame} is valid, @code{#f} if not.
+A frame object can become invalid if the frame it refers to doesn't
+exist anymore in the inferior.  All @code{<gdb:frame>} procedures will throw
+an exception if the frame is invalid at the time the procedure is called.
+@end deffn
+
+@deffn {Scheme Procedure} frame-name frame
+Return the function name of @var{frame}, or @code{#f} if it can't be
+obtained.
+@end deffn
+
+@deffn {Scheme Procedure} frame-arch frame
+Return the @code{<gdb:architecture>} object corresponding to @var{frame}'s
+architecture.  @xref{Architectures In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} frame-type frame
+Return the type of @var{frame}.  The value can be one of:
+
+@table @code
+@item NORMAL_FRAME
+An ordinary stack frame.
+
+@item DUMMY_FRAME
+A fake stack frame that was created by @value{GDBN} when performing an
+inferior function call.
+
+@item INLINE_FRAME
+A frame representing an inlined function.  The function was inlined
+into a @code{NORMAL_FRAME} that is older than this one.
+
+@item TAILCALL_FRAME
+A frame representing a tail call.  @xref{Tail Call Frames}.
+
+@item SIGTRAMP_FRAME
+A signal trampoline frame.  This is the frame created by the OS when
+it calls into a signal handler.
+
+@item ARCH_FRAME
+A fake stack frame representing a cross-architecture call.
+
+@item SENTINEL_FRAME
+This is like @code{NORMAL_FRAME}, but it is only used for the
+newest frame.
+@end table
+@end deffn
+
+@deffn {Scheme Procedure} frame-unwind-stop-reason frame
+Return an integer representing the reason why it's not possible to find
+more frames toward the outermost frame.  Use
+@code{unwind-stop-reason-string} to convert the value returned by this
+function to a string. The value can be one of:
+
+@table @code
+@item FRAME_UNWIND_NO_REASON
+No particular reason (older frames should be available).
+
+@item FRAME_UNWIND_NULL_ID
+The previous frame's analyzer returns an invalid result.
+
+@item FRAME_UNWIND_OUTERMOST
+This frame is the outermost.
+
+@item FRAME_UNWIND_UNAVAILABLE
+Cannot unwind further, because that would require knowing the 
+values of registers or memory that have not been collected.
+
+@item FRAME_UNWIND_INNER_ID
+This frame ID looks like it ought to belong to a NEXT frame,
+but we got it for a PREV frame.  Normally, this is a sign of
+unwinder failure.  It could also indicate stack corruption.
+
+@item FRAME_UNWIND_SAME_ID
+This frame has the same ID as the previous one.  That means
+that unwinding further would almost certainly give us another
+frame with exactly the same ID, so break the chain.  Normally,
+this is a sign of unwinder failure.  It could also indicate
+stack corruption.
+
+@item FRAME_UNWIND_NO_SAVED_PC
+The frame unwinder did not find any saved PC, but we needed
+one to unwind further.
+
+@item FRAME_UNWIND_FIRST_ERROR
+Any stop reason greater or equal to this value indicates some kind
+of error.  This special value facilitates writing code that tests
+for errors in unwinding in a way that will work correctly even if
+the list of the other values is modified in future @value{GDBN}
+versions.  Using it, you could write:
+
+@smallexample
+(define reason (frame-unwind-stop-readon (selected-frame)))
+(define reason-str (unwind-stop-reason-string reason))
+(if (>= reason FRAME_UNWIND_FIRST_ERROR)
+    (format #t "An error occured: ~s\n" reason-str))
+@end smallexample
+@end table
+@end deffn
+
+@deffn {Scheme Procedure} frame-pc frame
+Return the frame's resume address.
+@end deffn
+
+@deffn {Scheme Procedure} frame-block frame
+Return the frame's code block as a @code{<gdb:block>} object.
+@xref{Blocks In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} frame-function frame
+Return the symbol for the function corresponding to this frame
+as a @code{<gdb:symbol>} object, or @code{#f} if there isn't one.
+@xref{Symbols In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} frame-older frame
+Return the frame that called @var{frame}.
+@end deffn
+
+@deffn {Scheme Procedure} frame-newer frame
+Return the frame called by @var{frame}.
+@end deffn
+
+@deffn {Scheme Procedure} frame-sal frame
+Return the frame's @code{<gdb:sal>} (symtab and line) object.
+@xref{Symbol Tables In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} frame-read-var variable @r{[}#:block block@r{]}
+Return the value of @var{variable} in this frame.  If the optional
+argument @var{block} is provided, search for the variable from that
+block; otherwise start at the frame's current block (which is
+determined by the frame's current program counter).  @var{variable}
+must be a string or a @code{<gdb:symbol>} object.  @var{block} must be a
+@code{<gdb:block>} object.
+@end deffn
+
+@deffn {Scheme Procedure} frame-select frame
+Set @var{frame} to be the selected frame.  @xref{Stack, ,Examining the
+Stack}.
+@end deffn
+
+@deffn {Scheme Procedure} selected-frame
+Return the selected frame object.  @xref{Selection,,Selecting a Frame}.
+@end deffn
+
+@deffn {Scheme Procedure} newest-frame
+Return the newest frame object for the selected thread.
+@end deffn
+
+@deffn {Scheme Procedure} unwind-stop-reason-string reason
+Return a string explaining the reason why @value{GDBN} stopped unwinding
+frames, as expressed by the given @var{reason} code (an integer, see the
+@code{frame-unwind-stop-reason} procedure above in this section).
+@end deffn
+
+@node Blocks In Guile
+@subsubsection Accessing blocks from Guile.
+
+@cindex blocks in guile
+@tindex <gdb:block>
+
+In @value{GDBN}, symbols are stored in blocks.  A block corresponds
+roughly to a scope in the source code.  Blocks are organized
+hierarchically, and are represented individually in Guile as an object
+of type @code{<gdb:block>}.  Blocks rely on debugging information being
+available.
+
+A frame has a block.  Please see @ref{Frames In Guile}, for a more
+in-depth discussion of frames.
+
+The outermost block is known as the @dfn{global block}.  The global
+block typically holds public global variables and functions.
+
+The block nested just inside the global block is the @dfn{static
+block}.  The static block typically holds file-scoped variables and
+functions.
+
+@value{GDBN} provides a method to get a block's superblock, but there
+is currently no way to examine the sub-blocks of a block, or to
+iterate over all the blocks in a symbol table (@pxref{Symbol Tables In
+Guile}).
+
+Here is a short example that should help explain blocks:
+
+@smallexample
+/* This is in the global block.  */
+int global;
+
+/* This is in the static block.  */
+static int file_scope;
+
+/* 'function' is in the global block, and 'argument' is
+   in a block nested inside of 'function'.  */
+int function (int argument)
+@{
+  /* 'local' is in a block inside 'function'.  It may or may
+     not be in the same block as 'argument'.  */
+  int local;
+
+  @{
+     /* 'inner' is in a block whose superblock is the one holding
+        'local'.  */
+     int inner;
+
+     /* If this call is expanded by the compiler, you may see
+        a nested block here whose function is 'inline_function'
+        and whose superblock is the one holding 'inner'.  */
+     inline_function ();
+  @}
+@}
+@end smallexample
+
+The following block-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} block? object
+Return @code{#t} if @var{object} is a @code{<gdb:block>} object.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} block-valid? block
+Returns @code{#t} if @code{<gdb:block>} @var{block} is valid,
+@code{#f} if not.  A block object can become invalid if the block it
+refers to doesn't exist anymore in the inferior.  All other
+@code{<gdb:block>} methods will throw an exception if it is invalid at
+the time the procedure is called.  The block's validity is also checked
+during iteration over symbols of the block.
+@end deffn
+
+@deffn {Scheme Procedure} block-start block
+Return the start address of @code{<gdb:block>} @var{block}.
+@end deffn
+
+@deffn {Scheme Procedure} block-end block
+Return the end address of @code{<gdb:block>} @var{block}.
+@end deffn
+
+@deffn {Scheme Procedure} block-function block
+Return the name of @code{<gdb:block>} @var{block} represented as a
+@code{<gdb:symbol>} object.
+If the block is not named, then @code{#f} is returned.
+
+For ordinary function blocks, the superblock is the static block.
+However, you should note that it is possible for a function block to
+have a superblock that is not the static block -- for instance this
+happens for an inlined function.
+@end deffn
+
+@deffn {Scheme Procedure} block-superblock block
+Return the block containing @code{<gdb:block>} @var{block}.
+If the parent block does not exist, then @code{#f} is returned.
+@end deffn
+
+@deffn {Scheme Procedure} block-global-block block
+Return the global block associated with @code{<gdb:block>} @var{block}.
+@end deffn
+
+@deffn {Scheme Procedure} block-static-block block
+Return the static block associated with @code{<gdb:block>} @var{block}.
+@end deffn
+
+@deffn {Scheme Procedure} block-global? block
+Return @code{#t} if @code{<gdb:block>} @var{block} is a global block.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} block-static? block
+Return @code{#t} if @code{<gdb:block>} @var{block} is a static block.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} block-symbols
+Return a list of all symbols (as <gdb:symbol> objects) in
+@code{<gdb:block>} @var{block}.
+@end deffn
+
+@deffn {Scheme Procedure} make-block-symbols-iterator block
+Return an object of type @code{<gdb:iterator>} that will iterate
+over all symbols of the block.
+Guile programs should not assume that a specific block object will
+always contain a given symbol, since changes in @value{GDBN} features and
+infrastructure may cause symbols move across blocks in a symbol table.
+@xref{Iterators In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} block-symbols-progress?
+Return #t if the object is a <gdb:block-symbols-progress> object.
+This object would be obtained from the @code{progress} element of the
+@code{<gdb:iterator>} object returned by @code{make-block-symbols-iterator}.
+@end deffn
+
+@deffn {Scheme Procedure} lookup-block pc
+Return the innermost @code{<gdb:block>} containing the given @var{pc}
+value.  If the block cannot be found for the @var{pc} value specified,
+the function will return @code{#f}.
+@end deffn
+
+@node Symbols In Guile
+@subsubsection Guile representation of Symbols.
+
+@cindex symbols in guile
+@tindex <gdb:symbol>
+
+@value{GDBN} represents every variable, function and type as an
+entry in a symbol table.  @xref{Symbols, ,Examining the Symbol Table}.
+Guile represents these symbols in @value{GDBN} with the
+@code{<gdb:symbol>} object.
+
+The following symbol-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} symbol? object
+Return @code{#t} if @var{object} is an object of type @code{<gdb:symbol>}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-valid? symbol
+Return @code{#t} if the @code{<gdb:symbol>} object is valid,
+@code{#f} if not.  A @code{<gdb:symbol>} object can become invalid if
+the symbol it refers to does not exist in @value{GDBN} any longer.
+All other @code{<gdb:symbol>} procedures will throw an exception if it is
+invalid at the time the procedure is called.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-type symbol
+Return the type of @var{symbol} or @code{#f} if no type is recorded.
+The result is an object of type @code{<gdb:type>}.
+@xref{Types In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-symtab symbol
+Return the symbol table in which @var{symbol} appears.
+The result is an object of type @code{<gdb:symtab>}.
+@xref{Symbol Tables In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-line symbol
+Return the line number in the source code at which @var{symbol} was defined.
+This is an integer.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-name symbol
+Return the name of @var{symbol} as a string.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-linkage-name symbol
+Return the name of @var{symbol}, as used by the linker (i.e., may be mangled).
+@end deffn
+
+@deffn {Scheme Procedure} symbol-print-name symbol
+Return the name of @var{symbol} in a form suitable for output.  This is either
+@code{name} or @code{linkage_name}, depending on whether the user
+asked @value{GDBN} to display demangled or mangled names.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-addr-class symbol
+Return the address class of the symbol.  This classifies how to find the value
+of a symbol.  Each address class is a constant defined in the
+@code{(gdb)} module and described later in this chapter.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-needs-frame? symbol
+Return @code{#t} if evaluating @var{symbol}'s value requires a frame
+(@pxref{Frames In Guile}) and @code{#f} otherwise.  Typically,
+local variables will require a frame, but other symbols will not.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-argument? symbol
+Return @code{#t} if @var{symbol} is an argument of a function.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-constant? symbol
+Return @code{#t} if @var{symbol} is a constant.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-function? symbol
+Return @code{#t} if @var{symbol} is a function or a method.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-variable? symbol
+Return @code{#t} if @var{symbol} is a variable.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} symbol-value symbol @r{[}#:frame frame@r{]}
+Compute the value of @var{symbol}, as a @code{<gdb:value>}.  For
+functions, this computes the address of the function, cast to the
+appropriate type.  If the symbol requires a frame in order to compute
+its value, then @var{frame} must be given.  If @var{frame} is not
+given, or if @var{frame} is invalid, then an exception is thrown.
+@end deffn
+
+@c TODO: line length
+@deffn {Scheme Procedure} lookup-symbol name @r{[}#:block block@r{]} @r{[}#:domain domain@r{]}
+This function searches for a symbol by name.  The search scope can be
+restricted to the parameters defined in the optional domain and block
+arguments.
+
+@var{name} is the name of the symbol.  It must be a string.  The
+optional @var{block} argument restricts the search to symbols visible
+in that @var{block}.  The @var{block} argument must be a
+@code{<gdb:block>} object.  If omitted, the block for the current frame
+is used.  The optional @var{domain} argument restricts
+the search to the domain type.  The @var{domain} argument must be a
+domain constant defined in the @code{(gdb)} module and described later
+in this chapter.
+
+The result is a list of two elements.
+The first element is a @code{<gdb:symbol>} object or @code{#f} if the symbol
+is not found.
+If the symbol is found, the second element is @code{#t} if the symbol
+is a field of a method's object (e.g., @code{this} in C@t{++}),
+otherwise it is @code{#f}.
+If the symbol is not found, the second element is @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} lookup-global-symbol name @r{[}#:domain domain@r{]}
+This function searches for a global symbol by name.
+The search scope can be restricted by the domain argument.
+
+@var{name} is the name of the symbol.  It must be a string.
+The optional @var{domain} argument restricts the search to the domain type.
+The @var{domain} argument must be a domain constant defined in the @code{(gdb)}
+module and described later in this chapter.
+
+The result is a @code{<gdb:symbol>} object or @code{#f} if the symbol
+is not found.
+@end deffn
+
+The available domain categories in @code{<gdb:symbol>} are represented
+as constants in the @code{(gdb)} module:
+
+@vtable @code
+@item SYMBOL_UNDEF_DOMAIN
+This is used when a domain has not been discovered or none of the
+following domains apply.  This usually indicates an error either
+in the symbol information or in @value{GDBN}'s handling of symbols.
+
+@item SYMBOL_VAR_DOMAIN
+This domain contains variables, function names, typedef names and enum
+type values.
+
+@item SYMBOL_STRUCT_DOMAIN
+This domain holds struct, union and enum type names.
+
+@item SYMBOL_LABEL_DOMAIN
+This domain contains names of labels (for gotos).
+
+@item SYMBOL_VARIABLES_DOMAIN
+This domain holds a subset of the @code{SYMBOLS_VAR_DOMAIN}; it
+contains everything minus functions and types.
+
+@item SYMBOL_FUNCTION_DOMAIN
+This domain contains all functions.
+
+@item SYMBOL_TYPES_DOMAIN
+This domain contains all types.
+@end vtable
+
+The available address class categories in @code{<gdb:symbol>} are represented
+as constants in the @code{gdb} module:
+
+@vtable @code
+@item SYMBOL_LOC_UNDEF
+If this is returned by address class, it indicates an error either in
+the symbol information or in @value{GDBN}'s handling of symbols.
+
+@item SYMBOL_LOC_CONST
+Value is constant int.
+
+@item SYMBOL_LOC_STATIC
+Value is at a fixed address.
+
+@item SYMBOL_LOC_REGISTER
+Value is in a register.
+
+@item SYMBOL_LOC_ARG
+Value is an argument.  This value is at the offset stored within the
+symbol inside the frame's argument list.
+
+@item SYMBOL_LOC_REF_ARG
+Value address is stored in the frame's argument list.  Just like
+@code{LOC_ARG} except that the value's address is stored at the
+offset, not the value itself.
+
+@item SYMBOL_LOC_REGPARM_ADDR
+Value is a specified register.  Just like @code{LOC_REGISTER} except
+the register holds the address of the argument instead of the argument
+itself.
+
+@item SYMBOL_LOC_LOCAL
+Value is a local variable.
+
+@item SYMBOL_LOC_TYPEDEF
+Value not used.  Symbols in the domain @code{SYMBOL_STRUCT_DOMAIN} all
+have this class.
+
+@item SYMBOL_LOC_BLOCK
+Value is a block.
+
+@item SYMBOL_LOC_CONST_BYTES
+Value is a byte-sequence.
+
+@item SYMBOL_LOC_UNRESOLVED
+Value is at a fixed address, but the address of the variable has to be
+determined from the minimal symbol table whenever the variable is
+referenced.
+
+@item SYMBOL_LOC_OPTIMIZED_OUT
+The value does not actually exist in the program.
+
+@item SYMBOL_LOC_COMPUTED
+The value's address is a computed location.
+@end vtable
+
+@node Symbol Tables In Guile
+@subsubsection Symbol table representation in Guile.
+
+@cindex symbol tables in guile
+@tindex <gdb:symtab>
+@tindex <gdb:sal>
+
+Access to symbol table data maintained by @value{GDBN} on the inferior
+is exposed to Guile via two objects: @code{<gdb:sal>} (symtab-and-line) and
+@code{<gdb:symtab>}.  Symbol table and line data for a frame is returned
+from the @code{frame-find-sal} @code{<gdb:frame>} procedure.
+@xref{Frames In Guile}.
+
+For more information on @value{GDBN}'s symbol table management, see
+@ref{Symbols, ,Examining the Symbol Table}.
+
+The following symtab-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} symtab? object
+Return @code{#t} if @var{object} is an object of type @code{<gdb:symtab>}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} symtab-valid? symtab
+Return @code{#t} if the @code{<gdb:symtab>} object is valid,
+@code{#f} if not.  A @code{<gdb:symtab>} object becomes invalid when
+the symbol table it refers to no longer exists in @value{GDBN}.
+All other @code{<gdb:symtab>} procedures will throw an exception
+if it is invalid at the time the procedure is called.
+@end deffn
+
+@deffn {Scheme Procedure} symtab-filename symtab
+Return the symbol table's source filename.
+@end deffn
+
+@deffn {Scheme Procedure} symtab-fullname symtab
+Return the symbol table's source absolute file name.
+@end deffn
+
+@deffn {Scheme Procedure} symtab-objfile symtab
+Return the symbol table's backing object file.  @xref{Objfiles In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} symtab-global-block symtab
+Return the global block of the underlying symbol table.
+@xref{Blocks In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} symtab-static-block symtab
+Return the static block of the underlying symbol table.
+@xref{Blocks In Guile}.
+@end deffn
+
+The following symtab-and-line-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} sal? object
+Return @code{#t} if @var{object} is an object of type @code{<gdb:sal>}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} sal-valid? sal
+Return @code{#t} if @var{sal} is valid, @code{#f} if not.
+A @code{<gdb:sal>} object becomes invalid when the Symbol table object
+it refers to no longer exists in @value{GDBN}.  All other
+@code{<gdb:sal>} procedures will throw an exception if it is
+invalid at the time the procedure is called.
+@end deffn
+
+@deffn {Scheme Procedure} sal-symtab sal
+Return the symbol table object (@code{<gdb:symtab>}) for @var{sal}.
+@end deffn
+
+@deffn {Scheme Procedure} sal-line sal
+Return the line number for @var{sal}.
+@end deffn
+
+@deffn {Scheme Procedure} sal-pc sal
+Return the start of the address range occupied by code for @var{sal}.
+@end deffn
+
+@deffn {Scheme Procedure} sal-last sal
+Return the end of the address range occupied by code for @var{sal}.
+@end deffn
+
+@deffn {Scheme Procedure} find-pc-line pc
+Return the @code{<gdb:sal>} object corresponding to the @var{pc} value.
+If an invalid value of @var{pc} is passed as an argument, then the
+@code{symtab} and @code{line} attributes of the returned @code{<gdb:sal>}
+object will be @code{#f} and 0 respectively.
+@end deffn
+
+@node Breakpoints In Guile
+@subsubsection Manipulating breakpoints using Guile
+
+@cindex breakpoints in guile
+@tindex <gdb:breakpoint>
+
+Breakpoints in Guile are represented by objects of type
+@code{<gdb:breakpoint>}.
+
+The following breakpoint-related procedures are provided by the
+@code{(gdb)} module:
+
+@c TODO: line length
+@deffn {Scheme Procedure} create-breakpoint! location @r{[}#:type type@r{]} @r{[}#:wp-class wp-class@r{]} @r{[}#:internal internal@r{]}
+Create a new breakpoint.  @var{spec} is a string naming the
+location of the breakpoint, or an expression that defines a watchpoint.
+The contents can be any location recognized by the @code{break} command,
+or in the case of a watchpoint, by the @code{watch} command.
+
+The optional @var{type} denotes the breakpoint to create.
+This argument can be either: @code{BP_BREAKPOINT} or @code{BP_WATCHPOINT}.
+@var{type} defaults to @code{BP_BREAKPOINT}.
+
+The optional @var{wp-class} argument defines the class of watchpoint to
+create, if @var{type} is @code{BP_WATCHPOINT}.  If a watchpoint class is
+not provided, it is assumed to be a @code{WP_WRITE} class.
+
+The optional @var{internal} argument allows the breakpoint to become
+invisible to the user.  The breakpoint will neither be reported when
+created, nor will it be listed in the output from @code{info breakpoints}
+(but will be listed with the @code{maint info breakpoints} command).
+If an internal flag is not provided, the breakpoint is visible
+(non-internal).
+
+When a watchpoint is created, @value{GDBN} will try to create a
+hardware assisted watchpoint.  If successful, the type of the watchpoint
+is changed from @code{BP_WATCHPOINT} to @code{BP_HARDWARE_WATCHPOINT}
+for @code{WP_WRITE}, @code{BP_READ_WATCHPOINT} for @code{WP_READ},
+and @code{BP_ACCESS_WATCHPOINT} for @code{WP_ACCESS}.
+If not successful, the type of the watchpoint is left as @code{WP_WATCHPOINT}.
+
+The available types are represented by constants defined in the @code{gdb}
+module:
+
+@vtable @code
+@item BP_BREAKPOINT
+Normal code breakpoint.
+
+@item BP_WATCHPOINT
+Watchpoint breakpoint.
+
+@item BP_HARDWARE_WATCHPOINT
+Hardware assisted watchpoint.
+This value cannot be specified when creating the breakpoint.
+
+@item BP_READ_WATCHPOINT
+Hardware assisted read watchpoint.
+This value cannot be specified when creating the breakpoint.
+
+@item BP_ACCESS_WATCHPOINT
+Hardware assisted access watchpoint.
+This value cannot be specified when creating the breakpoint.
+@end vtable
+
+The available watchpoint types represented by constants are defined in the
+@code{(gdb)} module:
+
+@vtable @code
+@item WP_READ
+Read only watchpoint.
+
+@item WP_WRITE
+Write only watchpoint.
+
+@item WP_ACCESS
+Read/Write watchpoint.
+@end vtable
+
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-delete! breakpoint
+Permanently delete @var{breakpoint}.  This also invalidates the
+Guile @var{breakpoint} object.  Any further attempt to access the
+object will throw an exception.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoints
+Return a list of all breakpoints.
+Each element of the list is a @code{<gdb:breakpoint>} object.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint? object
+Return @code{#t} if @var{object} is a @code{<gdb:breakpoint>} object,
+and @code{#f} otherwise.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-valid? breakpoint
+Return @code{#t} if @var{breakpoint} is valid, @code{#f} otherwise.
+A @code{<gdb:breakpoint>} object can become invalid
+if the user deletes the breakpoint.  In this case, the object still
+exists, but the underlying breakpoint does not.  In the cases of
+watchpoint scope, the watchpoint remains valid even if execution of the
+inferior leaves the scope of that watchpoint.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-number breakpoint
+Return the breakpoint's number --- the identifier used by
+the user to manipulate the breakpoint.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-type breakpoint
+Return the breakpoint's type --- the identifier used to
+determine the actual breakpoint type or use-case.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-visible? breakpoint
+Return @code{#t} if the breakpoint is visible to the user
+when hit, or when the @samp{info breakpoints} command is run.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-location breakpoint
+Return the location of the breakpoint, as specified by
+the user.  It is a string.  If the breakpoint does not have a location
+(that is, it is a watchpoint) return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-expression breakpoint
+Return the breakpoint expression, as specified by the user.  It is a string.
+If the breakpoint does not have an expression (the breakpoint is not a
+watchpoint) return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-enabled? breakpoint
+Return @code{#t} if the breakpoint is enabled, and @code{#f} otherwise.
+@end deffn
+
+@deffn {Scheme Procedure} set-breakpoint-enabled! breakpoint flag
+Set the enabled state of @var{breakpoint} to @var{flag}.
+If flag is @code{#f} it is disabled, otherwise it is enabled.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-silent? breakpoint
+Return @code{#t} if the breakpoint is silent, and @code{#f} otherwise.
+
+Note that a breakpoint can also be silent if it has commands and the
+first command is @code{silent}.  This is not reported by the
+@code{silent} attribute.
+@end deffn
+
+@deffn {Scheme Procedure} set-breakpoint-silent! breakpoint flag
+Set the silent state of @var{breakpoint} to @var{flag}.
+If flag is @code{#f} the breakpoint is made silent,
+otherwise it is made non-silent (or noisy).
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-ignore-count breakpoint
+Return the ignore count for @var{breakpoint}.
+@end deffn
+
+@deffn {Scheme Procedure} set-breakpoint-ignore-count! breakpoint count
+Set the ignore count for @var{breakpoint} to @var{count}.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-hit-count breakpoint
+Return hit count of @var{breakpoint}.
+@end deffn
+
+@deffn {Scheme Procedure} set-breakpoint-hit-count! breakpoint count
+Set the hit count of @var{breakpoint} to @var{count}.
+At present, @var{count} must be zero.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-thread breakpoint
+Return the thread-id for thread-specific breakpoint @var{breakpoint}.
+Return #f if @var{breakpoint} is not thread-specific.
+@end deffn
+
+@deffn {Scheme Procedure} set-breakpoint-thread! breakpoint thread-id|#f
+Set the thread-id for @var{breakpoint} to @var{thread-id}.
+If set to @code{#f}, the breakpoint is no longer thread-specific.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-task breakpoint
+If the breakpoint is Ada task-specific, return the Ada task id.
+If the breakpoint is not task-specific (or the underlying
+language is not Ada), return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} set-breakpoint-task! breakpoint task
+Set the Ada task of @var{breakpoint} to @var{task}.
+If set to @code{#f}, the breakpoint is no longer task-specific.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-condition breakpoint
+Return the condition of @var{breakpoint}, as specified by the user.
+It is a string.  If there is no condition, return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} set-breakpoint-condition! breakpoint condition
+Set the condition of @var{breakpoint} to @var{condition},
+which must be a string.  If set to @code{#f} then the breakpoint
+becomes unconditional.
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-stop breakpoint
+Return the stop predicate of @var{breakpoint}.
+See @code{set-breakpoint-stop!} below in this section.
+@end deffn
+
+@deffn {Scheme Procedure} set-breakpoint-stop! breakpoint procedure|#f
+Set the stop predicate of @var{breakpoint}.
+@var{procedure} takes one argument: the <gdb:breakpoint> object.
+If this predicate is set to a procedure then it is invoked whenever
+the inferior reaches this breakpoint.  If it returns @code{#t},
+or any non-@code{#f} value, then the inferior is stopped,
+otherwise the inferior will continue.
+
+If there are multiple breakpoints at the same location with a
+@code{stop} predicate, each one will be called regardless of the
+return status of the previous.  This ensures that all @code{stop}
+predicates have a chance to execute at that location.  In this scenario
+if one of the methods returns @code{#t} but the others return
+@code{#f}, the inferior will still be stopped.
+
+You should not alter the execution state of the inferior (i.e.@:, step,
+next, etc.), alter the current frame context (i.e.@:, change the current
+active frame), or alter, add or delete any breakpoint.  As a general
+rule, you should not alter any data within @value{GDBN} or the inferior
+at this time.
+
+Example @code{stop} implementation:
+
+@smallexample
+(define (my-stop? bkpt)
+  (let ((int-val (parse-and-eval "foo")))
+    (value=? int-val 3)))
+(define bkpt (create-breakpoint! "main.c:42"))
+(set-breakpoint-stop! bkpt my-stop?)
+@end smallexample
+@end deffn
+
+@deffn {Scheme Procedure} breakpoint-commands breakpoint
+Return the commands attached to @var{breakpoint} as a string,
+or @code{#f} if there are none.
+@end deffn
+
+@node Lazy Strings In Guile
+@subsubsection Guile representation of lazy strings.
+
+@cindex lazy strings in guile
+@tindex <gdb:lazy-string>
+
+A @dfn{lazy string} is a string whose contents is not retrieved or
+encoded until it is needed.
+
+A @code{<gdb:lazy-string>} is represented in @value{GDBN} as an
+@code{address} that points to a region of memory, an @code{encoding}
+that will be used to encode that region of memory, and a @code{length}
+to delimit the region of memory that represents the string.  The
+difference between a @code{<gdb:lazy-string>} and a string wrapped within
+a @code{<gdb:value>} is that a @code{<gdb:lazy-string>} will be treated
+differently by @value{GDBN} when printing.  A @code{<gdb:lazy-string>} is
+retrieved and encoded during printing, while a @code{<gdb:value>}
+wrapping a string is immediately retrieved and encoded on creation.
+
+The following lazy-string-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} lazy-string? object
+Return @code{#t} if @var{object} is an object of type @code{<gdb:lazy-string>}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} lazy-string-address lazy-sring
+Return the address of @var{lazy-string}.
+@end deffn
+
+@deffn {Scheme Procedure} lazy-string-length lazy-string
+Return the length of @var{lazy-string} in characters.  If the
+length is -1, then the string will be fetched and encoded up to the
+first null of appropriate width.
+@end deffn
+
+@deffn {Scheme Procedure} lazy-string-encoding lazy-string
+Return the encoding that will be applied to @var{lazy-string}
+when the string is printed by @value{GDBN}.  If the encoding is not
+set, or contains an empty string,  then @value{GDBN} will select the
+most appropriate encoding when the string is printed.
+@end deffn
+
+@deffn {Scheme Procedure} lazy-string-type lazy-string
+Return the type that is represented by @var{lazy-string}'s type.
+For a lazy string this will always be a pointer type.  To
+resolve this to the lazy string's character type, use @code{type-target-type}.
+@xref{Types In Guile}.
+@end deffn
+
+@deffn {Scheme Procedure} lazy-string->value lazy-string
+Convert the @code{<gdb:lazy-string>} to a @code{<gdb:value>}.  This value
+will point to the string in memory, but will lose all the delayed
+retrieval, encoding and handling that @value{GDBN} applies to a
+@code{<gdb:lazy-string>}.
+@end deffn
+
+@node Architectures In Guile
+@subsubsection Guile representation of architectures
+
+@cindex guile architectures
+@tindex <gdb:arch>
+
+@value{GDBN} uses architecture specific parameters and artifacts in a
+number of its various computations.  An architecture is represented
+by an instance of the @code{<gdb:arch>} class.
+
+The following architecture-related procedures are provided by the
+@code{(gdb)} module:
+
+@deffn {Scheme Procedure} arch? object
+Return @code{#t} if @var{object} is an object of type @code{<gdb:arch>}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} current-arch
+Return the current architecture as a @code{<gdb:arch>} object.
+@end deffn
+
+@deffn {Scheme Procedure} arch-name arch
+Return the name (string value) of @code{<gdb:arch>} @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-charset arch
+Return name of target character set of @code{<gdb:arch>} @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-wide-charset
+Return name of target wide character set of @code{<gdb:arch>} @var{arch}.
+@end deffn
+
+Each architecture provides a set of predefined types, obtained by
+the following functions.
+
+@deffn {Scheme Procedure} arch-void-type arch
+Return the @code{<gdb:type>} object for a @code{void} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-char-type arch
+Return the @code{<gdb:type>} object for a @code{char} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-short-type arch
+Return the @code{<gdb:type>} object for a @code{short} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-int-type arch
+Return the @code{<gdb:type>} object for an @code{int} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-long-type arch
+Return the @code{<gdb:type>} object for a @code{long} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-schar-type arch
+Return the @code{<gdb:type>} object for a @code{signed char} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-uchar-type arch
+Return the @code{<gdb:type>} object for an @code{unsigned char} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-ushort-type arch
+Return the @code{<gdb:type>} object for an @code{unsigned short} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-uint-type arch
+Return the @code{<gdb:type>} object for an @code{unsigned int} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-ulong-type arch
+Return the @code{<gdb:type>} object for an @code{unsigned long} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-float-type arch
+Return the @code{<gdb:type>} object for a @code{float} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-double-type arch
+Return the @code{<gdb:type>} object for a @code{double} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-longdouble-type arch
+Return the @code{<gdb:type>} object for a @code{long double} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-bool-type arch
+Return the @code{<gdb:type>} object for a @code{bool} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-longlong-type arch
+Return the @code{<gdb:type>} object for a @code{long long} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-ulonglong-type arch
+Return the @code{<gdb:type>} object for an @code{unsigned long long} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-int8-type arch
+Return the @code{<gdb:type>} object for an @code{int8} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-uint8-type arch
+Return the @code{<gdb:type>} object for a @code{uint8} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-int16-type arch
+Return the @code{<gdb:type>} object for an @code{int16} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-uint16-type arch
+Return the @code{<gdb:type>} object for a @code{uint16} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-int32-type arch
+Return the @code{<gdb:type>} object for an @code{int32} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-uint32-type arch
+Return the @code{<gdb:type>} object for a @code{uint32} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-int64-type arch
+Return the @code{<gdb:type>} object for an @code{int64} type
+of architecture @var{arch}.
+@end deffn
+
+@deffn {Scheme Procedure} arch-uint64-type arch
+Return the @code{<gdb:type>} object for a @code{uint64} type
+of architecture @var{arch}.
+@end deffn
+
+Example:
+
+@smallexample
+(gdb) guile (type-name (arch-uchar-type (current-arch)))
+"unsigned char"
+@end smallexample
+
+@node Disassembly In Guile
+@subsubsection Disassembly In Guile
+
+The disassembler can be invoked from Scheme code.
+Furthermore, the disassembler can take a Guile port as input,
+allowing one to disassemble from any source, and not just target memory.
+
+@c TODO: line length
+@deffn {Scheme Procedure} arch-disassemble arch start-pc @r{[}#:port port@r{]} @r{[}#:offset offset@r{]} @r{[}#:size size@r{]} @r{[}#:count count@r{]})
+Return a list of disassembled instructions starting from the memory
+address @var{start-pc}.
+
+The optional argument @var{port} specifies the input port to read bytes from.
+If @var{port} is @code{#f} then bytes are read from target memory.
+
+The optional argument @var{offset} specifies the address offset of the
+first byte in @var{port}.  This is useful, for example, when @var{port}
+specifies a @samp{bytevector} and you want the bytevector to be disassembled
+as if it came from that address.  The @var{start-pc} passed to the reader
+for @var{port} is offset by the same amount.
+
+Example:
+@smallexample
+(gdb) guile (use-modules (rnrs io ports))
+(gdb) guile (define pc (value->integer (parse-and-eval "$pc")))
+(gdb) guile (define mem (open-memory #:start pc))
+(gdb) guile (define bv (get-bytevector-n mem 10))
+(gdb) guile (define bv-port (open-bytevector-input-port bv))
+(gdb) guile (define arch (current-arch))
+(gdb) guile (arch-disassemble arch pc #:port bv-port #:offset pc)
+(((address . 4195516) (asm . "mov    $0x4005c8,%edi") (length . 5)))
+@end smallexample
+
+The optional arguments @var{size} and
+@var{count} determine the number of instructions in the returned list.
+If either @var{size} or @var{count} is specified as zero, then
+no instructions are disassembled and an empty list is returned.
+If both the optional arguments @var{size} and @var{count} are
+specified, then a list of at most @var{count} disassembled instructions
+whose start address falls in the closed memory address interval from
+@var{start-pc} to (@var{start-pc} + @var{size} - 1) are returned.
+If @var{size} is not specified, but @var{count} is specified,
+then @var{count} number of instructions starting from the address
+@var{start-pc} are returned.  If @var{count} is not specified but
+@var{size} is specified, then all instructions whose start address
+falls in the closed memory address interval from @var{start-pc} to
+(@var{start-pc} + @var{size} - 1) are returned.
+If neither @var{size} nor @var{count} are specified, then a single
+instruction at @var{start-pc} is returned.
+
+Each element of the returned list is an alist (associative list)
+with the following keys:
+
+@table @code
+
+@item address
+The value corresponding to this key is a Guile integer of
+the memory address of the instruction.
+
+@item asm
+The value corresponding to this key is a string value which represents
+the instruction with assembly language mnemonics.  The assembly
+language flavor used is the same as that specified by the current CLI
+variable @code{disassembly-flavor}.  @xref{Machine Code}.
+
+@item length
+The value corresponding to this key is the length of the instruction in bytes.
+
+@end table
+@end deffn
+
+@node I/O Ports in Guile
+@subsubsection I/O Ports in Guile
+
+@deffn {Scheme Procedure} input-port
+Return @value{GDBN}'s input port as a Guile port object.
+@end deffn
+
+@deffn {Scheme Procedure} output-port
+Return @value{GDBN}'s output port as a Guile port object.
+@end deffn
+
+@deffn {Scheme Procedure} error-port
+Return @value{GDBN}'s error port as a Guile port object.
+@end deffn
+
+@deffn {Scheme Procedure} stdio-port? object
+Return @code{#t} if @var{object} is a @value{GDBN} stdio port.
+Otherwise return @code{#f}.
+@end deffn
+
+@node Memory Ports in Guile
+@subsubsection Memory Ports in Guile
+
+@value{GDBN} provides a @code{port} interface to target memory.
+This allows Guile code to read/write target memory using Guile's port and
+bytevector functionality.  The main routine is @code{open-memory} which
+returns a port object.  One can then read/write memory using that object.
+
+@deffn {Scheme Procedure} open-memory @r{[}#:mode mode{]} @r{[}#:start address{]} @r{[}#:size size{]}
+Return a port object that can be used for reading and writing memory.
+@var{mode} is the standard mode argument to Guile port open routines,
+except that it is restricted to one of @samp{"r"}, @samp{"w"}, or @samp{"r+"}.
+For compatibility @samp{"b"} (binary) may also be present,
+but we ignore it: memory ports are binary only.
+The default is @samp{"r"}, read-only.
+
+The chunk of memory that can be accessed can be bounded.
+If both @var{start} and @var{size} are unspecified, all of memory can be
+accessed.  If only @var{start} is specified, all of memory from that point
+on can be accessed.  If only @var{size} if specified, all memory in the
+range [0,@var{size}) can be accessed.  If both are specified, all memory
+in the rane [@var{start},@var{start}+@var{size}) can be accessed.
+@end deffn
+
+@deffn {Scheme Procedure} memory-port?
+Return @code{#t} if @var{object} is an object of type @code{<gdb:memory-port>}.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} memory-port-range memory-port
+Return the range of @code{<gdb:memory-port>} @var{memory-port} as a list
+of two elements: @code{(start end)}.  The range is @var{start} to @var{end}
+inclusive.
+@end deffn
+
+@deffn {Scheme Procedure} memory-port-read-buffer-size memory-port
+Return the size of the read buffer of @code{<gdb:memory-port>}
+@var{memory-port}.
+@end deffn
+
+@deffn {Scheme Procedure} set-memory-port-read-buffer-size! memory-port size
+Set the size of the read buffer of @code{<gdb:memory-port>}
+@var{memory-port} to @var{size}.  The result is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} memory-port-write-buffer-size memory-port
+Return the size of the write buffer of @code{<gdb:memory-port>}
+@var{memory-port}.
+@end deffn
+
+@deffn {Scheme Procedure} set-memory-port-write-buffer-size! memory-port size
+Set the size of the write buffer of @code{<gdb:memory-port>}
+@var{memory-port} to @var{size}.  The result is unspecified.
+@end deffn
+
+A memory port is closed like any other port, with @code{close-port}.
+
+Combined with Guile's @code{bytevectors}, memory ports provide a lot
+of utility.  For example, to fill a buffer of 10 integers in memory,
+one can do something like the following.
+
+@smallexample
+;; In the program: int buffer[10];
+(use-modules (rnrs bytevectors))
+(use-modules (rnrs io ports))
+(define addr (parse-and-eval "buffer"))
+(define n 10)
+(define byte-size (* n 4))
+(define mem-port (open-memory #:mode "r+" #:start
+                              (value->integer addr) #:size byte-size))
+(define byte-vec (make-bytevector byte-size))
+(do ((i 0 (+ i 1)))
+    ((>= i n))
+    (bytevector-s32-native-set! byte-vec (* i 4) (* i 42)))
+(put-bytevector mem-port byte-vec)
+(close-port mem-port)
+@end smallexample
+
+@node Iterators In Guile
+@subsubsection Iterators In Guile
+
+@cindex guile iterators
+@tindex <gdb:iterator>
+
+A simple iterator facility is provided to allow, for example,
+iterating over the set of program symbols without having to first
+construct a list of all of them.  A useful contribution would be
+to add support for SRFI 41 and SRFI 45.
+
+@deffn {Scheme Procedure} make-iterator object progress next!
+A @code{<gdb:iterator>} object is constructed with the @code{make-iterator}
+procedure.  It takes three arguments: the object to be iterated over,
+an object to record the progress of the iteration, and a procedure to
+return the next element in the iteration, or an implementation chosen value
+to denote the end of iteration.
+
+By convention, end of iteration is marked with @code{(end-of-iteration)},
+and may be tested with the @code{end-of-iteration?} predicate.
+The result of @code{(end-of-iteration)} is chosen so that it is not
+otherwise used by the @code{(gdb)} module.  If you are using
+@code{<gdb:iterator>} in your own code it is your responsibility to
+maintain this invariant.
+
+A trivial example for illustration's sake:
+
+@smallexample
+(use-modules (gdb iterator))
+(define my-list (list 1 2 3))
+(define iter
+  (make-iterator my-list my-list
+                 (lambda (iter)
+                   (let ((l (iterator-progress iter)))
+                     (if (eq? l '())
+                         (end-of-iteration)
+                         (begin
+                           (set-iterator-progress! iter (cdr l))
+                           (car l)))))))
+@end smallexample
+
+Here is a slightly more realistic example, which computes a list of all the
+functions in @code{my-global-block}.
+
+@smallexample
+(use-modules (gdb iterator))
+(define this-sal (find-pc-line (frame-pc (selected-frame))))
+(define this-symtab (sal-symtab this-sal))
+(define this-global-block (symtab-global-block this-symtab))
+(define syms-iter (make-block-symbols-iterator this-global-block))
+(define functions (iterator-filter symbol-function? syms-iter))
+@end smallexample
+@end deffn
+
+@deffn {Scheme Procedure} iterator? object
+Return @code{#t} if @var{object} is a @code{<gdb:iterator>} object.
+Otherwise return @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} iterator-object iterator
+Return the first argument that was passed to @code{make-iterator}.
+This is the object being iterated over.
+@end deffn
+
+@deffn {Scheme Procedure} iterator-progress iterator
+Return the object tracking iteration progress.
+@end deffn
+
+@deffn {Scheme Procedure} set-iterator-progress! iterator new-value
+Set the object tracking iteration progress.
+@end deffn
+
+@deffn {Scheme Procedure} iterator-next! iterator
+Invoke the procedure that was the third argument to @code{make-iterator},
+passing it one argument, the @code{<gdb:iterator>} object.
+The result is either the next element in the iteration, or an end
+marker as implemented by the @code{next!} procedure.
+By convention the end marker is the result of @code{(end-of-iteration)}.
+@end deffn
+
+@deffn {Scheme Procedure} end-of-iteration
+Return the Scheme object that denotes end of iteration.
+@end deffn
+
+@deffn {Scheme Procedure} end-of-iteration? object
+Return @code{#t} if @var{object} is the end of iteration marker.
+Otherwise return @code{#f}.
+@end deffn
+
+These functions are provided by the @code{(gdb iterator)} module to
+assist in using iterators.
+
+@deffn {Scheme Procedure} make-list-iterator list
+Return a @code{<gdb:iterator>} object that will iterate over @var{list}.
+@end deffn
+
+@deffn {Scheme Procedure} iterator->list iterator
+Return the elements pointed to by @var{iterator} as a list.
+@end deffn
+
+@deffn {Scheme Procedure} iterator-map proc iterator
+Return the list of objects obtained by applying @var{proc} to the object
+pointed to by @var{iterator} and to each subsequent object.
+@end deffn
+
+@deffn {Scheme Procedure} iterator-for-each proc iterator
+Apply @var{proc} to each element pointed to by @var{iterator}.
+The result is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} iterator-filter pred iterator
+Return the list of elements pointed to by @var{iterator} that satisfy
+@var{pred}.
+@end deffn
+
+@deffn {Scheme Procedure} iterator-until pred iterator
+Run @var{iterator} until the result of @code{(pred element)} is true
+and return that as the result.  Otherwise return @code{#f}.
+@end deffn
+
+@node Guile Auto-loading
+@subsection Guile Auto-loading
+@cindex guile auto-loading
+
+When a new object file is read (for example, due to the @code{file}
+command, or because the inferior has loaded a shared library),
+@value{GDBN} will look for Guile support scripts in two ways:
+@file{@var{objfile}-gdb.scm} and the @code{.debug_gdb_scripts} section.
+@xref{Auto-loading extensions}.
+
+The auto-loading feature is useful for supplying application-specific
+debugging commands and scripts.
+
+Auto-loading can be enabled or disabled,
+and the list of auto-loaded scripts can be printed.
+
+@table @code
+@anchor{set auto-load guile-scripts}
+@kindex set auto-load guile-scripts
+@item set auto-load guile-scripts [on|off]
+Enable or disable the auto-loading of Guile scripts.
+
+@anchor{show auto-load guile-scripts}
+@kindex show auto-load guile-scripts
+@item show auto-load guile-scripts
+Show whether auto-loading of Guile scripts is enabled or disabled.
+
+@anchor{info auto-load guile-scripts}
+@kindex info auto-load guile-scripts
+@cindex print list of auto-loaded Guile scripts
+@item info auto-load guile-scripts [@var{regexp}]
+Print the list of all Guile scripts that @value{GDBN} auto-loaded.
+
+Also printed is the list of Guile scripts that were mentioned in
+the @code{.debug_gdb_scripts} section and were not found.
+This is useful because their names are not printed when @value{GDBN}
+tries to load them and fails.  There may be many of them, and printing
+an error message for each one is problematic.
+
+If @var{regexp} is supplied only Guile scripts with matching names are printed.
+
+Example:
+
+@smallexample
+(gdb) info auto-load guile-scripts
+Loaded Script
+Yes    scm-section-script.scm
+       full name: /tmp/scm-section-script.scm
+No     my-foo-pretty-printers.scm
+@end smallexample
+@end table
+
+When reading an auto-loaded file, @value{GDBN} sets the
+@dfn{current objfile}.  This is available via the @code{current-objfile}
+procedure (@pxref{Objfiles In Guile}).  This can be useful for
+registering objfile-specific pretty-printers.
+
+@node Guile Modules
+@subsection Guile Modules
+@cindex guile modules
+
+@value{GDBN} comes with several modules to assist writing Guile code.
+
+@menu
+* Guile Printing Module::  Building and registering pretty-printers
+* Guile Types Module::     Utilities for working with types
+@end menu
+
+@node Guile Printing Module
+@subsubsection Guile Printing Module
+
+This module provides a collection of utilities for working with
+pretty-printers.
+
+Usage:
+
+@smallexample
+(use-modules (gdb printing))
+@end smallexample
+
+@deffn {Scheme Procedure} prepend-pretty-printer! object printer
+Add @var{printer} to the front of the list of pretty-printers for
+@var{object}.  @var{object} must either be a @code{<gdb:objfile>} object
+or @code{#f} in which case @var{printer} is added to the global list of
+printers.
+@end deffn
+
+@deffn {Scheme Procecure} append-pretty-printer! object printer
+Add @var{printer} to the end of the list of pretty-printers for
+@var{object}.  @var{object} must either be a @code{<gdb:objfile>} object
+or @code{#f} in which case @var{printer} is added to the global list of
+printers.
+@end deffn
+
+@node Guile Types Module
+@subsubsection Guile Types Module
+
+This module provides a collection of utilities for working with
+@code{<gdb:type>} objects.
+
+Usage:
+
+@smallexample
+(use-modules (gdb types))
+@end smallexample
+
+@deffn {Scheme Procedure} get-basic-type type
+Return @var{type} with const and volatile qualifiers stripped,
+and with typedefs and C@t{++} references converted to the underlying type.
+
+C@t{++} example:
+
+@smallexample
+typedef const int const_int;
+const_int foo (3);
+const_int& foo_ref (foo);
+int main () @{ return 0; @}
+@end smallexample
+
+Then in gdb:
+
+@smallexample
+(gdb) start
+(gdb) guile (use-modules ((gdb) (gdb types)))
+(gdb) guile (define foo-ref (parse-and-eval "foo_ref"))
+(gdb) guile (get-basic-type (value-type foo-ref))
+int
+@end smallexample
+@end deffn
+
+@deffn {Scheme Procedure} type-has-field-deep? type field
+Return @code{#t} if @var{type}, assumed to be a type with fields
+(e.g., a structure or union), has field @var{field}.
+Otherwise return @code{#f}.
+This searches baseclasses, whereas @code{type-has-field?} does not.
+@end deffn
+
+@deffn {Scheme Procedure} make-enum-hashtable enum-type
+Return a Guile hash table produced from @var{enum-type}.
+Elements in the hash table are referenced with @code{hashq-ref}.
+@end deffn
diff --git a/gdb/extension.c b/gdb/extension.c
index a61f5ca..c2f502b 100644
--- a/gdb/extension.c
+++ b/gdb/extension.c
@@ -30,6 +30,7 @@
 #include "observer.h"
 #include "cli/cli-script.h"
 #include "python/python.h"
+#include "guile/guile.h"
 
 /* Iterate over all external extension languages, regardless of whether the
    support has been compiled in or not.
@@ -100,6 +101,7 @@ static const struct extension_language_defn * const extension_languages[] =
 {
   /* To preserve existing behaviour, python should always appear first.  */
   &extension_language_python,
+  &extension_language_guile,
   NULL
 };
 
diff --git a/gdb/extension.h b/gdb/extension.h
index 8408701..61dc81b 100644
--- a/gdb/extension.h
+++ b/gdb/extension.h
@@ -53,7 +53,8 @@ enum extension_language
   {
     EXT_LANG_NONE,
     EXT_LANG_GDB,
-    EXT_LANG_PYTHON
+    EXT_LANG_PYTHON,
+    EXT_LANG_GUILE
   };
 
 /* Extension language frame-filter status return values.  */
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 042c17d..622eff0 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1446,6 +1446,40 @@ lookup_struct_elt_type (struct type *type, const char *name, int noerr)
   error (_("Type %s has no component named %s."), typename, name);
 }
 
+/* Store in *MAX the largest number representable by unsigned integer type
+   TYPE.  */
+
+void
+get_unsigned_type_max (struct type *type, ULONGEST *max)
+{
+  unsigned int n;
+
+  CHECK_TYPEDEF (type);
+  gdb_assert (TYPE_CODE (type) == TYPE_CODE_INT && TYPE_UNSIGNED (type));
+  gdb_assert (TYPE_LENGTH (type) <= sizeof (ULONGEST));
+
+  /* Written this way to avoid overflow.  */
+  n = TYPE_LENGTH (type) * TARGET_CHAR_BIT;
+  *max = ((((ULONGEST) 1 << (n - 1)) - 1) << 1) | 1;
+}
+
+/* Store in *MIN, *MAX the smallest and largest numbers representable by
+   signed integer type TYPE.  */
+
+void
+get_signed_type_minmax (struct type *type, LONGEST *min, LONGEST *max)
+{
+  unsigned int n;
+
+  CHECK_TYPEDEF (type);
+  gdb_assert (TYPE_CODE (type) == TYPE_CODE_INT && !TYPE_UNSIGNED (type));
+  gdb_assert (TYPE_LENGTH (type) <= sizeof (LONGEST));
+
+  n = TYPE_LENGTH (type) * TARGET_CHAR_BIT;
+  *min = -((ULONGEST) 1 << (n - 1));
+  *max = ((ULONGEST) 1 << (n - 1)) - 1;
+}
+
 /* Lookup the vptr basetype/fieldno values for TYPE.
    If found store vptr_basetype in *BASETYPEP if non-NULL, and return
    vptr_fieldno.  Also, if found and basetype is from the same objfile,
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 61ddeff..643c610 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -1545,6 +1545,10 @@ extern struct type *lookup_unsigned_typename (const struct language_defn *,
 extern struct type *lookup_signed_typename (const struct language_defn *,
 					    struct gdbarch *, const char *);
 
+extern void get_unsigned_type_max (struct type *, ULONGEST *);
+
+extern void get_signed_type_minmax (struct type *, LONGEST *, LONGEST *);
+
 extern struct type *check_typedef (struct type *);
 
 #define CHECK_TYPEDEF(TYPE)			\
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");
+}
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 8b9ec44..da1348b 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,64 @@
+2014-02-10  Doug Evans  <xdje42@gmail.com>
+
+	* 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.
+
 2014-02-10  Yao Qi  <yao@codesourcery.com>
 
 	PR testsuite/16543
diff --git a/gdb/testsuite/configure b/gdb/testsuite/configure
index aa08add..4bf6121 100755
--- a/gdb/testsuite/configure
+++ b/gdb/testsuite/configure
@@ -3448,7 +3448,7 @@ done
 
 
 
-ac_config_files="$ac_config_files Makefile gdb.ada/Makefile gdb.arch/Makefile gdb.asm/Makefile gdb.base/Makefile gdb.btrace/Makefile gdb.cell/Makefile gdb.cp/Makefile gdb.disasm/Makefile gdb.dwarf2/Makefile gdb.dlang/Makefile gdb.fortran/Makefile gdb.gdb/Makefile gdb.go/Makefile gdb.server/Makefile gdb.java/Makefile gdb.hp/Makefile gdb.hp/gdb.objdbg/Makefile gdb.hp/gdb.base-hp/Makefile gdb.hp/gdb.aCC/Makefile gdb.hp/gdb.compat/Makefile gdb.hp/gdb.defects/Makefile gdb.linespec/Makefile gdb.mi/Makefile gdb.modula2/Makefile gdb.multi/Makefile gdb.objc/Makefile gdb.opencl/Makefile gdb.opt/Makefile gdb.pascal/Makefile gdb.perf/Makefile gdb.python/Makefile gdb.reverse/Makefile gdb.stabs/Makefile gdb.threads/Makefile gdb.trace/Makefile gdb.xml/Makefile"
+ac_config_files="$ac_config_files Makefile gdb.ada/Makefile gdb.arch/Makefile gdb.asm/Makefile gdb.base/Makefile gdb.btrace/Makefile gdb.cell/Makefile gdb.cp/Makefile gdb.disasm/Makefile gdb.dwarf2/Makefile gdb.dlang/Makefile gdb.fortran/Makefile gdb.gdb/Makefile gdb.go/Makefile gdb.server/Makefile gdb.java/Makefile gdb.hp/Makefile gdb.hp/gdb.objdbg/Makefile gdb.hp/gdb.base-hp/Makefile gdb.hp/gdb.aCC/Makefile gdb.hp/gdb.compat/Makefile gdb.hp/gdb.defects/Makefile gdb.guile/Makefile gdb.linespec/Makefile gdb.mi/Makefile gdb.modula2/Makefile gdb.multi/Makefile gdb.objc/Makefile gdb.opencl/Makefile gdb.opt/Makefile gdb.pascal/Makefile gdb.perf/Makefile gdb.python/Makefile gdb.reverse/Makefile gdb.stabs/Makefile gdb.threads/Makefile gdb.trace/Makefile gdb.xml/Makefile"
 
 cat >confcache <<\_ACEOF
 # This file is a shell script that caches the results of configure
@@ -4170,6 +4170,7 @@ do
     "gdb.hp/gdb.aCC/Makefile") CONFIG_FILES="$CONFIG_FILES gdb.hp/gdb.aCC/Makefile" ;;
     "gdb.hp/gdb.compat/Makefile") CONFIG_FILES="$CONFIG_FILES gdb.hp/gdb.compat/Makefile" ;;
     "gdb.hp/gdb.defects/Makefile") CONFIG_FILES="$CONFIG_FILES gdb.hp/gdb.defects/Makefile" ;;
+    "gdb.guile/Makefile") CONFIG_FILES="$CONFIG_FILES gdb.guile/Makefile" ;;
     "gdb.linespec/Makefile") CONFIG_FILES="$CONFIG_FILES gdb.linespec/Makefile" ;;
     "gdb.mi/Makefile") CONFIG_FILES="$CONFIG_FILES gdb.mi/Makefile" ;;
     "gdb.modula2/Makefile") CONFIG_FILES="$CONFIG_FILES gdb.modula2/Makefile" ;;
diff --git a/gdb/testsuite/configure.ac b/gdb/testsuite/configure.ac
index b6640bd..fb084d4 100644
--- a/gdb/testsuite/configure.ac
+++ b/gdb/testsuite/configure.ac
@@ -95,7 +95,7 @@ AC_OUTPUT([Makefile \
   gdb.server/Makefile gdb.java/Makefile \
   gdb.hp/Makefile gdb.hp/gdb.objdbg/Makefile gdb.hp/gdb.base-hp/Makefile \
   gdb.hp/gdb.aCC/Makefile gdb.hp/gdb.compat/Makefile \
-  gdb.hp/gdb.defects/Makefile gdb.linespec/Makefile \
+  gdb.hp/gdb.defects/Makefile gdb.guile/Makefile gdb.linespec/Makefile \
   gdb.mi/Makefile gdb.modula2/Makefile gdb.multi/Makefile \
   gdb.objc/Makefile gdb.opencl/Makefile gdb.opt/Makefile gdb.pascal/Makefile \
   gdb.perf/Makefile gdb.python/Makefile gdb.reverse/Makefile gdb.stabs/Makefile \
diff --git a/gdb/testsuite/gdb.base/help.exp b/gdb/testsuite/gdb.base/help.exp
index c55eaf6..c4032a5 100644
--- a/gdb/testsuite/gdb.base/help.exp
+++ b/gdb/testsuite/gdb.base/help.exp
@@ -124,4 +124,4 @@ gdb_test "apropos \\\(print\[\^ bsiedf\\\".-\]\\\)" "handle -- Specify how to ha
 # test apropos >1 word string
 gdb_test "apropos handle signal" "handle -- Specify how to handle signals"
 # test apropos apropos
-gdb_test "apropos apropos" "apropos -- Search for commands matching a REGEXP"
+gdb_test "apropos apropos" "apropos -- Search for commands matching a REGEXP.*"
diff --git a/gdb/testsuite/gdb.guile/Makefile.in b/gdb/testsuite/gdb.guile/Makefile.in
new file mode 100644
index 0000000..37f9cb0
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/Makefile.in
@@ -0,0 +1,17 @@
+VPATH = @srcdir@
+srcdir = @srcdir@
+
+EXECUTABLES =
+
+MISCELLANEOUS =
+
+all info install-info dvi install uninstall installcheck check:
+	@echo "Nothing to be done for $@..."
+
+clean mostlyclean:
+	-rm -f *~ *.o *.ci
+	-rm -f *.dwo *.dwp
+	-rm -f core $(EXECUTABLES) $(MISCELLANEOUS)
+
+distclean maintainer-clean realclean: clean
+	-rm -f Makefile config.status config.log gdb.log gdb.sum
diff --git a/gdb/testsuite/gdb.guile/guile.exp b/gdb/testsuite/gdb.guile/guile.exp
new file mode 100644
index 0000000..2a171fe
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/guile.exp
@@ -0,0 +1,77 @@
+# Copyright (C) 2008-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests basic Guile features.
+
+load_lib gdb-guile.exp
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+
+# Do this instead of the skip_guile_check.
+# We want to do some tests when Guile is not present.
+gdb_test_multiple "guile (display 23) (newline)" "verify guile support" {
+    -re "Undefined command.*$gdb_prompt $" {
+	unsupported "Guile not supported."
+	return
+    }
+    -re "not supported.*$gdb_prompt $"	{
+      unsupported "guile support is disabled"
+
+      # If Guile is not supported, verify that sourcing a guile script
+      # causes an error.
+      gdb_test "source $srcdir/$subdir/source2.scm" \
+	  "Error in sourced command file:.*" \
+	  "source source2.scm when guile disabled"
+      return
+    }
+    -re "$gdb_prompt $"	{}
+}
+
+gdb_install_guile_utils
+gdb_install_guile_module
+
+gdb_test_multiline "multi-line guile command" \
+  "guile" "" \
+  "(print 23)" "" \
+  "end" "= 23"
+
+gdb_test_multiline "show guile command" \
+  "define zzq" "Type commands for definition of .* just \"end\"\\.*" \
+  "guile" "" \
+  "(print 23)" "" \
+  "end" "" \
+  "end" "" \
+  "show user zzq" "User command \"zzq\":.*  guile.*\\(print 23\\).*  end"
+
+gdb_test "source $srcdir/$subdir/source2.scm" "yes" "source source2.scm"
+
+gdb_test "source -s source2.scm" "yes" "source -s source2.scm"
+
+gdb_test "guile (print (current-objfile))" "= #f"
+gdb_test "guile (print (objfiles))" "= \\(\\)"
+
+gdb_test_no_output \
+    {guile (define x (execute "printf \"%d\", 23" #:to-string #t))}
+gdb_test "guile (print x)" "= 23"
+
+gdb_test_no_output "guile (define a (execute \"help\" #:to-string #t))" \
+    "collect help from uiout"
+
+gdb_test "guile (print a)" "= .*aliases -- Aliases of other commands.*" \
+    "verify help to uiout"
diff --git a/gdb/testsuite/gdb.guile/scm-arch.c b/gdb/testsuite/gdb.guile/scm-arch.c
new file mode 100644
index 0000000..6c0ef92
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-arch.c
@@ -0,0 +1,22 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+int
+main (void)
+{
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-arch.exp b/gdb/testsuite/gdb.guile/scm-arch.exp
new file mode 100644
index 0000000..1fcf615
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-arch.exp
@@ -0,0 +1,33 @@
+# Copyright 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/>.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+   return
+}
+
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" "get frame"
+gdb_scm_test_silent_cmd "guile (define arch (frame-arch frame))" "get arch"
+gdb_scm_test_silent_cmd "guile (define pc (frame-pc frame))" "get pc"
diff --git a/gdb/testsuite/gdb.guile/scm-block.c b/gdb/testsuite/gdb.guile/scm-block.c
new file mode 100644
index 0000000..69c37d0
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-block.c
@@ -0,0 +1,38 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+int block_func (void)
+{
+  int i = 0;
+  {
+    double i = 1.0;
+    double f = 2.0;
+    {
+      const char *i = "stuff";
+      const char *f = "foo";
+      const char *b = "bar";
+      return 0; /* Block break here.  */
+    }
+  }
+}
+
+
+int main (int argc, char *argv[])
+{
+  block_func ();
+  return 0; /* Break at end. */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-block.exp b/gdb/testsuite/gdb.guile/scm-block.exp
new file mode 100644
index 0000000..32d109a
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-block.exp
@@ -0,0 +1,107 @@
+# 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the mechanism exposing blocks to Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return -1
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_breakpoint [gdb_get_line_number "Block break here."]
+gdb_continue_to_breakpoint "Block break here."
+
+# Test initial innermost block.
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
+    "Get frame inner"
+gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
+    "Get block inner"
+gdb_test "guile (print block)" "#<gdb:block $hex-$hex>" \
+    "Check block not #f"
+gdb_test "guile (print (block-function block))" \
+    "#f" "First anonymous block"
+gdb_test "guile (print (block-start block))" \
+    "${decimal}" "Check start not #f"
+gdb_test "guile (print (block-end block))" \
+    "${decimal}" "Check end not #f"
+
+# Test eq?.
+gdb_test "guile (print (eq? (frame-block frame) (frame-block frame)))" \
+     "= #t" "Check eq? on same block"
+gdb_test "guile (print (eq? block (block-global-block block)))" \
+     "= #f" "Check eq? on different blocks"
+
+# Test global/static blocks.
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
+    "Get frame for global/static"
+gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
+    "Get block for global/static"
+gdb_test "guile (print (block-global? block))" \
+    "#f" "Not a global block"
+gdb_test "guile (print (block-static? block))" \
+    "#f" "Not a static block"
+gdb_scm_test_silent_cmd "guile (define gblock (block-global-block block))" \
+    "Get global block"
+gdb_scm_test_silent_cmd "guile (define sblock (block-static-block block))" \
+    "Get static block"
+gdb_test "guile (print (block-global? gblock))" \
+    "#t" "Is the global block"
+gdb_test "guile (print (block-static? sblock))" \
+    "#t" "Is the static block"
+
+# Move up superblock(s) until we reach function block_func.
+gdb_test_no_output "guile (set! block (block-superblock block))" \
+    "Get superblock"
+gdb_test "guile (print (block-function block))" \
+    "#f" "Second anonymous block"
+gdb_test_no_output "guile (set! block (block-superblock block))" \
+    "Get superblock 2"
+gdb_test "guile (print (block-function block))" \
+    "block_func" "Print superblock 2 function"
+
+# Switch frames, then test for main block.
+gdb_test "up" ".*"
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
+    "Get frame 2"
+gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
+    "Get frame 2's block"
+gdb_test "guile (print block)" "#<gdb:block main $hex-$hex>" \
+    "Check Frame 2's block not #f"
+gdb_test "guile (print (block-function block))" \
+    "main" "main block"
+
+# Test block-valid?.  This must always be the last test in this
+# testcase as it unloads the object file.
+delete_breakpoints
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
+    "Get frame for valid?"
+gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
+    "Get frame block for valid?"
+gdb_test "guile (print (block-valid? block))" \
+    "#t" "Check block validity"
+gdb_unload
+gdb_test "guile (print (block-valid? block))" \
+    "#f" "Check block validity after unload"
diff --git a/gdb/testsuite/gdb.guile/scm-breakpoint.c b/gdb/testsuite/gdb.guile/scm-breakpoint.c
new file mode 100644
index 0000000..c8dc7f7
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-breakpoint.c
@@ -0,0 +1,44 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+int result = 0;
+
+int multiply (int i)
+{
+  return i * i;
+}
+
+int add (int i)
+{
+  return i + i; 
+}
+
+
+int main (int argc, char *argv[])
+{
+  int foo = 5;
+  int bar = 42;
+  int i;
+
+  for (i = 0; i < 10; i++)
+    {
+      result += multiply (foo);  /* Break at multiply. */
+      result += add (bar); /* Break at add. */
+    }
+
+  return 0; /* Break at end. */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-breakpoint.exp b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
new file mode 100644
index 0000000..b25d4e0
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
@@ -0,0 +1,438 @@
+# 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the mechanism exposing breakpoints to Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return -1
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+proc test_bkpt_basic { } {
+    global srcfile testfile hex decimal
+
+    with_test_prefix "test_bkpt_basic" {
+	# Start with a fresh gdb.
+	clean_restart ${testfile}
+
+	if ![gdb_guile_runto_main] {
+	    return
+	}
+
+	# Initially there should be one breakpoint: main.
+
+	gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+	    "get breakpoint list 1"
+	gdb_test "guile (print (car blist))" \
+	    "<gdb:breakpoint #1 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @main>" \
+	    "check main breakpoint"
+	gdb_test "guile (print (breakpoint-location (car blist)))" \
+	    "main" "check main breakpoint location"
+
+	set mult_line [gdb_get_line_number "Break at multiply."]
+	gdb_breakpoint ${mult_line}
+	gdb_continue_to_breakpoint "Break at multiply."
+
+	# Check that the Guile breakpoint code noted the addition of a
+	# breakpoint "behind the scenes".
+	gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+	    "get breakpoint list 2"
+	gdb_scm_test_silent_cmd "guile (define mult-bkpt (cadr blist))" \
+	    "get multiply breakpoint"
+	gdb_test "guile (print (length blist))" \
+	    "= 2" "check for two breakpoints"
+	gdb_test "guile (print mult-bkpt)" \
+	    "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:1 ignore:0 @.*scm-breakpoint.c:$mult_line>" \
+	    "check multiply breakpoint"
+	gdb_test "guile (print (breakpoint-location mult-bkpt))" \
+	    "scm-breakpoint\.c:${mult_line}*" \
+	    "check multiply breakpoint location"
+
+	# Check hit and ignore counts. 
+	gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
+	    "= 1" "check multiply breakpoint hit count"
+	gdb_scm_test_silent_cmd "guile (set-breakpoint-ignore-count! mult-bkpt 4)" \
+	    "set multiply breakpoint ignore count"
+	gdb_continue_to_breakpoint "Break at multiply."
+	gdb_test "guile (print (breakpoint-hit-count mult-bkpt))" \
+	    "= 6" "check multiply breakpoint hit count 2"
+	gdb_test "print result" \
+	    " = 545" "check expected variable result after 6 iterations"
+
+	# Test breakpoint is enabled and disabled correctly.
+	gdb_breakpoint [gdb_get_line_number "Break at add."]
+	gdb_continue_to_breakpoint "Break at add."
+	gdb_test "guile (print (breakpoint-enabled? mult-bkpt))" \
+	    "= #t" "check multiply breakpoint enabled"
+	gdb_scm_test_silent_cmd  "guile (set-breakpoint-enabled! mult-bkpt #f)" \
+	    "set multiply breakpoint disabled"
+	gdb_continue_to_breakpoint "Break at add."
+	gdb_scm_test_silent_cmd  "guile (set-breakpoint-enabled! mult-bkpt #t)" \
+	    "set multiply breakpoint enabled"
+	gdb_continue_to_breakpoint "Break at multiply."
+
+	# Test other getters and setters.
+	gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+	    "get breakpoint list 3"
+	gdb_test "guile (print (breakpoint-thread mult-bkpt))" \
+	    "= #f" "check breakpoint thread"
+	gdb_test "guile (print (= (breakpoint-type mult-bkpt) BP_BREAKPOINT))" \
+	    "= #t" "check breakpoint type"
+	gdb_test "guile (print (map breakpoint-number blist))" \
+	    "= \\(1 2 3\\)" "check breakpoint numbers"
+    }
+}
+
+proc test_bkpt_deletion { } {
+    global srcfile testfile hex decimal
+
+    with_test_prefix test_bkpt_deletion {
+	# Start with a fresh gdb.
+	clean_restart ${testfile}
+
+	if ![gdb_guile_runto_main] {
+	    return
+	}
+
+	# Test breakpoints are deleted correctly.
+	set deltst_location [gdb_get_line_number "Break at multiply."]
+	set end_location [gdb_get_line_number "Break at end."]
+	gdb_scm_test_silent_cmd  "guile (define dp1 (create-breakpoint! \"$deltst_location\"))" \
+	    "create deltst breakpoint"
+	gdb_breakpoint [gdb_get_line_number "Break at end."]
+	gdb_scm_test_silent_cmd "guile (define del-list (breakpoints))" \
+	    "get breakpoint list 4"
+	gdb_test "guile (print (length del-list))" \
+	    "= 3" "number of breakpoints before delete"
+	gdb_continue_to_breakpoint "Break at multiply." \
+	    ".*/$srcfile:$deltst_location.*"
+	gdb_scm_test_silent_cmd  "guile (breakpoint-delete! dp1)" \
+	    "delete breakpoint"
+	gdb_test "guile (print (breakpoint-number dp1))" \
+	    "ERROR: .*: Invalid object: <gdb:breakpoint> in position 1: #<gdb:breakpoint #2>.*" \
+	    "check breakpoint invalidated"
+	gdb_scm_test_silent_cmd "guile (set! del-list (breakpoints))" \
+	    "get breakpoint list 5"
+	gdb_test "guile (print (length del-list))" \
+	    "= 2" "number of breakpoints after delete"
+	gdb_continue_to_breakpoint "Break at end." ".*/$srcfile:$end_location.*"
+    }
+}
+
+proc test_bkpt_cond_and_cmds { } {
+    global srcfile testfile hex decimal
+
+    with_test_prefix test_bkpt_cond_and_cmds {
+	# Start with a fresh gdb.
+	clean_restart ${testfile}
+
+	if ![gdb_guile_runto_main] {
+	    return
+	}
+
+	# Test conditional setting.
+	set bp_location1 [gdb_get_line_number "Break at multiply."]
+	gdb_scm_test_silent_cmd  "guile (define bp1 (create-breakpoint! \"$bp_location1\"))" \
+	    "create multiply breakpoint"
+	gdb_continue_to_breakpoint "Break at multiply."
+	gdb_scm_test_silent_cmd  "guile (set-breakpoint-condition! bp1 \"i == 5\")" \
+	    "set condition"
+	gdb_test "guile (print (breakpoint-condition bp1))" \
+	    "= i == 5" "test condition has been set"
+	gdb_continue_to_breakpoint "Break at multiply."
+	gdb_test "print i" \
+	    "5" "test conditional breakpoint stopped after five iterations"
+	gdb_scm_test_silent_cmd  "guile (set-breakpoint-condition! bp1 #f)" \
+	    "clear condition"
+	gdb_test "guile (print (breakpoint-condition bp1))" \
+	    "= #f" "test condition has been removed"
+	gdb_continue_to_breakpoint "Break at multiply."
+	gdb_test "print i" "6" "test breakpoint stopped after six iterations"
+
+	# Test commands.
+	gdb_breakpoint [gdb_get_line_number "Break at add."]
+	set test {commands $bpnum}
+	gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
+	set test {print "Command for breakpoint has been executed."}
+	gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
+	set test {print result}
+	gdb_test_multiple $test $test { -re "\r\n>$" { pass $test } }
+	gdb_test "end"
+
+	gdb_scm_test_silent_cmd "guile (define blist (breakpoints))" \
+	    "get breakpoint list 6"
+	gdb_test "guile (print (breakpoint-commands (list-ref blist (- (length blist) 1))))" \
+	    "print \"Command for breakpoint has been executed.\".*print result"
+    }
+}
+
+proc test_bkpt_invisible { } {
+    global srcfile testfile hex decimal
+
+    with_test_prefix test_bkpt_invisible {
+	# Start with a fresh gdb.
+	clean_restart ${testfile}
+
+	if ![gdb_guile_runto_main] {
+	    return
+	}
+
+	# Test invisible breakpoints.
+	delete_breakpoints
+	set ibp_location [gdb_get_line_number "Break at multiply."]
+	gdb_scm_test_silent_cmd  "guile (define vbp (create-breakpoint! \"$ibp_location\" #:internal #f))" \
+	    "create visible breakpoint"
+	gdb_scm_test_silent_cmd "guile (define vbp (car (breakpoints)))" \
+	    "get visible breakpoint"
+	gdb_test "guile (print vbp)" \
+	    "= #<gdb:breakpoint #2 BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
+	    "check visible bp obj exists"
+	gdb_test "guile (print (breakpoint-location vbp))" \
+	    "scm-breakpoint\.c:$ibp_location*" "check visible breakpoint location"
+	gdb_test "guile (print (breakpoint-visible? vbp))" \
+	    "= #t" "check breakpoint visibility"
+	gdb_test "info breakpoints" \
+	    "scm-breakpoint\.c:$ibp_location.*" \
+	    "check info breakpoints shows visible breakpoints"
+	delete_breakpoints
+	gdb_scm_test_silent_cmd  "guile (define ibp (create-breakpoint! \"$ibp_location\" #:internal #t))" \
+	    "create invisible breakpoint"
+	gdb_test "guile (print ibp)" \
+	    "= #<gdb:breakpoint #-$decimal BP_BREAKPOINT enabled noisy hit:0 ignore:0 @.*scm-breakpoint.c:$ibp_location>" \
+	    "check invisible bp obj exists"
+	gdb_test "guile (print (breakpoint-location ibp))" \
+	    "scm-breakpoint\.c:$ibp_location*" "check invisible breakpoint location"
+	gdb_test "guile (print (breakpoint-visible? ibp))" \
+	    "= #f" "check breakpoint invisibility"
+	gdb_test "info breakpoints" \
+	    "No breakpoints or watchpoints.*" \
+	    "check info breakpoints does not show invisible breakpoints"
+	gdb_test "maint info breakpoints" \
+	    "scm-breakpoint\.c:$ibp_location.*" \
+	    "check maint info breakpoints shows invisible breakpoints"
+    }
+}
+
+proc test_watchpoints { } {
+    global srcfile testfile hex decimal
+
+    with_test_prefix test_watchpoints {
+	# Start with a fresh gdb.
+	clean_restart ${testfile}
+
+	# Disable hardware watchpoints if necessary.
+	if [target_info exists gdb,no_hardware_watchpoints] {
+	    gdb_test_no_output "set can-use-hw-watchpoints 0" ""
+	}
+	if ![gdb_guile_runto_main] {
+	    return
+	}
+
+	gdb_scm_test_silent_cmd  "guile (define wp1 (create-breakpoint! \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE))" \
+	    "create watchpoint"
+	gdb_test "continue" \
+	    ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*main.*" \
+	    "test watchpoint write"
+    }
+}
+
+proc test_bkpt_internal { } {
+    global srcfile testfile hex decimal
+
+    with_test_prefix test_bkpt_internal {
+	# Start with a fresh gdb.
+	clean_restart ${testfile}
+
+	# Disable hardware watchpoints if necessary.
+	if [target_info exists gdb,no_hardware_watchpoints] {
+	    gdb_test_no_output "set can-use-hw-watchpoints 0" ""
+	}
+	if ![gdb_guile_runto_main] {
+	    return
+	}
+
+	delete_breakpoints
+
+	gdb_scm_test_silent_cmd  "guile (define wp1 (create-breakpoint! \"result\" #:type BP_WATCHPOINT #:wp-class WP_WRITE #:internal #t))" \
+	    "create invisible watchpoint"
+	gdb_test "info breakpoints" \
+	    "No breakpoints or watchpoints.*" \
+	    "check info breakpoints does not show invisible watchpoint"
+	gdb_test "maint info breakpoints" \
+	    ".*watchpoint.*result.*" \
+	    "check maint info breakpoints shows invisible watchpoint"
+	gdb_test "continue" \
+	    ".*\[Ww\]atchpoint.*result.*Old value = 0.*New value = 25.*" \
+	    "test invisible watchpoint write"
+    }
+}
+
+proc test_bkpt_eval_funcs { } {
+    global srcfile testfile hex decimal
+
+    with_test_prefix test_bkpt_eval_funcs {
+	# Start with a fresh gdb.
+	clean_restart ${testfile}
+
+	# Disable hardware watchpoints if necessary.
+	if [target_info exists gdb,no_hardware_watchpoints] {
+	    gdb_test_no_output "set can-use-hw-watchpoints 0" ""
+	}
+	if ![gdb_guile_runto_main] {
+	    return
+	}
+
+	delete_breakpoints
+
+	gdb_test_multiline "data collection breakpoint 1" \
+	    "guile" "" \
+	    "(define (make-bp-data) (cons 0 0))" "" \
+	    "(define bp-data-count car)" "" \
+	    "(define set-bp-data-count! set-car!)" "" \
+	    "(define bp-data-inf-i cdr)" "" \
+	    "(define set-bp-data-inf-i! set-cdr!)" "" \
+	    "(define (bp-eval-count bkpt) (bp-data-count (gsmob-property bkpt 'bp-data)))" "" \
+	    "(define (bp-eval-inf-i bkpt) (bp-data-inf-i (gsmob-property bkpt 'bp-data)))" "" \
+	    "(define (make-bp-eval location)" "" \
+	    "  (let ((bp (create-breakpoint! location)))" "" \
+	    "    (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+	    "    (set-breakpoint-stop! bp" "" \
+	    "       (lambda (bkpt)" "" \
+	    "         (let ((data (gsmob-property bkpt 'bp-data))" "" \
+	    "               (inf-i (parse-and-eval \"i\")))" "" \
+	    "           (set-bp-data-count! data (+ (bp-data-count data) 1))" "" \
+	    "           (set-bp-data-inf-i! data inf-i)" "" \
+	    "           (value=? inf-i 3))))" "" \
+	    "    bp))" "" \
+	    "end" ""
+
+	gdb_test_multiline "data collection breakpoint 2" \
+	    "guile" "" \
+	    "(define (make-bp-also-eval location)" "" \
+	    "  (let ((bp (create-breakpoint! location)))" "" \
+	    "    (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+	    "    (set-breakpoint-stop! bp" "" \
+	    "       (lambda (bkpt)" "" \
+	    "         (let* ((data (gsmob-property bkpt 'bp-data))" "" \
+	    "                (count (+ (bp-data-count data) 1)))" "" \
+	    "           (set-bp-data-count! data count)" "" \
+	    "           (= count 9))))" "" \
+	    "    bp))" "" \
+	    "end" ""
+
+	gdb_test_multiline "data collection breakpoint 3" \
+	    "guile" "" \
+	    "(define (make-bp-basic location)" "" \
+	    "  (let ((bp (create-breakpoint! location)))" "" \
+	    "    (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+	    "    bp))" "" \
+	    "end" ""
+
+	set bp_location2 [gdb_get_line_number "Break at multiply."]
+	set end_location [gdb_get_line_number "Break at end."]
+	gdb_scm_test_silent_cmd  "guile (define eval-bp1 (make-bp-eval \"$bp_location2\"))" \
+	    "create eval-bp1 breakpoint"
+	gdb_scm_test_silent_cmd  "guile (define also-eval-bp1 (make-bp-also-eval \"$bp_location2\"))" \
+	    "create also-eval-bp1 breakpoint"
+	gdb_scm_test_silent_cmd  "guile (define never-eval-bp1 (make-bp-also-eval \"$end_location\"))" \
+	    "create never-eval-bp1 breakpoint"
+	gdb_continue_to_breakpoint "Break at multiply." ".*/$srcfile:$bp_location2.*"
+	gdb_test "print i" "3" "check inferior value matches guile accounting"
+	gdb_test "guile (print (bp-eval-inf-i eval-bp1))" \
+	    "= 3" "check guile accounting matches inferior"
+	gdb_test "guile (print (bp-eval-count also-eval-bp1))" \
+	    "= 4" \
+	    "check non firing same-location breakpoint eval function was also called at each stop 1"
+	gdb_test "guile (print (bp-eval-count eval-bp1))" \
+	    "= 4" \
+	    "check non firing same-location breakpoint eval function was also called at each stop 2"
+
+	# Check we cannot assign a condition to a breakpoint with a stop-func,
+	# and cannot assign a stop-func to a breakpoint with a condition.
+
+	delete_breakpoints
+	set cond_bp [gdb_get_line_number "Break at multiply."]
+	gdb_scm_test_silent_cmd  "guile (define eval-bp1 (make-bp-eval \"$cond_bp\"))" \
+	    "create eval-bp1 breakpoint 2"
+	set test_cond {cond $bpnum}
+	gdb_test "$test_cond \"foo==3\"" \
+	    "Only one stop condition allowed.*"
+	gdb_scm_test_silent_cmd  "guile (define eval-bp2 (make-bp-basic \"$cond_bp\"))" \
+	    "create basic breakpoint"
+	gdb_scm_test_silent_cmd  "guile (set-breakpoint-condition! eval-bp2 \"1==1\")" \
+	    "set a condition"
+	gdb_test_multiline "construct an eval function" \
+	    "guile" "" \
+	    "(define (stop-func bkpt)" "" \
+	    "   return #t)" "" \
+	    "end" ""
+	gdb_test "guile (set-breakpoint-stop! eval-bp2 stop-func)"  \
+	    "Only one stop condition allowed.*"
+
+	# Check that stop-func is run when location has normal bp.
+
+	delete_breakpoints
+	gdb_breakpoint [gdb_get_line_number "Break at multiply."]
+	gdb_scm_test_silent_cmd  "guile (define check-eval (make-bp-eval \"$bp_location2\"))" \
+	    "create check-eval breakpoint"
+	gdb_test "guile (print (bp-eval-count check-eval))" \
+	    "= 0" \
+	    "test that evaluate function has not been yet executed (ie count = 0)"
+	gdb_continue_to_breakpoint "Break at multiply." ".*/$srcfile:$bp_location2.*"
+	gdb_test "guile (print (bp-eval-count check-eval))" \
+	    "= 1" \
+	    "test that evaluate function is run when location also has normal bp"
+
+	# Test watchpoints with stop-func.
+
+	gdb_test_multiline "watchpoint stop func" \
+	    "guile" "" \
+	    "(define (make-wp-eval location)" "" \
+	    "  (let ((wp (create-breakpoint! location #:type BP_WATCHPOINT #:wp-class WP_WRITE)))" "" \
+	    "    (set-breakpoint-stop! wp" "" \
+	    "      (lambda (bkpt)" "" \
+	    "        (let ((result (parse-and-eval \"result\")))" "" \
+	    "          (value=? result 788))))" "" \
+	    "    wp))" "" \
+	    "end" ""
+
+	delete_breakpoints
+	gdb_scm_test_silent_cmd  "guile (define wp1 (make-wp-eval \"result\"))" \
+	    "create watchpoint"
+	gdb_test "continue" ".*\[Ww\]atchpoint.*result.*Old value =.*New value = 788.*" \
+	    "test watchpoint write"
+
+	# Misc final tests.
+
+	gdb_test "guile (print (bp-eval-count never-eval-bp1))" \
+	    "= 0" \
+	    "check that this unrelated breakpoints eval function was never called"
+    }
+}
+
+test_bkpt_basic
+test_bkpt_deletion
+test_bkpt_cond_and_cmds
+test_bkpt_invisible
+test_watchpoints
+test_bkpt_internal
+test_bkpt_eval_funcs
diff --git a/gdb/testsuite/gdb.guile/scm-disasm.c b/gdb/testsuite/gdb.guile/scm-disasm.c
new file mode 100644
index 0000000..6c0ef92
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-disasm.c
@@ -0,0 +1,22 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+int
+main (void)
+{
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-disasm.exp b/gdb/testsuite/gdb.guile/scm-disasm.exp
new file mode 100644
index 0000000..5a1dae3
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-disasm.exp
@@ -0,0 +1,133 @@
+# Copyright 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/>.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+   return
+}
+
+# Disassemble one instruction at pc and verify the result.
+
+proc test_disassemble_1 { name address extra_args } {
+    with_test_prefix $name {
+	gdb_scm_test_silent_cmd "guile (define insn-list (arch-disassemble arch $address $extra_args #:size 1 #:count 1))" \
+	    "disassemble"
+
+	gdb_test "guile (print (length insn-list))" \
+	    "= 1" "test number of instructions"
+	gdb_scm_test_silent_cmd "guile (define insn (car insn-list))" \
+	    "get instruction"
+
+	# Verify all the fields are present.
+	gdb_test "guile (print (->bool (assq-ref insn 'address)))" \
+	    "= #t" "test key address"
+	gdb_test "guile (print (->bool (assq-ref insn 'asm)))" \
+	    "= #t" "test key asm"
+	gdb_test "guile (print (->bool (assq-ref insn 'length)))" \
+	    "= #t" "test key length"
+
+	# Verify the correct address is used.
+	gdb_test "guile (print (= $address (assq-ref insn 'address)))" \
+	    "= #t" "verify correct address"
+    }
+}
+
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" "get frame"
+gdb_scm_test_silent_cmd "guile (define arch (frame-arch frame))" "get arch"
+gdb_scm_test_silent_cmd "guile (define pc (frame-pc frame))" "get pc"
+
+gdb_test "guile (print (arch-disassemble arch pc #:size 0))" \
+    "= \\(\\)" "disassemble, zero size"
+gdb_test "guile (print (arch-disassemble arch pc #:count 0))" \
+    "= \\(\\)" "disassemble, zero count"
+
+gdb_scm_test_silent_cmd "guile (define insn-list1 (arch-disassemble arch pc #:size 1 #:count 1))" \
+    "disassemble"
+gdb_scm_test_silent_cmd "guile (define insn-list2 (arch-disassemble arch pc #:size 1))" \
+    "disassemble, no count"
+gdb_scm_test_silent_cmd "guile (define insn-list3 (arch-disassemble arch pc #:count 1))" \
+    "disassemble, no end"
+gdb_scm_test_silent_cmd "guile (define insn-list4 (arch-disassemble arch pc))" \
+    "disassemble, no end no count"
+
+gdb_test "guile (print (length insn-list1))" \
+    "= 1" "test number of instructions 1"
+gdb_test "guile (print (length insn-list2))" \
+    "= 1" "test number of instructions 2"
+gdb_test "guile (print (length insn-list3))" \
+    "= 1" "test number of instructions 3"
+gdb_test "guile (print (length insn-list4))" \
+    "= 1" "test number of instructions 4"
+
+test_disassemble_1 "basic" "pc" ""
+
+# Negative test
+gdb_test "guile (arch-disassemble arch 0 #:size 1)" \
+    "ERROR: Cannot access memory at address 0x.*" "test bad memory access"
+
+# Test disassembly through a port.
+
+gdb_scm_test_silent_cmd "guile (define mem (open-memory))" \
+    "open memory port"
+
+test_disassemble_1 "memory-port" "pc" "#:port mem"
+
+gdb_scm_test_silent_cmd "guile (define insn-list-mem (arch-disassemble arch pc #:port mem #:size 1 #:count 1))" \
+    "disassemble via memory port"
+
+# Test memory error reading from port.
+
+gdb_scm_test_silent_cmd "guile (define mem1 (open-memory #:start pc #:size 4))" \
+    "open restricted range memory port"
+
+# The x86 disassembler tries to be clever and will print "byte 0x42" if
+# there is insufficient memory for the entire instruction.
+# So we pass "#:count 5" to ensure the disassembler tries to read beyond
+# the end of the memory range.
+gdb_test "guile (arch-disassemble arch pc #:port mem1 #:count 5 #:offset pc)" \
+    "ERROR: Cannot access memory at address 0x.*" \
+    "test bad memory access from port"
+
+# Test disassembly of a bytevector.
+
+gdb_scm_test_silent_cmd "guile (use-modules (rnrs io ports))" \
+    "import (rnrs io ports)"
+
+# First fetch the length of the instruction at $pc.
+gdb_scm_test_silent_cmd "guile (define insn-list-for-bv (arch-disassemble arch pc))" \
+    "get insn for bytevector"
+gdb_test_no_output "guile (define insn-length (assq-ref (car insn-list-for-bv) 'length))" \
+    "get insn length for bytevector"
+
+# Read the insn into a bytevector.
+gdb_test_no_output "guile (define insn-bv (get-bytevector-n (open-memory #:start pc #:size insn-length) insn-length))" \
+    "read insn into bytevector"
+
+# Disassemble the bytevector.
+gdb_scm_test_silent_cmd "guile (define insn-list-from-bv (arch-disassemble arch pc #:port (open-bytevector-input-port insn-bv) #:offset pc))" \
+    "disassemble bytevector"
+
+gdb_test "guile (print (equal? insn-list-for-bv insn-list-from-bv))" \
+    "= #t" "verify bytevector disassembly"
diff --git a/gdb/testsuite/gdb.guile/scm-equal.c b/gdb/testsuite/gdb.guile/scm-equal.c
new file mode 100644
index 0000000..108c9be
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-equal.c
@@ -0,0 +1,24 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+int x;
+
+int
+main (void)
+{
+  return x;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-equal.exp b/gdb/testsuite/gdb.guile/scm-equal.exp
new file mode 100644
index 0000000..ae23aa8
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-equal.exp
@@ -0,0 +1,55 @@
+# Copyright 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests equal? for the various gsmobs.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+   return
+}
+
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" "get frame"
+gdb_scm_test_silent_cmd "guile (define arch (frame-arch frame))" "get arch"
+
+gdb_test "guile (print (equal? (selected-frame) (newest-frame)))" \
+    "= #t" "equal? frame"
+gdb_test "guile (print (equal? (selected-frame) (frame-older (newest-frame))))" \
+    "= #f" "not equal? frame"
+
+gdb_test "guile (print (equal? (make-value 1) (make-value 1)))" \
+    "= #t" "equal? value"
+gdb_test "guile (print (equal? (make-value 1) (make-value 2)))" \
+    "= #f" "not equal? value"
+
+gdb_test "guile (print (equal? (value-type (make-value 1)) (value-type (make-value 2))))" \
+    "= #t" "equal? type"
+gdb_test "guile (print (equal? (value-type (make-value 1)) (value-type (make-value 2.5))))" \
+    "= #f" "not equal? type"
+
+gdb_test "guile (print (equal? (lookup-global-symbol \"main\") (lookup-global-symbol \"main\")))" \
+    "= #t" "equal? symbol"
+gdb_test "guile (print (equal? (lookup-global-symbol \"main\") (lookup-global-symbol \"x\")))" \
+    "= #f" "not equal? symbol"
diff --git a/gdb/testsuite/gdb.guile/scm-error-1.scm b/gdb/testsuite/gdb.guile/scm-error-1.scm
new file mode 100644
index 0000000..a68f491
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-error-1.scm
@@ -0,0 +1,19 @@
+;; Copyright (C) 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/>.
+
+(use-modules (gdb))
+
+;; An intentional error to test error handling when loading a file.
+(define foo (+ 42 #f))
diff --git a/gdb/testsuite/gdb.guile/scm-error-2.scm b/gdb/testsuite/gdb.guile/scm-error-2.scm
new file mode 100644
index 0000000..87a7ee5
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-error-2.scm
@@ -0,0 +1,30 @@
+;; Copyright (C) 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/>.
+
+(use-modules (gdb))
+
+;; Create a set of functions to call, with the last one having an error,
+;; so we can test backtrace printing.
+
+(define foo #f)
+
+(define (top-func x)
+  (+ (middle-func x) 1))
+
+(define (middle-func x)
+  (+ (bottom-func x) 1))
+
+(define (bottom-func x)
+  (+ x foo))
diff --git a/gdb/testsuite/gdb.guile/scm-error.exp b/gdb/testsuite/gdb.guile/scm-error.exp
new file mode 100644
index 0000000..b5a1028
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-error.exp
@@ -0,0 +1,117 @@
+# 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/>.
+
+# Test various error conditions.
+
+set testfile "scm-error"
+
+load_lib gdb-guile.exp
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+# Test error while loading .scm.
+
+# Give the files a new name so we don't clobber the real one if
+# objfile == srcdir.
+set remote_guile_file_1 [gdb_remote_download host \
+			     ${srcdir}/${subdir}/${testfile}-1.scm \
+			     ${subdir}/t-${testfile}-1.scm]
+set remote_guile_file_2 [gdb_remote_download host \
+			     ${srcdir}/${subdir}/${testfile}-2.scm \
+			     ${subdir}/t-${testfile}-2.scm]
+
+gdb_test "source $remote_guile_file_1" \
+    "(ERROR: )?In procedure \[+\]: Wrong type: #f.*" \
+    "error loading scm file caught"
+
+gdb_test "p 1" " = 1" "no delayed error"
+
+# Test setting/showing the various states for "guile print-stack".
+
+gdb_test "show guile print-stack" \
+    "The mode of Guile exception printing on error is \"message\".*" \
+    "test print-stack show setting of default"
+gdb_test_no_output "set guile print-stack full" \
+    "test print-stack full setting"
+gdb_test "show guile print-stack" \
+    "The mode of Guile exception printing on error is \"full\".*" \
+    "test print-stack show setting to full"
+gdb_test_no_output "set guile print-stack none" \
+    "test print-stack none setting"
+gdb_test "show guile print-stack" \
+    "The mode of Guile exception printing on error is \"none\".*" \
+    "test print-stack show setting to none"
+# Reset back to default, just in case.
+gdb_test_no_output "set guile print-stack message" \
+    "reset print-stack to default, post set/show tests"
+
+# Test "set guile print-stack none".
+
+gdb_test_no_output "set guile print-stack none" \
+    "set print-stack to none, for error test"
+
+set test_name "no error printed"
+set command "guile (define x doesnt-exist)"
+gdb_test_multiple $command $test_name {
+    -re "Backtrace.*$gdb_prompt $" { fail $test_name }
+    -re "ERROR.*$gdb_prompt $"     { fail $test_name }
+    -re "$gdb_prompt $"            { pass $test_name }
+}
+
+# Test "set guile print-stack message".
+
+gdb_test_no_output "set guile print-stack message" \
+    "set print-stack to message, for error test"
+
+set test_name "error message printed"
+set command "guile (define x doesnt-exist)"
+gdb_test_multiple $command $test_name {
+    -re "Backtrace.*$gdb_prompt $" { fail $test_name }
+    -re "ERROR.*$gdb_prompt $"     { pass $test_name }
+}
+
+# Test "set guile print-stack full".
+
+gdb_scm_test_silent_cmd "source $remote_guile_file_2" ""
+
+gdb_test_no_output "set guile print-stack full" \
+    "set print-stack to full, for backtrace test"
+
+gdb_test "guile (define x (top-func 42))" \
+    "Guile Backtrace:.*top-func 42.*middle-func 42.*bottom-func 42.*" \
+    "backtrace printed"
+
+# Verify gdb-specific errors are printed properly.
+# i.e., each gdb error is registered to use init.scm:%error-printer.
+
+gdb_test_no_output "set guile print-stack message" \
+    "set print-stack to message, for error printing tests"
+
+gdb_test "guile (throw 'gdb:error \"subr\" \"misc error: ~a\" (list 42))" \
+    "ERROR: In procedure subr: misc error: 42.*"
+
+gdb_test "guile (throw 'gdb:invalid-object-error \"subr\" \"invalid object error: ~a\" (list 42))" \
+    "ERROR: In procedure subr: invalid object error: 42.*"
+
+gdb_test "guile (throw 'gdb:memory-error \"subr\" \"memory error: ~a\" (list 42))" \
+    "ERROR: In procedure subr: memory error: 42.*"
+
+gdb_test "guile (throw 'gdb:pp-type-error \"subr\" \"pp-type error: ~a\" (list 42))" \
+    "ERROR: In procedure subr: pp-type error: 42.*"
diff --git a/gdb/testsuite/gdb.guile/scm-frame-args.c b/gdb/testsuite/gdb.guile/scm-frame-args.c
new file mode 100644
index 0000000..c20b1e1
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-frame-args.c
@@ -0,0 +1,60 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+#include <string.h>
+
+struct s
+{
+  int m;
+};
+
+struct ss
+{
+  struct s a;
+  struct s b;
+};
+
+void
+init_s (struct s *s, int m)
+{
+  s->m = m;
+}
+
+void
+init_ss (struct ss *s, int a, int b)
+{
+  init_s (&s->a, a);
+  init_s (&s->b, b);
+}
+
+void
+foo (int x, struct ss ss)
+{
+  return; /* break-here */
+}
+
+int
+main ()
+{
+  struct ss ss;
+
+  init_ss (&ss, 1, 2);
+
+  foo (42, ss);
+
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-frame-args.exp b/gdb/testsuite/gdb.guile/scm-frame-args.exp
new file mode 100644
index 0000000..22ce6fe
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-frame-args.exp
@@ -0,0 +1,76 @@
+# Copyright (C) 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/>.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+# Give the file a new name so we don't clobber the real one if
+# objfile == srcdir.
+set remote_guile_file [gdb_remote_download host \
+			   ${srcdir}/${subdir}/${testfile}.scm \
+			   ${subdir}/t-${testfile}.scm]
+
+gdb_scm_load_file "$remote_guile_file" "load script"
+
+gdb_breakpoint [gdb_get_line_number "break-here"]
+gdb_continue_to_breakpoint "break-here" ".* break-here .*"
+
+# Test all combinations with raw off.
+
+gdb_test_no_output "set print raw frame-arguments off"
+
+gdb_test_no_output "set print frame-arguments none"
+gdb_test "frame" ".*foo \\(x=\[.\]{3}, ss=\[.\]{3}\\).*" \
+    "frame pretty,none"
+
+#gdb_test_no_output "set guile print-stack full"
+
+gdb_test_no_output "set print frame-arguments scalars"
+gdb_test "frame" ".*foo \\(x=42, ss=super struct = {\[.\]{3}}\\).*" \
+    "frame pretty,scalars"
+
+gdb_test_no_output "set print frame-arguments all"
+gdb_test "frame" \
+    ".*foo \\(x=42, ss=super struct = {a = m=<1>, b = m=<2>}\\).*" \
+    "frame pretty,all"
+
+# Test all combinations with raw on.
+
+gdb_test_no_output "set print raw frame-arguments on"
+
+gdb_test_no_output "set print frame-arguments none"
+gdb_test "frame" ".*foo \\(x=\[.\]{3}, ss=\[.\]{3}\\).*" \
+    "frame raw,none"
+
+gdb_test_no_output "set print frame-arguments scalars"
+gdb_test "frame" ".*foo \\(x=42, ss=\[.\]{3}\\).*" \
+    "frame raw,scalars"
+
+gdb_test_no_output "set print frame-arguments all"
+gdb_test "frame" \
+    ".*foo \\(x=42, ss={a = {m = 1}, b = {m = 2}}\\).*" \
+    "frame raw,all"
diff --git a/gdb/testsuite/gdb.guile/scm-frame-args.scm b/gdb/testsuite/gdb.guile/scm-frame-args.scm
new file mode 100644
index 0000000..20d42f8
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-frame-args.scm
@@ -0,0 +1,69 @@
+;; Copyright (C) 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/>.
+
+(use-modules (gdb) (gdb printing))
+
+(define (make-pp_s-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (let ((m (value-field val "m")))
+       (format #f "m=<~A>" m)))
+   #f))
+
+(define (make-pp_ss-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer) "super struct")
+   (lambda (printer)
+     (make-iterator val
+		    (make-field-iterator (value-type val))
+		    (lambda (iter)
+		      (let ((field (iterator-next!
+				    (iterator-progress iter))))
+			(if (end-of-iteration? field)
+			    field
+			    (let ((name (field-name field)))
+			      (cons name (value-field val name))))))))))
+
+(define (get-type-for-printing val)
+  "Return type of val, stripping away typedefs, etc."
+  (let ((type (value-type val)))
+    (if (= (type-code type) TYPE_CODE_REF)
+	(set! type (type-target type)))
+    (type-strip-typedefs (type-unqualified type))))
+
+(define (make-pretty-printer-dict)
+  (let ((dict (make-hash-table)))
+    (hash-set! dict "struct s" make-pp_s-printer)
+    (hash-set! dict "s" make-pp_s-printer)
+    (hash-set! dict "struct ss" make-pp_ss-printer)
+    (hash-set! dict "ss" make-pp_ss-printer)
+    dict))
+
+(define *pretty-printer*
+ (make-pretty-printer
+  "pretty-printer-test"
+  (let ((pretty-printers-dict (make-pretty-printer-dict)))
+    (lambda (matcher val)
+      "Look-up and return a pretty-printer that can print val."
+      (let ((type (get-type-for-printing val)))
+	(let ((typename (type-tag type)))
+	  (if typename
+	      (let ((printer-maker (hash-ref pretty-printers-dict typename)))
+		(and printer-maker (printer-maker val)))
+	      #f)))))))
+
+(append-pretty-printer! #f *pretty-printer*)
diff --git a/gdb/testsuite/gdb.guile/scm-frame-inline.c b/gdb/testsuite/gdb.guile/scm-frame-inline.c
new file mode 100644
index 0000000..a3669bc
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-frame-inline.c
@@ -0,0 +1,43 @@
+/* This test is part of GDB, the GNU debugger.
+
+   Copyright 2011-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/>.  */
+
+volatile int v = 42;
+
+__attribute__((__always_inline__)) static inline int
+f (void)
+{
+  /* Provide first stub line so that GDB understand the PC is already inside
+     the inlined function and does not expect a step into it.  */
+  v++;
+  v++;		/* break-here */
+
+  return v;
+}
+
+__attribute__((__noinline__)) static int
+g (void)
+{
+  volatile int l = v;
+
+  return f ();
+}
+
+int
+main (void)
+{
+  return g ();
+}
diff --git a/gdb/testsuite/gdb.guile/scm-frame-inline.exp b/gdb/testsuite/gdb.guile/scm-frame-inline.exp
new file mode 100644
index 0000000..ed1c3b8
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-frame-inline.exp
@@ -0,0 +1,43 @@
+# Copyright (C) 2011-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/>.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![runto main] {
+    fail "Can't run to main"
+    return
+}
+
+gdb_install_guile_utils
+gdb_install_guile_module
+
+gdb_breakpoint [gdb_get_line_number "break-here"]
+gdb_continue_to_breakpoint "break-here"
+
+gdb_test "info frame" "inlined into frame 1\r\n.*"
+
+gdb_test "up" "#1  g .*"
+
+gdb_test "guile (print (frame-read-var (selected-frame) \"l\"))" \
+    "= 42"
diff --git a/gdb/testsuite/gdb.guile/scm-frame.c b/gdb/testsuite/gdb.guile/scm-frame.c
new file mode 100644
index 0000000..82db341
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-frame.c
@@ -0,0 +1,30 @@
+int f2 (int a)
+{
+  return ++a;
+}
+
+int f1 (int a, int b)
+{
+  return f2(a) + b;
+}
+
+int block (void)
+{
+  int i = 99;
+  {
+    double i = 1.1;
+    double f = 2.2;
+    {
+      const char *i = "stuff";
+      const char *f = "foo";
+      const char *b = "bar";
+      return 0; /* Block break here.  */
+    }
+  }
+}
+
+int main (int argc, char *argv[])
+{
+  block ();
+  return f1 (1, 2);
+}
diff --git a/gdb/testsuite/gdb.guile/scm-frame.exp b/gdb/testsuite/gdb.guile/scm-frame.exp
new file mode 100644
index 0000000..04c8cda
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-frame.exp
@@ -0,0 +1,122 @@
+# Copyright (C) 2009-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the frame support in Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return -1
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+# The following tests require execution.
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_breakpoint [gdb_get_line_number "Block break here."]
+gdb_continue_to_breakpoint "Block break here."
+gdb_scm_test_silent_cmd "guile (define bf1 (selected-frame))" \
+    "get frame"
+
+# Test frame-architecture method.
+gdb_scm_test_silent_cmd "guile (define show-arch-str (execute \"show architecture\" #:to-string #t))" \
+    "show arch"
+gdb_test "guile (print (->bool (string-contains show-arch-str (arch-name (frame-arch bf1)))))" \
+    "#t" "test frame-arch"
+
+# First test that read-var is unaffected by PR 11036 changes.
+gdb_test "guile (print (frame-read-var bf1 \"i\"))" \
+    "\"stuff\"" "test i"
+gdb_test "guile (print (frame-read-var bf1 \"f\"))" \
+    "\"foo\"" "test f"
+gdb_test "guile (print (frame-read-var bf1 \"b\"))" \
+    "\"bar\"" "test b"
+
+# Test the read-var function in another block other than the current
+# block (in this case, the super block). Test thar read-var is reading
+# the correct variables of i and f but they are the correct value and type.
+gdb_scm_test_silent_cmd "guile (define sb (block-superblock (frame-block bf1)))" \
+    "get superblock"
+gdb_test "guile (print (frame-read-var bf1 \"i\" #:block sb))" "1.1.*" \
+    "test i = 1.1"
+gdb_test "guile (print (value-type (frame-read-var bf1 \"i\" #:block sb)))" \
+    "double" "test double i"
+gdb_test "guile (print (frame-read-var bf1 \"f\" #:block sb))" \
+    "2.2.*" "test f = 2.2"
+gdb_test "guile (print (value-type (frame-read-var bf1 \"f\" #:block sb)))" \
+    "double" "test double f"
+
+# And again test another outerblock, this time testing "i" is the
+# correct value and type.
+gdb_scm_test_silent_cmd "guile (set! sb (block-superblock sb))" \
+    "get superblock #2"
+gdb_test "guile (print (frame-read-var bf1 \"i\" #:block sb))" \
+    "99" "test i = 99"
+gdb_test "guile (print (value-type (frame-read-var bf1 \"i\" #:block sb)))" \
+    "int" "test int i"
+
+gdb_breakpoint "f2"
+gdb_continue_to_breakpoint "breakpoint at f2"
+gdb_scm_test_silent_cmd "guile (define bframe (selected-frame))" \
+    "get bottom-most frame"
+gdb_test "up" ".*" ""
+
+gdb_scm_test_silent_cmd "guile (define f1 (selected-frame))" \
+"get second frame"
+gdb_scm_test_silent_cmd "guile (define f0 (frame-newer f1))" \
+    "get first frame"
+
+gdb_test "guile (print (eq? f1 (newest-frame)))" \
+    #f "selected frame -vs- newest frame"
+gdb_test "guile (print (eq? bframe (newest-frame)))" \
+    #t "newest frame -vs- newest frame"
+
+gdb_test "guile (print (eq? f0 f1))" \
+    "#f" "test equality comparison (false)"
+gdb_test "guile (print (eq? f0 f0))" \
+    "#t" "test equality comparison (true)"
+gdb_test "guile (print (frame-valid? f0))" \
+    "#t" "test frame-valid?"
+gdb_test "guile (print (frame-name f0))" \
+    "f2" "test frame-name"
+gdb_test "guile (print (= (frame-type f0) NORMAL_FRAME))" \
+    "#t" "test frame-type"
+gdb_test "guile (print (= (frame-unwind-stop-reason f0) FRAME_UNWIND_NO_REASON))" \
+    "#t" "test frame-unwind-stop-reason"
+gdb_test "guile (print (unwind-stop-reason-string FRAME_UNWIND_INNER_ID))" \
+    "previous frame inner to this frame \\(corrupt stack\\?\\)" \
+    "test unwind-stop-reason-string"
+gdb_test "guile (print (format #f \"= ~A\" (frame-pc f0)))" \
+    "= \[0-9\]+" "test frame-pc"
+gdb_test "guile (print (format #f \"= ~A\" (eq? (frame-older f0) f1)))" \
+    "= #t" "test frame-older"
+gdb_test "guile (print (format #f \"= ~A\" (eq? (frame-newer f1) f0)))" \
+    "= #t" "test frame-newer"
+gdb_test "guile (print (frame-read-var f0 \"variable_which_surely_doesnt_exist\"))" \
+  "ERROR: .*: Out of range: variable not found: \"variable_which_surely_doesnt_exist\".*" \
+  "test frame-read-var - error"
+gdb_test "guile (print (format #f \"= ~A\" (frame-read-var f0 \"a\")))" \
+    "= 1" "test frame-read-var - success"
+
+gdb_test "guile (print (format #f \"= ~A\" (eq? (selected-frame) f1)))" \
+    "= #t" "test selected-frame"
diff --git a/gdb/testsuite/gdb.guile/scm-generics.exp b/gdb/testsuite/gdb.guile/scm-generics.exp
new file mode 100644
index 0000000..664affc
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-generics.exp
@@ -0,0 +1,42 @@
+# 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests using GDB smobs with generics.
+
+load_lib gdb-guile.exp
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+gdb_reinitialize_dir $srcdir/$subdir
+
+gdb_install_guile_utils
+gdb_install_guile_module
+
+gdb_test_no_output "guile (use-modules ((oop goops)))"
+
+gdb_test_no_output "guile (define-generic +)"
+gdb_test_no_output "guile (define-method (+ (x <gdb:value>) (y <gdb:value>)) (value-add x y))"
+
+gdb_test_no_output "guile (define x (make-value 42))"
+
+gdb_test_no_output "guile (define y (+ x x))"
+
+gdb_test "guile y" "#<gdb:value 84>"
diff --git a/gdb/testsuite/gdb.guile/scm-gsmob.exp b/gdb/testsuite/gdb.guile/scm-gsmob.exp
new file mode 100644
index 0000000..470afc4
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-gsmob.exp
@@ -0,0 +1,70 @@
+# Copyright (C) 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests basic gsmob features.
+
+load_lib gdb-guile.exp
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+gdb_reinitialize_dir $srcdir/$subdir
+
+gdb_install_guile_utils
+gdb_install_guile_module
+
+# Test the transition from alist to htab in the property list.
+# N.B. This has the same value as gdb/guile/scm-gsmob.c.
+set SMOB_PROP_HTAB_THRESHOLD 7
+
+gdb_test_no_output "gu (define arch (current-arch))"
+
+# Return a property name for integer I suitable for sorting.
+
+proc prop_name { i } {
+    return [format "prop%02d" $i]
+}
+
+# Set and ref the properties in separate loops to verify previously set
+# properties are not lost when we set a new property or switch to htabs.
+for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} {
+    gdb_test "gu (print (gsmob-has-property? arch '[prop_name $i]))" \
+	"= #f" "property prop$i not present before set"
+    gdb_test_no_output "gu (set-gsmob-property! arch '[prop_name $i] $i)" \
+	"set prop $i"
+    gdb_test "gu (print (gsmob-has-property? arch '[prop_name $i]))" \
+	"= #t" "property prop$i present after set"
+}
+for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} {
+    gdb_test "gu (print (gsmob-has-property? arch '[prop_name $i]))" \
+	"= #t" "property prop$i present after all set"
+    gdb_test "gu (print (gsmob-property arch '[prop_name $i]))" \
+	"= $i" "ref prop $i"
+}
+
+# Verify gsmob-properties.
+set prop_list ""
+for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} {
+    set prop_list "$prop_list [prop_name $i]"
+}
+set prop_list [lsort $prop_list]
+verbose -log "prop_list: $prop_list"
+gdb_test "gu (print (sort (gsmob-properties arch) (lambda (a b) (string<? (symbol->string a) (symbol->string b)))))" \
+    "= \\($prop_list\\)" "gsmob-properties"
diff --git a/gdb/testsuite/gdb.guile/scm-iterator.c b/gdb/testsuite/gdb.guile/scm-iterator.c
new file mode 100644
index 0000000..80e9178
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-iterator.c
@@ -0,0 +1,28 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+void
+foo (void)
+{
+}
+
+int
+main (void)
+{
+  foo ();
+  return 0; /* Break at end. */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-iterator.exp b/gdb/testsuite/gdb.guile/scm-iterator.exp
new file mode 100644
index 0000000..8ee67ed
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-iterator.exp
@@ -0,0 +1,62 @@
+# Copyright (C) 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the iterator facility.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return -1
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_breakpoint [gdb_get_line_number "Break at end."]
+gdb_continue_to_breakpoint "Break at end."
+
+gdb_scm_test_silent_cmd "guile (use-modules (gdb iterator))" \
+    "import (gdb iterator)"
+
+gdb_scm_test_silent_cmd "guile (define this-sal (find-pc-line (frame-pc (selected-frame))))" \
+    "get frame sal"
+
+gdb_scm_test_silent_cmd "guile (define this-symtab (sal-symtab this-sal))" \
+    "get frame symtab"
+
+gdb_scm_test_silent_cmd "guile (define this-global-block (symtab-global-block this-symtab))" \
+    "get frame global block"
+
+gdb_scm_test_silent_cmd "guile (define syms-iter (make-block-symbols-iterator this-global-block))" \
+    "get global block iterator"
+
+gdb_scm_test_silent_cmd "guile (define functions (iterator-filter symbol-function? syms-iter))" \
+    "get global functions"
+
+gdb_test "guile (print (sort (map symbol-name functions) string<?))" \
+    "= \\(foo main\\)" "test function list"
+
+gdb_scm_test_silent_cmd "guile (define syms-iter (make-block-symbols-iterator this-global-block))" \
+    "get global block iterator 2"
+
+gdb_test "guile (print (sort (map symbol-name (iterator->list syms-iter)) string<?))" \
+    "= \\(foo main\\)" "iterator->list"
diff --git a/gdb/testsuite/gdb.guile/scm-math.c b/gdb/testsuite/gdb.guile/scm-math.c
new file mode 100644
index 0000000..347fc22
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-math.c
@@ -0,0 +1,30 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+enum e
+  {
+    ONE = 1,
+    TWO = 2
+  };
+
+enum e evalue = TWO;
+
+int
+main (int argc, char *argv[])
+{
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-math.exp b/gdb/testsuite/gdb.guile/scm-math.exp
new file mode 100644
index 0000000..12caa71
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-math.exp
@@ -0,0 +1,309 @@
+# Copyright (C) 2008-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests <gdb:value> math operations.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+proc test_value_numeric_ops {} {
+    global gdb_prompt
+
+    gdb_scm_test_silent_cmd "gu (define i (make-value 5))" \
+	"create first integer value"
+    gdb_scm_test_silent_cmd "gu (define j (make-value 2))" \
+	"create second integer value"
+    gdb_test "gu (print (value-add i j))" \
+	"= 7" "add two integer values"
+    gdb_test "gu (raw-print (value-add i j))" \
+	"= #<gdb:value 7>" "verify type of integer add result"
+
+    gdb_scm_test_silent_cmd "gu (define f (make-value  1.25))" \
+	"create first double value"
+    gdb_scm_test_silent_cmd "gu (define g (make-value 2.5))" \
+	"create second double value"
+    gdb_test "gu (print (value-add f g))" \
+	"= 3.75" "add two double values"
+    gdb_test "gu (raw-print (value-add f g))" \
+	"= #<gdb:value 3.75>" "verify type of double add result"
+
+    gdb_test "gu (print (value-sub i j))" \
+	"= 3" "subtract two integer values"
+    gdb_test "gu (print (value-sub f g))" \
+	"= -1.25" "subtract two double values"
+
+    gdb_test "gu (print (value-mul i j))" \
+	"= 10" "multiply two integer values"
+    gdb_test "gu (print (value-mul f g))" \
+	"= 3.125" "multiply two double values"
+
+    gdb_test "gu (print (value-div i j))" \
+	"= 2" "divide two integer values"
+    gdb_test "gu (print (value-div f g))" \
+	"= 0.5" "divide two double values"
+    gdb_test "gu (print (value-rem i j))" \
+	"= 1" "take remainder of two integer values"
+    gdb_test "gu (print (value-mod i j))" \
+	"= 1" "take modulus of two integer values"
+
+    gdb_test "gu (print (value-pow i j))" \
+	"= 25" "integer value raised to the power of another integer value"
+    gdb_test "gu (print (value-pow g j))" \
+	"= 6.25" "double value raised to the power of integer value"
+
+    gdb_test "gu (print (value-neg i))" \
+	"= -5" "negated integer value"
+    gdb_test "gu (print (value-pos i))" \
+	"= 5" "positive integer value"
+    gdb_test "gu (print (value-neg f))" \
+	"= -1.25" "negated double value"
+    gdb_test "gu (print (value-pos f))" \
+	"= 1.25" "positive double value"
+    gdb_test "gu (print (value-abs (value-sub j i)))" \
+	"= 3" "absolute of integer value"
+    gdb_test "gu (print (value-abs (value-sub f g)))" \
+	"= 1.25" "absolute of double value"
+
+    gdb_test "gu (print (value-lsh i j))" \
+	"= 20" "left shift"
+    gdb_test "gu (print (value-rsh i j))" \
+	"= 1" "right shift"
+
+    gdb_test "gu (print (value-min i j))" \
+	"= 2" "min"
+    gdb_test "gu (print (value-max i j))" \
+	"= 5" "max"
+
+    gdb_test "gu (print (value-lognot i))" \
+	"= -6" "lognot"
+    gdb_test "gu (print (value-logand i j))" \
+	"= 0" "logand i j"
+    gdb_test "gu (print (value-logand 5 1))" \
+	"= 1" "logand 5 1"
+    gdb_test "gu (print (value-logior i j))" \
+	"= 7" "logior i j"
+    gdb_test "gu (print (value-logior 5 1))" \
+	"= 5" "logior 5 1"
+    gdb_test "gu (print (value-logxor i j))" \
+	"= 7" "logxor i j"
+    gdb_test "gu (print (value-logxor 5 1))" \
+	"= 4" "logxor 5 1"
+
+    # Test <gdb:value> mixed with Guile types.
+
+    gdb_test "gu (print (value-sub i 1))" \
+	"= 4" "subtract integer value from guile integer"
+    gdb_test "gu (raw-print (value-sub i 1))" \
+	"#<gdb:value 4>" \
+	"verify type of mixed integer subtraction result"
+    gdb_test "gu (print (value-add f 1.5))" \
+	"= 2.75" "add double value with guile float"
+
+    gdb_test "gu (print (value-sub 1 i))" \
+	"= -4" "subtract guile integer from integer value"
+    gdb_test "gu (print (value-add 1.5 f))" \
+	"= 2.75" "add guile float with double value"
+
+    # Enum conversion test.
+    gdb_test "print evalue" "= TWO"
+    gdb_test "gu (print (value->integer (history-ref 0)))" "= 2"
+
+    # Test pointer arithmetic.
+
+    # First, obtain the pointers.
+    gdb_test "print (void *) 2" ".*" ""
+    gdb_test_no_output "gu (define a (history-ref 0))"
+    gdb_test "print (void *) 5" ".*" ""
+    gdb_test_no_output "gu (define b (history-ref 0))"
+
+    gdb_test "gu (print (value-add a 5))" \
+	"= 0x7( <.*>)?" "add pointer value with guile integer"
+    gdb_test "gu (print (value-sub b 2))" \
+	"= 0x3( <.*>)?" "subtract guile integer from pointer value"
+    gdb_test "gu (print (value-sub b a))" \
+	"= 3" "subtract two pointer values"
+
+    # Test some invalid operations.
+
+    gdb_test_multiple "gu (print (value-add i '()))" "catch error in guile type conversion" {
+	-re "Wrong type argument in position 2.*$gdb_prompt $" {pass "catch error in guile type conversion"}
+	-re "= .*$gdb_prompt $"  {fail "catch error in guile type conversion"}
+	-re "$gdb_prompt $"      {fail "catch error in guile type conversion"}
+    }
+
+    gdb_test_multiple "gu (print (value-add i \"foo\"))" "catch throw of GDB error" {
+	-re "Argument to arithmetic operation not a number or boolean.*$gdb_prompt $" {pass "catch throw of GDB error"}
+	-re "= .*$gdb_prompt $"         {fail "catch throw of GDB error"}
+	-re "$gdb_prompt $"             {fail "catch throw of GDB error"}
+    }
+}
+
+# Return the max signed int of size SIZE.
+# TCL 8.5 required here.  Use lookup table instead?
+
+proc get_max_int { size } {
+    return [expr "(1 << ($size - 1)) - 1"]
+}
+
+# Return the min signed int of size SIZE.
+# TCL 8.5 required here.  Use lookup table instead?
+
+proc get_min_int { size } {
+    return [expr "-(1 << ($size - 1))"]
+}
+
+# Return the max unsigned int of size SIZE.
+# TCL 8.5 required here.  Use lookup table instead?
+
+proc get_max_uint { size } {
+    return [expr "(1 << $size) - 1"]
+}
+
+# Helper routine for test_value_numeric_ranges.
+
+proc test_make_int_value { name size } {
+    set max [get_max_int $size]
+    set min [get_min_int $size]
+    set umax [get_max_uint $size]
+    gdb_test "gu (print (value-type (make-value $max)))" \
+	"= $name" "test make-value $name $size max"
+    gdb_test "gu (print (value-type (make-value $min)))" \
+	"= $name" "test make-value $name $size min"
+    gdb_test "gu (print (value-type (make-value $umax)))" \
+	"= unsigned $name" "test make-value unsigned $name $size umax"
+}
+
+# Helper routine for test_value_numeric_ranges.
+
+proc test_make_typed_int_value { size } {
+    set name "int$size"
+    set uname "uint$size"
+    set max [get_max_int $size]
+    set min [get_min_int $size]
+    set umax [get_max_uint $size]
+
+    gdb_test "gu (print (make-value $max #:type (arch-${name}-type arch)))" \
+	"= $max" "test make-value $name $size max"
+    gdb_test "gu (print (make-value $min #:type (arch-${name}-type arch)))" \
+	"= $min" "test make-value $name $size min"
+    gdb_test "gu (print (make-value $umax #:type (arch-${uname}-type arch)))" \
+	"= $umax" "test make-value $uname $size umax"
+
+    gdb_test "gu (print (make-value (+ $max 1) #:type (arch-${name}-type arch)))" \
+	"ERROR.*Out of range.*" "test make-value $name $size max+1"
+    gdb_test "gu (print (make-value (- $min 1) #:type (arch-${name}-type arch)))" \
+	"ERROR.*Out of range.*" "test make-value $name $size min-1"
+    gdb_test "gu (print (make-value (+ $umax 1) #:type (arch-${uname}-type arch)))" \
+	"ERROR.*Out of range.*" "test make-value $uname $size umax+1"
+}
+
+proc test_value_numeric_ranges {} {
+    # We can't assume anything about sizeof (int), etc. on the target.
+    # Keep it simple for now, this will cover everything important for
+    # the major targets.
+    set int_size [get_sizeof "int" 0]
+    set long_size [get_sizeof "long" 0]
+    gdb_test_no_output "gu (define arch (current-arch))"
+
+    if { $int_size == 4 } {
+	test_make_int_value int 32
+    }
+    if { $long_size == 8} {
+	test_make_int_value long 64
+    }
+    gdb_test "gu (print (value-type (make-value (ash 1 64))))" \
+	"ERROR:.*value not a number representable.*" \
+	"test make-value, number too large"
+
+    foreach size { 8 16 32 } {
+	test_make_typed_int_value $size
+    }
+    if { $long_size == 8 } {
+	test_make_typed_int_value 64
+    }
+}
+
+proc test_value_boolean {} {
+    # Note: Boolean values print as 0,1 because they are printed in the
+    # current language (in this case C).
+
+    gdb_test "gu (print (make-value #t))" "= 1" "create boolean true"
+    gdb_test "gu (print (make-value #f))" "= 0" "create boolean false"
+
+    gdb_test "gu (print (value-not (make-value #t)))" \
+	"= 0" "not true"
+    gdb_test "gu (print (value-not (make-value #f)))" \
+	"= 1" "not false"
+
+    gdb_test "gu (raw-print (make-value #t))" \
+	"#<gdb:value 1>" "verify type of boolean"
+}
+
+proc test_value_compare {} {
+    gdb_test "gu (print (value<? 1 1))" \
+	"#f" "less than, equal"
+    gdb_test "gu (print (value<? 1 2))" \
+	"#t" "less than, less"
+    gdb_test "gu (print (value<? 2 1))" \
+	"#f" "less than, greater"
+
+    gdb_test "gu (print (value<=? 1 1))" \
+	"#t" "less or equal, equal"
+    gdb_test "gu (print (value<=? 1 2))" \
+	"#t" "less or equal, less"
+    gdb_test "gu (print (value<=? 2 1))" \
+	"#f" "less or equal, greater"
+
+    gdb_test "gu (print (value=? 1 1))" \
+	"#t" "equality"
+    gdb_test "gu (print (value=? 1 2))" \
+	"#f" "inequality"
+    gdb_test "gu (print (value=? (make-value 1) 1.0))" \
+	"#t" "equality of gdb:value with Guile value"
+    gdb_test "gu (print (value=? (make-value 1) 2))" \
+	"#f" "inequality of gdb:value with Guile value"
+
+    gdb_test "gu (print (value>? 1 1))" \
+	"#f" "greater than, equal"
+    gdb_test "gu (print (value>? 1 2))" \
+	"#f" "greater than, less"
+    gdb_test "gu (print (value>? 2 1))" \
+	"#t" "greater than, greater"
+
+    gdb_test "gu (print (value>=? 1 1))" \
+	"#t" "greater or equal, equal"
+    gdb_test "gu (print (value>=? 1 2))" \
+	"#f" "greater or equal, less"
+    gdb_test "gu (print (value>=? 2 1))" \
+	"#t" "greater or equal, greater"
+}
+
+if {[prepare_for_testing $testfile.exp $testfile $srcfile {debug c}]} {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+   return
+}
+
+test_value_numeric_ops
+test_value_numeric_ranges
+test_value_boolean
+test_value_compare
diff --git a/gdb/testsuite/gdb.guile/scm-objfile-script-gdb.in b/gdb/testsuite/gdb.guile/scm-objfile-script-gdb.in
new file mode 100644
index 0000000..e576721
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile-script-gdb.in
@@ -0,0 +1,55 @@
+;; Copyright (C) 2011-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/>.
+
+;; This file is part of the GDB testsuite.
+
+(use-modules (gdb) (gdb printing))
+
+(define (make-pp_ss-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (let ((a (value-field val "a"))
+	   (b (value-field val "b")))
+       (format #f "a=<~A> b=<~A>" a b)))
+   #f))
+
+(define (get-type-for-printing val)
+  "Return type of val, stripping away typedefs, etc."
+  (let ((type (value-type val)))
+    (if (= (type-code type) TYPE_CODE_REF)
+	(set! type (type-target type)))
+    (type-strip-typedefs (type-unqualified type))))
+
+(define (make-pretty-printer-dict)
+  (let ((dict (make-hash-table)))
+    (hash-set! dict "struct ss" make-pp_ss-printer)
+    (hash-set! dict "ss" make-pp_ss-printer)
+    dict))
+
+(define *pretty-printer*
+ (make-pretty-printer
+  "pretty-printer-test"
+  (let ((pretty-printers-dict (make-pretty-printer-dict)))
+    (lambda (matcher val)
+      "Look-up and return a pretty-printer that can print val."
+      (let ((type (get-type-for-printing val)))
+	(let ((typename (type-tag type)))
+	  (if typename
+	      (let ((printer-maker (hash-ref pretty-printers-dict typename)))
+		(and printer-maker (printer-maker val)))
+	      #f)))))))
+
+(append-pretty-printer! #f *pretty-printer*)
diff --git a/gdb/testsuite/gdb.guile/scm-objfile-script.c b/gdb/testsuite/gdb.guile/scm-objfile-script.c
new file mode 100644
index 0000000..10f4776
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile-script.c
@@ -0,0 +1,39 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2011-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/>.  */
+
+struct ss
+{
+  int a;
+  int b;
+};
+
+void
+init_ss (struct ss *s, int a, int b)
+{
+  s->a = a;
+  s->b = b;
+}
+
+int
+main ()
+{
+  struct ss ss;
+
+  init_ss (&ss, 1, 2);
+
+  return 0;      /* break to inspect struct and union */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-objfile-script.exp b/gdb/testsuite/gdb.guile/scm-objfile-script.exp
new file mode 100644
index 0000000..65d0c44
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile-script.exp
@@ -0,0 +1,57 @@
+# Copyright (C) 2011-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests automagic loading of -gdb.scm scripts.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if {[build_executable $testfile.exp $testfile $srcfile debug] == -1} {
+    return
+}
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+# Make the -gdb.scm script available to gdb, it is automagically loaded by gdb.
+# Care is taken to put it in the same directory as the binary so that
+# gdb will find it.
+set remote_guile_file [remote_download host \
+			   ${srcdir}/${subdir}/${testfile}-gdb.in \
+			   [standard_output_file ${testfile}-gdb.scm]]
+
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_test_no_output "set auto-load safe-path ${remote_guile_file}" \
+    "set auto-load safe-path"
+gdb_load ${binfile}
+
+# Verify gdb loaded the script.
+gdb_test "info auto-load guile-scripts" "Yes.*/${testfile}-gdb.scm.*"
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_test "b [gdb_get_line_number {break to inspect} ${testfile}.c ]" \
+    ".*Breakpoint.*"
+gdb_test "continue" ".*Breakpoint.*"
+
+gdb_test "print ss" " = a=<1> b=<2>"
diff --git a/gdb/testsuite/gdb.guile/scm-objfile.c b/gdb/testsuite/gdb.guile/scm-objfile.c
new file mode 100644
index 0000000..dbdc9b3
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile.c
@@ -0,0 +1,23 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2011-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/>.  */
+
+int
+main ()
+{
+  int some_var = 0;
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-objfile.exp b/gdb/testsuite/gdb.guile/scm-objfile.exp
new file mode 100644
index 0000000..70da488
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile.exp
@@ -0,0 +1,57 @@
+# Copyright (C) 2011-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the objfile support in Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+    fail "Can't run to main"
+    return
+}
+
+gdb_scm_test_silent_cmd "gu (define sym (lookup-symbol \"some_var\"))" \
+    "Find a symbol in objfile"
+gdb_scm_test_silent_cmd "gu (define objfile (symtab-objfile (symbol-symtab (car sym))))" \
+    "Get backing object file"
+
+gdb_test "gu (print (objfile-filename objfile))" \
+    ".*scm-objfile.*" "Get objfile filename"
+gdb_test "gu (print (objfile-valid? objfile))" \
+    "#t" "Get objfile validity"
+
+gdb_test "gu (print (->bool (or-map (lambda (o) (string-contains (objfile-filename o) \"scm-objfile\")) (objfiles))))" \
+    "= #t" "scm-objfile in objfile list"
+
+gdb_test "gu (print (objfile-pretty-printers objfile))" \
+    "= \\(\\)"
+
+gdb_test "guile (set-objfile-pretty-printers! objfile 0)" \
+    "ERROR: .*: Wrong type argument in position 2 \\(expecting list\\): 0.*"
+
+# Do this last.
+gdb_unload
+gdb_test "gu (print (objfile-valid? objfile))" \
+    "#f" "Get objfile validity after unload"
diff --git a/gdb/testsuite/gdb.guile/scm-ports.exp b/gdb/testsuite/gdb.guile/scm-ports.exp
new file mode 100644
index 0000000..ceb9a5f
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-ports.exp
@@ -0,0 +1,37 @@
+# Copyright (C) 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests GDB provided ports.
+
+load_lib gdb-guile.exp
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+gdb_reinitialize_dir $srcdir/$subdir
+
+gdb_install_guile_utils
+gdb_install_guile_module
+
+gdb_test "guile (print (stdio-port? 42))" "= #f"
+gdb_test "guile (print (stdio-port? (%make-void-port \"r\")))" "= #f"
+gdb_test "guile (print (stdio-port? (input-port)))" "= #t"
+gdb_test "guile (print (stdio-port? (output-port)))" "= #t"
+gdb_test "guile (print (stdio-port? (error-port)))" "= #t"
diff --git a/gdb/testsuite/gdb.guile/scm-pretty-print.c b/gdb/testsuite/gdb.guile/scm-pretty-print.c
new file mode 100644
index 0000000..0fd05f5
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-pretty-print.c
@@ -0,0 +1,353 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2008-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/>.  */
+
+#include <string.h>
+
+struct s
+{
+  int a;
+  int *b;
+};
+
+struct ss
+{
+  struct s a;
+  struct s b;
+};
+
+struct arraystruct
+{
+  int y;
+  struct s x[2];
+};
+
+struct ns {
+  const char *null_str;
+  int length;
+};
+
+struct lazystring {
+  const char *lazy_str;
+};
+
+struct hint_error {
+  int x;
+};
+
+struct children_as_list {
+  int x;
+};
+
+#ifdef __cplusplus
+struct S : public s {
+  int zs;
+};
+
+struct SS {
+  int zss;
+  S s;
+};
+
+struct SSS
+{
+  SSS (int x, const S& r);
+  int a;
+  const S &b;
+};
+SSS::SSS (int x, const S& r) : a(x), b(r) { }
+
+class VirtualTest 
+{ 
+ private: 
+  int value; 
+
+ public: 
+  VirtualTest () 
+    { 
+      value = 1;
+    } 
+};
+
+class Vbase1 : public virtual VirtualTest { };
+class Vbase2 : public virtual VirtualTest { };
+class Vbase3 : public virtual VirtualTest { };
+
+class Derived : public Vbase1, public Vbase2, public Vbase3
+{ 
+ private: 
+  int value; 
+  
+ public:
+  Derived () 
+    { 
+      value = 2; 
+    }
+};
+
+class Fake
+{
+  int sname;
+  
+ public:
+  Fake (const int name = 0):
+  sname (name)
+  {
+  }
+};
+#endif
+
+struct substruct {
+  int a;
+  int b;
+};
+
+struct outerstruct {
+  struct substruct s;
+  int x;
+};
+
+struct outerstruct
+substruct_test (void)
+{
+  struct outerstruct outer;
+  outer.s.a = 0;
+  outer.s.b = 0;
+  outer.x = 0;
+
+  outer.s.a = 3;		/* MI outer breakpoint here */
+
+  return outer;  
+}
+
+typedef struct string_repr
+{
+  struct whybother
+  {
+    const char *contents;
+  } whybother;
+} string;
+
+/* This lets us avoid malloc.  */
+int array[100];
+int narray[10];
+
+struct justchildren
+{
+  int len;
+  int *elements;
+};
+
+typedef struct justchildren nostring_type;
+
+struct memory_error
+{
+  const char *s;
+};
+
+struct container
+{
+  string name;
+  int len;
+  int *elements;
+};
+
+typedef struct container zzz_type;
+
+string
+make_string (const char *s)
+{
+  string result;
+  result.whybother.contents = s;
+  return result;
+}
+
+zzz_type
+make_container (const char *s)
+{
+  zzz_type result;
+
+  result.name = make_string (s);
+  result.len = 0;
+  result.elements = 0;
+
+  return result;
+}
+
+void
+add_item (zzz_type *c, int val)
+{
+  if (c->len == 0)
+    c->elements = array;
+  c->elements[c->len] = val;
+  ++c->len;
+}
+
+void
+set_item(zzz_type *c, int i, int val)
+{
+  if (i < c->len)
+    c->elements[i] = val;
+}
+
+void init_s(struct s *s, int a)
+{
+  s->a = a;
+  s->b = &s->a;
+}
+
+void init_ss(struct ss *s, int a, int b)
+{
+  init_s(&s->a, a);
+  init_s(&s->b, b);
+}
+
+void do_nothing(void)
+{
+  int c;
+
+  c = 23;			/* Another MI breakpoint */
+}
+
+struct nullstr
+{
+  char *s;
+};
+
+struct string_repr string_1 = { { "one" } };
+struct string_repr string_2 = { { "two" } };
+
+static int
+eval_func (int p1, int p2, int p3, int p4, int p5, int p6, int p7, int p8)
+{
+  return p1;
+}
+
+static void
+eval_sub (void)
+{
+  struct eval_type_s { int x; } eval1 = { 1 }, eval2 = { 2 }, eval3 = { 3 },
+				eval4 = { 4 }, eval5 = { 5 }, eval6 = { 6 },
+				eval7 = { 7 }, eval8 = { 8 }, eval9 = { 9 };
+
+  eval1.x++; /* eval-break */
+}
+
+static void
+bug_14741()
+{
+  zzz_type c = make_container ("bug_14741");
+  add_item (&c, 71);
+  set_item(&c, 0, 42); /* breakpoint bug 14741 */
+  set_item(&c, 0, 5);
+}
+
+int
+main ()
+{
+  struct ss  ss;
+  struct ss  ssa[2];
+  struct arraystruct arraystruct;
+  string x = make_string ("this is x");
+  zzz_type c = make_container ("container");
+  zzz_type c2 = make_container ("container2");
+  const struct string_repr cstring = { { "const string" } };
+  /* Clearing by being `static' could invoke an other GDB C++ bug.  */
+  struct nullstr nullstr;
+  nostring_type nstype, nstype2;
+  struct memory_error me;
+  struct ns ns, ns2;
+  struct lazystring estring, estring2;
+  struct hint_error hint_error;
+  struct children_as_list children_as_list;
+
+  nstype.elements = narray;
+  nstype.len = 0;
+
+  me.s = "blah";
+
+  init_ss(&ss, 1, 2);
+  init_ss(ssa+0, 3, 4);
+  init_ss(ssa+1, 5, 6);
+  memset (&nullstr, 0, sizeof nullstr);
+
+  arraystruct.y = 7;
+  init_s (&arraystruct.x[0], 23);
+  init_s (&arraystruct.x[1], 24);
+
+  ns.null_str = "embedded\0null\0string";
+  ns.length = 20;
+
+  /* Make a "corrupted" string.  */
+  ns2.null_str = NULL;
+  ns2.length = 20;
+
+  estring.lazy_str = "embedded x\201\202\203\204" ;
+
+  /* Incomplete UTF-8, but ok Latin-1.  */
+  estring2.lazy_str = "embedded x\302";
+
+#ifdef __cplusplus
+  S cps;
+
+  cps.zs = 7;
+  init_s(&cps, 8);
+
+  SS cpss;
+  cpss.zss = 9;
+  init_s(&cpss.s, 10);
+
+  SS cpssa[2];
+  cpssa[0].zss = 11;
+  init_s(&cpssa[0].s, 12);
+  cpssa[1].zss = 13;
+  init_s(&cpssa[1].s, 14);
+
+  SSS sss(15, cps);
+
+  SSS& ref (sss);
+
+  Derived derived;
+  
+  Fake fake (42);
+#endif
+
+  add_item (&c, 23);		/* MI breakpoint here */
+  add_item (&c, 72);
+
+#ifdef MI
+  add_item (&c, 1011);
+  c.elements[0] = 1023;
+  c.elements[0] = 2323;
+
+  add_item (&c2, 2222);
+  add_item (&c2, 3333);
+
+  substruct_test ();
+  do_nothing ();
+#endif
+
+  nstype.elements[0] = 7;
+  nstype.elements[1] = 42;
+  nstype.len = 2;
+  
+  nstype2 = nstype;
+
+  eval_sub ();
+
+  bug_14741();      /* break to inspect struct and union */
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-pretty-print.exp b/gdb/testsuite/gdb.guile/scm-pretty-print.exp
new file mode 100644
index 0000000..cd3ae95
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-pretty-print.exp
@@ -0,0 +1,148 @@
+# Copyright (C) 2008-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests Guile-based pretty-printing for the CLI.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+proc run_lang_tests {exefile lang} {
+    global srcdir subdir srcfile testfile hex
+    if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${exefile}" executable "debug $lang"] != "" } {
+	untested "Couldn't compile ${srcfile} in $lang mode"
+	return
+    }
+
+    set nl "\[\r\n\]+"
+
+    # Start with a fresh gdb.
+    gdb_exit
+    gdb_start
+    gdb_reinitialize_dir $srcdir/$subdir
+    gdb_load ${exefile}
+
+    if ![gdb_guile_runto_main] {
+	return
+    }
+
+    gdb_test_no_output "set print pretty on"
+
+    gdb_test "b [gdb_get_line_number {break to inspect} ${testfile}.c ]" \
+	".*Breakpoint.*"
+    gdb_test "continue" ".*Breakpoint.*"
+
+    set remote_scheme_file [gdb_remote_download host \
+				${srcdir}/${subdir}/${testfile}.scm]
+
+    gdb_scm_load_file ${remote_scheme_file}
+
+    gdb_test "print ss" " = a=<a=<1> b=<$hex>> b=<a=<2> b=<$hex>>"
+    gdb_test "print ssa\[1\]" " = a=<a=<5> b=<$hex>> b=<a=<6> b=<$hex>>"
+    gdb_test "print ssa" " = {a=<a=<3> b=<$hex>> b=<a=<4> b=<$hex>>, a=<a=<5> b=<$hex>> b=<a=<6> b=<$hex>>}"
+
+    gdb_test "print arraystruct" " = {$nl *y = 7, *$nl *x = {a=<23> b=<$hex>, a=<24> b=<$hex>} *$nl *}"
+
+    if {$lang == "c++"} {
+	gdb_test "print cps" "= a=<8> b=<$hex>"
+	gdb_test "print cpss" " = {$nl *zss = 9, *$nl *s = a=<10> b=<$hex>$nl}"
+	gdb_test "print cpssa\[0\]" " = {$nl *zss = 11, *$nl *s = a=<12> b=<$hex>$nl}"
+	gdb_test "print cpssa\[1\]" " = {$nl *zss = 13, *$nl *s = a=<14> b=<$hex>$nl}"
+	gdb_test "print cpssa" " = {{$nl *zss = 11, *$nl *s = a=<12> b=<$hex>$nl *}, {$nl *zss = 13, *$nl *s = a=<14> b=<$hex>$nl *}}"
+	gdb_test "print sss" "= a=<15> b=<a=<8> b=<$hex>>"
+	gdb_test "print ref" "= a=<15> b=<a=<8> b=<$hex>>"
+	gdb_test "print derived" \
+	    " = \{.*<Vbase1> = pp class name: Vbase1.*<Vbase2> = \{.*<VirtualTest> = pp value variable is: 1,.*members of Vbase2:.*_vptr.Vbase2 = $hex.*<Vbase3> = \{.*members of Vbase3.*members of Derived:.*value = 2.*"
+	gdb_test "print ns " "\"embedded\\\\000null\\\\000string\""
+	gdb_scm_test_silent_cmd "set print elements 3" "" 1
+	gdb_test "print ns" "emb\.\.\.."
+	gdb_scm_test_silent_cmd "set print elements 10" "" 1
+	gdb_test "print ns" "embedded\\\\000n\.\.\.."
+	gdb_scm_test_silent_cmd "set print elements 200" "" 1
+    }
+
+    gdb_test "print ns2" "<error reading variable: ERROR: Cannot access memory at address 0x0>"
+
+    gdb_test "print x" " = \"this is x\""
+    gdb_test "print cstring" " = \"const string\""
+
+    gdb_test "print estring" " = \"embedded x\\\\201\\\\202\\\\203\\\\204\""
+
+    gdb_test_no_output "guile (set! *pp-ls-encoding* \"UTF-8\")"
+    gdb_test "print estring2" "\"embedded \", <incomplete sequence \\\\302>"
+
+    gdb_test_no_output "set guile print-stack full"
+    gdb_test "print hint_error" "ERROR: Invalid display hint: 42\r\nhint_error_val"
+
+    gdb_test "print c" " = container \"container\" with 2 elements = {$nl *.0. = 23,$nl *.1. = 72$nl}"
+
+    gdb_test "print nstype" " = {$nl *.0. = 7,$nl *.1. = 42$nl}"
+
+    gdb_test_no_output "set print pretty off"
+    gdb_test "print nstype" " = {.0. = 7, .1. = 42}" \
+	"print nstype on one line"
+
+    gdb_continue_to_end
+}
+
+run_lang_tests "${binfile}" "c"
+run_lang_tests "${binfile}-cxx" "c++"
+
+# Run various other tests.
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+set remote_scheme_file [gdb_remote_download host \
+			    ${srcdir}/${subdir}/${testfile}.scm]
+
+gdb_scm_load_file ${remote_scheme_file}
+
+gdb_breakpoint [gdb_get_line_number "eval-break"]
+gdb_continue_to_breakpoint "eval-break" ".* eval-break .*"
+
+gdb_test "info locals" "eval9 = eval=<123456789>"
+
+gdb_test "b [gdb_get_line_number {break to inspect} ${testfile}.c ]" \
+    ".*Breakpoint.*"
+gdb_test "continue" ".*Breakpoint.*"
+
+gdb_test "print ss" " = a=<a=<1> b=<$hex>> b=<a=<2> b=<$hex>>" \
+    "print ss enabled #1"
+
+gdb_test_no_output "guile (disable-matcher!)"
+
+gdb_test "print ss" " = {a = {a = 1, b = $hex}, b = {a = 2, b = $hex}}" \
+    "print ss disabled"
+
+gdb_test_no_output "guile (enable-matcher!)"
+
+gdb_test "print ss" " = a=<a=<1> b=<$hex>> b=<a=<2> b=<$hex>>" \
+    "print ss enabled #2"
diff --git a/gdb/testsuite/gdb.guile/scm-pretty-print.scm b/gdb/testsuite/gdb.guile/scm-pretty-print.scm
new file mode 100644
index 0000000..a42527c
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-pretty-print.scm
@@ -0,0 +1,301 @@
+;; Copyright (C) 2008-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/>.
+
+;; This file is part of the GDB testsuite.
+;; It tests Scheme pretty printers.
+
+(use-modules (gdb) (gdb printing))
+
+(define (make-pointer-iterator pointer len)
+  (let ((next! (lambda (iter)
+		 (let* ((start (iterator-object iter))
+			(progress (iterator-progress iter))
+			(current (car progress))
+			(len (cdr progress)))
+		   (if (= current len)
+		       (end-of-iteration)
+		       (let ((pointer (value-add start current)))
+			 (set-car! progress (+ current 1))
+			 (cons (format #f "[~A]" current)
+			       (value-dereference pointer))))))))
+    (make-iterator pointer (cons 0 len) next!)))
+
+(define (make-pointer-iterator-except pointer len)
+  (let ((next! (lambda (iter)
+		 (if *exception-flag*
+		     (throw 'gdb:memory-error "hi bob"))
+		 (let* ((start (iterator-object iter))
+			(progress (iterator-progress iter))
+			(current (car progress))
+			(len (cdr progress)))
+		   (if (= current len)
+		       (end-of-iteration)
+		       (let ((pointer (value-add start current)))
+			 (set-car! progress (+ current 1))
+			 (cons (format #f "[~A]" current)
+			       (value-dereference pointer))))))))
+    (make-iterator pointer (cons 0 len) next!)))
+
+;; Test returning a <gdb:value> from a printer.
+
+(define (make-string-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (value-field (value-field val "whybother")
+		  "contents"))
+   #f))
+
+;; Test a printer with children.
+
+(define (make-container-printer val)
+  ;; This is a little different than the Python version in that if there's
+  ;; an error accessing these fields we'll throw it at matcher time instead
+  ;; of at printer time.  Done this way to explore the possibilities.
+  (let ((name (value-field val "name"))
+	(len (value-field val "len"))
+	(elements (value-field val "elements")))
+    (make-pretty-printer-worker
+     #f
+     (lambda (printer)
+       (format #f "container ~A with ~A elements"
+	       name len))
+     (lambda (printer)
+       (make-pointer-iterator elements (value->integer len))))))
+
+;; Test "array" display hint.
+
+(define (make-array-printer val)
+  (let ((name (value-field val "name"))
+	(len (value-field val "len"))
+	(elements (value-field val "elements")))
+    (make-pretty-printer-worker
+     "array"
+     (lambda (printer)
+       (format #f "array ~A with ~A elements"
+	       name len))
+     (lambda (printer)
+       (make-pointer-iterator elements (value->integer len))))))
+
+;; Flag to make no-string-container printer throw an exception.
+
+(define *exception-flag* #f)
+
+;; Test a printer where to_string returns #f.
+
+(define (make-no-string-container-printer val)
+  (let ((len (value-field val "len"))
+	(elements (value-field val "elements")))
+    (make-pretty-printer-worker
+     #f
+     (lambda (printer) #f)
+     (lambda (printer)
+       (make-pointer-iterator-except elements (value->integer len))))))
+
+(define (make-pp_s-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (let ((a (value-field val "a"))
+	   (b (value-field val "b")))
+       (if (not (value=? (value-address a) b))
+	   (error (format #f "&a(~A) != b(~A)"
+			  (value-address a) b)))
+       (format #f "a=<~A> b=<~A>" a b)))
+   #f))
+
+(define (make-pp_ss-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (let ((a (value-field val "a"))
+	   (b (value-field val "b")))
+       (format #f "a=<~A> b=<~A>" a b)))
+   #f))
+
+(define (make-pp_sss-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (let ((a (value-field val "a"))
+	   (b (value-field val "b")))
+       (format #f "a=<~A> b=<~A>" a b)))
+   #f))
+
+(define (make-pp_multiple_virtual-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (format #f "pp value variable is: ~A" (value-field val "value")))
+   #f))
+
+(define (make-pp_vbase1-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (format #f "pp class name: ~A" (type-tag (value-type val))))
+   #f))
+
+(define (make-pp_nullstr-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (value->string (value-field val "s")
+		    #:encoding (arch-charset (current-arch))))
+   #f))
+
+(define (make-pp_ns-printer val)
+  (make-pretty-printer-worker
+   "string"
+   (lambda (printer)
+     (let ((len (value-field val "length")))
+       (value->string (value-field val "null_str")
+		      #:encoding (arch-charset (current-arch))
+		      #:length (value->integer len))))
+   #f))
+
+(define *pp-ls-encoding* #f)
+
+(define (make-pp_ls-printer val)
+  (make-pretty-printer-worker
+   "string"
+   (lambda (printer)
+     (if *pp-ls-encoding*
+	 (value->lazy-string (value-field val "lazy_str")
+			     #:encoding *pp-ls-encoding*)
+	 (value->lazy-string (value-field val "lazy_str"))))
+   #f))
+
+(define (make-pp_hint_error-printer val)
+  "Use an invalid value for the display hint."
+  (make-pretty-printer-worker
+   42
+   (lambda (printer) "hint_error_val")
+   #f))
+
+(define (make-pp_children_as_list-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer) "children_as_list_val")
+   (lambda (printer) (make-list-iterator (list (cons "one" 1))))))
+
+(define (make-pp_outer-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (format #f "x = ~A" (value-field val "x")))
+   (lambda (printer)
+     (make-list-iterator (list (cons "s" (value-field val "s"))
+			       (cons "x" (value-field val "x")))))))
+
+(define (make-memory-error-string-printer val)
+  (make-pretty-printer-worker
+   "string"
+   (lambda (printer)
+     (scm-error 'gdb:memory-error "memory-error-printer"
+		"Cannot access memory." '() '()))
+   #f))
+
+(define (make-pp_eval_type-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (execute "bt" #:to-string #t)
+     (format #f "eval=<~A>"
+	     (value-print
+	      (parse-and-eval
+	       "eval_func (123456789, 2, 3, 4, 5, 6, 7, 8)"))))
+   #f))
+
+(define (get-type-for-printing val)
+  "Return type of val, stripping away typedefs, etc."
+  (let ((type (value-type val)))
+    (if (= (type-code type) TYPE_CODE_REF)
+	(set! type (type-target type)))
+    (type-strip-typedefs (type-unqualified type))))
+
+(define (disable-matcher!)
+  (set-pretty-printer-enabled! *pretty-printer* #f))
+
+(define (enable-matcher!)
+  (set-pretty-printer-enabled! *pretty-printer* #t))
+
+(define (make-pretty-printer-dict)
+  (let ((dict (make-hash-table)))
+    (hash-set! dict "struct s" make-pp_s-printer)
+    (hash-set! dict "s" make-pp_s-printer)
+    (hash-set! dict "S" make-pp_s-printer)
+
+    (hash-set! dict "struct ss" make-pp_ss-printer)
+    (hash-set! dict "ss" make-pp_ss-printer)
+    (hash-set! dict "const S &" make-pp_s-printer)
+    (hash-set! dict "SSS" make-pp_sss-printer)
+    
+    (hash-set! dict "VirtualTest" make-pp_multiple_virtual-printer)
+    (hash-set! dict "Vbase1" make-pp_vbase1-printer)
+
+    (hash-set! dict "struct nullstr" make-pp_nullstr-printer)
+    (hash-set! dict "nullstr" make-pp_nullstr-printer)
+    
+    ;; Note that we purposely omit the typedef names here.
+    ;; Printer lookup is based on canonical name.
+    ;; However, we do need both tagged and untagged variants, to handle
+    ;; both the C and C++ cases.
+    (hash-set! dict "struct string_repr" make-string-printer)
+    (hash-set! dict "struct container" make-container-printer)
+    (hash-set! dict "struct justchildren" make-no-string-container-printer)
+    (hash-set! dict "string_repr" make-string-printer)
+    (hash-set! dict "container" make-container-printer)
+    (hash-set! dict "justchildren" make-no-string-container-printer)
+
+    (hash-set! dict "struct ns" make-pp_ns-printer)
+    (hash-set! dict "ns" make-pp_ns-printer)
+
+    (hash-set! dict "struct lazystring" make-pp_ls-printer)
+    (hash-set! dict "lazystring" make-pp_ls-printer)
+
+    (hash-set! dict "struct outerstruct" make-pp_outer-printer)
+    (hash-set! dict "outerstruct" make-pp_outer-printer)
+
+    (hash-set! dict "struct hint_error" make-pp_hint_error-printer)
+    (hash-set! dict "hint_error" make-pp_hint_error-printer)
+
+    (hash-set! dict "struct children_as_list"
+	       make-pp_children_as_list-printer)
+    (hash-set! dict "children_as_list" make-pp_children_as_list-printer)
+
+    (hash-set! dict "memory_error" make-memory-error-string-printer)
+
+    (hash-set! dict "eval_type_s" make-pp_eval_type-printer)
+
+    dict))
+
+;; This is one way to register a printer that is composed of several
+;; subprinters, but there's no way to disable or list individual subprinters.
+
+(define *pretty-printer*
+ (make-pretty-printer
+  "pretty-printer-test"
+  (let ((pretty-printers-dict (make-pretty-printer-dict)))
+    (lambda (matcher val)
+      "Look-up and return a pretty-printer that can print val."
+      (let ((type (get-type-for-printing val)))
+	(let ((typename (type-tag type)))
+	  (if typename
+	      (let ((printer-maker (hash-ref pretty-printers-dict typename)))
+		(and printer-maker (printer-maker val)))
+	      #f)))))))
+
+(append-pretty-printer! #f *pretty-printer*)
diff --git a/gdb/testsuite/gdb.guile/scm-section-script.c b/gdb/testsuite/gdb.guile/scm-section-script.c
new file mode 100644
index 0000000..8a1ede9
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-section-script.c
@@ -0,0 +1,55 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+#include "symcat.h"
+#include "gdb/section-scripts.h"
+
+/* Put the path to the pretty-printer script in .debug_gdb_scripts so
+   gdb will automagically loaded it.  */
+
+#define DEFINE_GDB_SCRIPT(script_name) \
+  asm("\
+.pushsection \".debug_gdb_scripts\", \"MS\",@progbits,1\n\
+.byte " XSTRING (SECTION_SCRIPT_ID_SCHEME_FILE) "\n\
+.asciz \"" script_name "\"\n\
+.popsection \n\
+");
+
+DEFINE_GDB_SCRIPT (SCRIPT_FILE)
+
+struct ss
+{
+  int a;
+  int b;
+};
+
+void
+init_ss (struct ss *s, int a, int b)
+{
+  s->a = a;
+  s->b = b;
+}
+
+int
+main ()
+{
+  struct ss ss;
+
+  init_ss (&ss, 1, 2);
+
+  return 0;      /* break to inspect struct and union */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-section-script.exp b/gdb/testsuite/gdb.guile/scm-section-script.exp
new file mode 100644
index 0000000..0c5e489
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-section-script.exp
@@ -0,0 +1,80 @@
+# 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/>.
+
+# This file is part of the GDB testsuite.  It tests automagic loading of
+# scripts specified in the .debug_gdb_scripts section.
+
+# This test can only be run on targets which support ELF and use gas.
+# For now pick a sampling of likely targets.
+if {![istarget *-*-linux*]
+    && ![istarget *-*-gnu*]
+    && ![istarget *-*-elf*]
+    && ![istarget *-*-openbsd*]
+    && ![istarget arm*-*-eabi*]
+    && ![istarget arm*-*-symbianelf*]
+    && ![istarget powerpc-*-eabi*]} {
+    verbose "Skipping scm-section-script.exp because of lack of support."
+    return
+}
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+# Make this available to gdb before the program starts, it is
+# automagically loaded by gdb.
+# Give the file a new name so we don't clobber the real one if
+# objfile == srcdir.
+# We also need to do this before compiling the program because the name
+# of the script file is encoded in the binary.
+# FIXME: Can we get gdb_remote_download to call standard_output_file for us?
+set remote_guile_file [gdb_remote_download host \
+			   ${srcdir}/${subdir}/${testfile}.scm \
+			   ${subdir}/t-${testfile}.scm]
+
+if {[build_executable $testfile.exp $testfile $srcfile \
+	[list debug "additional_flags=-I${srcdir}/../../include -DSCRIPT_FILE=\"$remote_guile_file\""]] == -1} {
+    return
+}
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_test_no_output "set auto-load safe-path ${remote_guile_file}" \
+    "set auto-load safe-path"
+gdb_load ${binfile}
+
+# Verify gdb loaded the script.
+gdb_test "info auto-load guile-scripts" "Yes.*${testfile}.scm.*"
+# Again, with a regexp this time.
+gdb_test "info auto-load guile-scripts ${testfile}" "Yes.*${testfile}.scm.*"
+# Again, with a regexp that matches no scripts.
+gdb_test "info auto-load guile-scripts no-script-matches-this" \
+  "No auto-load scripts matching no-script-matches-this."
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_test "b [gdb_get_line_number {break to inspect} ${testfile}.c ]" \
+    ".*Breakpoint.*"
+gdb_test "continue" ".*Breakpoint.*"
+
+gdb_test "print ss" " = a=<1> b=<2>"
diff --git a/gdb/testsuite/gdb.guile/scm-section-script.scm b/gdb/testsuite/gdb.guile/scm-section-script.scm
new file mode 100644
index 0000000..cd31db9
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-section-script.scm
@@ -0,0 +1,55 @@
+;; 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/>.
+
+;; This file is part of the GDB testsuite.
+
+(use-modules (gdb) (gdb printing))
+
+(define (make-pp_ss-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (let ((a (value-field val "a"))
+	   (b (value-field val "b")))
+       (format #f "a=<~A> b=<~A>" a b)))
+   #f))
+
+(define (get-type-for-printing val)
+  "Return type of val, stripping away typedefs, etc."
+  (let ((type (value-type val)))
+    (if (= (type-code type) TYPE_CODE_REF)
+	(set! type (type-target type)))
+    (type-strip-typedefs (type-unqualified type))))
+
+(define (make-pretty-printer-dict)
+  (let ((dict (make-hash-table)))
+    (hash-set! dict "struct ss" make-pp_ss-printer)
+    (hash-set! dict "ss" make-pp_ss-printer)
+    dict))
+
+(define *pretty-printer*
+ (make-pretty-printer
+  "pretty-printer-test"
+  (let ((pretty-printers-dict (make-pretty-printer-dict)))
+    (lambda (matcher val)
+      "Look-up and return a pretty-printer that can print val."
+      (let ((type (get-type-for-printing val)))
+	(let ((typename (type-tag type)))
+	  (if typename
+	      (let ((printer-maker (hash-ref pretty-printers-dict typename)))
+		(and printer-maker (printer-maker val)))
+	      #f)))))))
+
+(append-pretty-printer! #f *pretty-printer*)
diff --git a/gdb/testsuite/gdb.guile/scm-symbol.c b/gdb/testsuite/gdb.guile/scm-symbol.c
new file mode 100644
index 0000000..3201365
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-symbol.c
@@ -0,0 +1,69 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+#ifdef __cplusplus
+class SimpleClass
+{
+ private:
+  int i;
+
+ public:
+  void seti (int arg)
+  {
+    i = arg;
+  }
+
+  int valueofi (void)
+  {
+    return i; /* Break in class. */
+  }
+};
+#endif
+
+int qq = 72;			/* line of qq */
+
+int func (int arg)
+{
+  int i = 2;
+  i = i * arg; /* Block break here.  */
+  return arg;
+}
+
+struct simple_struct
+{
+  int a;
+};
+
+int main (int argc, char *argv[])
+{
+#ifdef __cplusplus
+  SimpleClass sclass;
+#endif
+  int a = 0;
+  int result;
+  struct simple_struct ss = { 10 };
+  enum tag {one, two, three};
+  enum tag t = one;
+
+  result = func (42);
+
+#ifdef __cplusplus
+  sclass.seti (42);
+  sclass.valueofi ();
+#endif
+  return 0; /* Break at end.  */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-symbol.exp b/gdb/testsuite/gdb.guile/scm-symbol.exp
new file mode 100644
index 0000000..5d25c53
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-symbol.exp
@@ -0,0 +1,196 @@
+# 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the mechanism exposing symbols to Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if {[prepare_for_testing $testfile.exp $testfile $srcfile debug]} {
+    return -1
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+# These tests are done before we call gdb_guile_runto_main so we have to
+# import the gdb module ourselves.
+gdb_install_guile_utils
+gdb_install_guile_module
+
+# Test looking up a global symbol before we runto_main as this is the
+# point where we don't have a current frame, and we don't want to
+# require one.
+gdb_scm_test_silent_cmd "guile (define main-func (lookup-global-symbol \"main\"))" \
+    "lookup main"
+gdb_test "guile (print (symbol-function? main-func))" \
+    "= #t" "test (symbol-function? main)"
+gdb_test "guile (print (lookup-global-symbol \"junk\"))" \
+    "= #f" "test (lookup-global-symbol junk)"
+
+gdb_test "guile (print (symbol-value main-func))" \
+    "= {int \\(int, char \[*\]\[*\]\\)} $hex \\<main\\>" "print value of main"
+
+set qq_line [gdb_get_line_number "line of qq"]
+gdb_scm_test_silent_cmd "guile (define qq-var (lookup-global-symbol \"qq\"))" \
+    "lookup qq"
+gdb_test "guile (print (symbol-line qq-var))" \
+    "= $qq_line" "print line number of qq"
+gdb_test "guile (print (symbol-value qq-var))" \
+    "= 72" "print value of qq"
+gdb_test "guile (print (symbol-needs-frame? qq-var))" \
+    "= #f" "print whether qq needs a frame"
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+# Test symbol eq? and equal?.
+gdb_test "guile (print (eq? (lookup-global-symbol \"main\") (lookup-global-symbol \"main\")))" \
+    "= #t"
+gdb_test "guile (print (equal? (lookup-global-symbol \"main\") (lookup-global-symbol \"main\")))" \
+    "= #t"
+
+gdb_breakpoint [gdb_get_line_number "Block break here."]
+gdb_continue_to_breakpoint "Block break here."
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
+    "get frame at block break"
+gdb_scm_test_silent_cmd "guile (define block (frame-block frame))" \
+    "get block at block break"
+
+# Test symbol-argument?.
+gdb_scm_test_silent_cmd "guile (define arg (car (lookup-symbol \"arg\")))" \
+    "get variable arg"
+gdb_test "guile (print (symbol-variable? arg))" "= #f"
+gdb_test "guile (print (symbol-constant? arg))" "= #f"
+gdb_test "guile (print (symbol-argument? arg))" "= #t"
+gdb_test "guile (print (symbol-function? arg))" "= #f"
+
+# Test symbol-function?.
+gdb_scm_test_silent_cmd "guile (define func (block-function block))" \
+    "get block function"
+gdb_test "guile (print (symbol-variable? func))" "= #f"
+gdb_test "guile (print (symbol-constant? func))" "= #f"
+gdb_test "guile (print (symbol-argument? func))" "= #f"
+gdb_test "guile (print (symbol-function? func))" "= #t"
+
+# Test attributes of func.
+gdb_test "guile (print (symbol-name func))" "func"
+gdb_test "guile (print (symbol-print-name func))" "func"
+gdb_test "guile (print (symbol-linkage-name func))" "func"
+gdb_test "guile (print (= (symbol-addr-class func) SYMBOL_LOC_BLOCK))" "= #t"
+
+gdb_breakpoint [gdb_get_line_number "Break at end."]
+gdb_continue_to_breakpoint "Break at end."
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
+    "get frame at end"
+
+# Test symbol-variable?.
+gdb_scm_test_silent_cmd "guile (define a (car (lookup-symbol \"a\")))" \
+    "get variable a"
+gdb_test "guile (print (symbol-variable? a))" "= #t"
+gdb_test "guile (print (symbol-constant? a))" "= #f"
+gdb_test "guile (print (symbol-argument? a))" "= #f"
+gdb_test "guile (print (symbol-function? a))" "= #f"
+
+# Test attributes of a.
+gdb_test "guile (print (= (symbol-addr-class a) SYMBOL_LOC_COMPUTED))" "= #t"
+
+gdb_test "guile (print (symbol-value a))" \
+    "ERROR: Symbol requires a frame to compute its value.*"\
+    "try to print value of a without a frame"
+gdb_test "guile (print (symbol-value a #:frame frame))" \
+    "= 0" "print value of a"
+gdb_test "guile (print (symbol-needs-frame? a))" \
+    "= #t" "print whether a needs a frame"
+
+# Test symbol-constant?.
+gdb_scm_test_silent_cmd "guile (define t (car (lookup-symbol \"one\")))" \
+    "get constant t"
+gdb_test "guile (print (symbol-variable? t))" "= #f"
+gdb_test "guile (print (symbol-constant? t))" "= #t"
+gdb_test "guile (print (symbol-argument? t))" "= #f"
+gdb_test "guile (print (symbol-function? t))" "= #f"
+
+# Test attributes of t.
+gdb_test "guile (print (= (symbol-addr-class t) SYMBOL_LOC_CONST))" "= #t"
+
+# Test type attribute.
+gdb_test "guile (print (symbol-type t))" "= enum tag"
+
+# Test symtab attribute.
+gdb_test "guile (print (symbol-symtab t))" "= #<gdb:symtab .*gdb.guile/scm-symbol.c>"
+
+# C++ tests
+# Recompile binary.
+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}-cxx" executable "debug c++"] != "" } {
+    untested "Couldn't compile ${srcfile} in c++ mode"
+    return -1
+}
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}-cxx
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_breakpoint [gdb_get_line_number "Break in class."]
+gdb_continue_to_breakpoint "Break in class."
+
+gdb_scm_test_silent_cmd "guile (define cplusframe (selected-frame))" \
+    "get frame at class"
+gdb_scm_test_silent_cmd "guile (define cplusfunc (block-function (frame-block cplusframe)))" \
+    "get function at class"
+
+gdb_test "guile (print (symbol-variable? cplusfunc))" "= #f"
+gdb_test "guile (print (symbol-constant? cplusfunc))" "= #f"
+gdb_test "guile (print (symbol-argument? cplusfunc))" "= #f"
+gdb_test "guile (print (symbol-function? cplusfunc))" "= #t"
+
+gdb_test "guile (print (symbol-name cplusfunc))" \
+    "= SimpleClass::valueofi().*" "test method.name"
+gdb_test "guile (print (symbol-print-name cplusfunc))" \
+    "= SimpleClass::valueofi().*" "test method.print_name"
+# FIXME: GDB is broken here and we're verifying broken behaviour.
+# (linkage-name should be the mangled name)
+gdb_test "guile (print (symbol-linkage-name cplusfunc))" \
+    "SimpleClass::valueofi().*" "test method.linkage_name"
+gdb_test "guile (print (= (symbol-addr-class cplusfunc) SYMBOL_LOC_BLOCK))" "= #t"
+
+# Test is_valid when the objfile is unloaded.  This must be the last
+# test as it unloads the object file in GDB.
+# Start with a fresh gdb.
+clean_restart ${testfile}
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_breakpoint [gdb_get_line_number "Break at end."]
+gdb_continue_to_breakpoint "Break at end."
+gdb_scm_test_silent_cmd "guile (define a (car (lookup-symbol \"a\")))" \
+    "get variable a for unload"
+gdb_test "guile (print (symbol-valid? a))" \
+    "= #t" "test symbol validity pre-unload"
+delete_breakpoints
+gdb_unload
+gdb_test "guile (print (symbol-valid? a))" \
+    "= #f" "test symbol validity post-unload"
+gdb_test_no_output "guile (set! a #f) (gc)" "test symbol destructor"
diff --git a/gdb/testsuite/gdb.guile/scm-symtab-2.c b/gdb/testsuite/gdb.guile/scm-symtab-2.c
new file mode 100644
index 0000000..d45aa6c
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-symtab-2.c
@@ -0,0 +1,28 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+void
+func1 ()
+{
+  return;
+}
+
+int
+func2 ()
+{
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-symtab.c b/gdb/testsuite/gdb.guile/scm-symtab.c
new file mode 100644
index 0000000..e4662cd
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-symtab.c
@@ -0,0 +1,45 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+/* In scm-symtab-2.c.  */
+extern void func1 (void);
+extern int func2 (void);
+
+struct simple_struct
+{
+  int a;
+};
+
+struct simple_struct qq;
+
+int
+func (int arg)
+{
+  int i = 2;
+  i = i * arg; /* Block break here.  */
+  return arg;
+}
+
+int
+main (int argc, char *argv[])
+{
+  qq.a = func (42);
+
+  func1 ();
+  func2 ();      /* Break at func2 call site.  */
+  return 0;      /* Break to end.  */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-symtab.exp b/gdb/testsuite/gdb.guile/scm-symtab.exp
new file mode 100644
index 0000000..4309ae6
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-symtab.exp
@@ -0,0 +1,142 @@
+# 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the Guile symbol table support.
+
+load_lib gdb-guile.exp
+
+standard_testfile scm-symtab.c scm-symtab-2.c
+
+if {[prepare_for_testing $testfile.exp $testfile \
+	 [list $srcfile $srcfile2] debug]} {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+# Setup and get the symbol table.
+set line_no [gdb_get_line_number "Block break here."]
+gdb_breakpoint $line_no
+gdb_continue_to_breakpoint "Block break here."
+gdb_scm_test_silent_cmd "guile (define frame (selected-frame))" \
+    "get frame"
+gdb_scm_test_silent_cmd "guile (define sal (frame-sal frame))" \
+    "get sal"
+gdb_scm_test_silent_cmd "guile (define symtab (sal-symtab sal))" \
+    "get symtab"
+gdb_scm_test_silent_cmd "guile (define global-block (symtab-global-block symtab))" \
+    "get global block"
+gdb_scm_test_silent_cmd "guile (define static-block (symtab-static-block symtab))" \
+    "get static block"
+
+gdb_scm_test_silent_cmd "guile (define global-symbols (map symbol-name (block-symbols global-block)))" \
+    "get global symbol names"
+gdb_scm_test_silent_cmd "guile (define static-symbols (map symbol-name (block-symbols static-block)))" \
+    "get static symbol names"
+gdb_scm_test_silent_cmd "guile (define global-isymbols '()) (define static-isymbols '())" \
+    "set up iterated symbol name lists"
+# TODO: iterated symbols
+gdb_scm_test_silent_cmd "step" "Step to the next line"
+gdb_scm_test_silent_cmd "guile (define new-pc (sal-pc (frame-sal (selected-frame))))" \
+    "get new pc"
+
+# Test sal.
+gdb_test "guile (print (sal-symtab sal))" \
+    ".*gdb.guile/scm-symtab.c.*" "Test sal-symtab"
+gdb_test "guile (print (sal-pc sal))" \
+    "${decimal}" "test sal-pc"
+gdb_test "guile (print (= (sal-last sal) (- new-pc 1)))" \
+    "#t" "test sal-last"
+gdb_test "guile (print (sal-line sal))" \
+    "$line_no" "test sal-line"
+gdb_test "guile (print (sal-valid? sal))" \
+    "#t" "test sal-valid?"
+
+# Test eq? on symtabs.
+gdb_scm_test_silent_cmd "guile (define sal1 (frame-sal frame))" \
+    "get sal1"
+gdb_scm_test_silent_cmd "guile (define sal2 (frame-sal (frame-older frame)))" \
+    "get sal2"
+gdb_test "guile (print (eq? symtab (sal-symtab sal1)))" \
+    "= #t" "test eq? of equal symtabs"
+gdb_test "guile (print (eq? symtab (sal-symtab sal2)))" \
+    "= #t" "test eq? of equal symtabs from different sals"
+gdb_test "guile (print (eq? symtab (symbol-symtab (lookup-global-symbol \"func1\"))))" \
+    "= #f" "test eq? of not-equal symtabs"
+
+# Test symbol table.
+gdb_test "guile (print (symtab-filename symtab))" \
+    ".*gdb.guile/scm-symtab.c.*" "test symtab-filename"
+gdb_test "guile (print (symtab-objfile symtab))" \
+    "#<gdb:objfile .*scm-symtab>" "test symtab-objfile"
+gdb_test "guile (print (symtab-fullname symtab))" \
+    "testsuite/gdb.guile/scm-symtab.c.*" "test symtab-fullname"
+gdb_test "guile (print (symtab-valid? symtab))" \
+    "#t" "test symtab-valid?"
+gdb_test "guile (print (->bool (member \"qq\" global-symbols)))" \
+    "#t" "test qq in global symbols"
+gdb_test "guile (print (->bool (member \"func\" global-symbols)))" \
+    "#t" "test func in global symbols"
+gdb_test "guile (print (->bool (member \"main\" global-symbols)))" \
+    "#t" "test main in global symbols"
+gdb_test "guile (print (->bool (member \"int\" static-symbols)))" \
+    "#t" "test int in static symbols"
+gdb_test "guile (print (->bool (member \"char\" static-symbols)))" \
+    "#t" "test char in static symbols"
+gdb_test "guile (print (->bool (member \"simple_struct\" static-symbols)))" \
+    "#t" "test simple_struct in static symbols"
+
+# Test is_valid when the objfile is unloaded.  This must be the last
+# test as it unloads the object file in GDB.
+gdb_unload
+gdb_test "guile (print (sal-valid? sal))" \
+    "#f" "test sal-valid? after unloading"
+gdb_test "guile (print (symtab-valid? symtab))" \
+    "#f" "test symtab-valid? after unloading"
+
+gdb_test_no_output "guile (set! sal #f)" \
+    "test sal destructor"
+gdb_test_no_output "guile (set! symtab #f)" \
+    "test symtab destructor"
+gdb_test_no_output "guile (gc)" "GC to trigger destructors"
+
+# Start with a fresh gdb.
+clean_restart ${testfile}
+
+# Test find-pc-line.
+# The following tests require execution.
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+runto [gdb_get_line_number "Break at func2 call site."]
+
+gdb_scm_test_silent_cmd "guile (define line (sal-line (frame-sal (selected-frame))))" \
+    "get line number of func2 call site"
+gdb_test "guile (print (= (sal-line (find-pc-line (frame-pc (selected-frame)))) line))" \
+    "#t" "test find-pc-line at func2 call site"
+
+gdb_scm_test_silent_cmd "step" "step into func2"
+gdb_scm_test_silent_cmd "up" "step out of func2"
+
+gdb_test "guile (print (> (sal-line (find-pc-line (frame-pc (selected-frame)))) line))" \
+    "#t" "test find-pc-line with resume address"
diff --git a/gdb/testsuite/gdb.guile/scm-type.c b/gdb/testsuite/gdb.guile/scm-type.c
new file mode 100644
index 0000000..7cee383
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-type.c
@@ -0,0 +1,77 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2009-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/>.  */
+
+struct s
+{
+  int a;
+  int b;
+};
+
+typedef struct s TS;
+TS ts;
+
+#ifdef __cplusplus
+struct C
+{
+  int c;
+  int d;
+};
+
+struct D : C
+{
+  int e;
+  int f;
+};
+
+template<typename T, int I, int C::*MP>
+struct Temargs
+{
+};
+
+Temargs<D, 23, &C::c> temvar;
+
+#endif
+
+enum E
+{ v1, v2, v3
+};
+
+struct s vec_data_1 = {1, 1};
+struct s vec_data_2 = {1, 2};
+
+int
+main ()
+{
+  int ar[2] = {1,2};
+  struct s st;
+#ifdef __cplusplus
+  C c;
+  c.c = 1;
+  c.d = 2;
+  D d;
+  d.e = 3;
+  d.f = 4;
+#endif
+  enum E e;
+  
+  st.a = 3;
+  st.b = 5;
+
+  e = v2;
+  
+  return 0;      /* break to inspect struct and array.  */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-type.exp b/gdb/testsuite/gdb.guile/scm-type.exp
new file mode 100644
index 0000000..4a3969e
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-type.exp
@@ -0,0 +1,299 @@
+# Copyright (C) 2009-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the mechanism of exposing types to Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if [get_compiler_info c++] {
+    return -1
+}
+
+# Build inferior to language specification.
+
+proc build_inferior {exefile lang} {
+    global srcdir subdir srcfile
+
+    if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${exefile}" executable "debug $lang"] != "" } {
+	untested "Couldn't compile ${srcfile} in $lang mode"
+	return -1
+    }
+    return 0
+}
+
+# Restart GDB.
+# The result is the same as gdb_guile_runto_main.
+
+proc restart_gdb {exefile} {
+    global srcdir subdir
+
+    gdb_exit
+    gdb_start
+    gdb_reinitialize_dir $srcdir/$subdir
+    gdb_load ${exefile}
+
+    if { [skip_guile_tests] } {
+	return 0
+    }
+
+    if ![gdb_guile_runto_main] {
+	return 0
+    }
+    gdb_scm_test_silent_cmd "guile (use-modules (gdb iterator))" \
+	"load iterator module"
+
+    return 1
+}
+
+# Set breakpoint and run to that breakpoint.
+
+proc runto_bp {bp} {
+    gdb_breakpoint [gdb_get_line_number $bp]
+    gdb_continue_to_breakpoint $bp
+}
+
+proc test_fields {lang} {
+    with_test_prefix "test_fields" {
+	global gdb_prompt
+
+	# fields of a typedef should still return the underlying field list
+	gdb_test "guile (print (length (type-fields (value-type (parse-and-eval \"ts\")))))" \
+	    "= 2" "$lang typedef field list"
+
+	if {$lang == "c++"} {
+	    # Test usage with a class.
+	    gdb_scm_test_silent_cmd "print c" "print value (c)"
+	    gdb_scm_test_silent_cmd "guile (define c (history-ref 0))" \
+		"get value (c) from history"
+	    gdb_scm_test_silent_cmd "guile (define fields (type-fields (value-type c)))" \
+		"get fields from c type"
+	    gdb_test "guile (print (length fields))" \
+		"= 2" "check number of fields of c"
+	    gdb_test "guile (print (field-name (car fields)))" \
+		"= c" "check class field c name"
+	    gdb_test "guile (print (field-name (cadr fields)))" \
+		"= d" "check class field d name"
+	}
+
+	# Test normal fields usage in structs.
+	gdb_scm_test_silent_cmd "print st" "print value (st)"
+	gdb_scm_test_silent_cmd "guile (define st (history-ref 0))" \
+	    "get value (st) from history"
+	gdb_scm_test_silent_cmd "guile (define st-type (value-type st))" \
+	    "get st-type"
+	gdb_scm_test_silent_cmd "guile (define fields (type-fields st-type))" \
+	    "get fields from st.type"
+	gdb_test "guile (print (length fields))" \
+	    "= 2" "check number of fields (st)"
+	gdb_test "guile (print (field-name (car fields)))" \
+	    "= a" "check structure field a name"
+	gdb_test "guile (print (field-name (cadr fields)))" \
+	    "= b" "check structure field b name"
+	gdb_test "guile (print (field-name (type-field st-type \"a\")))" \
+	    "= a" "check fields lookup by name"
+
+	# Test has-field?
+	gdb_test "guile (print (type-has-field? st-type \"b\"))" \
+	    "= #t" "check existent field"
+	gdb_test "guile (print (type-has-field? st-type \"nosuch\"))" \
+	    "= #f" "check non-existent field"
+
+	# Test Guile mapping behavior of gdb:type for structs/classes.
+	gdb_test "guile (print (type-num-fields (value-type st)))" \
+	    "= 2" "check number of fields (st) with type-num-fields"
+	gdb_scm_test_silent_cmd "guile (define fi (make-field-iterator st-type))" \
+	    "create field iterator"
+	gdb_test "guile (print (iterator-map field-bitpos fi))" \
+	    "= \\(0 32\\)" "check field iterator"
+
+	# Test rejection of mapping operations on scalar types.
+	gdb_test "guile (print (make-field-iterator (field-type (type-field st-type \"a\"))))" \
+	    "ERROR: .*: Out of range: type is not a structure, union, or enum type in position 1: .*" \
+	    "check field iterator on bad type"
+
+	# Test type-array.
+	gdb_scm_test_silent_cmd "print ar" "print value (ar)"
+	gdb_scm_test_silent_cmd "guile (define ar (history-ref 0))" \
+	    "get value (ar) from history"
+	gdb_scm_test_silent_cmd "guile (define ar0 (value-subscript ar 0))" \
+	    "define ar0"
+	gdb_test "guile (print (value-cast ar0 (type-array (value-type ar0) 1)))" \
+	    "= \\{1, 2\\}" "cast to array with one argument"
+	gdb_test "guile (print (value-cast ar0 (type-array (value-type ar0) 0 1)))" \
+	    "= \\{1, 2\\}" "cast to array with two arguments"
+
+	# Test type-vector.
+	# Note: vectors cast differently than arrays.  Here ar[0] is replicated
+	# for the size of the vector.
+	gdb_scm_test_silent_cmd "print vec_data_1" "print value (vec_data_1)"
+	gdb_scm_test_silent_cmd "guile (define vec_data_1 (history-ref 0))" \
+	    "get value (vec_data_1) from history"
+
+	gdb_scm_test_silent_cmd "print vec_data_2" "print value (vec_data_2)"
+	gdb_scm_test_silent_cmd "guile (define vec_data_2 (history-ref 0))" \
+	    "get value (vec_data_2) from history"
+
+	gdb_scm_test_silent_cmd "guile (define vec1 (value-cast vec_data_1 (type-vector (value-type ar0) 1)))" \
+	    "set vec1"
+	gdb_test "guile (print vec1)" \
+	    "= \\{1, 1\\}" "cast to vector with one argument"
+	gdb_scm_test_silent_cmd "guile (define vec2 (value-cast vec_data_1 (type-vector (value-type ar0) 0 1)))" \
+	    "set vec2"
+	gdb_test "guile (print vec2)" \
+	    "= \\{1, 1\\}" "cast to vector with two arguments"
+	gdb_test "guile (print (value=? vec1 vec2))" \
+	    "= #t"
+	gdb_scm_test_silent_cmd "guile (define vec3 (value-cast vec_data_2 (type-vector (value-type ar0) 1)))" \
+	    "set vec3"
+	gdb_test "guile (print (value=? vec1 vec3))" \
+	    "= #f"
+    }
+}
+
+proc test_equality {lang} {
+    with_test_prefix "test_equality" {
+	gdb_scm_test_silent_cmd "guile (define st (parse-and-eval \"st\"))" \
+	    "get st"
+	gdb_scm_test_silent_cmd "guile (define ar (parse-and-eval \"ar\"))" \
+	    "get ar"
+	gdb_test "guile (print (eq? (value-type st) (value-type st)))" \
+	    "= #t" "test type eq? on equal types"
+	gdb_test "guile (print (eq? (value-type st) (value-type ar)))" \
+	    "= #f" "test type eq? on not-equal types"
+	gdb_test "guile (print (equal? (value-type st) (value-type st)))" \
+	    "= #t" "test type eq? on equal types"
+	gdb_test "guile (print (equal? (value-type st) (value-type ar)))" \
+	    "= #f" "test type eq? on not-equal types"
+
+	if {$lang == "c++"} {
+	    gdb_scm_test_silent_cmd "guile (define c (parse-and-eval \"c\"))" \
+		"get c"
+	    gdb_scm_test_silent_cmd "guile (define d (parse-and-eval \"d\"))" \
+		"get d"
+	    gdb_test "guile (print (eq? (value-type c) (field-type (car (type-fields (value-type d))))))" \
+		"= #t" "test c++ type eq? on equal types"
+	    gdb_test "guile (print (eq? (value-type c) (value-type d)))" \
+		"= #f" "test c++ type eq? on not-equal types"
+	    gdb_test "guile (print (equal? (value-type c) (field-type (car (type-fields (value-type d))))))" \
+		"= #t" "test c++ type equal? on equal types"
+	    gdb_test "guile (print (equal? (value-type c) (value-type d)))" \
+		"= #f" "test c++ type equal? on not-equal types"
+	}
+    }
+}
+
+proc test_enums {} {
+    with_test_prefix "test_enum" {
+	gdb_scm_test_silent_cmd "print e" "print value (e)"
+	gdb_scm_test_silent_cmd "guile (define e (history-ref 0))" \
+	    "get value (e) from history"
+	gdb_scm_test_silent_cmd "guile (define fields (type-fields (value-type e)))" \
+	    "extract type fields from e"
+	gdb_test "guile (print (length fields))" \
+	    "= 3" "check the number of enum fields"
+	gdb_test "guile (print (field-name (car fields)))" \
+	    "= v1" "check enum field\[0\] name"
+	gdb_test "guile (print (field-name (cadr fields)))" \
+	    "= v2" "check enum field\[1\]name"
+
+	# Ditto but by mapping operations.
+	gdb_test "guile (print (type-num-fields (value-type e)))" \
+	    "= 3" "check the number of enum values"
+	gdb_test "guile (print (field-name (type-field (value-type e) \"v1\")))" \
+	    "= v1" "check enum field lookup by name (v1)"
+	gdb_test "guile (print (field-name (type-field (value-type e) \"v3\")))" \
+	    "= v3" "check enum field lookup by name (v3)"
+	gdb_test "guile (print (iterator-map field-enumval (make-field-iterator (value-type e))))" \
+	    "\\(0 1 2\\)" "check enum fields iteration"
+    }
+}
+
+proc test_base_class {} {
+    with_test_prefix "test_base_class" {
+	gdb_scm_test_silent_cmd "print d" "print value (d)"
+	gdb_scm_test_silent_cmd "guile (define d (history-ref 0))" \
+	    "get value (d) from history"
+	gdb_scm_test_silent_cmd "guile (define fields (type-fields (value-type d)))" \
+	    "extract type fields from d"
+	gdb_test "guile (print (length fields))" \
+	    "= 3" "check the number of fields"
+	gdb_test "guile (print (field-baseclass? (car fields)))" \
+	    "= #t" "check base class (fields\[0\])"
+	gdb_test "guile (print (field-baseclass? (cadr fields)))" \
+	    "= #f" "check base class (fields\[1\])"
+    }
+}
+
+proc test_range {} {
+    with_test_prefix "test_range" {
+	with_test_prefix "on ranged value" {
+	    # Test a valid range request.
+	    gdb_scm_test_silent_cmd "print ar" "print value (ar)"
+	    gdb_scm_test_silent_cmd "guile (define ar (history-ref 0))" \
+		"get value (ar) from history"
+	    gdb_test "guile (print (length (type-range (value-type ar))))" \
+		"= 2" "check correct tuple length"
+	    gdb_test "guile (print (type-range (value-type ar)))" \
+		"= \\(0 1\\)" "check range"
+	}
+
+	with_test_prefix "on unranged value" {
+	    # Test where a range does not exist.
+	    gdb_scm_test_silent_cmd "print st" "print value (st)"
+	    gdb_scm_test_silent_cmd "guile (define st (history-ref 0))" \
+		"get value (st) from history"
+	    gdb_test "guile (print (type-range (value-type st)))" \
+		"ERROR: .*: Wrong type argument in position 1 \\(expecting ranged type\\): .*" \
+		"check range for non ranged type"
+	}
+    }
+}
+
+# Perform C Tests.
+
+if { [build_inferior "${binfile}" "c"] < 0 } {
+    return
+}
+if ![restart_gdb "${binfile}"] {
+    return
+}
+
+with_test_prefix "lang_c" {
+    runto_bp "break to inspect struct and array."
+    test_fields "c"
+    test_equality "c"
+    test_enums
+}
+
+# Perform C++ Tests.
+
+if { [build_inferior "${binfile}-cxx" "c++"] < 0 } {
+    return
+}
+if ![restart_gdb "${binfile}-cxx"] {
+    return
+}
+
+with_test_prefix "lang_cpp" {
+    runto_bp "break to inspect struct and array."
+    test_fields "c++"
+    test_base_class
+    test_range
+    test_equality "c++"
+    test_enums
+}
diff --git a/gdb/testsuite/gdb.guile/scm-value-cc.cc b/gdb/testsuite/gdb.guile/scm-value-cc.cc
new file mode 100644
index 0000000..df19f0b
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-value-cc.cc
@@ -0,0 +1,39 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2012-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/>.  */
+
+class A {
+};
+
+typedef int *int_ptr;
+
+int
+func (const A &a)
+{
+  int val = 10;
+  int &int_ref = val;
+  int_ptr ptr = &val;
+  int_ptr &int_ptr_ref = ptr;
+
+  return 0; /* Break here.  */
+}
+
+int
+main ()
+{
+  A obj;
+  return func (obj);
+}
diff --git a/gdb/testsuite/gdb.guile/scm-value-cc.exp b/gdb/testsuite/gdb.guile/scm-value-cc.exp
new file mode 100644
index 0000000..685deb1
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-value-cc.exp
@@ -0,0 +1,57 @@
+# Copyright (C) 2012-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the mechanism exposing c++ values to Guile.
+
+load_lib gdb-guile.exp
+
+if { [skip_cplus_tests] } { continue }
+
+standard_testfile .cc
+
+if {[prepare_for_testing $testfile.exp $testfile $srcfile {debug c++}]} {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+   return
+}
+
+gdb_breakpoint [gdb_get_line_number "Break here."]
+gdb_continue_to_breakpoint "Break here" ".*Break here.*"
+
+gdb_test "gu (print (value-type (parse-and-eval \"a\")))" \
+    "= const A &"
+gdb_test "gu (print (value-type (value-referenced-value (parse-and-eval \"a\"))))" \
+    "= const A"
+gdb_test "gu (print (value-type (parse-and-eval \"int_ref\")))" \
+    "= int &"
+gdb_test "gu (print (value-type (value-referenced-value (parse-and-eval \"int_ref\"))))" \
+    "= int"
+gdb_test "gu (print (value-referenced-value (parse-and-eval \"int_ref\")))" \
+    "= 10"
+
+gdb_test "gu (print (value-type (value-dereference (parse-and-eval \"int_ptr_ref\"))))" \
+    "= int"
+gdb_test "gu (print (value-type (value-referenced-value (parse-and-eval \"int_ptr_ref\"))))" \
+    "= int_ptr"
+gdb_test "gu (print (value-dereference (value-referenced-value (parse-and-eval \"int_ptr_ref\"))))" \
+    "= 10"
+gdb_test "gu (print (value-referenced-value (value-referenced-value (parse-and-eval \"int_ptr_ref\"))))" \
+    "= 10"
diff --git a/gdb/testsuite/gdb.guile/scm-value.c b/gdb/testsuite/gdb.guile/scm-value.c
new file mode 100644
index 0000000..3c61911
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-value.c
@@ -0,0 +1,101 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2008-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/>.  */
+
+#include <stdio.h>
+
+struct s
+{
+  int a;
+  int b;
+};
+
+union u
+{
+  int a;
+  float b;
+};
+
+enum e
+  {
+    ONE = 1,
+    TWO = 2
+  };
+
+typedef struct s *PTR;
+
+enum e evalue = TWO;
+
+#ifdef __cplusplus
+
+struct Base {
+  virtual int x() { return 5; }
+};
+
+struct Derived : public Base {
+};
+
+Base *base = new Derived ();
+
+void ptr_ref(int*& rptr_int)
+{
+  return; /* break to inspect pointer by reference. */
+}
+#endif
+
+void func1 ()
+{
+  printf ("void function called\n");
+}
+
+int func2 (int arg1, int arg2)
+{
+  return arg1 + arg2;
+}
+
+char **save_argv;
+
+int
+main (int argc, char *argv[])
+{
+  char *cp = argv[0]; /* Prevent gcc from optimizing argv[] out.  */
+  struct s s;
+  union u u;
+  PTR x = &s;
+  char st[17] = "divide et impera";
+  char nullst[17] = "divide\0et\0impera";
+  void (*fp1) (void)  = &func1;
+  int  (*fp2) (int, int) = &func2;
+  const char *sptr = "pointer";
+  const char *embed = "embedded x\201\202\203\204";
+  int a[3] = {1,2,3};
+  int *p = a;
+  int i = 2;
+  int *ptr_i = &i;
+  const char *sn = 0;
+  s.a = 3;
+  s.b = 5;
+  u.a = 7;
+  (*fp1) ();
+  (*fp2) (10,20);
+
+#ifdef __cplusplus
+  ptr_ref(ptr_i);
+#endif
+
+  save_argv = argv;      /* break to inspect struct and union */
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-value.exp b/gdb/testsuite/gdb.guile/scm-value.exp
new file mode 100644
index 0000000..3ebdd58
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-value.exp
@@ -0,0 +1,449 @@
+# Copyright (C) 2008-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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the mechanism exposing values to Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+# Build inferior to language specification.
+# LANG is one of "c" or "c++".
+proc build_inferior {exefile lang} {
+    global srcdir subdir srcfile testfile hex
+
+    # Use different names for .o files based on the language.
+    # For Fission, the debug info goes in foo.dwo and we don't want,
+    # for example, a C++ compile to clobber the dwo of a C compile.
+    # ref: http://gcc.gnu.org/wiki/DebugFission
+    switch ${lang} {
+	"c" { set filename ${testfile}.o }
+	"c++" { set filename ${testfile}-cxx.o }
+    }
+    set objfile [standard_output_file $filename]
+
+    if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${objfile}" object "debug $lang"] != ""
+	 || [gdb_compile "${objfile}" "${exefile}" executable "debug $lang"] != "" } {
+	untested "Couldn't compile ${srcfile} in $lang mode"
+	return -1
+    }
+    return 0
+}
+
+proc test_value_in_inferior {} {
+    global gdb_prompt
+    global testfile
+
+    gdb_breakpoint [gdb_get_line_number "break to inspect struct and union"]
+
+    gdb_continue_to_breakpoint "break to inspect struct and union"
+
+    # Just get inferior variable s in the value history, available to guile.
+    gdb_test "print s" "= {a = 3, b = 5}" ""
+
+    gdb_scm_test_silent_cmd "gu (define s (history-ref 0))" "set s"
+
+    gdb_test "gu (print (value-field s \"a\"))" \
+	"= 3" "access element inside struct using string name"
+
+    # Test dereferencing the argv pointer.
+
+    # Just get inferior variable argv the value history, available to guile.
+    gdb_test "print argv" "= \\(char \\*\\*\\) 0x.*" ""
+
+    gdb_scm_test_silent_cmd "gu (define argv (history-ref 0))" \
+	"set argv"
+    gdb_scm_test_silent_cmd "gu (define arg0 (value-dereference argv))" \
+	"set arg0"
+
+    # Check that the dereferenced value is sane.
+    if { ! [target_info exists noargs] } {
+	gdb_test "gu (print arg0)" \
+	    "0x.*$testfile\"" "verify dereferenced value"
+    }
+
+    # Smoke-test value-optimized-out?.
+    gdb_test "gu (print (value-optimized-out? arg0))" \
+	"= #f" "Test value-optimized-out?"
+
+    # Test address attribute.
+    gdb_test "gu (print (value-address arg0))" \
+	"= 0x\[\[:xdigit:\]\]+" "Test address attribute"
+    # Test address attribute is #f in a non-addressable value.
+    gdb_test "gu (print (value-address (make-value 42)))" \
+	"= #f" "Test address attribute in non-addressable value"
+
+    # Test displaying a variable that is temporarily at a bad address.
+    # But if we can examine what's at memory address 0, then we'll also be
+    # able to display it without error.  Don't run the test in that case.
+    set can_read_0 0
+    gdb_test_multiple "x 0" "memory at address 0" {
+	-re "0x0:\[ \t\]*Cannot access memory at address 0x0\r\n$gdb_prompt $" { }
+	-re "0x0:\[ \t\]*Error accessing memory address 0x0\r\n$gdb_prompt $" { }
+	-re "\r\n$gdb_prompt $" {
+	    set can_read_0 1
+	}
+    }
+
+    # Test memory error.
+    set test "parse_and_eval with memory error"
+    if {$can_read_0} {
+	untested $test
+    } else {
+	gdb_test "gu (print (parse-and-eval \"*(int*)0\"))" \
+	    "ERROR: Cannot access memory at address 0x0.*" $test
+    }
+
+    # Test Guile lazy value handling
+    set test "memory error and lazy values"
+    if {$can_read_0} {
+	untested $test
+    } else {
+	gdb_test_no_output "gu (define inval (parse-and-eval \"*(int*)0\"))"
+	gdb_test "gu (print (value-lazy? inval))" \
+	    "#t"
+	gdb_test "gu (define inval2 (value-add inval 1))" \
+	    "ERROR: Cannot access memory at address 0x0.*" $test
+	gdb_test "gu (value-fetch-lazy! inval))" \
+	    "ERROR: Cannot access memory at address 0x0.*" $test
+    }
+    gdb_test_no_output "gu (define argc-lazy (parse-and-eval \"argc\"))"
+    gdb_test_no_output "gu (define argc-notlazy (parse-and-eval \"argc\"))"
+    gdb_test_no_output "gu (value-fetch-lazy! argc-notlazy)"
+    gdb_test "gu (print (value-lazy? argc-lazy))" "= #t"
+    gdb_test "gu (print (value-lazy? argc-notlazy))" "= #f"
+    gdb_test "print argc" "= 1" "sanity check argc"
+    gdb_test "gu (print (value-lazy? argc-lazy))" "= #t"
+    gdb_test_no_output "set argc=2"
+    gdb_test "gu (print argc-notlazy)" "= 1"
+    gdb_test "gu (print argc-lazy)" "= 2"
+    gdb_test "gu (print (value-lazy? argc-lazy))" "= #f"
+
+    # Test string fetches, both partial and whole.
+    gdb_test "print st" "\"divide et impera\""
+    gdb_scm_test_silent_cmd "gu (define st (history-ref 0))" \
+	"inf: get st value from history"
+    gdb_test "gu (print (value->string st))" \
+	"= divide et impera"  "Test string with no length"
+    gdb_test "gu (print (value->string st #:length -1))" \
+	"= divide et impera" "Test string (length = -1) is all of the string"
+    gdb_test "gu (print (value->string st #:length 6))" \
+	"= divide"
+    gdb_test "gu (print (string-append \"---\" (value->string st #:length 0) \"---\"))" \
+	"= ------" "Test string (length = 0) is empty"
+    gdb_test "gu (print (string-length (value->string st #:length 0)))" \
+	"= 0" "Test length is 0"
+
+    # Fetch a string that has embedded nulls.
+    gdb_test "print nullst" "\"divide\\\\000et\\\\000impera\".*"
+    gdb_scm_test_silent_cmd "gu (define nullst (history-ref 0))" \
+	"inf: get nullst value from history"
+    gdb_test "gu (print (value->string nullst))" \
+	"divide" "Test string to first null"
+    gdb_scm_test_silent_cmd "gu (set! nullst (value->string nullst #:length 9))" \
+	"get string beyond null"
+    gdb_test "gu (print nullst)" \
+	"= divide\\\\000et"
+}
+
+proc test_strings {} {
+    gdb_test "gu (make-value \"test\")" "#<gdb:value \"test\">" "make string"
+
+    # Test string conversion errors.
+    set save_charset [get_target_charset]
+    gdb_test_no_output "set target-charset UTF-8"
+
+    gdb_test_no_output "gu (set-port-conversion-strategy! #f 'error)"
+    gdb_test "gu (print (value->string (make-value (string #\\x1234)) #:encoding \"ASCII\"))" \
+	"ERROR.*decoding-error.*" \
+	"value->string with default #:errors = 'error"
+
+    # There is no 'escape strategy for C->SCM string conversions, but it's
+    # still a legitimate value for %default-port-conversion-strategy.
+    # GDB handles this by, umm, substituting 'substitute.
+    # Use this case to also handle "#:errors #f" which explicitly says
+    # "use %default-port-conversion-strategy".
+    gdb_test_no_output "gu (set-port-conversion-strategy! #f 'escape)"
+    gdb_test "gu (print (value->string (make-value (string #\\x1234)) #:encoding \"ASCII\" #:errors #f))" \
+	"= \[?\]{3}" "value->string with default #:errors = 'escape"
+
+    # This is last in the default conversion tests so that
+    # %default-port-conversion-strategy ends up with the default value.
+    gdb_test_no_output "gu (set-port-conversion-strategy! #f 'substitute)"
+    gdb_test "gu (print (value->string (make-value (string #\\x1234)) #:encoding \"ASCII\"))" \
+	"= \[?\]{3}" "value->string with default #:errors = 'substitute"
+
+    gdb_test "gu (print (value->string (make-value (string #\\x1234)) #:encoding \"ASCII\" #:errors 'error))" \
+	"ERROR.*decoding-error.*" "value->string #:errors 'error"
+    gdb_test "gu (print (value->string (make-value (string #\\x1234)) #:encoding \"ASCII\" #:errors 'substitute))" \
+	"= \[?\]{3}" "value->string #:errors 'substitute"
+    gdb_test "gu (print (value->string (make-value \"abc\") #:errors \"foo\"))" \
+	"ERROR.*invalid error kind.*" "bad value for #:errors"
+
+    gdb_test_no_output "set target-charset $save_charset" \
+	"restore target-charset"
+}
+
+proc test_lazy_strings {} {
+    global hex
+
+    gdb_test "print sptr" "\"pointer\""
+    gdb_scm_test_silent_cmd "gu (define sptr (history-ref 0))" \
+	"lazy strings: get sptr value from history"
+
+    gdb_scm_test_silent_cmd "gu (define lstr (value->lazy-string sptr))" \
+	"Aquire lazy string"
+    gdb_test "gu (print (lazy-string-type lstr))" \
+	"= const char \*." "Test lazy-string type name equality"
+    gdb_test "gu (print (value-type sptr))" \
+	"= const char \*." "Test string type name equality"
+    gdb_test "print sn" "0x0"
+    gdb_scm_test_silent_cmd "gu (define snptr (history-ref 0))" \
+	"lazy strings: get snptr value from history"
+    gdb_test "gu (define snstr (value->lazy-string snptr #:length 5))" \
+	".*cannot create a lazy string with address.*" "Test lazy string"
+    gdb_scm_test_silent_cmd "gu (define snstr (value->lazy-string snptr #:length 0))" \
+	"Successfully create a lazy string"
+    gdb_test "gu (print (lazy-string-length snstr))" \
+	"= 0" "Test lazy string length"
+    gdb_test "gu (print (lazy-string-address snstr))" \
+	"= 0" "Test lazy string address"
+}
+
+proc test_inferior_function_call {} {
+    global gdb_prompt hex decimal
+
+    # Correct inferior call without arguments.
+    gdb_test "p/x fp1" "= $hex.*"
+    gdb_scm_test_silent_cmd "gu (define fp1 (history-ref 0))" \
+	"get fp1 value from history"
+    gdb_scm_test_silent_cmd "gu (set! fp1 (value-dereference fp1))" \
+	"dereference fp1"
+    gdb_test "gu (print (value-call fp1 '()))" \
+	"= void"
+
+    # Correct inferior call with arguments.
+    gdb_test "p/x fp2" "= $hex.*"
+    gdb_scm_test_silent_cmd "gu (define fp2 (history-ref 0))" \
+	"get fp2 value from history"
+    gdb_scm_test_silent_cmd "gu (set! fp2 (value-dereference fp2))" \
+	"dereference fp2"
+    gdb_test "gu (print (value-call fp2 (list 10 20)))" \
+	"= 30"
+
+    # Incorrect to call an int value.
+    gdb_test "p i" "= $decimal.*"
+    gdb_scm_test_silent_cmd "gu (define i (history-ref 0))" \
+	"inf call: get i value from history"
+    gdb_test "gu (print (value-call i '()))" \
+	"ERROR: .*: Wrong type argument in position 1 \\(expecting function \\(value of TYPE_CODE_FUNC\\)\\): .*"
+
+    # Incorrect number of arguments.
+    gdb_test "p/x fp2" "= $hex.*"
+    gdb_scm_test_silent_cmd "gu (define fp3 (history-ref 0))" \
+	"get fp3 value from history"
+    gdb_scm_test_silent_cmd "gu (set! fp3 (value-dereference fp3))" \
+	"dereference fp3"
+    gdb_test "gu (print (value-call fp3 (list 10)))" \
+	"ERROR: Too few arguments in function call.*"
+}
+
+proc test_value_after_death {} {
+    # Construct a type while the inferior is still running.
+    gdb_scm_test_silent_cmd "gu (define ptrtype (lookup-type \"PTR\"))" \
+	"create PTR type"
+
+    # Kill the inferior and remove the symbols.
+    gdb_test "kill" "" "kill the inferior" \
+	"Kill the program being debugged. .y or n. $" \
+	"y"
+    gdb_test "file" "" "Discard the symbols" \
+	"Discard symbol table from.*y or n. $" \
+	"y"
+
+    # Now create a value using that type.  Relies on arg0, created by
+    # test_value_in_inferior.
+    gdb_scm_test_silent_cmd "gu (define castval (value-cast arg0 (type-pointer ptrtype)))" \
+	"cast arg0 to PTR"
+
+    # Make sure the type is deleted.
+    gdb_scm_test_silent_cmd "gu (set! ptrtype #f)" \
+	"delete PTR type"
+
+    # Now see if the value's type is still valid.
+    gdb_test "gu (print (value-type castval))" \
+	"= PTR ." "print value's type"
+}
+
+# Regression test for invalid subscript operations.  The bug was that
+# the type of the value was not being checked before allowing a
+# subscript operation to proceed.
+
+proc test_subscript_regression {exefile lang} {
+    # Start with a fresh gdb.
+    clean_restart ${exefile}
+
+    if ![gdb_guile_runto_main ] {
+	fail "Can't run to main"
+	return
+    }
+
+    if {$lang == "c++"} {
+	gdb_breakpoint [gdb_get_line_number "break to inspect pointer by reference"]
+	gdb_continue_to_breakpoint "break to inspect pointer by reference"
+
+	gdb_scm_test_silent_cmd "print rptr_int" \
+	    "Obtain address"
+	gdb_scm_test_silent_cmd "gu (define rptr (history-ref 0))" \
+	    "set rptr"
+	gdb_test "gu (print (value-subscript rptr 0))" \
+	    "= 2" "Check pointer passed as reference"
+
+	# Just the most basic test of dynamic_cast -- it is checked in
+	# the C++ tests.
+	gdb_test "gu (print (value->bool (value-dynamic-cast (parse-and-eval \"base\") (type-pointer (lookup-type \"Derived\")))))" \
+	    "= #t"
+
+	# Likewise.
+	gdb_test "gu (print (value-dynamic-type (parse-and-eval \"base\")))" \
+	    "= Derived \[*\]"
+	# A static type case.
+	gdb_test "gu (print (value-dynamic-type (parse-and-eval \"5\")))" \
+	    "= int"
+    }
+
+    gdb_breakpoint [gdb_get_line_number "break to inspect struct and union"]
+    gdb_continue_to_breakpoint "break to inspect struct and union"
+
+    gdb_scm_test_silent_cmd "gu (define intv (make-value 1))" \
+	"Create int value for subscript test"
+    gdb_scm_test_silent_cmd "gu (define stringv (make-value \"foo\"))" \
+	"Create string value for subscript test"
+
+    # Try to access an int with a subscript.  This should fail.
+    gdb_test "gu (print intv)" \
+	"= 1" "Baseline print of an int Guile value"
+    gdb_test "gu (print (value-subscript intv 0))" \
+	"ERROR: Cannot subscript requested type.*" \
+	"Attempt to access an integer with a subscript"
+
+    # Try to access a string with a subscript.  This should pass.
+    gdb_test "gu (print stringv)" \
+	"= \"foo\"" "Baseline print of a string Guile value"
+    gdb_test "gu (print (value-subscript stringv 0))" \
+	"= 102 'f'" "Attempt to access a string with a subscript"
+
+    # Try to access an int array via a pointer with a subscript.
+    # This should pass.
+    gdb_scm_test_silent_cmd "print p" "Build pointer to array"
+    gdb_scm_test_silent_cmd "gu (define pointer (history-ref 0))" "set pointer"
+    gdb_test "gu (print (value-subscript pointer 0))" \
+	"= 1" "Access array via pointer with int subscript"
+    gdb_test "gu (print (value-subscript pointer intv))" \
+	"= 2" "Access array via pointer with value subscript"
+
+    # Try to access a single dimension array with a subscript to the
+    # result.  This should fail.
+    gdb_test "gu (print (value-subscript (value-subscript pointer intv) 0))" \
+	"ERROR: Cannot subscript requested type.*" \
+	"Attempt to access an integer with a subscript 2"
+
+    # Lastly, test subscript access to an array with multiple
+    # dimensions.  This should pass.
+    gdb_scm_test_silent_cmd "print {\"fu \",\"foo\",\"bar\"}" "Build array"
+    gdb_scm_test_silent_cmd "gu (define marray (history-ref 0))" ""
+    gdb_test "gu (print (value-subscript (value-subscript marray 1) 2))" \
+	"o." "Test multiple subscript"
+}
+
+# A few tests of gdb:parse-and-eval.
+
+proc test_parse_and_eval {} {
+    gdb_test "gu (print (parse-and-eval \"23\"))" \
+	"= 23" "parse-and-eval constant test"
+    gdb_test "gu (print (parse-and-eval \"5 + 7\"))" \
+	"= 12" "parse-and-eval simple expression test"
+    gdb_test "gu (raw-print (parse-and-eval \"5 + 7\"))" \
+	"#<gdb:value 12>" "parse-and-eval type test"
+}
+
+# Test that values are hashable.
+# N.B.: While smobs are hashable, the hash is really non-existent,
+# they all get hashed to the same value.  Guile may provide a hash function
+# for smobs in a future release.  In the meantime one should use a custom
+# hash table that uses gdb:hash-gsmob.
+
+proc test_value_hash {} {
+    gdb_test_multiline "Simple Guile value dictionary" \
+	"guile" "" \
+	"(define one (make-value 1))" "" \
+	"(define two (make-value 2))" "" \
+	"(define three (make-value 3))" "" \
+        "(define vdict (make-hash-table 5))" "" \
+	"(hash-set! vdict one \"one str\")" "" \
+	"(hash-set! vdict two \"two str\")" "" \
+	"(hash-set! vdict three \"three str\")" "" \
+	"end"
+    gdb_test "gu (print (hash-ref vdict one))" \
+	"one str" "Test dictionary hash 1"
+    gdb_test "gu (print (hash-ref vdict two))" \
+	"two str" "Test dictionary hash 2"
+    gdb_test "gu (print (hash-ref vdict three))" \
+	"three str" "Test dictionary hash 3"
+}
+
+# Build C version of executable.  C++ is built later.
+if { [build_inferior "${binfile}" "c"] < 0 } {
+    return
+}
+
+# Start with a fresh gdb.
+clean_restart ${binfile}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+gdb_install_guile_utils
+gdb_install_guile_module
+
+test_parse_and_eval
+test_value_hash
+
+# The following tests require execution.
+
+if ![gdb_guile_runto_main] {
+    fail "Can't run to main"
+    return
+}
+
+test_value_in_inferior
+test_inferior_function_call
+test_strings
+test_lazy_strings
+test_value_after_death
+
+# Test either C or C++ values. 
+
+test_subscript_regression "${binfile}" "c"
+
+if ![skip_cplus_tests] {
+    if { [build_inferior "${binfile}-cxx" "c++"] < 0 } {
+	return
+    }
+    with_test_prefix "c++" {
+	test_subscript_regression "${binfile}-cxx" "c++"
+    }
+}
diff --git a/gdb/testsuite/gdb.guile/source2.scm b/gdb/testsuite/gdb.guile/source2.scm
new file mode 100644
index 0000000..f00c269
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/source2.scm
@@ -0,0 +1,19 @@
+;; This testcase is part of GDB, the GNU debugger.
+;;
+;; Copyright 2008-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/>.
+
+(display (format "y~As" "e"))
+(newline)
diff --git a/gdb/testsuite/gdb.guile/types-module.cc b/gdb/testsuite/gdb.guile/types-module.cc
new file mode 100644
index 0000000..90c682a
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/types-module.cc
@@ -0,0 +1,38 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 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/>.  */
+
+enum enum_type { A, B, C };
+
+class base
+{
+ public:
+  int base_member;
+};
+
+class derived : public base
+{
+ public:
+  enum_type derived_member;
+};
+
+derived d;
+
+int
+main (void)
+{
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/types-module.exp b/gdb/testsuite/gdb.guile/types-module.exp
new file mode 100644
index 0000000..8562f3c
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/types-module.exp
@@ -0,0 +1,50 @@
+# Copyright (C) 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/>.
+
+# This file is part of the GDB testsuite.
+# It tests the (gdb types) module.
+
+load_lib gdb-guile.exp
+
+standard_testfile .cc
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return -1
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_scm_test_silent_cmd "guile (use-modules (gdb types))" \
+    "import (gdb types)"
+
+gdb_scm_test_silent_cmd "guile (define d (lookup-type \"derived\"))" \
+    "get derived type"
+
+gdb_test "guile (print (type-has-field? d \"base_member\"))" \
+    "= #f" "type-has-field? member in baseclass"
+
+gdb_test "guile (print (type-has-field-deep? d \"base_member\"))" \
+    "= #t" "type-has-field-deep? member in baseclass"
+
+gdb_scm_test_silent_cmd "guile (define enum-htab (make-enum-hashtable (lookup-type \"enum_type\")))" \
+    "create enum hash table"
+
+gdb_test "guile (print (hash-ref enum-htab \"B\"))" \
+    "= 1" "verify make-enum-hashtable"
diff --git a/gdb/testsuite/lib/gdb-guile.exp b/gdb/testsuite/lib/gdb-guile.exp
new file mode 100644
index 0000000..d46f200
--- /dev/null
+++ b/gdb/testsuite/lib/gdb-guile.exp
@@ -0,0 +1,127 @@
+# Copyright 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/>.
+
+# Utilities for Guile-scripting related tests.
+
+# Guile doesn't print the 0x prefix on hex numbers.
+set ghex {[0-9a-f]+}
+
+# Return a 1 for configurations that do not support Guile scripting.
+
+proc skip_guile_tests {} {
+    global gdb_prompt
+
+    gdb_test_multiple "guile (display \"test\\n\")" "verify guile support" {
+	-re "Undefined command.*$gdb_prompt $" {
+	    unsupported "Guile not supported."
+	    return 1
+	}
+	-re "not supported.*$gdb_prompt $" {
+	    unsupported "Guile support is disabled."
+	    return 1
+	}
+	-re "$gdb_prompt $" {}
+    }
+
+    return 0
+}
+
+# Run a command in GDB, and report a failure if a Scheme exception is thrown.
+# If report_pass is true, report a pass if no exception is thrown.
+# This also catches the "Undefined command" error that happens if the user
+# passes, e.g., "(print foo)" instead of "guile (print foo)".
+
+proc gdb_scm_test_silent_cmd { cmd name {report_pass 1} } {
+    global gdb_prompt
+
+    gdb_test_multiple $cmd $name {
+	-re "Backtrace.*$gdb_prompt $" { fail $name }
+	-re "ERROR.*$gdb_prompt $"     { fail $name }
+	-re "Undefined command: .*$gdb_prompt $" { fail $name }
+	-re "$gdb_prompt $"            { if $report_pass { pass $name } }
+    }
+}
+
+# Usage: gdb_test_multiline NAME INPUT RESULT {INPUT RESULT} ...
+# Run a test named NAME, consisting of multiple lines of input.
+# After each input line INPUT, search for result line RESULT.
+# Succeed if all results are seen; fail otherwise.
+# FIXME: Move to gdb.exp and remove Python's gdb_py_test_multiple.
+
+proc gdb_test_multiline { name args } {
+    global gdb_prompt
+    foreach {input result} $args {
+	if {[gdb_test_multiple $input "$name - $input" {
+	    -re "\[\r\n\]*($result)\[\r\n\]+($gdb_prompt | *>)$" {
+		pass "$name - $input"
+	    }
+	}]} {
+	    return 1
+	}
+    }
+    return 0
+}
+
+# Load Scheme file FILE_NAME.
+# TEST_NAME can be used to specify the name of the test,
+# otherwise a standard test name is provided.
+#
+# Note: When Guile loads something and auto-compilation is enabled
+# (which is useful and the default), then the first time a file is loaded
+# Guile will compile the file and store the result somewhere
+# (e.g., $HOME/.cache/guile).  Output of the compilation process will
+# appear in gdb.log.  But since Guile only does this when necessary
+# don't be confused if you don't always see it - Guile just skipped it
+# because it thought it was unnecessary.
+
+proc gdb_scm_load_file { file_name {test_name ""} } {
+    if { $test_name == "" } {
+	set test_name "guile (load \"[file tail $file_name]\")"
+    }
+    # Note: This can produce output if Guile compiles the file.
+    gdb_scm_test_silent_cmd "guile (load \"$file_name\")" $test_name
+}
+
+# Install various utilities in Guile to simplify tests.
+#
+# print - combination of display + newline
+
+proc gdb_install_guile_utils { } {
+    # Define utilities in Guile to save needing (newline) all the time,
+    # and in the case of "print" add a prefix to help erroneous passes.
+    gdb_test_no_output "guile (define (print x) (format #t \"= ~A\" x) (newline))"
+    gdb_test_no_output "guile (define (raw-print x) (format #t \"= ~S\" x) (newline))"
+}
+
+# Install the gdb module.
+
+proc gdb_install_guile_module { } {
+    gdb_test_no_output "guile (use-modules (gdb))"
+}
+
+# Wrapper around runto_main that installs the guile utils and module.
+# The result is the same as for runto_main.
+
+proc gdb_guile_runto_main { } {
+    if ![runto_main] {
+	fail "Can't run to main"
+	return 0
+    }
+
+    gdb_install_guile_utils
+    gdb_install_guile_module
+
+    return 1
+}
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 3716472..66dc8f7 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -4399,6 +4399,23 @@ proc get_sizeof { type default } {
     return [get_integer_valueof "sizeof (${type})" $default]
 }
 
+proc get_target_charset { } {
+    global gdb_prompt
+
+    gdb_test_multiple "show target-charset" "" {
+	-re "The target character set is \"auto; currently (\[^\"\]*)\".*$gdb_prompt $" {
+	    return $expect_out(1,string)
+	}
+	-re "The target character set is \"(\[^\"\]*)\".*$gdb_prompt $" {
+	    return $expect_out(1,string)
+	}
+    }
+
+    # Pick a reasonable default.
+    warning "Unable to read target-charset."
+    return "UTF-8"
+}
+
 # Get the current value for remotetimeout and return it.
 proc get_remotetimeout { } {
     global gdb_prompt