OpenE2K
/
binutils-gdb
12
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Andy Wingo 2014-05-26 17:34:27 -07:00 committed by Doug Evans
parent 3ce6e97279
commit b2715b270a
22 changed files with 102 additions and 344 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gdb/ChangeLog
View File

@ -1,3 +1,20 @@
2014-05-26 Andy Wingo <wingo@igalia.com>
Doug Evans <xdje42@gmail.com>
* 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 <wingo@igalia.com> 2014-05-26 Andy Wingo <wingo@igalia.com>
* configure.ac (try_guile_versions): Allow building with guile 2.2. * configure.ac (try_guile_versions): Allow building with guile 2.2.

5
gdb/doc/ChangeLog
View File

@ -1,3 +1,8 @@
2014-05-26 Andy Wingo <wingo@igalia.com>
* guile.texi (GDB Scheme Data Types): Remove documentation for
removed interfaces. Update spelling of gdb-object-kind.
2014-05-26 Andy Wingo <wingo@igalia.com> 2014-05-26 Andy Wingo <wingo@igalia.com>
* guile.texi (Basic Guile): Fix some typos. * guile.texi (Basic Guile): Fix some typos.

46
gdb/doc/guile.texi
View File

@ -331,46 +331,18 @@ This is the string passed to @code{--target} when @value{GDBN} was configured.
@node GDB Scheme Data Types @node GDB Scheme Data Types
@subsubsection GDB Scheme Data Types @subsubsection GDB Scheme Data Types
@cindex gdb smobs @cindex gdb objects
@value{GDBN} uses Guile's @dfn{smob} (small object) The values exposed by @value{GDBN} to Guile are known as
data type for all @value{GDBN} objects @dfn{@value{GDBN} objects}. There are several kinds of @value{GDBN}
(@pxref{Defining New Types (Smobs),,, guile, GNU Guile Reference Manual}). object, and each is disjoint from all other types known to Guile.
The smobs that @value{GDBN} provides are called @dfn{gsmobs}.
@deffn {Scheme Procedure} gsmob-kind gsmob @deffn {Scheme Procedure} gdb-object-kind object
Return the kind of the gsmob, e.g., @code{<gdb:breakpoint>}, Return the kind of the @value{GDBN} object, e.g., @code{<gdb:breakpoint>},
as a symbol. as a symbol.
@end deffn @end deffn
Every @code{gsmob} provides a common set of functions for extending @value{GDBN} defines the following object types:
them in simple ways. Each @code{gsmob} has a list of properties,
initially empty. These properties are akin to Guile's object properties,
but are stored with the @code{gsmob}
(@pxref{Object Properties,,, guile, GNU Guile Reference Manual}).
Property names can be any @code{eq?}-able value, but it is recommended
that they be symbols.
@deffn {Scheme Procedure} set-gsmob-property! gsmob property-name value
Set the value of property @code{property-name} to value @code{value}.
The result is unspecified.
@end deffn
@deffn {Scheme Procedure} gsmob-property gsmob property-name
Return the value of property @code{property-name}.
If the property isn't present then @code{#f} is returned.
@end deffn
@deffn {Scheme Procedure} gsmob-has-property? gsmob property-name
Return @code{#t} if @code{gsmob} has property @code{property-name}.
Otherwise return @code{#f}.
@end deffn
@deffn {Scheme Procedure} gsmob-properties gsmob
Return an unsorted list of names of properties.
@end deffn
@value{GDBN} defines the following Scheme smobs:
@table @code @table @code
@item <gdb:arch> @item <gdb:arch>
@ -425,8 +397,8 @@ Return an unsorted list of names of properties.
@xref{Values From Inferior In Guile}. @xref{Values From Inferior In Guile}.
@end table @end table
The following gsmobs are managed internally so that the Scheme function The following @value{GDBN} objects are managed internally so that the
@code{eq?} may be applied to them. Scheme function @code{eq?} may be applied to them.
@table @code @table @code
@item <gdb:arch> @item <gdb:arch>

31
gdb/guile/guile-internal.h
View File

@ -153,26 +153,31 @@ extern void gdbscm_dynwind_xfree (void *ptr);
extern int gdbscm_is_procedure (SCM proc); 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: /* All gdb smobs must contain one of the following as the first member:
gdb_smob, chained_gdb_smob, or eqable_gdb_smob. gdb_smob, chained_gdb_smob, or eqable_gdb_smob.
The next,prev members of chained_gdb_smob allow for chaining gsmobs Chained GDB smobs should have chained_gdb_smob as their first member. The
together so that, for example, when an objfile is deleted we can clean up next,prev members of chained_gdb_smob allow for chaining gsmobs together so
all smobs that reference it. 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 Eq-able GDB smobs should have eqable_gdb_smob as their first member. The
same gsmob instead of creating a new one, allowing them to be eq?-able. 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. 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 gdb_smob as if it is a subclass. To that end we use macro GDB_SMOB_HEAD
to ensure this. */ to ensure this. */
#define GDB_SMOB_HEAD \ #define GDB_SMOB_HEAD \
/* Property list for externally added fields. */ \ int empty_base_class;
SCM properties;
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, extern void gdbscm_init_eqable_gsmob (eqable_gdb_smob *base,
SCM containing_scm); 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, extern void gdbscm_add_objfile_ref (struct objfile *objfile,
const struct objfile_data *data_key, const struct objfile_data *data_key,
chained_gdb_smob *g_smob); chained_gdb_smob *g_smob);

8
gdb/guile/lib/gdb.scm
View File

@ -270,13 +270,9 @@
make-pretty-printer-worker make-pretty-printer-worker
pretty-printer-worker? pretty-printer-worker?
;; scm-smob.c ;; scm-gsmob.c
gsmob-kind gdb-object-kind
gsmob-property
set-gsmob-property!
gsmob-has-property?
gsmob-properties
;; scm-string.c ;; scm-string.c

5
gdb/guile/scm-arch.c
View File

@ -53,10 +53,7 @@ static int arscm_is_arch (SCM);
static SCM static SCM
arscm_mark_arch_smob (SCM self) arscm_mark_arch_smob (SCM self)
{ {
arch_smob *a_smob = (arch_smob *) SCM_SMOB_DATA (self); return SCM_BOOL_F;
/* Do this last. */
return gdbscm_mark_gsmob (&a_smob->base);
} }
/* The smob "print" function for <gdb:arch>. */ /* The smob "print" function for <gdb:arch>. */

11
gdb/guile/scm-block.c
View File

@ -125,10 +125,7 @@ bkscm_objfile_block_map (struct objfile *objfile)
static SCM static SCM
bkscm_mark_block_smob (SCM self) bkscm_mark_block_smob (SCM self)
{ {
block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (self); return SCM_BOOL_F;
/* Do this last. */
return gdbscm_mark_eqable_gsmob (&b_smob->base);
} }
/* 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 static SCM
bkscm_mark_block_syms_progress_smob (SCM self) bkscm_mark_block_syms_progress_smob (SCM self)
{ {
block_syms_progress_smob *i_smob return SCM_BOOL_F;
= (block_syms_progress_smob *) SCM_SMOB_DATA (self);
/* Do this last. */
return gdbscm_mark_gsmob (&i_smob->base);
} }
/* The smob "print" function for <gdb:block-symbols-iterator>. */ /* The smob "print" function for <gdb:block-symbols-iterator>. */

5
gdb/guile/scm-breakpoint.c
View File

@ -83,10 +83,7 @@ bpscm_mark_breakpoint_smob (SCM self)
/* We don't mark containing_scm here. It is just a backlink to our /* We don't mark containing_scm here. It is just a backlink to our
container, and is gc'protected until the breakpoint is deleted. */ container, and is gc'protected until the breakpoint is deleted. */
scm_gc_mark (bp_smob->stop); return bp_smob->stop;
/* Do this last. */
return gdbscm_mark_gsmob (&bp_smob->base);
} }
/* The smob "free" function for <gdb:breakpoint>. */ /* The smob "free" function for <gdb:breakpoint>. */

4
gdb/guile/scm-exception.c
View File

@ -109,9 +109,7 @@ exscm_mark_exception_smob (SCM self)
exception_smob *e_smob = (exception_smob *) SCM_SMOB_DATA (self); exception_smob *e_smob = (exception_smob *) SCM_SMOB_DATA (self);
scm_gc_mark (e_smob->key); scm_gc_mark (e_smob->key);
scm_gc_mark (e_smob->args); return e_smob->args;
/* Do this last. */
return gdbscm_mark_gsmob (&e_smob->base);
} }
/* The smob "print" function for <gdb:exception>. */ /* The smob "print" function for <gdb:exception>. */

5
gdb/guile/scm-frame.c
View File

@ -135,10 +135,7 @@ frscm_inferior_frame_map (struct inferior *inferior)
static SCM static SCM
frscm_mark_frame_smob (SCM self) frscm_mark_frame_smob (SCM self)
{ {
frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self); return SCM_BOOL_F;
/* Do this last. */
return gdbscm_mark_eqable_gsmob (&f_smob->base);
} }
/* The smob "free" function for <gdb:frame>. */ /* The smob "free" function for <gdb:frame>. */

219
gdb/guile/scm-gsmob.c
View File

@ -30,25 +30,16 @@
specify the gdb smob kind, that is left for another day if it ever is specify the gdb smob kind, that is left for another day if it ever is
needed. needed.
We want the objects we export to Scheme to be extensible by the user. Some GDB smobs are "chained gsmobs". They are used to assist with life-time
A gsmob (gdb smob) adds a simple API on top of smobs to support this. tracking of GDB objects vs Scheme objects. Gsmobs can "subclass"
This allows GDB objects to be easily extendable in a useful manner.
To that end, all smobs in gdb have gdb_smob as the first member.
On top of gsmobs there are "chained gsmobs". They are used to assist with
life-time tracking of GDB objects vs Scheme objects. Gsmobs can "subclass"
chained_gdb_smob, which contains a doubly-linked list to assist with chained_gdb_smob, which contains a doubly-linked list to assist with
life-time tracking. life-time tracking.
On top of gsmobs there are also "eqable gsmobs". Gsmobs can "subclass" Some other GDB smobs are "eqable gsmobs". Gsmob implementations can
eqable_gdb_smob instead of gdb_smob, and is used to make gsmobs eq?-able. "subclass" eqable_gdb_smob to make gsmobs eq?-able. This is done by
This is done by recording all gsmobs in a hash table and before creating a recording all gsmobs in a hash table and before creating a gsmob first
gsmob first seeing if it's already in the table. Eqable gsmobs can also be seeing if it's already in the table. Eqable gsmobs can also be used where
used where lifetime-tracking is required. lifetime-tracking is required. */
Gsmobs (and chained/eqable gsmobs) add an extra field that is used to
record extra data: "properties". It is a table of key/value pairs
that can be set with set-gsmob-property!, gsmob-property. */
#include "defs.h" #include "defs.h"
#include "hashtab.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. */ /* Hash function for registered_gsmobs hash table. */
static hashval_t static hashval_t
@ -131,7 +113,7 @@ gdbscm_make_smob_type (const char *name, size_t size)
void void
gdbscm_init_gsmob (gdb_smob *base) 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;
}
/* gsmob accessors */ /* 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. */ "-kind" because smobs aren't real GOOPS classes. */
static SCM 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;
}
/* When underlying gdb data structures are deleted, we need to update any /* When underlying gdb data structures are deleted, we need to update any
smobs with references to them. There are several smobs that reference 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, /* 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., <gdb:breakpoint>, as a symbol." }, Return the kind of the GDB object, e.g., <gdb:breakpoint>, as a symbol." },
{ "gsmob-property", 2, 0, 0, gdbscm_gsmob_property,
"\
Return the specified property of the gsmob." },
{ "set-gsmob-property!", 3, 0, 0, gdbscm_set_gsmob_property_x,
"\
Set the specified property of the gsmob." },
{ "gsmob-has-property?", 2, 0, 0, gdbscm_gsmob_has_property_p,
"\
Return #t if the specified property is present." },
{ "gsmob-properties", 1, 0, 0, gdbscm_gsmob_properties,
"\
Return an unsorted list of names of properties." },
END_FUNCTIONS END_FUNCTIONS
}; };

4
gdb/guile/scm-iterator.c
View File

@ -119,9 +119,7 @@ itscm_mark_iterator_smob (SCM self)
scm_gc_mark (i_smob->object); scm_gc_mark (i_smob->object);
scm_gc_mark (i_smob->progress); scm_gc_mark (i_smob->progress);
scm_gc_mark (i_smob->next_x); return i_smob->next_x;
/* Do this last. */
return gdbscm_mark_gsmob (&i_smob->base);
} }
/* The smob "print" function for <gdb:iterator>. */ /* The smob "print" function for <gdb:iterator>. */

5
gdb/guile/scm-lazy-string.c
View File

@ -68,10 +68,7 @@ static scm_t_bits lazy_string_smob_tag;
static SCM static SCM
lsscm_mark_lazy_string_smob (SCM self) lsscm_mark_lazy_string_smob (SCM self)
{ {
lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (self); return SCM_BOOL_F;
/* Do this last. */
return gdbscm_mark_gsmob (&ls_smob->base);
} }
/* The smob "free" function for <gdb:lazy-string>. */ /* The smob "free" function for <gdb:lazy-string>. */

5
gdb/guile/scm-objfile.c
View File

@ -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 /* We don't mark containing_scm here. It is just a backlink to our
container, and is gc-protected until the objfile is deleted. */ container, and is gc-protected until the objfile is deleted. */
/* Do this last. */ return o_smob->pretty_printers;
return gdbscm_mark_gsmob (&o_smob->base);
} }
/* The smob "print" function for <gdb:objfile>. */ /* The smob "print" function for <gdb:objfile>. */

8
gdb/guile/scm-pretty-print.c
View File

@ -136,9 +136,7 @@ ppscm_mark_pretty_printer_smob (SCM self)
scm_gc_mark (pp_smob->name); scm_gc_mark (pp_smob->name);
scm_gc_mark (pp_smob->enabled); scm_gc_mark (pp_smob->enabled);
scm_gc_mark (pp_smob->lookup); return pp_smob->lookup;
/* Do this last. */
return gdbscm_mark_gsmob (&pp_smob->base);
} }
/* 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->display_hint);
scm_gc_mark (w_smob->to_string); scm_gc_mark (w_smob->to_string);
scm_gc_mark (w_smob->children); return w_smob->children;
/* Do this last. */
return gdbscm_mark_gsmob (&w_smob->base);
} }
/* The smob "print" function for <gdb:pretty-printer-worker>. */ /* The smob "print" function for <gdb:pretty-printer-worker>. */

5
gdb/guile/scm-symbol.c
View File

@ -100,10 +100,7 @@ syscm_objfile_symbol_map (struct symbol *symbol)
static SCM static SCM
syscm_mark_symbol_smob (SCM self) syscm_mark_symbol_smob (SCM self)
{ {
symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self); return SCM_BOOL_F;
/* Do this last. */
return gdbscm_mark_eqable_gsmob (&s_smob->base);
} }
/* The smob "free" function for <gdb:symbol>. */ /* The smob "free" function for <gdb:symbol>. */

10
gdb/guile/scm-symtab.c
View File

@ -127,10 +127,7 @@ stscm_objfile_symtab_map (struct symtab *symtab)
static SCM static SCM
stscm_mark_symtab_smob (SCM self) stscm_mark_symtab_smob (SCM self)
{ {
symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self); return SCM_BOOL_F;
/* Do this last. */
return gdbscm_mark_eqable_gsmob (&st_smob->base);
} }
/* 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); return s_smob->symtab_scm;
/* Do this last. */
return gdbscm_mark_gsmob (&s_smob->base);
} }
/* The smob "free" function for <gdb:sal>. */ /* The smob "free" function for <gdb:sal>. */

9
gdb/guile/scm-type.c
View File

@ -186,10 +186,7 @@ tyscm_type_map (struct type *type)
static SCM static SCM
tyscm_mark_type_smob (SCM self) tyscm_mark_type_smob (SCM self)
{ {
type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self); return SCM_BOOL_F;
/* Do this last. */
return gdbscm_mark_eqable_gsmob (&t_smob->base);
} }
/* 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); return f_smob->type_scm;
/* Do this last. */
return gdbscm_mark_gsmob (&f_smob->base);
} }
/* The smob "print" function for <gdb:field>. */ /* The smob "print" function for <gdb:field>. */

4
gdb/guile/scm-value.c
View File

@ -132,9 +132,7 @@ vlscm_mark_value_smob (SCM self)
scm_gc_mark (v_smob->address); scm_gc_mark (v_smob->address);
scm_gc_mark (v_smob->type); scm_gc_mark (v_smob->type);
scm_gc_mark (v_smob->dynamic_type); return v_smob->dynamic_type;
/* Do this last. */
return gdbscm_mark_gsmob (&v_smob->base);
} }
/* The smob "free" function for <gdb:value>. */ /* The smob "free" function for <gdb:value>. */

6
gdb/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2014-05-26 Andy Wingo <wingo@igalia.com>
* 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 <yao@codesourcery.com> 2014-05-26 Yao Qi <yao@codesourcery.com>
* gdb.server/no-thread-db.exp: Specify source file name * gdb.server/no-thread-db.exp: Specify source file name

14
gdb/testsuite/gdb.guile/scm-breakpoint.exp
View File

@ -310,14 +310,14 @@ proc test_bkpt_eval_funcs { } {
"(define set-bp-data-count! set-car!)" "" \ "(define set-bp-data-count! set-car!)" "" \
"(define bp-data-inf-i cdr)" "" \ "(define bp-data-inf-i cdr)" "" \
"(define set-bp-data-inf-i! set-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-count bkpt) (bp-data-count (object-property bkpt 'bp-data)))" "" \
"(define (bp-eval-inf-i bkpt) (bp-data-inf-i (gsmob-property bkpt 'bp-data)))" "" \ "(define (bp-eval-inf-i bkpt) (bp-data-inf-i (object-property bkpt 'bp-data)))" "" \
"(define (make-bp-eval location)" "" \ "(define (make-bp-eval location)" "" \
" (let ((bp (create-breakpoint! 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" "" \ " (set-breakpoint-stop! bp" "" \
" (lambda (bkpt)" "" \ " (lambda (bkpt)" "" \
" (let ((data (gsmob-property bkpt 'bp-data))" "" \ " (let ((data (object-property bkpt 'bp-data))" "" \
" (inf-i (parse-and-eval \"i\")))" "" \ " (inf-i (parse-and-eval \"i\")))" "" \
" (set-bp-data-count! data (+ (bp-data-count data) 1))" "" \ " (set-bp-data-count! data (+ (bp-data-count data) 1))" "" \
" (set-bp-data-inf-i! data inf-i)" "" \ " (set-bp-data-inf-i! data inf-i)" "" \
@ -329,10 +329,10 @@ proc test_bkpt_eval_funcs { } {
"guile" "" \ "guile" "" \
"(define (make-bp-also-eval location)" "" \ "(define (make-bp-also-eval location)" "" \
" (let ((bp (create-breakpoint! 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" "" \ " (set-breakpoint-stop! bp" "" \
" (lambda (bkpt)" "" \ " (lambda (bkpt)" "" \
" (let* ((data (gsmob-property bkpt 'bp-data))" "" \ " (let* ((data (object-property bkpt 'bp-data))" "" \
" (count (+ (bp-data-count data) 1)))" "" \ " (count (+ (bp-data-count data) 1)))" "" \
" (set-bp-data-count! data count)" "" \ " (set-bp-data-count! data count)" "" \
" (= count 9))))" "" \ " (= count 9))))" "" \
@ -343,7 +343,7 @@ proc test_bkpt_eval_funcs { } {
"guile" "" \ "guile" "" \
"(define (make-bp-basic location)" "" \ "(define (make-bp-basic location)" "" \
" (let ((bp (create-breakpoint! 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))" "" \ " bp))" "" \
"end" "" "end" ""

20
gdb/testsuite/gdb.guile/scm-gsmob.exp
View File

@ -45,26 +45,24 @@ proc prop_name { i } {
# Set and ref the properties in separate loops to verify previously set # 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. # 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} { 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)" \ gdb_test "gu (print (set-object-property! arch '[prop_name $i] $i))" \
"set prop $i" "= $i" "set prop $i"
gdb_test "gu (print (gsmob-has-property? arch '[prop_name $i]))" \ gdb_test "gu (print (object-property arch '[prop_name $i]))" \
"= #t" "property prop$i present after set" "= $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]))" \ gdb_test "gu (print (object-property arch '[prop_name $i]))" \
"= #t" "property prop$i present after all set"
gdb_test "gu (print (gsmob-property arch '[prop_name $i]))" \
"= $i" "ref prop $i" "= $i" "ref prop $i"
} }
# Verify gsmob-properties. # Verify properties.
set prop_list "" set prop_list ""
for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} { for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} {
set prop_list "$prop_list [prop_name $i]" set prop_list "$prop_list [prop_name $i]"
} }
set prop_list [lsort $prop_list] set prop_list [lsort $prop_list]
verbose -log "prop_list: $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)))))" \ gdb_test "gu (print (sort (map car (object-properties arch)) (lambda (a b) (string<? (symbol->string a) (symbol->string b)))))" \
"= \\($prop_list\\)" "gsmob-properties" "= \\($prop_list\\)" "object-properties"