[PATCH v2 28/36] Guile extension language: scm-symtab.c

[Doug Evans <xdje42 at gmail dot com>]

This patch adds the interface to the symbol table.

2014-01-20  Doug Evans  <xdje42@gmail.com>

	* guile/scm-symtab.c: New file.

	testsuite/
	* gdb.guile/scm-symtab-2.c: New file.
	* gdb.guile/scm-symtab.c: New file.
	* gdb.guile/scm-symtab.exp: New file.

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/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"