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