gdb smob cleanups

	* guile/guile-internal.h (GDB_SMOB_HEAD): Replace properties with
	empty_base_class.  All uses updated.
	(gdbscm_mark_gsmob, gdbscm_mark_chained_gsmob)
	(gdbscm_mark_eqable_gsmob): Remove these now-unneeded functions.
	Adapt all callers.
	* guile/scm-gsmob.c (gdbscm_mark_gsmob)
	(gdbscm_mark_chained_gsmob, gdbscm_mark_eqable_gsmob): Remove.
	(gdbscm_gsmob_property, gdbscm_set_gsmob_property_x)
	(gdbscm_gsmob_has_property_p, add_property_name)
	(gdbscm_gsmob_properties): Remove, and remove them from gsmob_functions.
	* guile/lib/gdb.scm (gdb-object-property, set-gdb-object-property)
	(gdb-object-has-property?, gdb-object-properties): Remove.
	(gdb-object-kind): Renamed from gsmob-kind.

	doc/
	* guile.texi (GDB Scheme Data Types): Remove documentation for
	removed interfaces.  Update spelling of gdb-object-kind.

	testsuite/
	* gdb.guile/scm-breakpoint.exp:
	* gdb.guile/scm-gsmob.exp: Update to use plain old object
	properties instead of gdb-object-properties.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 296ef2275d0f4d07b234cf8ff62d6de3b80d096a..37305f499f2514c2439d9c1c46c228f231965c79 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,20 @@
+2014-05-26  Andy Wingo  <[email protected]>
+           Doug Evans  <[email protected]>
+
+       * guile/guile-internal.h (GDB_SMOB_HEAD): Replace properties with
+       empty_base_class.  All uses updated.
+       (gdbscm_mark_gsmob, gdbscm_mark_chained_gsmob)
+       (gdbscm_mark_eqable_gsmob): Remove these now-unneeded functions.
+       Adapt all callers.
+       * guile/scm-gsmob.c (gdbscm_mark_gsmob)
+       (gdbscm_mark_chained_gsmob, gdbscm_mark_eqable_gsmob): Remove.
+       (gdbscm_gsmob_property, gdbscm_set_gsmob_property_x)
+       (gdbscm_gsmob_has_property_p, add_property_name)
+       (gdbscm_gsmob_properties): Remove, and remove them from gsmob_functions.
+       * guile/lib/gdb.scm (gdb-object-property, set-gdb-object-property)
+       (gdb-object-has-property?, gdb-object-properties): Remove.
+       (gdb-object-kind): Renamed from gsmob-kind.
+

 2014-05-26  Andy Wingo  <[email protected]>
 
        * configure.ac (try_guile_versions): Allow building with guile 2.2.
 2014-05-26  Andy Wingo  <[email protected]>
 
        * configure.ac (try_guile_versions): Allow building with guile 2.2.

diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog
index a5784ef7618879a42b05e81c724353a82710b70c..f869b5e017c05b628a0d8a7d7b48a43dd42b0403 100644 (file)
--- a/gdb/doc/ChangeLog
+++ b/gdb/doc/ChangeLog
@@ -1,3 +1,8 @@
+2014-05-26  Andy Wingo  <[email protected]>
+
+       * guile.texi (GDB Scheme Data Types): Remove documentation for
+       removed interfaces.  Update spelling of gdb-object-kind.
+

 2014-05-26  Andy Wingo  <[email protected]>
 
        * guile.texi (Basic Guile): Fix some typos.
 2014-05-26  Andy Wingo  <[email protected]>
 
        * guile.texi (Basic Guile): Fix some typos.

diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi
index 7082ef9d1825f783e830d0805a71578cad317547..3e03c7cea73f3a5f286e63bdb33db27cbf129d39 100644 (file)
--- a/gdb/doc/guile.texi
+++ b/gdb/doc/guile.texi
@@ -331,46 +331,18 @@ This is the string passed to @code{--target} when @value{GDBN} was configured.
 
 @node GDB Scheme Data Types
 @subsubsection GDB Scheme Data Types
 
 @node GDB Scheme Data Types
 @subsubsection GDB Scheme Data Types

-@cindex gdb smobs
+@cindex gdb objects

 
 

-@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}.
+The values exposed by @value{GDBN} to Guile are known as
+@dfn{@value{GDBN} objects}.  There are several kinds of @value{GDBN}
+object, and each is disjoint from all other types known to Guile.

 
 

-@deffn {Scheme Procedure} gsmob-kind gsmob
-Return the kind of the gsmob, e.g., @code{<gdb:breakpoint>},
+@deffn {Scheme Procedure} gdb-object-kind object
+Return the kind of the @value{GDBN} object, e.g., @code{<gdb:breakpoint>},

 as a symbol.
 @end deffn
 
 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:
+@value{GDBN} defines the following object types:

 
 @table @code
 @item <gdb:arch>
 
 @table @code
 @item <gdb:arch>


@@ -425,8 +397,8 @@ Return an unsorted list of names of properties.
 @xref{Values From Inferior In Guile}.
 @end table
 
 @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.
+The following @value{GDBN} objects are managed internally so that the
+Scheme function @code{eq?} may be applied to them.

 
 @table @code
 @item <gdb:arch>
 
 @table @code
 @item <gdb:arch>

diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
index b6d01f453bc1192c8d0afa474fad265d50c8003d..e2e1c012c134eb3c986b8ece71a3511602f5129d 100644 (file)
--- a/gdb/guile/guile-internal.h
+++ b/gdb/guile/guile-internal.h
@@ -153,26 +153,31 @@ extern void gdbscm_dynwind_xfree (void *ptr);
 
 extern int gdbscm_is_procedure (SCM proc);
 \f
 
 extern int gdbscm_is_procedure (SCM proc);
 \f

-/* GDB smobs, from scm-smob.c */
+/* GDB smobs, from scm-gsmob.c */

 
 /* All gdb smobs must contain one of the following as the first member:
    gdb_smob, chained_gdb_smob, or eqable_gdb_smob.
 
 
 /* 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.
+   Chained GDB smobs should have chained_gdb_smob as their first member.  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.
+   Eq-able GDB smobs should have eqable_gdb_smob as their first member.  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
+   All other smobs should have gdb_smob as their first member.
+   FIXME: dje/2014-05-26: gdb_smob was useful during early development as a
+   "baseclass" for all gdb smobs.  If it's still unused by gdb 8.0 delete it.
+
+   IMPORTANT: chained_gdb_smob and eqable_gdb-smob are "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.  */
 
    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;
+#define GDB_SMOB_HEAD \
+  int empty_base_class;

 
 typedef struct
 {
 
 typedef struct
 {


@@ -222,12 +227,6 @@ extern void gdbscm_init_chained_gsmob (chained_gdb_smob *base);
 extern void gdbscm_init_eqable_gsmob (eqable_gdb_smob *base,
                                      SCM containing_scm);
 
 extern void gdbscm_init_eqable_gsmob (eqable_gdb_smob *base,
                                      SCM containing_scm);
 

-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_add_objfile_ref (struct objfile *objfile,
                                    const struct objfile_data *data_key,
                                    chained_gdb_smob *g_smob);

diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm
index f12769ea8fdc5a90e7eb8ded161cee1cc72d28d5..ec739c7e30c7179d272096642d55c2a494b695ec 100644 (file)
--- a/gdb/guile/lib/gdb.scm
+++ b/gdb/guile/lib/gdb.scm
@@ -270,13 +270,9 @@
  make-pretty-printer-worker
  pretty-printer-worker?
 
  make-pretty-printer-worker
  pretty-printer-worker?
 

- ;; scm-smob.c
+ ;; scm-gsmob.c

 
 

- gsmob-kind
- gsmob-property
- set-gsmob-property!
- gsmob-has-property?
- gsmob-properties
+ gdb-object-kind

 
  ;; scm-string.c
 
 
  ;; scm-string.c
 

diff --git a/gdb/guile/scm-arch.c b/gdb/guile/scm-arch.c
index fa578f3feab6b8cede73c35b29a3187108c449ed..aa170f0e6dfc1b5efcf4dd9bfc9998296606cd47 100644 (file)
--- a/gdb/guile/scm-arch.c
+++ b/gdb/guile/scm-arch.c
@@ -53,10 +53,7 @@ static int arscm_is_arch (SCM);
 static SCM
 arscm_mark_arch_smob (SCM self)
 {
 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);
+  return SCM_BOOL_F;

 }
 
 /* The smob "print" function for <gdb:arch>.  */
 }
 
 /* The smob "print" function for <gdb:arch>.  */

diff --git a/gdb/guile/scm-block.c b/gdb/guile/scm-block.c
index 4e1748ea51b51df9d9c1b8aed552f1c589b02411..94c171efa20754549a787fa022141f4316b99d0f 100644 (file)
--- a/gdb/guile/scm-block.c
+++ b/gdb/guile/scm-block.c
@@ -125,10 +125,7 @@ bkscm_objfile_block_map (struct objfile *objfile)
 static SCM
 bkscm_mark_block_smob (SCM self)
 {
 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);
+  return SCM_BOOL_F;

 }
 
 /* The smob "free" function for <gdb:block>.  */
 }
 
 /* The smob "free" function for <gdb:block>.  */


@@ -540,11 +537,7 @@ gdbscm_block_symbols (SCM self)
 static SCM
 bkscm_mark_block_syms_progress_smob (SCM self)
 {
 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);
+  return SCM_BOOL_F;

 }
 
 /* The smob "print" function for <gdb:block-symbols-iterator>.  */
 }
 
 /* The smob "print" function for <gdb:block-symbols-iterator>.  */

diff --git a/gdb/guile/scm-breakpoint.c b/gdb/guile/scm-breakpoint.c
index c8371aad55ce3514cf75c9e382f03af4eadadd68..97621b8e82c7c01824fe4d8ff018267167a33232 100644 (file)
--- a/gdb/guile/scm-breakpoint.c
+++ b/gdb/guile/scm-breakpoint.c
@@ -83,10 +83,7 @@ bpscm_mark_breakpoint_smob (SCM 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.  */
 
   /* 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);
+  return bp_smob->stop;

 }
 
 /* The smob "free" function for <gdb:breakpoint>.  */
 }
 
 /* The smob "free" function for <gdb:breakpoint>.  */

diff --git a/gdb/guile/scm-exception.c b/gdb/guile/scm-exception.c
index ffe83ede184b833b74f502413d74f712a54ccd67..c892884b54cea94b11bee3733d7ef777040a338a 100644 (file)
--- a/gdb/guile/scm-exception.c
+++ b/gdb/guile/scm-exception.c
@@ -109,9 +109,7 @@ exscm_mark_exception_smob (SCM self)
   exception_smob *e_smob = (exception_smob *) SCM_SMOB_DATA (self);
 
   scm_gc_mark (e_smob->key);
   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);
+  return e_smob->args;

 }
 
 /* The smob "print" function for <gdb:exception>.  */
 }
 
 /* The smob "print" function for <gdb:exception>.  */

diff --git a/gdb/guile/scm-frame.c b/gdb/guile/scm-frame.c
index 6031a7ff342802c616568ce4f86c5249c5d2091b..ee30597651c1360a36a9458581b8095c343d4983 100644 (file)
--- a/gdb/guile/scm-frame.c
+++ b/gdb/guile/scm-frame.c
@@ -135,10 +135,7 @@ frscm_inferior_frame_map (struct inferior *inferior)
 static SCM
 frscm_mark_frame_smob (SCM self)
 {
 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);
+  return SCM_BOOL_F;

 }
 
 /* The smob "free" function for <gdb:frame>.  */
 }
 
 /* The smob "free" function for <gdb:frame>.  */

diff --git a/gdb/guile/scm-gsmob.c b/gdb/guile/scm-gsmob.c
index b0f9e19566450dd29ab5bbd1676d7701b6ed8da0..156ca8cc8177a6654d01075f09858500d662684c 100644 (file)
--- a/gdb/guile/scm-gsmob.c
+++ b/gdb/guile/scm-gsmob.c
@@ -30,25 +30,16 @@
    specify the gdb smob kind, that is left for another day if it ever is
    needed.
 
    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"
+   Some GDB smobs 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.
 
    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.  */
+   Some other GDB smobs are "eqable gsmobs".  Gsmob implementations can
+   "subclass" eqable_gdb_smob 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.  */

 
 #include "defs.h"
 #include "hashtab.h"
 
 #include "defs.h"
 #include "hashtab.h"


@@ -61,15 +52,6 @@
 
 static htab_t registered_gsmobs;
 
 
 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 function for registered_gsmobs hash table.  */
 
 static hashval_t


@@ -131,7 +113,7 @@ gdbscm_make_smob_type (const char *name, size_t size)
 void
 gdbscm_init_gsmob (gdb_smob *base)
 {
 void
 gdbscm_init_gsmob (gdb_smob *base)
 {

-  base->properties = SCM_EOL;
+  base->empty_base_class = 0;

 }
 
 /* Initialize a chained_gdb_smob.
 }
 
 /* Initialize a chained_gdb_smob.


@@ -157,46 +139,6 @@ gdbscm_init_eqable_gsmob (eqable_gdb_smob *base, SCM containing_scm)
   base->containing_scm = containing_scm;
 }
 
   base->containing_scm = containing_scm;
 }
 

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

 \f
 /* gsmob accessors */
 
 \f
 /* gsmob accessors */
 


@@ -212,9 +154,9 @@ gsscm_get_gsmob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
   return self;
 }
 
   return self;
 }
 

-/* (gsmob-kind gsmob) -> symbol
+/* (gdb-object-kind gsmob) -> symbol

 
 

-   Note: While one might want to name this gsmob-class-name, it is named
+   Note: While one might want to name this gdb-object-class-name, it is named

    "-kind" because smobs aren't real GOOPS classes.  */
 
 static SCM
    "-kind" because smobs aren't real GOOPS classes.  */
 
 static SCM


@@ -236,124 +178,6 @@ gdbscm_gsmob_kind (SCM self)
   return result;
 }
 
   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;
-}

 \f
 /* When underlying gdb data structures are deleted, we need to update any
    smobs with references to them.  There are several smobs that reference
 \f
 /* When underlying gdb data structures are deleted, we need to update any
    smobs with references to them.  There are several smobs that reference


@@ -449,25 +273,12 @@ gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab, eqable_gdb_smob *base)
 
 static const scheme_function gsmob_functions[] =
 {
 
 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,
+  /* N.B. There is a general rule of not naming symbols in gdb-guile with a
+     "gdb" prefix.  This symbol does not violate this rule because it is to
+     be read as "gdb-object-foo", not "gdb-foo".  */
+  { "gdb-object-kind", 1, 0, 0, gdbscm_gsmob_kind,

     "\
     "\

-Return an unsorted list of names of properties." },
+Return the kind of the GDB object, e.g., <gdb:breakpoint>, as a symbol." },

 
   END_FUNCTIONS
 };
 
   END_FUNCTIONS
 };

diff --git a/gdb/guile/scm-iterator.c b/gdb/guile/scm-iterator.c
index a6deb849d5fb40ea401efed81f3ee2bb077c48f2..e0155a9d4af715ccbf9da64f5967c7507b17348b 100644 (file)
--- a/gdb/guile/scm-iterator.c
+++ b/gdb/guile/scm-iterator.c
@@ -119,9 +119,7 @@ itscm_mark_iterator_smob (SCM self)
 
   scm_gc_mark (i_smob->object);
   scm_gc_mark (i_smob->progress);
 
   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);
+  return i_smob->next_x;

 }
 
 /* The smob "print" function for <gdb:iterator>.  */
 }
 
 /* The smob "print" function for <gdb:iterator>.  */

diff --git a/gdb/guile/scm-lazy-string.c b/gdb/guile/scm-lazy-string.c
index e965d01f96bbbc141cabc31ecdf709e12c867088..10494ea2ee32205f650206f6c5dab3a6f97f2271 100644 (file)
--- a/gdb/guile/scm-lazy-string.c
+++ b/gdb/guile/scm-lazy-string.c
@@ -68,10 +68,7 @@ static scm_t_bits lazy_string_smob_tag;
 static SCM
 lsscm_mark_lazy_string_smob (SCM self)
 {
 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);
+  return SCM_BOOL_F;

 }
 
 /* The smob "free" function for <gdb:lazy-string>.  */
 }
 
 /* The smob "free" function for <gdb:lazy-string>.  */

diff --git a/gdb/guile/scm-objfile.c b/gdb/guile/scm-objfile.c
index 70f7e3343aff9f6b287c2f5c09b4c38b62e1abcf..145f22bd6443e3c6d16365feb6319c22198028d4 100644 (file)
--- a/gdb/guile/scm-objfile.c
+++ b/gdb/guile/scm-objfile.c
@@ -69,13 +69,10 @@ ofscm_mark_objfile_smob (SCM self)
 {
   objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (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.  */
 
   /* 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);
+  return o_smob->pretty_printers;

 }
 
 /* The smob "print" function for <gdb:objfile>.  */
 }
 
 /* The smob "print" function for <gdb:objfile>.  */

diff --git a/gdb/guile/scm-pretty-print.c b/gdb/guile/scm-pretty-print.c
index 1b9902f45974fb02861cc5d72fe9447c2121cea7..cc97dcdb893944575d5e84f809b76e3794c990c3 100644 (file)
--- a/gdb/guile/scm-pretty-print.c
+++ b/gdb/guile/scm-pretty-print.c
@@ -136,9 +136,7 @@ ppscm_mark_pretty_printer_smob (SCM self)
 
   scm_gc_mark (pp_smob->name);
   scm_gc_mark (pp_smob->enabled);
 
   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);
+  return pp_smob->lookup;

 }
 
 /* The smob "print" function for <gdb:pretty-printer>.  */
 }
 
 /* The smob "print" function for <gdb:pretty-printer>.  */


@@ -267,9 +265,7 @@ ppscm_mark_pretty_printer_worker_smob (SCM self)
 
   scm_gc_mark (w_smob->display_hint);
   scm_gc_mark (w_smob->to_string);
 
   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);
+  return w_smob->children;

 }
 
 /* The smob "print" function for <gdb:pretty-printer-worker>.  */
 }
 
 /* The smob "print" function for <gdb:pretty-printer-worker>.  */

diff --git a/gdb/guile/scm-symbol.c b/gdb/guile/scm-symbol.c
index 0c5cc053c5c862bf0c6811c93221c939aeaf96ae..b6a92a4d48e668031cbc44643b34fd4c088587a5 100644 (file)
--- a/gdb/guile/scm-symbol.c
+++ b/gdb/guile/scm-symbol.c
@@ -100,10 +100,7 @@ syscm_objfile_symbol_map (struct symbol *symbol)
 static SCM
 syscm_mark_symbol_smob (SCM self)
 {
 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);
+  return SCM_BOOL_F;

 }
 
 /* The smob "free" function for <gdb:symbol>.  */
 }
 
 /* The smob "free" function for <gdb:symbol>.  */

diff --git a/gdb/guile/scm-symtab.c b/gdb/guile/scm-symtab.c
index 7294fea0608bf7ef43ac21392ad40d9e6e3939ca..845b13f69b2f17ab440c2e5e08fe39462c312ad7 100644 (file)
--- a/gdb/guile/scm-symtab.c
+++ b/gdb/guile/scm-symtab.c
@@ -127,10 +127,7 @@ stscm_objfile_symtab_map (struct symtab *symtab)
 static SCM
 stscm_mark_symtab_smob (SCM self)
 {
 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);
+  return SCM_BOOL_F;

 }
 
 /* The smob "free" function for <gdb:symtab>.  */
 }
 
 /* The smob "free" function for <gdb:symtab>.  */


@@ -407,10 +404,7 @@ stscm_mark_sal_smob (SCM self)
 {
   sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (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);
+  return s_smob->symtab_scm;

 }
 
 /* The smob "free" function for <gdb:sal>.  */
 }
 
 /* The smob "free" function for <gdb:sal>.  */

diff --git a/gdb/guile/scm-type.c b/gdb/guile/scm-type.c
index 9345c2845f2d84563fec4f47c3f2050e3e990b8e..8d09fbd53145d7888f1ab986c909345e80e14f94 100644 (file)
--- a/gdb/guile/scm-type.c
+++ b/gdb/guile/scm-type.c
@@ -186,10 +186,7 @@ tyscm_type_map (struct type *type)
 static SCM
 tyscm_mark_type_smob (SCM self)
 {
 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);
+  return SCM_BOOL_F;

 }
 
 /* The smob "free" function for <gdb:type>.  */
 }
 
 /* The smob "free" function for <gdb:type>.  */


@@ -422,9 +419,7 @@ tyscm_mark_field_smob (SCM self)
 {
   field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (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);
+  return f_smob->type_scm;

 }
 
 /* The smob "print" function for <gdb:field>.  */
 }
 
 /* The smob "print" function for <gdb:field>.  */

diff --git a/gdb/guile/scm-value.c b/gdb/guile/scm-value.c
index 2160a1eceff1bedee852d59ea09f1685523ccd66..6e82d26df9dbc4e11be5a4ceb609e4133a879f9e 100644 (file)
--- a/gdb/guile/scm-value.c
+++ b/gdb/guile/scm-value.c
@@ -132,9 +132,7 @@ vlscm_mark_value_smob (SCM self)
 
   scm_gc_mark (v_smob->address);
   scm_gc_mark (v_smob->type);
 
   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);
+  return v_smob->dynamic_type;

 }
 
 /* The smob "free" function for <gdb:value>.  */
 }
 
 /* The smob "free" function for <gdb:value>.  */

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index de32b614c97680727f3339e5d55c712938f12262..dc9cff0c720e579b766091371a32c5e6a07cfed6 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-05-26  Andy Wingo  <[email protected]>
+
+       * gdb.guile/scm-breakpoint.exp:
+       * gdb.guile/scm-gsmob.exp: Update to use plain old object
+       properties instead of gdb-object-properties.
+

 2014-05-26  Yao Qi  <[email protected]>
 
        * gdb.server/no-thread-db.exp: Specify source file name
 2014-05-26  Yao Qi  <[email protected]>
 
        * gdb.server/no-thread-db.exp: Specify source file name

diff --git a/gdb/testsuite/gdb.guile/scm-breakpoint.exp b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
index b25d4e08891bae9aaa03ab3a0c965cfd7cd2d8a5..fd7c970ae615ca97a9c06796289b2455dc287e78 100644 (file)
--- a/gdb/testsuite/gdb.guile/scm-breakpoint.exp
+++ b/gdb/testsuite/gdb.guile/scm-breakpoint.exp
@@ -310,14 +310,14 @@ proc test_bkpt_eval_funcs { } {
            "(define set-bp-data-count! set-car!)" "" \
            "(define bp-data-inf-i cdr)" "" \
            "(define set-bp-data-inf-i! set-cdr!)" "" \
            "(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 (bp-eval-count bkpt) (bp-data-count (object-property bkpt 'bp-data)))" "" \
+           "(define (bp-eval-inf-i bkpt) (bp-data-inf-i (object-property bkpt 'bp-data)))" "" \

            "(define (make-bp-eval location)" "" \
            "  (let ((bp (create-breakpoint! location)))" "" \
            "(define (make-bp-eval location)" "" \
            "  (let ((bp (create-breakpoint! location)))" "" \

-           "    (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+           "    (set-object-property! bp 'bp-data (make-bp-data))" "" \

            "    (set-breakpoint-stop! bp" "" \
            "       (lambda (bkpt)" "" \
            "    (set-breakpoint-stop! bp" "" \
            "       (lambda (bkpt)" "" \

-           "         (let ((data (gsmob-property bkpt 'bp-data))" "" \
+           "         (let ((data (object-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)" "" \
            "               (inf-i (parse-and-eval \"i\")))" "" \
            "           (set-bp-data-count! data (+ (bp-data-count data) 1))" "" \
            "           (set-bp-data-inf-i! data inf-i)" "" \


@@ -329,10 +329,10 @@ proc test_bkpt_eval_funcs { } {
            "guile" "" \
            "(define (make-bp-also-eval location)" "" \
            "  (let ((bp (create-breakpoint! location)))" "" \
            "guile" "" \
            "(define (make-bp-also-eval location)" "" \
            "  (let ((bp (create-breakpoint! location)))" "" \

-           "    (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+           "    (set-object-property! bp 'bp-data (make-bp-data))" "" \

            "    (set-breakpoint-stop! bp" "" \
            "       (lambda (bkpt)" "" \
            "    (set-breakpoint-stop! bp" "" \
            "       (lambda (bkpt)" "" \

-           "         (let* ((data (gsmob-property bkpt 'bp-data))" "" \
+           "         (let* ((data (object-property bkpt 'bp-data))" "" \

            "                (count (+ (bp-data-count data) 1)))" "" \
            "           (set-bp-data-count! data count)" "" \
            "           (= count 9))))" "" \
            "                (count (+ (bp-data-count data) 1)))" "" \
            "           (set-bp-data-count! data count)" "" \
            "           (= count 9))))" "" \


@@ -343,7 +343,7 @@ proc test_bkpt_eval_funcs { } {
            "guile" "" \
            "(define (make-bp-basic location)" "" \
            "  (let ((bp (create-breakpoint! location)))" "" \
            "guile" "" \
            "(define (make-bp-basic location)" "" \
            "  (let ((bp (create-breakpoint! location)))" "" \

-           "    (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \
+           "    (set-object-property! bp 'bp-data (make-bp-data))" "" \

            "    bp))" "" \
            "end" ""
 
            "    bp))" "" \
            "end" ""
 

diff --git a/gdb/testsuite/gdb.guile/scm-gsmob.exp b/gdb/testsuite/gdb.guile/scm-gsmob.exp
index 470afc4f2c554f167a1c82b35c4780ffc3c55d10..70c3a65ebd3056e505c43b16857c5dcdb65b645a 100644 (file)
--- a/gdb/testsuite/gdb.guile/scm-gsmob.exp
+++ b/gdb/testsuite/gdb.guile/scm-gsmob.exp
@@ -45,26 +45,24 @@ proc prop_name { 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} {
 # 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]))" \
+    gdb_test "gu (print (object-property arch '[prop_name $i]))" \

        "= #f" "property prop$i not present before set"
        "= #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"
+    gdb_test "gu (print (set-object-property! arch '[prop_name $i] $i))" \
+       "= $i" "set prop $i"
+    gdb_test "gu (print (object-property arch '[prop_name $i]))" \
+       "= $i" "property prop$i present after set"

 }
 for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} {
 }
 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]))" \
+    gdb_test "gu (print (object-property arch '[prop_name $i]))" \

        "= $i" "ref prop $i"
 }
 
        "= $i" "ref prop $i"
 }
 

-# Verify gsmob-properties.
+# Verify 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"
 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"
+gdb_test "gu (print (sort (map car (object-properties arch)) (lambda (a b) (string<? (symbol->string a) (symbol->string b)))))" \
+    "= \\($prop_list\\)" "object-properties"