GDB (xrefs)
scm-gsmob.c
Go to the documentation of this file.
1 /* GDB/Scheme smobs (gsmob is pronounced "jee smob")
2 
3  Copyright (C) 2014-2015 Free Software Foundation, Inc.
4 
5  This file is part of GDB.
6 
7  This program is free software; you can redistribute it and/or modify
8  it under the terms of the GNU General Public License as published by
9  the Free Software Foundation; either version 3 of the License, or
10  (at your option) any later version.
11 
12  This program is distributed in the hope that it will be useful,
13  but WITHOUT ANY WARRANTY; without even the implied warranty of
14  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15  GNU General Public License for more details.
16 
17  You should have received a copy of the GNU General Public License
18  along with this program. If not, see <http://www.gnu.org/licenses/>. */
19 
20 /* See README file in this directory for implementation notes, coding
21  conventions, et.al. */
22 
23 /* Smobs are Guile's "small object".
24  They are used to export C structs to Scheme.
25 
26  Note: There's only room in the encoding space for 256, and while we won't
27  come close to that, mixed with other libraries maybe someday we could.
28  We don't worry about it now, except to be aware of the issue.
29  We could allocate just a few smobs and use the unused smob flags field to
30  specify the gdb smob kind, that is left for another day if it ever is
31  needed.
32 
33  Some GDB smobs are "chained gsmobs". They are used to assist with life-time
34  tracking of GDB objects vs Scheme objects. Gsmobs can "subclass"
35  chained_gdb_smob, which contains a doubly-linked list to assist with
36  life-time tracking.
37 
38  Some other GDB smobs are "eqable gsmobs". Gsmob implementations can
39  "subclass" eqable_gdb_smob to make gsmobs eq?-able. This is done by
40  recording all gsmobs in a hash table and before creating a gsmob first
41  seeing if it's already in the table. Eqable gsmobs can also be used where
42  lifetime-tracking is required. */
43 
44 #include "defs.h"
45 #include "hashtab.h"
46 #include "objfiles.h"
47 #include "guile-internal.h"
48 
49 /* We need to call this. Undo our hack to prevent others from calling it. */
50 #undef scm_make_smob_type
51 
52 static htab_t registered_gsmobs;
53 
54 /* Hash function for registered_gsmobs hash table. */
55 
56 static hashval_t
57 hash_scm_t_bits (const void *item)
58 {
59  uintptr_t v = (uintptr_t) item;
60 
61  return v;
62 }
63 
64 /* Equality function for registered_gsmobs hash table. */
65 
66 static int
67 eq_scm_t_bits (const void *item_lhs, const void *item_rhs)
68 {
69  return item_lhs == item_rhs;
70 }
71 
72 /* Record GSMOB_CODE as being a gdb smob.
73  GSMOB_CODE is the result of scm_make_smob_type. */
74 
75 static void
76 register_gsmob (scm_t_bits gsmob_code)
77 {
78  void **slot;
79 
80  slot = htab_find_slot (registered_gsmobs, (void *) gsmob_code, INSERT);
81  gdb_assert (*slot == NULL);
82  *slot = (void *) gsmob_code;
83 }
84 
85 /* Return non-zero if SCM is any registered gdb smob object. */
86 
87 static int
88 gdbscm_is_gsmob (SCM scm)
89 {
90  void **slot;
91 
92  if (SCM_IMP (scm))
93  return 0;
94  slot = htab_find_slot (registered_gsmobs, (void *) SCM_TYP16 (scm),
95  NO_INSERT);
96  return slot != NULL;
97 }
98 
99 /* Call this to register a smob, instead of scm_make_smob_type. */
100 
101 scm_t_bits
102 gdbscm_make_smob_type (const char *name, size_t size)
103 {
104  scm_t_bits result = scm_make_smob_type (name, size);
105 
106  register_gsmob (result);
107  return result;
108 }
109 
110 /* Initialize a gsmob. */
111 
112 void
114 {
115  base->empty_base_class = 0;
116 }
117 
118 /* Initialize a chained_gdb_smob.
119  This is the same as gdbscm_init_gsmob except that it also sets prev,next
120  to NULL. */
121 
122 void
124 {
125  gdbscm_init_gsmob ((gdb_smob *) base);
126  base->prev = NULL;
127  base->next = NULL;
128 }
129 
130 /* Initialize an eqable_gdb_smob.
131  This is the same as gdbscm_init_gsmob except that it also sets
132  BASE->containing_scm to CONTAINING_SCM. */
133 
134 void
136 {
137  gdbscm_init_gsmob ((gdb_smob *) base);
138  base->containing_scm = containing_scm;
139 }
140 
141 
142 /* gsmob accessors */
143 
144 /* Return the gsmob in SELF.
145  Throws an exception if SELF is not a gsmob. */
146 
147 static SCM
148 gsscm_get_gsmob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
149 {
150  SCM_ASSERT_TYPE (gdbscm_is_gsmob (self), self, arg_pos, func_name,
151  _("any gdb smob"));
152 
153  return self;
154 }
155 
156 /* (gdb-object-kind gsmob) -> symbol
157 
158  Note: While one might want to name this gdb-object-class-name, it is named
159  "-kind" because smobs aren't real GOOPS classes. */
160 
161 static SCM
163 {
164  SCM smob, result;
165  scm_t_bits smobnum;
166  const char *name;
167  char *kind;
168 
169  smob = gsscm_get_gsmob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
170 
171  smobnum = SCM_SMOBNUM (smob);
172  name = SCM_SMOBNAME (smobnum);
173  kind = xstrprintf ("<%s>", name);
174  result = scm_from_latin1_symbol (kind);
175  xfree (kind);
176 
177  return result;
178 }
179 
180 
181 /* When underlying gdb data structures are deleted, we need to update any
182  smobs with references to them. There are several smobs that reference
183  objfile-based data, so we provide helpers to manage this. */
184 
185 /* Add G_SMOB to the reference chain for OBJFILE specified by DATA_KEY.
186  OBJFILE may be NULL, in which case just set prev,next to NULL. */
187 
188 void
190  const struct objfile_data *data_key,
191  chained_gdb_smob *g_smob)
192 {
193  g_smob->prev = NULL;
194  if (objfile != NULL)
195  {
196  g_smob->next = objfile_data (objfile, data_key);
197  if (g_smob->next)
198  g_smob->next->prev = g_smob;
199  set_objfile_data (objfile, data_key, g_smob);
200  }
201  else
202  g_smob->next = NULL;
203 }
204 
205 /* Remove G_SMOB from the reference chain for OBJFILE specified
206  by DATA_KEY. OBJFILE may be NULL. */
207 
208 void
210  const struct objfile_data *data_key,
211  chained_gdb_smob *g_smob)
212 {
213  if (g_smob->prev)
214  g_smob->prev->next = g_smob->next;
215  else if (objfile != NULL)
216  set_objfile_data (objfile, data_key, g_smob->next);
217  if (g_smob->next)
218  g_smob->next->prev = g_smob->prev;
219 }
220 
221 /* Create a hash table for mapping a pointer to a gdb data structure to the
222  gsmob that wraps it. */
223 
224 htab_t
225 gdbscm_create_eqable_gsmob_ptr_map (htab_hash hash_fn, htab_eq eq_fn)
226 {
227  htab_t htab = htab_create_alloc (7, hash_fn, eq_fn,
228  NULL, xcalloc, xfree);
229 
230  return htab;
231 }
232 
233 /* Return a pointer to the htab entry for the eq?-able gsmob BASE.
234  If the entry is found, *SLOT is non-NULL.
235  Otherwise *slot is NULL. */
236 
239 {
240  void **slot = htab_find_slot (htab, base, INSERT);
241 
242  return (eqable_gdb_smob **) slot;
243 }
244 
245 /* Record BASE in SLOT. SLOT must be the result of calling
246  gdbscm_find_eqable_gsmob_ptr_slot on BASE (or equivalent for lookup). */
247 
248 void
251 {
252  *slot = base;
253 }
254 
255 /* Remove BASE from HTAB.
256  BASE is a pointer to a gsmob that wraps a pointer to a GDB datum.
257  This is used, for example, when an object is freed.
258 
259  It is an error to call this if PTR is not in HTAB (only because it allows
260  for some consistency checking). */
261 
262 void
264 {
265  void **slot = htab_find_slot (htab, base, NO_INSERT);
266 
267  gdb_assert (slot != NULL);
268  htab_clear_slot (htab, slot);
269 }
270 
271 /* Initialize the Scheme gsmobs code. */
272 
273 static const scheme_function gsmob_functions[] =
274 {
275  /* N.B. There is a general rule of not naming symbols in gdb-guile with a
276  "gdb" prefix. This symbol does not violate this rule because it is to
277  be read as "gdb-object-foo", not "gdb-foo". */
278  { "gdb-object-kind", 1, 0, 0, gdbscm_gsmob_kind,
279  "\
280 Return the kind of the GDB object, e.g., <gdb:breakpoint>, as a symbol." },
281 
283 };
284 
285 void
287 {
288  registered_gsmobs = htab_create_alloc (10,
290  NULL, xcalloc, xfree);
291 
292  gdbscm_define_functions (gsmob_functions, 1);
293 }
GDB_SMOB_HEAD SCM containing_scm
void gdbscm_init_eqable_gsmob(eqable_gdb_smob *base, SCM containing_scm)
Definition: scm-gsmob.c:135
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
static int eq_scm_t_bits(const void *item_lhs, const void *item_rhs)
Definition: scm-gsmob.c:67
void xfree(void *)
Definition: common-utils.c:97
void gdbscm_clear_eqable_gsmob_ptr_slot(htab_t htab, eqable_gdb_smob *base)
Definition: scm-gsmob.c:263
#define FUNC_NAME
void gdbscm_fill_eqable_gsmob_ptr_slot(eqable_gdb_smob **slot, eqable_gdb_smob *base)
Definition: scm-gsmob.c:249
#define _(String)
Definition: gdb_locale.h:40
htab_t gdbscm_create_eqable_gsmob_ptr_map(htab_hash hash_fn, htab_eq eq_fn)
Definition: scm-gsmob.c:225
eqable_gdb_smob ** gdbscm_find_eqable_gsmob_ptr_slot(htab_t htab, eqable_gdb_smob *base)
Definition: scm-gsmob.c:238
static int gdbscm_is_gsmob(SCM scm)
Definition: scm-gsmob.c:88
const char *const name
Definition: aarch64-tdep.c:68
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:113
struct _chained_gdb_smob * next
static void register_gsmob(scm_t_bits gsmob_code)
Definition: scm-gsmob.c:76
GDB_SMOB_HEAD struct _chained_gdb_smob * prev
void gdbscm_initialize_smobs(void)
Definition: scm-gsmob.c:286
#define gdb_assert(expr)
Definition: gdb_assert.h:33
void gdbscm_add_objfile_ref(struct objfile *objfile, const struct objfile_data *data_key, chained_gdb_smob *g_smob)
Definition: scm-gsmob.c:189
char * xstrprintf(const char *format,...)
Definition: common-utils.c:107
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
void gdbscm_remove_objfile_ref(struct objfile *objfile, const struct objfile_data *data_key, chained_gdb_smob *g_smob)
Definition: scm-gsmob.c:209
#define END_FUNCTIONS
#define scm_make_smob_type
void gdbscm_init_chained_gsmob(chained_gdb_smob *base)
Definition: scm-gsmob.c:123
static SCM gsscm_get_gsmob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-gsmob.c:148
const struct frame_base * base
Definition: frame.c:133
static SCM gdbscm_gsmob_kind(SCM self)
Definition: scm-gsmob.c:162
static hashval_t hash_scm_t_bits(const void *item)
Definition: scm-gsmob.c:57
PTR xcalloc(size_t number, size_t size)
Definition: common-utils.c:71
size_t size
Definition: go32-nat.c:242
static htab_t registered_gsmobs
Definition: scm-gsmob.c:52