From b2715b270ae27eccefe8edbbacb3910bc7cc9383 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 26 May 2014 17:34:27 -0700 Subject: [PATCH] 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. --- gdb/ChangeLog | 17 ++ gdb/doc/ChangeLog | 5 + gdb/doc/guile.texi | 46 +---- gdb/guile/guile-internal.h | 31 ++- gdb/guile/lib/gdb.scm | 8 +- gdb/guile/scm-arch.c | 5 +- gdb/guile/scm-block.c | 11 +- gdb/guile/scm-breakpoint.c | 5 +- gdb/guile/scm-exception.c | 4 +- gdb/guile/scm-frame.c | 5 +- gdb/guile/scm-gsmob.c | 219 ++------------------- gdb/guile/scm-iterator.c | 4 +- gdb/guile/scm-lazy-string.c | 5 +- gdb/guile/scm-objfile.c | 5 +- gdb/guile/scm-pretty-print.c | 8 +- gdb/guile/scm-symbol.c | 5 +- gdb/guile/scm-symtab.c | 10 +- gdb/guile/scm-type.c | 9 +- gdb/guile/scm-value.c | 4 +- gdb/testsuite/ChangeLog | 6 + gdb/testsuite/gdb.guile/scm-breakpoint.exp | 14 +- gdb/testsuite/gdb.guile/scm-gsmob.exp | 20 +- 22 files changed, 102 insertions(+), 344 deletions(-) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 296ef2275d..37305f499f 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,20 @@ +2014-05-26 Andy Wingo + Doug Evans + + * 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 * configure.ac (try_guile_versions): Allow building with guile 2.2. diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog index a5784ef761..f869b5e017 100644 --- a/gdb/doc/ChangeLog +++ b/gdb/doc/ChangeLog @@ -1,3 +1,8 @@ +2014-05-26 Andy Wingo + + * guile.texi (GDB Scheme Data Types): Remove documentation for + removed interfaces. Update spelling of gdb-object-kind. + 2014-05-26 Andy Wingo * guile.texi (Basic Guile): Fix some typos. diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi index 7082ef9d18..3e03c7cea7 100644 --- 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 -@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{}, +@deffn {Scheme Procedure} gdb-object-kind object +Return the kind of the @value{GDBN} object, e.g., @code{}, 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 @@ -425,8 +397,8 @@ Return an unsorted list of names of properties. @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 diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h index b6d01f453b..e2e1c012c1 100644 --- 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); -/* 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. - 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. */ -#define GDB_SMOB_HEAD \ - /* Property list for externally added fields. */ \ - SCM properties; +#define GDB_SMOB_HEAD \ + int empty_base_class; 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 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); diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm index f12769ea8f..ec739c7e30 100644 --- a/gdb/guile/lib/gdb.scm +++ b/gdb/guile/lib/gdb.scm @@ -270,13 +270,9 @@ 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 diff --git a/gdb/guile/scm-arch.c b/gdb/guile/scm-arch.c index fa578f3fea..aa170f0e6d 100644 --- 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) { - 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 . */ diff --git a/gdb/guile/scm-block.c b/gdb/guile/scm-block.c index 4e1748ea51..94c171efa2 100644 --- 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) { - 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 . */ @@ -540,11 +537,7 @@ gdbscm_block_symbols (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 . */ diff --git a/gdb/guile/scm-breakpoint.c b/gdb/guile/scm-breakpoint.c index c8371aad55..97621b8e82 100644 --- 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. */ - 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 . */ diff --git a/gdb/guile/scm-exception.c b/gdb/guile/scm-exception.c index ffe83ede18..c892884b54 100644 --- 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); - 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 . */ diff --git a/gdb/guile/scm-frame.c b/gdb/guile/scm-frame.c index 6031a7ff34..ee30597651 100644 --- 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) { - 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 . */ diff --git a/gdb/guile/scm-gsmob.c b/gdb/guile/scm-gsmob.c index b0f9e19566..156ca8cc81 100644 --- 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. - 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. - 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" @@ -61,15 +52,6 @@ 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 @@ -131,7 +113,7 @@ gdbscm_make_smob_type (const char *name, size_t size) void gdbscm_init_gsmob (gdb_smob *base) { - base->properties = SCM_EOL; + base->empty_base_class = 0; } /* 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; } -/* 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 */ @@ -212,9 +154,9 @@ gsscm_get_gsmob_arg_unsafe (SCM self, int arg_pos, const char *func_name) 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 @@ -236,124 +178,6 @@ gdbscm_gsmob_kind (SCM self) 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 @@ -449,25 +273,12 @@ gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab, eqable_gdb_smob *base) static const scheme_function gsmob_functions[] = { - { "gsmob-kind", 1, 0, 0, gdbscm_gsmob_kind, + /* 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 the kind of the smob, e.g., , 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." }, +Return the kind of the GDB object, e.g., , as a symbol." }, END_FUNCTIONS }; diff --git a/gdb/guile/scm-iterator.c b/gdb/guile/scm-iterator.c index a6deb849d5..e0155a9d4a 100644 --- 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->next_x); - /* Do this last. */ - return gdbscm_mark_gsmob (&i_smob->base); + return i_smob->next_x; } /* The smob "print" function for . */ diff --git a/gdb/guile/scm-lazy-string.c b/gdb/guile/scm-lazy-string.c index e965d01f96..10494ea2ee 100644 --- 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) { - 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 . */ diff --git a/gdb/guile/scm-objfile.c b/gdb/guile/scm-objfile.c index 70f7e3343a..145f22bd64 100644 --- 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); - 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); + return o_smob->pretty_printers; } /* The smob "print" function for . */ diff --git a/gdb/guile/scm-pretty-print.c b/gdb/guile/scm-pretty-print.c index 1b9902f459..cc97dcdb89 100644 --- 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->lookup); - /* Do this last. */ - return gdbscm_mark_gsmob (&pp_smob->base); + return pp_smob->lookup; } /* The smob "print" function for . */ @@ -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->children); - /* Do this last. */ - return gdbscm_mark_gsmob (&w_smob->base); + return w_smob->children; } /* The smob "print" function for . */ diff --git a/gdb/guile/scm-symbol.c b/gdb/guile/scm-symbol.c index 0c5cc053c5..b6a92a4d48 100644 --- 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) { - 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 . */ diff --git a/gdb/guile/scm-symtab.c b/gdb/guile/scm-symtab.c index 7294fea060..845b13f69b 100644 --- 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) { - 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 . */ @@ -407,10 +404,7 @@ 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); + return s_smob->symtab_scm; } /* The smob "free" function for . */ diff --git a/gdb/guile/scm-type.c b/gdb/guile/scm-type.c index 9345c2845f..8d09fbd531 100644 --- 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) { - 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 . */ @@ -422,9 +419,7 @@ 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); + return f_smob->type_scm; } /* The smob "print" function for . */ diff --git a/gdb/guile/scm-value.c b/gdb/guile/scm-value.c index 2160a1ecef..6e82d26df9 100644 --- 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->dynamic_type); - /* Do this last. */ - return gdbscm_mark_gsmob (&v_smob->base); + return v_smob->dynamic_type; } /* The smob "free" function for . */ diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index de32b614c9..dc9cff0c72 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-05-26 Andy Wingo + + * 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 * 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 b25d4e0889..fd7c970ae6 100644 --- 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 (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)))" "" \ - " (set-gsmob-property! bp 'bp-data (make-bp-data))" "" \ + " (set-object-property! bp 'bp-data (make-bp-data))" "" \ " (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)" "" \ @@ -329,10 +329,10 @@ proc test_bkpt_eval_funcs { } { "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)" "" \ - " (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))))" "" \ @@ -343,7 +343,7 @@ proc test_bkpt_eval_funcs { } { "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" "" diff --git a/gdb/testsuite/gdb.guile/scm-gsmob.exp b/gdb/testsuite/gdb.guile/scm-gsmob.exp index 470afc4f2c..70c3a65ebd 100644 --- 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} { - 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" - 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} { - 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" } -# 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" -gdb_test "gu (print (sort (gsmob-properties arch) (lambda (a b) (stringstring a) (symbol->string b)))))" \ - "= \\($prop_list\\)" "gsmob-properties" +gdb_test "gu (print (sort (map car (object-properties arch)) (lambda (a b) (stringstring a) (symbol->string b)))))" \ + "= \\($prop_list\\)" "object-properties"