1 /* Scheme interface to objfiles.
3 Copyright (C) 2008-2019 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
26 #include "guile-internal.h"
28 /* The <gdb:objfile> smob.
29 The typedef for this struct is in guile-internal.h. */
33 /* This always appears first. */
36 /* The corresponding objfile. */
37 struct objfile *objfile;
39 /* The pretty-printer list of functions. */
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
48 static const char objfile_smob_name[] = "gdb:objfile";
50 /* The tag Guile knows the objfile smob by. */
51 static scm_t_bits objfile_smob_tag;
53 static const struct objfile_data *ofscm_objfile_data_key;
55 /* Return the list of pretty-printers registered with O_SMOB. */
58 ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob)
60 return o_smob->pretty_printers;
63 /* Administrivia for objfile smobs. */
65 /* The smob "print" function for <gdb:objfile>. */
68 ofscm_print_objfile_smob (SCM self, SCM port, scm_print_state *pstate)
70 objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self);
72 gdbscm_printf (port, "#<%s ", objfile_smob_name);
73 gdbscm_printf (port, "%s",
74 o_smob->objfile != NULL
75 ? objfile_name (o_smob->objfile)
79 scm_remember_upto_here_1 (self);
81 /* Non-zero means success. */
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
90 ofscm_make_objfile_smob (void)
92 objfile_smob *o_smob = (objfile_smob *)
93 scm_gc_malloc (sizeof (objfile_smob), objfile_smob_name);
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);
105 /* Clear the OBJFILE pointer in O_SMOB and unprotect the object from GC. */
108 ofscm_release_objfile (objfile_smob *o_smob)
110 o_smob->objfile = NULL;
111 scm_gc_unprotect_object (o_smob->containing_scm);
114 /* Objfile registry cleanup handler for when an objfile is deleted. */
117 ofscm_handle_objfile_deleted (struct objfile *objfile, void *datum)
119 objfile_smob *o_smob = (objfile_smob *) datum;
121 gdb_assert (o_smob->objfile == objfile);
123 ofscm_release_objfile (o_smob);
126 /* Return non-zero if SCM is a <gdb:objfile> object. */
129 ofscm_is_objfile (SCM scm)
131 return SCM_SMOB_PREDICATE (objfile_smob_tag, scm);
134 /* (objfile? object) -> boolean */
137 gdbscm_objfile_p (SCM scm)
139 return scm_from_bool (ofscm_is_objfile (scm));
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. */
147 ofscm_objfile_smob_from_objfile (struct objfile *objfile)
149 objfile_smob *o_smob;
151 o_smob = (objfile_smob *) objfile_data (objfile, ofscm_objfile_data_key);
154 SCM o_scm = ofscm_make_objfile_smob ();
156 o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
157 o_smob->objfile = objfile;
159 set_objfile_data (objfile, ofscm_objfile_data_key, o_smob);
160 scm_gc_protect_object (o_smob->containing_scm);
166 /* Return the <gdb:objfile> object that encapsulates OBJFILE. */
169 ofscm_scm_from_objfile (struct objfile *objfile)
171 objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
173 return o_smob->containing_scm;
176 /* Returns the <gdb:objfile> object in SELF.
177 Throws an exception if SELF is not a <gdb:objfile> object. */
180 ofscm_get_objfile_arg_unsafe (SCM self, int arg_pos, const char *func_name)
182 SCM_ASSERT_TYPE (ofscm_is_objfile (self), self, arg_pos, func_name,
188 /* Returns a pointer to the objfile smob of SELF.
189 Throws an exception if SELF is not a <gdb:objfile> object. */
191 static objfile_smob *
192 ofscm_get_objfile_smob_arg_unsafe (SCM self, int arg_pos,
193 const char *func_name)
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);
201 /* Return non-zero if objfile O_SMOB is valid. */
204 ofscm_is_valid (objfile_smob *o_smob)
206 return o_smob->objfile != NULL;
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. */
212 static objfile_smob *
213 ofscm_get_valid_objfile_smob_arg_unsafe (SCM self, int arg_pos,
214 const char *func_name)
217 = ofscm_get_objfile_smob_arg_unsafe (self, arg_pos, func_name);
219 if (!ofscm_is_valid (o_smob))
221 gdbscm_invalid_object_error (func_name, arg_pos, self,
228 /* Objfile methods. */
230 /* (objfile-valid? <gdb:objfile>) -> boolean
231 Returns #t if this object file still exists in GDB. */
234 gdbscm_objfile_valid_p (SCM self)
237 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
239 return scm_from_bool (o_smob->objfile != NULL);
242 /* (objfile-filename <gdb:objfile>) -> string
243 Returns the objfile's file name.
244 Throw's an exception if the underlying objfile is invalid. */
247 gdbscm_objfile_filename (SCM self)
250 = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
252 return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile));
255 /* (objfile-progspace <gdb:objfile>) -> <gdb:progspace>
256 Returns the objfile's progspace.
257 Throw's an exception if the underlying objfile is invalid. */
260 gdbscm_objfile_progspace (SCM self)
263 = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
265 return psscm_scm_from_pspace (o_smob->objfile->pspace);
268 /* (objfile-pretty-printers <gdb:objfile>) -> list
269 Returns the list of pretty-printers for this objfile. */
272 gdbscm_objfile_pretty_printers (SCM self)
275 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
277 return o_smob->pretty_printers;
280 /* (set-objfile-pretty-printers! <gdb:objfile> list) -> unspecified
281 Set the pretty-printers for this objfile. */
284 gdbscm_set_objfile_pretty_printers_x (SCM self, SCM printers)
287 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
289 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
290 SCM_ARG2, FUNC_NAME, _("list"));
292 o_smob->pretty_printers = printers;
294 return SCM_UNSPECIFIED;
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
301 static struct objfile *ofscm_current_objfile;
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
310 gdbscm_source_objfile_script (const struct extension_language_defn *extlang,
311 struct objfile *objfile, FILE *file,
312 const char *filename)
316 ofscm_current_objfile = objfile;
318 msg = gdbscm_safe_source_script (filename);
321 fprintf_filtered (gdb_stderr, "%s", msg);
325 ofscm_current_objfile = NULL;
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
335 gdbscm_execute_objfile_script (const struct extension_language_defn *extlang,
336 struct objfile *objfile, const char *name,
339 ofscm_current_objfile = objfile;
341 gdb::unique_xmalloc_ptr<char> msg
342 = gdbscm_safe_eval_string (script, 0 /* display_result */);
344 fprintf_filtered (gdb_stderr, "%s", msg.get ());
346 ofscm_current_objfile = NULL;
349 /* (current-objfile) -> <gdb:obfjile>
350 Return the current objfile, or #f if there isn't one.
351 Ideally this would be named ofscm_current_objfile, but that name is
352 taken by the variable recording the current objfile. */
355 gdbscm_get_current_objfile (void)
357 if (ofscm_current_objfile == NULL)
360 return ofscm_scm_from_objfile (ofscm_current_objfile);
363 /* (objfiles) -> list
364 Return a list of all objfiles in the current program space. */
367 gdbscm_objfiles (void)
373 for (objfile *objf : current_program_space->objfiles ())
375 SCM item = ofscm_scm_from_objfile (objf);
377 result = scm_cons (item, result);
380 return scm_reverse_x (result, SCM_EOL);
383 /* Initialize the Scheme objfile support. */
385 static const scheme_function objfile_functions[] =
387 { "objfile?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_p),
389 Return #t if the object is a <gdb:objfile> object." },
391 { "objfile-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_valid_p),
393 Return #t if the objfile is valid (hasn't been deleted from gdb)." },
395 { "objfile-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_filename),
397 Return the file name of the objfile." },
399 { "objfile-progspace", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_progspace),
401 Return the progspace that the objfile lives in." },
403 { "objfile-pretty-printers", 1, 0, 0,
404 as_a_scm_t_subr (gdbscm_objfile_pretty_printers),
406 Return a list of pretty-printers of the objfile." },
408 { "set-objfile-pretty-printers!", 2, 0, 0,
409 as_a_scm_t_subr (gdbscm_set_objfile_pretty_printers_x),
411 Set the list of pretty-printers of the objfile." },
413 { "current-objfile", 0, 0, 0, as_a_scm_t_subr (gdbscm_get_current_objfile),
415 Return the current objfile if there is one or #f if there isn't one." },
417 { "objfiles", 0, 0, 0, as_a_scm_t_subr (gdbscm_objfiles),
419 Return a list of all objfiles in the current program space." },
425 gdbscm_initialize_objfiles (void)
428 = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob));
429 scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob);
431 gdbscm_define_functions (objfile_functions, 1);
433 ofscm_objfile_data_key
434 = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted);