GDB (xrefs)

scm-objfile.c
Go to the documentation of this file.
1 /* Scheme interface to objfiles.
2
3 Copyright (C) 2008-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 #include "defs.h"
24 #include "objfiles.h"
25 #include "language.h"
26 #include "guile-internal.h"
27
28 /* The <gdb:objfile> smob.
29 The typedef for this struct is in guile-internal.h. */
30
31 struct _objfile_smob
32 {
33 /* This always appears first. */
34 gdb_smob base;
35
36 /* The corresponding objfile. */
37 struct objfile *objfile;
38
39 /* The pretty-printer list of functions. */
40 SCM pretty_printers;
41
42 /* The <gdb:objfile> object we are contained in, needed to protect/unprotect
43 the object since a reference to it comes from non-gc-managed space
44 (the objfile). */
45 SCM containing_scm;
46 };
47
48 static const char objfile_smob_name[] = "gdb:objfile";
49
50 /* The tag Guile knows the objfile smob by. */
51 static scm_t_bits objfile_smob_tag;
52
53 static const struct objfile_data *ofscm_objfile_data_key;
54
55 /* Return the list of pretty-printers registered with O_SMOB. */
56
57 SCM
58 ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob)
59 {
60 return o_smob->pretty_printers;
61 }
62
63 /* Administrivia for objfile smobs. */
64
65 /* The smob "print" function for <gdb:objfile>. */
66
67 static int
68 ofscm_print_objfile_smob (SCM self, SCM port, scm_print_state *pstate)
69 {
70 objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self);
71
72 gdbscm_printf (port, "#<%s ", objfile_smob_name);
73 gdbscm_printf (port, "%s",
74 o_smob->objfile != NULL
75 ? objfile_name (o_smob->objfile)
76 : "{invalid}");
77 scm_puts (">", port);
78
79 scm_remember_upto_here_1 (self);
80
81 /* Non-zero means success. */
82 return 1;
83 }
84
85 /* Low level routine to create a <gdb:objfile> object.
86 It's empty in the sense that an OBJFILE still needs to be associated
87 with it. */
88
89 static SCM
90 ofscm_make_objfile_smob (void)
91 {
92 objfile_smob *o_smob = (objfile_smob *)
93 scm_gc_malloc (sizeof (objfile_smob), objfile_smob_name);
94 SCM o_scm;
95
96 o_smob->objfile = NULL;
97 o_smob->pretty_printers = SCM_EOL;
98 o_scm = scm_new_smob (objfile_smob_tag, (scm_t_bits) o_smob);
99 o_smob->containing_scm = o_scm;
100 gdbscm_init_gsmob (&o_smob->base);
101
102 return o_scm;
103 }
104
105 /* Clear the OBJFILE pointer in O_SMOB and unprotect the object from GC. */
106
107 static void
108 ofscm_release_objfile (objfile_smob *o_smob)
109 {
110 o_smob->objfile = NULL;
111 scm_gc_unprotect_object (o_smob->containing_scm);
112 }
113
114 /* Objfile registry cleanup handler for when an objfile is deleted. */
115
116 static void
117 ofscm_handle_objfile_deleted (struct objfile *objfile, void *datum)
118 {
119 objfile_smob *o_smob = (objfile_smob *) datum;
120
121 gdb_assert (o_smob->objfile == objfile);
122
123 ofscm_release_objfile (o_smob);
124 }
125
126 /* Return non-zero if SCM is a <gdb:objfile> object. */
127
128 static int
129 ofscm_is_objfile (SCM scm)
130 {
131 return SCM_SMOB_PREDICATE (objfile_smob_tag, scm);
132 }
133
134 /* (objfile? object) -> boolean */
135
136 static SCM
137 gdbscm_objfile_p (SCM scm)
138 {
139 return scm_from_bool (ofscm_is_objfile (scm));
140 }
141
142 /* Return a pointer to the objfile_smob that encapsulates OBJFILE,
143 creating one if necessary.
144 The result is cached so that we have only one copy per objfile. */
145
146 objfile_smob *
147 ofscm_objfile_smob_from_objfile (struct objfile *objfile)
148 {
149 objfile_smob *o_smob;
150
151 o_smob = (objfile_smob *) objfile_data (objfile, ofscm_objfile_data_key);
152 if (o_smob == NULL)
153 {
154 SCM o_scm = ofscm_make_objfile_smob ();
155
156 o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
157 o_smob->objfile = objfile;
158
159 set_objfile_data (objfile, ofscm_objfile_data_key, o_smob);
160 scm_gc_protect_object (o_smob->containing_scm);
161 }
162
163 return o_smob;
164 }
165
166 /* Return the <gdb:objfile> object that encapsulates OBJFILE. */
167
168 SCM
169 ofscm_scm_from_objfile (struct objfile *objfile)
170 {
171 objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
172
173 return o_smob->containing_scm;
174 }
175
176 /* Returns the <gdb:objfile> object in SELF.
177 Throws an exception if SELF is not a <gdb:objfile> object. */
178
179 static SCM
180 ofscm_get_objfile_arg_unsafe (SCM self, int arg_pos, const char *func_name)
181 {
182 SCM_ASSERT_TYPE (ofscm_is_objfile (self), self, arg_pos, func_name,
183 objfile_smob_name);
184
185 return self;
186 }
187
188 /* Returns a pointer to the objfile smob of SELF.
189 Throws an exception if SELF is not a <gdb:objfile> object. */
190
191 static objfile_smob *
192 ofscm_get_objfile_smob_arg_unsafe (SCM self, int arg_pos,
193 const char *func_name)
194 {
195 SCM o_scm = ofscm_get_objfile_arg_unsafe (self, arg_pos, func_name);
196 objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
197
198 return o_smob;
199 }
200
201 /* Return non-zero if objfile O_SMOB is valid. */
202
203 static int
204 ofscm_is_valid (objfile_smob *o_smob)
205 {
206 return o_smob->objfile != NULL;
207 }
208
209 /* Return the objfile smob in SELF, verifying it's valid.
210 Throws an exception if SELF is not a <gdb:objfile> object or is invalid. */
211
212 static objfile_smob *
213 ofscm_get_valid_objfile_smob_arg_unsafe (SCM self, int arg_pos,
214 const char *func_name)
215 {
216 objfile_smob *o_smob
217 = ofscm_get_objfile_smob_arg_unsafe (self, arg_pos, func_name);
218
219 if (!ofscm_is_valid (o_smob))
220 {
221 gdbscm_invalid_object_error (func_name, arg_pos, self,
222 _("<gdb:objfile>"));
223 }
224
225 return o_smob;
226 }
227
228 /* Objfile methods. */
229
230 /* (objfile-valid? <gdb:objfile>) -> boolean
231 Returns #t if this object file still exists in GDB. */
232
233 static SCM
234 gdbscm_objfile_valid_p (SCM self)
235 {
236 objfile_smob *o_smob
237 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
238
239 return scm_from_bool (o_smob->objfile != NULL);
240 }
241
242 /* (objfile-filename <gdb:objfile>) -> string
243 Returns the objfile's file name.
244 Throw's an exception if the underlying objfile is invalid. */
245
246 static SCM
247 gdbscm_objfile_filename (SCM self)
248 {
249 objfile_smob *o_smob
250 = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
251
252 return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile));
253 }
254
255 /* (objfile-progspace <gdb:objfile>) -> <gdb:progspace>
256 Returns the objfile's progspace.
257 Throw's an exception if the underlying objfile is invalid. */
258
259 static SCM
260 gdbscm_objfile_progspace (SCM self)
261 {
262 objfile_smob *o_smob
263 = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
264
265 return psscm_scm_from_pspace (o_smob->objfile->pspace);
266 }
267
268 /* (objfile-pretty-printers <gdb:objfile>) -> list
269 Returns the list of pretty-printers for this objfile. */
270
271 static SCM
272 gdbscm_objfile_pretty_printers (SCM self)
273 {
274 objfile_smob *o_smob
275 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
276
277 return o_smob->pretty_printers;
278 }
279
280 /* (set-objfile-pretty-printers! <gdb:objfile> list) -> unspecified
281 Set the pretty-printers for this objfile. */
282
283 static SCM
284 gdbscm_set_objfile_pretty_printers_x (SCM self, SCM printers)
285 {
286 objfile_smob *o_smob
287 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
288
289 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
290 SCM_ARG2, FUNC_NAME, _("list"));
291
292 o_smob->pretty_printers = printers;
293
294 return SCM_UNSPECIFIED;
295 }
296
297 /* The "current" objfile. This is set when gdb detects that a new
298 objfile has been loaded. It is only set for the duration of a call to
299 gdbscm_source_objfile_script and gdbscm_execute_objfile_script; it is NULL
300 at other times. */
301 static struct objfile *ofscm_current_objfile;
302
303 /* Set the current objfile to OBJFILE and then read FILE named FILENAME
304 as Guile code. This does not throw any errors. If an exception
305 occurs Guile will print the backtrace.
306 This is the extension_language_script_ops.objfile_script_sourcer
307 "method". */
308
309 void
310 gdbscm_source_objfile_script (const struct extension_language_defn *extlang,
311 struct objfile *objfile, FILE *file,
312 const char *filename)
313 {
314 char *msg;
315
316 ofscm_current_objfile = objfile;
317
318 msg = gdbscm_safe_source_script (filename);
319 if (msg != NULL)
320 {
321 fprintf_filtered (gdb_stderr, "%s", msg);
322 xfree (msg);
323 }
324
325 ofscm_current_objfile = NULL;
326 }
327
328 /* Set the current objfile to OBJFILE and then read FILE named FILENAME
329 as Guile code. This does not throw any errors. If an exception
330 occurs Guile will print the backtrace.
331 This is the extension_language_script_ops.objfile_script_sourcer
332 "method". */
333
334 void
335 gdbscm_execute_objfile_script (const struct extension_language_defn *extlang,
336 struct objfile *objfile, const char *name,
337 const char *script)
338 {
339 char *msg;
340
341 ofscm_current_objfile = objfile;
342
343 msg = gdbscm_safe_eval_string (script, 0 /* display_result */);
344 if (msg != NULL)
345 {
346 fprintf_filtered (gdb_stderr, "%s", msg);
347 xfree (msg);
348 }
349
350 ofscm_current_objfile = NULL;
351 }
352
353 /* (current-objfile) -> <gdb:obfjile>
354 Return the current objfile, or #f if there isn't one.
355 Ideally this would be named ofscm_current_objfile, but that name is
356 taken by the variable recording the current objfile. */
357
358 static SCM
359 gdbscm_get_current_objfile (void)
360 {
361 if (ofscm_current_objfile == NULL)
362 return SCM_BOOL_F;
363
364 return ofscm_scm_from_objfile (ofscm_current_objfile);
365 }
366
367 /* (objfiles) -> list
368 Return a list of all objfiles in the current program space. */
369
370 static SCM
371 gdbscm_objfiles (void)
372 {
373 struct objfile *objf;
374 SCM result;
375
376 result = SCM_EOL;
377
378 ALL_OBJFILES (objf)
379 {
380 SCM item = ofscm_scm_from_objfile (objf);
381
382 result = scm_cons (item, result);
383 }
384
385 return scm_reverse_x (result, SCM_EOL);
386 }
387
388 /* Initialize the Scheme objfile support. */
389
390 static const scheme_function objfile_functions[] =
391 {
392 { "objfile?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_p),
393 "\
394 Return #t if the object is a <gdb:objfile> object." },
395
396 { "objfile-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_valid_p),
397 "\
398 Return #t if the objfile is valid (hasn't been deleted from gdb)." },
399
400 { "objfile-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_filename),
401 "\
402 Return the file name of the objfile." },
403
404 { "objfile-progspace", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_progspace),
405 "\
406 Return the progspace that the objfile lives in." },
407
408 { "objfile-pretty-printers", 1, 0, 0,
409 as_a_scm_t_subr (gdbscm_objfile_pretty_printers),
410 "\
411 Return a list of pretty-printers of the objfile." },
412
413 { "set-objfile-pretty-printers!", 2, 0, 0,
414 as_a_scm_t_subr (gdbscm_set_objfile_pretty_printers_x),
415 "\
416 Set the list of pretty-printers of the objfile." },
417
418 { "current-objfile", 0, 0, 0, as_a_scm_t_subr (gdbscm_get_current_objfile),
419 "\
420 Return the current objfile if there is one or #f if there isn't one." },
421
422 { "objfiles", 0, 0, 0, as_a_scm_t_subr (gdbscm_objfiles),
423 "\
424 Return a list of all objfiles in the current program space." },
425
426 END_FUNCTIONS
427 };
428
429 void
430 gdbscm_initialize_objfiles (void)
431 {
432 objfile_smob_tag
433 = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob));
434 scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob);
435
436 gdbscm_define_functions (objfile_functions, 1);
437
438 ofscm_objfile_data_key
439 = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted);
440 }
ofscm_get_objfile_smob_arg_unsafe
static objfile_smob * ofscm_get_objfile_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-objfile.c:192
as_a_scm_t_subr
static scm_t_subr as_a_scm_t_subr(SCM(*func)(void))
Definition: guile-internal.h:66
scm_new_smob
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
Definition: guile-internal.h:141
ofscm_is_valid
static int ofscm_is_valid(objfile_smob *o_smob)
Definition: scm-objfile.c:204
gdbscm_define_functions
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
gdbscm_execute_objfile_script
void gdbscm_execute_objfile_script(const struct extension_language_defn *extlang, struct objfile *objfile, const char *name, const char *script)
Definition: scm-objfile.c:335
xfree
void xfree(void *)
objfile::pspace
struct program_space * pspace
Definition: objfiles.h:315
gdbscm_objfile_filename
static SCM gdbscm_objfile_filename(SCM self)
Definition: scm-objfile.c:247
gdbscm_objfile_pretty_printers
static SCM gdbscm_objfile_pretty_printers(SCM self)
Definition: scm-objfile.c:272
FUNC_NAME
#define FUNC_NAME
Definition: guile-internal.h:153
guile-internal.h
gdbscm_objfile_valid_p
static SCM gdbscm_objfile_valid_p(SCM self)
Definition: scm-objfile.c:234
gdbscm_source_objfile_script
void gdbscm_source_objfile_script(const struct extension_language_defn *extlang, struct objfile *objfile, FILE *file, const char *filename)
Definition: scm-objfile.c:310
gdbscm_make_smob_type
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
_objfile_smob::objfile
struct objfile * objfile
Definition: scm-objfile.c:37
_
#define _(String)
Definition: gdb_locale.h:35
defs.h
gdbscm_safe_source_script
char * gdbscm_safe_source_script(const char *filename)
Definition: scm-safe-call.c:434
ofscm_is_objfile
static int ofscm_is_objfile(SCM scm)
Definition: scm-objfile.c:129
ofscm_release_objfile
static void ofscm_release_objfile(objfile_smob *o_smob)
Definition: scm-objfile.c:108
gdbscm_is_true
#define gdbscm_is_true(scm)
Definition: guile-internal.h:134
objfiles.h
gdbscm_get_current_objfile
static SCM gdbscm_get_current_objfile(void)
Definition: scm-objfile.c:359
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
psscm_scm_from_pspace
SCM psscm_scm_from_pspace(struct program_space *)
Definition: scm-progspace.c:179
pstate
static struct parser_state * pstate
Definition: ada-exp.c:98
objfile::objfile
objfile(bfd *, const char *, objfile_flags)
Definition: objfiles.c:373
gdbscm_scm_from_c_string
SCM gdbscm_scm_from_c_string(const char *string)
Definition: scm-string.c:44
fprintf_filtered
void fprintf_filtered(struct ui_file *stream, const char *format,...)
Definition: utils.c:2008
objfile_smob_name
static const char objfile_smob_name[]
Definition: scm-objfile.c:48
_objfile_smob::base
gdb_smob base
Definition: scm-objfile.c:34
_objfile_smob::containing_scm
SCM containing_scm
Definition: scm-objfile.c:45
ofscm_make_objfile_smob
static SCM ofscm_make_objfile_smob(void)
Definition: scm-objfile.c:90
language.h
gdb_smob
Definition: guile-internal.h:241
scheme_function
Definition: guile-internal.h:91
objfile_functions
static const scheme_function objfile_functions[]
Definition: scm-objfile.c:390
ofscm_objfile_data_key
static const struct objfile_data * ofscm_objfile_data_key
Definition: scm-objfile.c:53
ofscm_scm_from_objfile
SCM ofscm_scm_from_objfile(struct objfile *objfile)
Definition: scm-objfile.c:169
ofscm_objfile_smob_from_objfile
objfile_smob * ofscm_objfile_smob_from_objfile(struct objfile *objfile)
Definition: scm-objfile.c:147
ofscm_handle_objfile_deleted
static void ofscm_handle_objfile_deleted(struct objfile *objfile, void *datum)
Definition: scm-objfile.c:117
extension_language_defn
Definition: extension-priv.h:53
ofscm_get_objfile_arg_unsafe
static SCM ofscm_get_objfile_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-objfile.c:180
objfile_name
const char * objfile_name(const struct objfile *objfile)
Definition: objfiles.c:1557
gdbscm_printf
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
gdb_assert
#define gdb_assert(expr)
Definition: gdb_assert.h:32
gdbscm_objfile_progspace
static SCM gdbscm_objfile_progspace(SCM self)
Definition: scm-objfile.c:260
ofscm_current_objfile
static struct objfile * ofscm_current_objfile
Definition: scm-objfile.c:301
_objfile_smob
Definition: scm-objfile.c:31
gdbscm_initialize_objfiles
void gdbscm_initialize_objfiles(void)
Definition: scm-objfile.c:430
objfile
Definition: objfiles.h:286
gdbscm_safe_eval_string
char * gdbscm_safe_eval_string(const char *string, int display_result)
Definition: scm-safe-call.c:398
objfile_smob_tag
static scm_t_bits objfile_smob_tag
Definition: scm-objfile.c:51
END_FUNCTIONS
#define END_FUNCTIONS
Definition: guile-internal.h:103
gdbscm_invalid_object_error
void gdbscm_invalid_object_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
Definition: scm-exception.c:325
gdbscm_objfiles
static SCM gdbscm_objfiles(void)
Definition: scm-objfile.c:371
gdb_stderr
#define gdb_stderr
Definition: utils.h:344
gdbscm_objfile_p
static SCM gdbscm_objfile_p(SCM scm)
Definition: scm-objfile.c:137
ofscm_get_valid_objfile_smob_arg_unsafe
static objfile_smob * ofscm_get_valid_objfile_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-objfile.c:213
ofscm_print_objfile_smob
static int ofscm_print_objfile_smob(SCM self, SCM port, scm_print_state *pstate)
Definition: scm-objfile.c:68
ofscm_objfile_smob_pretty_printers
SCM ofscm_objfile_smob_pretty_printers(objfile_smob *o_smob)
Definition: scm-objfile.c:58
ALL_OBJFILES
#define ALL_OBJFILES(obj)
Definition: objfiles.h:582
gdbscm_set_objfile_pretty_printers_x
static SCM gdbscm_set_objfile_pretty_printers_x(SCM self, SCM printers)
Definition: scm-objfile.c:284
_objfile_smob::pretty_printers
SCM pretty_printers
Definition: scm-objfile.c:40