Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* GDB/Scheme smobs (gsmob is pronounced "jee smob") |
2 | ||
3 | Copyright (C) 2014 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 | ||
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" | |
46 | #include "gdb_assert.h" | |
47 | #include "objfiles.h" | |
48 | #include "guile-internal.h" | |
49 | ||
50 | /* We need to call this. Undo our hack to prevent others from calling it. */ | |
51 | #undef scm_make_smob_type | |
52 | ||
53 | static htab_t registered_gsmobs; | |
54 | ||
ed3ef339 DE |
55 | /* Hash function for registered_gsmobs hash table. */ |
56 | ||
57 | static hashval_t | |
58 | hash_scm_t_bits (const void *item) | |
59 | { | |
60 | uintptr_t v = (uintptr_t) item; | |
61 | ||
62 | return v; | |
63 | } | |
64 | ||
65 | /* Equality function for registered_gsmobs hash table. */ | |
66 | ||
67 | static int | |
68 | eq_scm_t_bits (const void *item_lhs, const void *item_rhs) | |
69 | { | |
70 | return item_lhs == item_rhs; | |
71 | } | |
72 | ||
73 | /* Record GSMOB_CODE as being a gdb smob. | |
74 | GSMOB_CODE is the result of scm_make_smob_type. */ | |
75 | ||
76 | static void | |
77 | register_gsmob (scm_t_bits gsmob_code) | |
78 | { | |
79 | void **slot; | |
80 | ||
81 | slot = htab_find_slot (registered_gsmobs, (void *) gsmob_code, INSERT); | |
82 | gdb_assert (*slot == NULL); | |
83 | *slot = (void *) gsmob_code; | |
84 | } | |
85 | ||
86 | /* Return non-zero if SCM is any registered gdb smob object. */ | |
87 | ||
88 | static int | |
89 | gdbscm_is_gsmob (SCM scm) | |
90 | { | |
91 | void **slot; | |
92 | ||
93 | if (SCM_IMP (scm)) | |
94 | return 0; | |
95 | slot = htab_find_slot (registered_gsmobs, (void *) SCM_TYP16 (scm), | |
96 | NO_INSERT); | |
97 | return slot != NULL; | |
98 | } | |
99 | ||
100 | /* Call this to register a smob, instead of scm_make_smob_type. */ | |
101 | ||
102 | scm_t_bits | |
103 | gdbscm_make_smob_type (const char *name, size_t size) | |
104 | { | |
105 | scm_t_bits result = scm_make_smob_type (name, size); | |
106 | ||
107 | register_gsmob (result); | |
108 | return result; | |
109 | } | |
110 | ||
111 | /* Initialize a gsmob. */ | |
112 | ||
113 | void | |
114 | gdbscm_init_gsmob (gdb_smob *base) | |
115 | { | |
b2715b27 | 116 | base->empty_base_class = 0; |
ed3ef339 DE |
117 | } |
118 | ||
119 | /* Initialize a chained_gdb_smob. | |
120 | This is the same as gdbscm_init_gsmob except that it also sets prev,next | |
121 | to NULL. */ | |
122 | ||
123 | void | |
124 | gdbscm_init_chained_gsmob (chained_gdb_smob *base) | |
125 | { | |
126 | gdbscm_init_gsmob ((gdb_smob *) base); | |
127 | base->prev = NULL; | |
128 | base->next = NULL; | |
129 | } | |
130 | ||
131 | /* Initialize an eqable_gdb_smob. | |
132 | This is the same as gdbscm_init_gsmob except that it also sets | |
1254eefc | 133 | BASE->containing_scm to CONTAINING_SCM. */ |
ed3ef339 DE |
134 | |
135 | void | |
1254eefc | 136 | gdbscm_init_eqable_gsmob (eqable_gdb_smob *base, SCM containing_scm) |
ed3ef339 DE |
137 | { |
138 | gdbscm_init_gsmob ((gdb_smob *) base); | |
1254eefc | 139 | base->containing_scm = containing_scm; |
ed3ef339 DE |
140 | } |
141 | ||
ed3ef339 DE |
142 | \f |
143 | /* gsmob accessors */ | |
144 | ||
145 | /* Return the gsmob in SELF. | |
146 | Throws an exception if SELF is not a gsmob. */ | |
147 | ||
148 | static SCM | |
149 | gsscm_get_gsmob_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
150 | { | |
151 | SCM_ASSERT_TYPE (gdbscm_is_gsmob (self), self, arg_pos, func_name, | |
152 | _("any gdb smob")); | |
153 | ||
154 | return self; | |
155 | } | |
156 | ||
b2715b27 | 157 | /* (gdb-object-kind gsmob) -> symbol |
ed3ef339 | 158 | |
b2715b27 | 159 | Note: While one might want to name this gdb-object-class-name, it is named |
ed3ef339 DE |
160 | "-kind" because smobs aren't real GOOPS classes. */ |
161 | ||
162 | static SCM | |
163 | gdbscm_gsmob_kind (SCM self) | |
164 | { | |
165 | SCM smob, result; | |
166 | scm_t_bits smobnum; | |
167 | const char *name; | |
168 | char *kind; | |
169 | ||
170 | smob = gsscm_get_gsmob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
171 | ||
172 | smobnum = SCM_SMOBNUM (smob); | |
173 | name = SCM_SMOBNAME (smobnum); | |
174 | kind = xstrprintf ("<%s>", name); | |
175 | result = scm_from_latin1_symbol (kind); | |
176 | xfree (kind); | |
177 | ||
178 | return result; | |
179 | } | |
180 | ||
ed3ef339 DE |
181 | \f |
182 | /* When underlying gdb data structures are deleted, we need to update any | |
183 | smobs with references to them. There are several smobs that reference | |
184 | objfile-based data, so we provide helpers to manage this. */ | |
185 | ||
186 | /* Add G_SMOB to the reference chain for OBJFILE specified by DATA_KEY. | |
187 | OBJFILE may be NULL, in which case just set prev,next to NULL. */ | |
188 | ||
189 | void | |
190 | gdbscm_add_objfile_ref (struct objfile *objfile, | |
191 | const struct objfile_data *data_key, | |
192 | chained_gdb_smob *g_smob) | |
193 | { | |
194 | g_smob->prev = NULL; | |
195 | if (objfile != NULL) | |
196 | { | |
197 | g_smob->next = objfile_data (objfile, data_key); | |
198 | if (g_smob->next) | |
199 | g_smob->next->prev = g_smob; | |
200 | set_objfile_data (objfile, data_key, g_smob); | |
201 | } | |
202 | else | |
203 | g_smob->next = NULL; | |
204 | } | |
205 | ||
206 | /* Remove G_SMOB from the reference chain for OBJFILE specified | |
207 | by DATA_KEY. OBJFILE may be NULL. */ | |
208 | ||
209 | void | |
210 | gdbscm_remove_objfile_ref (struct objfile *objfile, | |
211 | const struct objfile_data *data_key, | |
212 | chained_gdb_smob *g_smob) | |
213 | { | |
214 | if (g_smob->prev) | |
215 | g_smob->prev->next = g_smob->next; | |
216 | else if (objfile != NULL) | |
217 | set_objfile_data (objfile, data_key, g_smob->next); | |
218 | if (g_smob->next) | |
219 | g_smob->next->prev = g_smob->prev; | |
220 | } | |
221 | ||
222 | /* Create a hash table for mapping a pointer to a gdb data structure to the | |
223 | gsmob that wraps it. */ | |
224 | ||
225 | htab_t | |
226 | gdbscm_create_eqable_gsmob_ptr_map (htab_hash hash_fn, htab_eq eq_fn) | |
227 | { | |
228 | htab_t htab = htab_create_alloc (7, hash_fn, eq_fn, | |
229 | NULL, xcalloc, xfree); | |
230 | ||
231 | return htab; | |
232 | } | |
233 | ||
234 | /* Return a pointer to the htab entry for the eq?-able gsmob BASE. | |
235 | If the entry is found, *SLOT is non-NULL. | |
236 | Otherwise *slot is NULL. */ | |
237 | ||
238 | eqable_gdb_smob ** | |
239 | gdbscm_find_eqable_gsmob_ptr_slot (htab_t htab, eqable_gdb_smob *base) | |
240 | { | |
241 | void **slot = htab_find_slot (htab, base, INSERT); | |
242 | ||
243 | return (eqable_gdb_smob **) slot; | |
244 | } | |
245 | ||
1254eefc DE |
246 | /* Record BASE in SLOT. SLOT must be the result of calling |
247 | gdbscm_find_eqable_gsmob_ptr_slot on BASE (or equivalent for lookup). */ | |
ed3ef339 DE |
248 | |
249 | void | |
250 | gdbscm_fill_eqable_gsmob_ptr_slot (eqable_gdb_smob **slot, | |
1254eefc | 251 | eqable_gdb_smob *base) |
ed3ef339 | 252 | { |
ed3ef339 DE |
253 | *slot = base; |
254 | } | |
255 | ||
256 | /* Remove BASE from HTAB. | |
257 | BASE is a pointer to a gsmob that wraps a pointer to a GDB datum. | |
258 | This is used, for example, when an object is freed. | |
259 | ||
260 | It is an error to call this if PTR is not in HTAB (only because it allows | |
261 | for some consistency checking). */ | |
262 | ||
263 | void | |
264 | gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab, eqable_gdb_smob *base) | |
265 | { | |
266 | void **slot = htab_find_slot (htab, base, NO_INSERT); | |
267 | ||
268 | gdb_assert (slot != NULL); | |
269 | htab_clear_slot (htab, slot); | |
270 | } | |
271 | \f | |
272 | /* Initialize the Scheme gsmobs code. */ | |
273 | ||
274 | static const scheme_function gsmob_functions[] = | |
275 | { | |
b2715b27 AW |
276 | /* N.B. There is a general rule of not naming symbols in gdb-guile with a |
277 | "gdb" prefix. This symbol does not violate this rule because it is to | |
278 | be read as "gdb-object-foo", not "gdb-foo". */ | |
279 | { "gdb-object-kind", 1, 0, 0, gdbscm_gsmob_kind, | |
ed3ef339 | 280 | "\ |
b2715b27 | 281 | Return the kind of the GDB object, e.g., <gdb:breakpoint>, as a symbol." }, |
ed3ef339 DE |
282 | |
283 | END_FUNCTIONS | |
284 | }; | |
285 | ||
286 | void | |
287 | gdbscm_initialize_smobs (void) | |
288 | { | |
289 | registered_gsmobs = htab_create_alloc (10, | |
290 | hash_scm_t_bits, eq_scm_t_bits, | |
291 | NULL, xcalloc, xfree); | |
292 | ||
293 | gdbscm_define_functions (gsmob_functions, 1); | |
294 | } |