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-2018 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
113 gdbscm_init_gsmob (gdb_smob *base)
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
123 gdbscm_init_chained_gsmob (chained_gdb_smob *base)
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
135 gdbscm_init_eqable_gsmob (eqable_gdb_smob *base, SCM containing_scm)
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
162 gdbscm_gsmob_kind (SCM self)
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
189 gdbscm_add_objfile_ref (struct objfile *objfile,
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 = (chained_gdb_smob *) 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
209 gdbscm_remove_objfile_ref (struct objfile *objfile,
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
237 eqable_gdb_smob **
238 gdbscm_find_eqable_gsmob_ptr_slot (htab_t htab, eqable_gdb_smob *base)
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
249 gdbscm_fill_eqable_gsmob_ptr_slot (eqable_gdb_smob **slot,
250 eqable_gdb_smob *base)
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
263 gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab, eqable_gdb_smob *base)
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, as_a_scm_t_subr (gdbscm_gsmob_kind),
279 "\
280 Return the kind of the GDB object, e.g., <gdb:breakpoint>, as a symbol." },
281
282 END_FUNCTIONS
283 };
284
285 void
286 gdbscm_initialize_smobs (void)
287 {
288 registered_gsmobs = htab_create_alloc (10,
289 hash_scm_t_bits, eq_scm_t_bits,
290 NULL, xcalloc, xfree);
291
292 gdbscm_define_functions (gsmob_functions, 1);
293 }
as_a_scm_t_subr
static scm_t_subr as_a_scm_t_subr(SCM(*func)(void))
Definition: guile-internal.h:66
gdbscm_init_eqable_gsmob
void gdbscm_init_eqable_gsmob(eqable_gdb_smob *base, SCM containing_scm)
Definition: scm-gsmob.c:135
gdbscm_define_functions
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
eq_scm_t_bits
static int eq_scm_t_bits(const void *item_lhs, const void *item_rhs)
Definition: scm-gsmob.c:67
xfree
void xfree(void *)
gdbscm_clear_eqable_gsmob_ptr_slot
void gdbscm_clear_eqable_gsmob_ptr_slot(htab_t htab, eqable_gdb_smob *base)
Definition: scm-gsmob.c:263
FUNC_NAME
#define FUNC_NAME
Definition: guile-internal.h:153
guile-internal.h
gdbscm_fill_eqable_gsmob_ptr_slot
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:35
defs.h
gdbscm_create_eqable_gsmob_ptr_map
htab_t gdbscm_create_eqable_gsmob_ptr_map(htab_hash hash_fn, htab_eq eq_fn)
Definition: scm-gsmob.c:225
gdbscm_find_eqable_gsmob_ptr_slot
eqable_gdb_smob ** gdbscm_find_eqable_gsmob_ptr_slot(htab_t htab, eqable_gdb_smob *base)
Definition: scm-gsmob.c:238
gdbscm_is_gsmob
static int gdbscm_is_gsmob(SCM scm)
Definition: scm-gsmob.c:88
objfiles.h
name
const char *const name
Definition: aarch64-tdep.c:76
gdbscm_init_gsmob
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:113
_chained_gdb_smob
Definition: guile-internal.h:246
_chained_gdb_smob::next
struct _chained_gdb_smob * next
Definition: guile-internal.h:251
register_gsmob
static void register_gsmob(scm_t_bits gsmob_code)
Definition: scm-gsmob.c:76
gdb_smob
Definition: guile-internal.h:241
scheme_function
Definition: guile-internal.h:91
_chained_gdb_smob::prev
GDB_SMOB_HEAD struct _chained_gdb_smob * prev
Definition: guile-internal.h:250
gdbscm_initialize_smobs
void gdbscm_initialize_smobs(void)
Definition: scm-gsmob.c:286
gdbscm_add_objfile_ref
void gdbscm_add_objfile_ref(struct objfile *objfile, const struct objfile_data *data_key, chained_gdb_smob *g_smob)
Definition: scm-gsmob.c:189
xstrprintf
char * xstrprintf(const char *format,...)
Definition: common-utils.c:107
gdb_assert
#define gdb_assert(expr)
Definition: gdb_assert.h:32
gdbscm_make_smob_type
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
gdbscm_remove_objfile_ref
void gdbscm_remove_objfile_ref(struct objfile *objfile, const struct objfile_data *data_key, chained_gdb_smob *g_smob)
Definition: scm-gsmob.c:209
objfile
Definition: objfiles.h:286
END_FUNCTIONS
#define END_FUNCTIONS
Definition: guile-internal.h:103
scm_make_smob_type
#define scm_make_smob_type
Definition: guile-internal.h:121
_eqable_gdb_smob
Definition: guile-internal.h:254
gdbscm_init_chained_gsmob
void gdbscm_init_chained_gsmob(chained_gdb_smob *base)
Definition: scm-gsmob.c:123
gsscm_get_gsmob_arg_unsafe
static SCM gsscm_get_gsmob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-gsmob.c:148
frame_info::base
const struct frame_base * base
Definition: frame.c:142
gdbscm_gsmob_kind
static SCM gdbscm_gsmob_kind(SCM self)
Definition: scm-gsmob.c:162
hash_scm_t_bits
static hashval_t hash_scm_t_bits(const void *item)
Definition: scm-gsmob.c:57
xcalloc
PTR xcalloc(size_t number, size_t size)
Definition: common-utils.c:72
size
size_t size
Definition: go32-nat.c:242
registered_gsmobs
static htab_t registered_gsmobs
Definition: scm-gsmob.c:52
gsmob_functions
static const scheme_function gsmob_functions[]
Definition: scm-gsmob.c:273