GDB (xrefs)
Loading...
Searching...
No Matches
scm-gsmob.c
Go to the documentation of this file.
1/* GDB/Scheme smobs (gsmob is pronounced "jee smob")
2
3 Copyright (C) 2014-2023 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
52static htab_t registered_gsmobs;
53
54/* Hash function for registered_gsmobs hash table. */
55
56static hashval_t
57hash_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
66static int
67eq_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
75static void
76register_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
87static int
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 Exports the created smob type from the current module. */
101
102scm_t_bits
103gdbscm_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
109#if SCM_MAJOR_VERSION == 2 && SCM_MINOR_VERSION == 0
110 /* Prior to Guile 2.1.0, smob classes were only exposed via exports
111 from the (oop goops) module. */
112 SCM bound_name = scm_string_append (scm_list_3 (scm_from_latin1_string ("<"),
113 scm_from_latin1_string (name),
114 scm_from_latin1_string (">")));
115 bound_name = scm_string_to_symbol (bound_name);
116 SCM smob_type = scm_public_ref (scm_list_2 (scm_from_latin1_symbol ("oop"),
117 scm_from_latin1_symbol ("goops")),
118 bound_name);
119#elif SCM_MAJOR_VERSION == 2 && SCM_MINOR_VERSION == 1 && SCM_MICRO_VERSION == 0
120 /* Guile 2.1.0 doesn't provide any API for looking up smob classes.
121 We could try allocating a fake instance and using scm_class_of,
122 but it's probably not worth the trouble for the sake of a single
123 development release. */
124# error "Unsupported Guile version"
125#else
126 /* Guile 2.1.1 and above provides scm_smob_type_class. */
127 SCM smob_type = scm_smob_type_class (result);
128#endif
129
130 SCM smob_type_name = scm_class_name (smob_type);
131 scm_define (smob_type_name, smob_type);
132 scm_module_export (scm_current_module (), scm_list_1 (smob_type_name));
133
134 return result;
135}
136
137/* Initialize a gsmob. */
138
139void
141{
142 base->empty_base_class = 0;
143}
144
145/* Initialize a chained_gdb_smob.
146 This is the same as gdbscm_init_gsmob except that it also sets prev,next
147 to NULL. */
148
149void
151{
152 gdbscm_init_gsmob ((gdb_smob *) base);
153 base->prev = NULL;
154 base->next = NULL;
155}
156
157/* Initialize an eqable_gdb_smob.
158 This is the same as gdbscm_init_gsmob except that it also sets
159 BASE->containing_scm to CONTAINING_SCM. */
160
161void
162gdbscm_init_eqable_gsmob (eqable_gdb_smob *base, SCM containing_scm)
163{
164 gdbscm_init_gsmob ((gdb_smob *) base);
165 base->containing_scm = containing_scm;
166}
167
168
169/* gsmob accessors */
170
171/* Return the gsmob in SELF.
172 Throws an exception if SELF is not a gsmob. */
173
174static SCM
175gsscm_get_gsmob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
176{
177 SCM_ASSERT_TYPE (gdbscm_is_gsmob (self), self, arg_pos, func_name,
178 _("any gdb smob"));
179
180 return self;
181}
182
183/* (gdb-object-kind gsmob) -> symbol
184
185 Note: While one might want to name this gdb-object-class-name, it is named
186 "-kind" because smobs aren't real GOOPS classes. */
187
188static SCM
190{
191 SCM smob, result;
192 scm_t_bits smobnum;
193 const char *name;
194
195 smob = gsscm_get_gsmob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
196
197 smobnum = SCM_SMOBNUM (smob);
198 name = SCM_SMOBNAME (smobnum);
199 gdb::unique_xmalloc_ptr<char> kind = xstrprintf ("<%s>", name);
200 result = scm_from_latin1_symbol (kind.get ());
201 return result;
202}
203
204
205/* When underlying gdb data structures are deleted, we need to update any
206 smobs with references to them. There are several smobs that reference
207 objfile-based data, so we provide helpers to manage this. */
208
209/* Create a hash table for mapping a pointer to a gdb data structure to the
210 gsmob that wraps it. */
211
212htab_t
213gdbscm_create_eqable_gsmob_ptr_map (htab_hash hash_fn, htab_eq eq_fn)
214{
215 htab_t htab = htab_create_alloc (7, hash_fn, eq_fn,
216 NULL, xcalloc, xfree);
217
218 return htab;
219}
220
221/* Return a pointer to the htab entry for the eq?-able gsmob BASE.
222 If the entry is found, *SLOT is non-NULL.
223 Otherwise *slot is NULL. */
224
227{
228 void **slot = htab_find_slot (htab, base, INSERT);
229
230 return (eqable_gdb_smob **) slot;
231}
232
233/* Record BASE in SLOT. SLOT must be the result of calling
234 gdbscm_find_eqable_gsmob_ptr_slot on BASE (or equivalent for lookup). */
235
236void
238 eqable_gdb_smob *base)
239{
240 *slot = base;
241}
242
243/* Remove BASE from HTAB.
244 BASE is a pointer to a gsmob that wraps a pointer to a GDB datum.
245 This is used, for example, when an object is freed.
246
247 It is an error to call this if PTR is not in HTAB (only because it allows
248 for some consistency checking). */
249
250void
252{
253 void **slot = htab_find_slot (htab, base, NO_INSERT);
254
255 gdb_assert (slot != NULL);
256 htab_clear_slot (htab, slot);
257}
258
259/* Initialize the Scheme gsmobs code. */
260
262{
263 /* N.B. There is a general rule of not naming symbols in gdb-guile with a
264 "gdb" prefix. This symbol does not violate this rule because it is to
265 be read as "gdb-object-foo", not "gdb-foo". */
266 { "gdb-object-kind", 1, 0, 0, as_a_scm_t_subr (gdbscm_gsmob_kind),
267 "\
268Return the kind of the GDB object, e.g., <gdb:breakpoint>, as a symbol." },
269
271};
272
273void
275{
276 registered_gsmobs = htab_create_alloc (10,
278 NULL, xcalloc, xfree);
279
281}
const char *const name
void xfree(void *)
void * xcalloc(size_t number, size_t size)
Definition alloc.c:85
size_t size
Definition go32-nat.c:239
#define END_FUNCTIONS
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition scm-utils.c:44
#define scm_make_smob_type
static scm_t_subr as_a_scm_t_subr(SCM(*func)(void))
#define FUNC_NAME
void gdbscm_init_eqable_gsmob(eqable_gdb_smob *base, SCM containing_scm)
Definition scm-gsmob.c:162
static htab_t registered_gsmobs
Definition scm-gsmob.c:52
htab_t gdbscm_create_eqable_gsmob_ptr_map(htab_hash hash_fn, htab_eq eq_fn)
Definition scm-gsmob.c:213
void gdbscm_init_gsmob(gdb_smob *base)
Definition scm-gsmob.c:140
static int gdbscm_is_gsmob(SCM scm)
Definition scm-gsmob.c:88
void gdbscm_init_chained_gsmob(chained_gdb_smob *base)
Definition scm-gsmob.c:150
static int eq_scm_t_bits(const void *item_lhs, const void *item_rhs)
Definition scm-gsmob.c:67
void gdbscm_clear_eqable_gsmob_ptr_slot(htab_t htab, eqable_gdb_smob *base)
Definition scm-gsmob.c:251
static hashval_t hash_scm_t_bits(const void *item)
Definition scm-gsmob.c:57
static SCM gdbscm_gsmob_kind(SCM self)
Definition scm-gsmob.c:189
void gdbscm_initialize_smobs(void)
Definition scm-gsmob.c:274
static SCM gsscm_get_gsmob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition scm-gsmob.c:175
eqable_gdb_smob ** gdbscm_find_eqable_gsmob_ptr_slot(htab_t htab, eqable_gdb_smob *base)
Definition scm-gsmob.c:226
static const scheme_function gsmob_functions[]
Definition scm-gsmob.c:261
void gdbscm_fill_eqable_gsmob_ptr_slot(eqable_gdb_smob **slot, eqable_gdb_smob *base)
Definition scm-gsmob.c:237
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition scm-gsmob.c:103
static void register_gsmob(scm_t_bits gsmob_code)
Definition scm-gsmob.c:76
GDB_SMOB_HEAD chained_gdb_smob * prev
chained_gdb_smob * next
GDB_SMOB_HEAD SCM containing_scm