Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* GDB/Scheme smobs (gsmob is pronounced "jee smob") |
2 | ||
61baf725 | 3 | Copyright (C) 2014-2017 Free Software Foundation, Inc. |
ed3ef339 DE |
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 | ||
b2715b27 AW |
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" | |
ed3ef339 DE |
35 | chained_gdb_smob, which contains a doubly-linked list to assist with |
36 | life-time tracking. | |
37 | ||
b2715b27 AW |
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. */ | |
ed3ef339 DE |
43 | |
44 | #include "defs.h" | |
45 | #include "hashtab.h" | |
ed3ef339 DE |
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 | ||
ed3ef339 DE |
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 | { | |
b2715b27 | 115 | base->empty_base_class = 0; |
ed3ef339 DE |
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 | |
1254eefc | 132 | BASE->containing_scm to CONTAINING_SCM. */ |
ed3ef339 DE |
133 | |
134 | void | |
1254eefc | 135 | gdbscm_init_eqable_gsmob (eqable_gdb_smob *base, SCM containing_scm) |
ed3ef339 DE |
136 | { |
137 | gdbscm_init_gsmob ((gdb_smob *) base); | |
1254eefc | 138 | base->containing_scm = containing_scm; |
ed3ef339 DE |
139 | } |
140 | ||
ed3ef339 DE |
141 | \f |
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 | ||
b2715b27 | 156 | /* (gdb-object-kind gsmob) -> symbol |
ed3ef339 | 157 | |
b2715b27 | 158 | Note: While one might want to name this gdb-object-class-name, it is named |
ed3ef339 DE |
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 | ||
ed3ef339 DE |
180 | \f |
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 | { | |
9a3c8263 | 196 | g_smob->next = (chained_gdb_smob *) objfile_data (objfile, data_key); |
ed3ef339 DE |
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 | ||
1254eefc DE |
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). */ | |
ed3ef339 DE |
247 | |
248 | void | |
249 | gdbscm_fill_eqable_gsmob_ptr_slot (eqable_gdb_smob **slot, | |
1254eefc | 250 | eqable_gdb_smob *base) |
ed3ef339 | 251 | { |
ed3ef339 DE |
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 | \f | |
271 | /* Initialize the Scheme gsmobs code. */ | |
272 | ||
273 | static const scheme_function gsmob_functions[] = | |
274 | { | |
b2715b27 AW |
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". */ | |
72e02483 | 278 | { "gdb-object-kind", 1, 0, 0, as_a_scm_t_subr (gdbscm_gsmob_kind), |
ed3ef339 | 279 | "\ |
b2715b27 | 280 | Return the kind of the GDB object, e.g., <gdb:breakpoint>, as a symbol." }, |
ed3ef339 DE |
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 | } |