1 /* Scheme interface to objfiles.
3 Copyright (C) 2008-2014 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 "mark" function for <gdb:objfile>. */
68 ofscm_mark_objfile_smob (SCM self)
70 objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self);
72 /* We don't mark containing_scm here. It is just a backlink to our
73 container, and is gc-protected until the objfile is deleted. */
75 return o_smob->pretty_printers;
78 /* The smob "print" function for <gdb:objfile>. */
81 ofscm_print_objfile_smob (SCM self, SCM port, scm_print_state *pstate)
83 objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self);
85 gdbscm_printf (port, "#<%s ", objfile_smob_name);
86 gdbscm_printf (port, "%s",
87 o_smob->objfile != NULL
88 ? objfile_name (o_smob->objfile)
92 scm_remember_upto_here_1 (self);
94 /* Non-zero means success. */
98 /* Low level routine to create a <gdb:objfile> object.
99 It's empty in the sense that an OBJFILE still needs to be associated
103 ofscm_make_objfile_smob (void)
105 objfile_smob *o_smob = (objfile_smob *)
106 scm_gc_malloc (sizeof (objfile_smob), objfile_smob_name);
109 o_smob->objfile = NULL;
110 o_smob->pretty_printers = SCM_EOL;
111 o_scm = scm_new_smob (objfile_smob_tag, (scm_t_bits) o_smob);
112 o_smob->containing_scm = o_scm;
113 gdbscm_init_gsmob (&o_smob->base);
118 /* Clear the OBJFILE pointer in O_SMOB and unprotect the object from GC. */
121 ofscm_release_objfile (objfile_smob *o_smob)
123 o_smob->objfile = NULL;
124 scm_gc_unprotect_object (o_smob->containing_scm);
127 /* Objfile registry cleanup handler for when an objfile is deleted. */
130 ofscm_handle_objfile_deleted (struct objfile *objfile, void *datum)
132 objfile_smob *o_smob = datum;
134 gdb_assert (o_smob->objfile == objfile);
136 ofscm_release_objfile (o_smob);
139 /* Return non-zero if SCM is a <gdb:objfile> object. */
142 ofscm_is_objfile (SCM scm)
144 return SCM_SMOB_PREDICATE (objfile_smob_tag, scm);
147 /* (objfile? object) -> boolean */
150 gdbscm_objfile_p (SCM scm)
152 return scm_from_bool (ofscm_is_objfile (scm));
155 /* Return a pointer to the objfile_smob that encapsulates OBJFILE,
156 creating one if necessary.
157 The result is cached so that we have only one copy per objfile. */
160 ofscm_objfile_smob_from_objfile (struct objfile *objfile)
162 objfile_smob *o_smob;
164 o_smob = objfile_data (objfile, ofscm_objfile_data_key);
167 SCM o_scm = ofscm_make_objfile_smob ();
169 o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
170 o_smob->objfile = objfile;
172 set_objfile_data (objfile, ofscm_objfile_data_key, o_smob);
173 scm_gc_protect_object (o_smob->containing_scm);
179 /* Return the <gdb:objfile> object that encapsulates OBJFILE. */
182 ofscm_scm_from_objfile (struct objfile *objfile)
184 objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
186 return o_smob->containing_scm;
189 /* Returns the <gdb:objfile> object in SELF.
190 Throws an exception if SELF is not a <gdb:objfile> object. */
193 ofscm_get_objfile_arg_unsafe (SCM self, int arg_pos, const char *func_name)
195 SCM_ASSERT_TYPE (ofscm_is_objfile (self), self, arg_pos, func_name,
201 /* Returns a pointer to the objfile smob of SELF.
202 Throws an exception if SELF is not a <gdb:objfile> object. */
204 static objfile_smob *
205 ofscm_get_objfile_smob_arg_unsafe (SCM self, int arg_pos,
206 const char *func_name)
208 SCM o_scm = ofscm_get_objfile_arg_unsafe (self, arg_pos, func_name);
209 objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
214 /* Return non-zero if objfile O_SMOB is valid. */
217 ofscm_is_valid (objfile_smob *o_smob)
219 return o_smob->objfile != NULL;
222 /* Return the objfile smob in SELF, verifying it's valid.
223 Throws an exception if SELF is not a <gdb:objfile> object or is invalid. */
225 static objfile_smob *
226 ofscm_get_valid_objfile_smob_arg_unsafe (SCM self, int arg_pos,
227 const char *func_name)
230 = ofscm_get_objfile_smob_arg_unsafe (self, arg_pos, func_name);
232 if (!ofscm_is_valid (o_smob))
234 gdbscm_invalid_object_error (func_name, arg_pos, self,
241 /* Objfile methods. */
243 /* (objfile-valid? <gdb:objfile>) -> boolean
244 Returns #t if this object file still exists in GDB. */
247 gdbscm_objfile_valid_p (SCM self)
250 = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
252 return scm_from_bool (o_smob->objfile != NULL);
255 /* (objfile-filename <gdb:objfile>) -> string
256 Returns the objfile's file name.
257 Throw's an exception if the underlying objfile is invalid. */
260 gdbscm_objfile_filename (SCM self)
263 = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
265 return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile));
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; it is NULL at other times. */
300 static struct objfile *ofscm_current_objfile;
302 /* Set the current objfile to OBJFILE and then read FILE named FILENAME
303 as Guile code. This does not throw any errors. If an exception
304 occurs Guile will print the backtrace.
305 This is the extension_language_script_ops.objfile_script_sourcer
309 gdbscm_source_objfile_script (const struct extension_language_defn *extlang,
310 struct objfile *objfile, FILE *file,
311 const char *filename)
315 ofscm_current_objfile = objfile;
317 msg = gdbscm_safe_source_script (filename);
320 fprintf_filtered (gdb_stderr, "%s", msg);
324 ofscm_current_objfile = NULL;
327 /* (current-objfile) -> <gdb:obfjile>
328 Return the current objfile, or #f if there isn't one.
329 Ideally this would be named ofscm_current_objfile, but that name is
330 taken by the variable recording the current objfile. */
333 gdbscm_get_current_objfile (void)
335 if (ofscm_current_objfile == NULL)
338 return ofscm_scm_from_objfile (ofscm_current_objfile);
341 /* (objfiles) -> list
342 Return a list of all objfiles in the current program space. */
345 gdbscm_objfiles (void)
347 struct objfile *objf;
354 SCM item = ofscm_scm_from_objfile (objf);
356 result = scm_cons (item, result);
359 return scm_reverse_x (result, SCM_EOL);
362 /* Initialize the Scheme objfile support. */
364 static const scheme_function objfile_functions[] =
366 { "objfile?", 1, 0, 0, gdbscm_objfile_p,
368 Return #t if the object is a <gdb:objfile> object." },
370 { "objfile-valid?", 1, 0, 0, gdbscm_objfile_valid_p,
372 Return #t if the objfile is valid (hasn't been deleted from gdb)." },
374 { "objfile-filename", 1, 0, 0, gdbscm_objfile_filename,
376 Return the file name of the objfile." },
378 { "objfile-pretty-printers", 1, 0, 0, gdbscm_objfile_pretty_printers,
380 Return a list of pretty-printers of the objfile." },
382 { "set-objfile-pretty-printers!", 2, 0, 0,
383 gdbscm_set_objfile_pretty_printers_x,
385 Set the list of pretty-printers of the objfile." },
387 { "current-objfile", 0, 0, 0, gdbscm_get_current_objfile,
389 Return the current objfile if there is one or #f if there isn't one." },
391 { "objfiles", 0, 0, 0, gdbscm_objfiles,
393 Return a list of all objfiles in the current program space." },
399 gdbscm_initialize_objfiles (void)
402 = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob));
403 scm_set_smob_mark (objfile_smob_tag, ofscm_mark_objfile_smob);
404 scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob);
406 gdbscm_define_functions (objfile_functions, 1);
408 ofscm_objfile_data_key
409 = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted);