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 scm_gc_mark (o_smob
->pretty_printers
);
74 /* We don't mark containing_scm here. It is just a backlink to our
75 container, and is gc-protected until the objfile is deleted. */
78 return gdbscm_mark_gsmob (&o_smob
->base
);
81 /* The smob "print" function for <gdb:objfile>. */
84 ofscm_print_objfile_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
86 objfile_smob
*o_smob
= (objfile_smob
*) SCM_SMOB_DATA (self
);
88 gdbscm_printf (port
, "#<%s ", objfile_smob_name
);
89 gdbscm_printf (port
, "%s",
90 o_smob
->objfile
!= NULL
91 ? objfile_name (o_smob
->objfile
)
95 scm_remember_upto_here_1 (self
);
97 /* Non-zero means success. */
101 /* Low level routine to create a <gdb:objfile> object.
102 It's empty in the sense that an OBJFILE still needs to be associated
106 ofscm_make_objfile_smob (void)
108 objfile_smob
*o_smob
= (objfile_smob
*)
109 scm_gc_malloc (sizeof (objfile_smob
), objfile_smob_name
);
112 o_smob
->objfile
= NULL
;
113 o_smob
->pretty_printers
= SCM_EOL
;
114 o_scm
= scm_new_smob (objfile_smob_tag
, (scm_t_bits
) o_smob
);
115 o_smob
->containing_scm
= o_scm
;
116 gdbscm_init_gsmob (&o_smob
->base
);
121 /* Clear the OBJFILE pointer in O_SMOB and unprotect the object from GC. */
124 ofscm_release_objfile (objfile_smob
*o_smob
)
126 o_smob
->objfile
= NULL
;
127 scm_gc_unprotect_object (o_smob
->containing_scm
);
130 /* Objfile registry cleanup handler for when an objfile is deleted. */
133 ofscm_handle_objfile_deleted (struct objfile
*objfile
, void *datum
)
135 objfile_smob
*o_smob
= datum
;
137 gdb_assert (o_smob
->objfile
== objfile
);
139 ofscm_release_objfile (o_smob
);
142 /* Return non-zero if SCM is a <gdb:objfile> object. */
145 ofscm_is_objfile (SCM scm
)
147 return SCM_SMOB_PREDICATE (objfile_smob_tag
, scm
);
150 /* (objfile? object) -> boolean */
153 gdbscm_objfile_p (SCM scm
)
155 return scm_from_bool (ofscm_is_objfile (scm
));
158 /* Return a pointer to the objfile_smob that encapsulates OBJFILE,
159 creating one if necessary.
160 The result is cached so that we have only one copy per objfile. */
163 ofscm_objfile_smob_from_objfile (struct objfile
*objfile
)
165 objfile_smob
*o_smob
;
167 o_smob
= objfile_data (objfile
, ofscm_objfile_data_key
);
170 SCM o_scm
= ofscm_make_objfile_smob ();
172 o_smob
= (objfile_smob
*) SCM_SMOB_DATA (o_scm
);
173 o_smob
->objfile
= objfile
;
175 set_objfile_data (objfile
, ofscm_objfile_data_key
, o_smob
);
176 scm_gc_protect_object (o_smob
->containing_scm
);
182 /* Return the <gdb:objfile> object that encapsulates OBJFILE. */
185 ofscm_scm_from_objfile (struct objfile
*objfile
)
187 objfile_smob
*o_smob
= ofscm_objfile_smob_from_objfile (objfile
);
189 return o_smob
->containing_scm
;
192 /* Returns the <gdb:objfile> object in SELF.
193 Throws an exception if SELF is not a <gdb:objfile> object. */
196 ofscm_get_objfile_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
198 SCM_ASSERT_TYPE (ofscm_is_objfile (self
), self
, arg_pos
, func_name
,
204 /* Returns a pointer to the objfile smob of SELF.
205 Throws an exception if SELF is not a <gdb:objfile> object. */
207 static objfile_smob
*
208 ofscm_get_objfile_smob_arg_unsafe (SCM self
, int arg_pos
,
209 const char *func_name
)
211 SCM o_scm
= ofscm_get_objfile_arg_unsafe (self
, arg_pos
, func_name
);
212 objfile_smob
*o_smob
= (objfile_smob
*) SCM_SMOB_DATA (o_scm
);
217 /* Return non-zero if objfile O_SMOB is valid. */
220 ofscm_is_valid (objfile_smob
*o_smob
)
222 return o_smob
->objfile
!= NULL
;
225 /* Return the objfile smob in SELF, verifying it's valid.
226 Throws an exception if SELF is not a <gdb:objfile> object or is invalid. */
228 static objfile_smob
*
229 ofscm_get_valid_objfile_smob_arg_unsafe (SCM self
, int arg_pos
,
230 const char *func_name
)
233 = ofscm_get_objfile_smob_arg_unsafe (self
, arg_pos
, func_name
);
235 if (!ofscm_is_valid (o_smob
))
237 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
244 /* Objfile methods. */
246 /* (objfile-valid? <gdb:objfile>) -> boolean
247 Returns #t if this object file still exists in GDB. */
250 gdbscm_objfile_valid_p (SCM self
)
253 = ofscm_get_objfile_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
255 return scm_from_bool (o_smob
->objfile
!= NULL
);
258 /* (objfile-filename <gdb:objfile>) -> string
259 Returns the objfile's file name.
260 Throw's an exception if the underlying objfile is invalid. */
263 gdbscm_objfile_filename (SCM self
)
266 = ofscm_get_valid_objfile_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
268 return gdbscm_scm_from_c_string (objfile_name (o_smob
->objfile
));
271 /* (objfile-pretty-printers <gdb:objfile>) -> list
272 Returns the list of pretty-printers for this objfile. */
275 gdbscm_objfile_pretty_printers (SCM self
)
278 = ofscm_get_objfile_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
280 return o_smob
->pretty_printers
;
283 /* (set-objfile-pretty-printers! <gdb:objfile> list) -> unspecified
284 Set the pretty-printers for this objfile. */
287 gdbscm_set_objfile_pretty_printers_x (SCM self
, SCM printers
)
290 = ofscm_get_objfile_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
292 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers
)), printers
,
293 SCM_ARG2
, FUNC_NAME
, _("list"));
295 o_smob
->pretty_printers
= printers
;
297 return SCM_UNSPECIFIED
;
300 /* The "current" objfile. This is set when gdb detects that a new
301 objfile has been loaded. It is only set for the duration of a call to
302 gdbscm_source_objfile_script; it is NULL at other times. */
303 static struct objfile
*ofscm_current_objfile
;
305 /* Set the current objfile to OBJFILE and then read FILE named FILENAME
306 as Guile code. This does not throw any errors. If an exception
307 occurs Guile will print the backtrace.
308 This is the extension_language_script_ops.objfile_script_sourcer
312 gdbscm_source_objfile_script (const struct extension_language_defn
*extlang
,
313 struct objfile
*objfile
, FILE *file
,
314 const char *filename
)
318 ofscm_current_objfile
= objfile
;
320 msg
= gdbscm_safe_source_script (filename
);
323 fprintf_filtered (gdb_stderr
, "%s", msg
);
327 ofscm_current_objfile
= NULL
;
330 /* (current-objfile) -> <gdb:obfjile>
331 Return the current objfile, or #f if there isn't one.
332 Ideally this would be named ofscm_current_objfile, but that name is
333 taken by the variable recording the current objfile. */
336 gdbscm_get_current_objfile (void)
338 if (ofscm_current_objfile
== NULL
)
341 return ofscm_scm_from_objfile (ofscm_current_objfile
);
344 /* (objfiles) -> list
345 Return a list of all objfiles in the current program space. */
348 gdbscm_objfiles (void)
350 struct objfile
*objf
;
357 SCM item
= ofscm_scm_from_objfile (objf
);
359 result
= scm_cons (item
, result
);
362 return scm_reverse_x (result
, SCM_EOL
);
365 /* Initialize the Scheme objfile support. */
367 static const scheme_function objfile_functions
[] =
369 { "objfile?", 1, 0, 0, gdbscm_objfile_p
,
371 Return #t if the object is a <gdb:objfile> object." },
373 { "objfile-valid?", 1, 0, 0, gdbscm_objfile_valid_p
,
375 Return #t if the objfile is valid (hasn't been deleted from gdb)." },
377 { "objfile-filename", 1, 0, 0, gdbscm_objfile_filename
,
379 Return the file name of the objfile." },
381 { "objfile-pretty-printers", 1, 0, 0, gdbscm_objfile_pretty_printers
,
383 Return a list of pretty-printers of the objfile." },
385 { "set-objfile-pretty-printers!", 2, 0, 0,
386 gdbscm_set_objfile_pretty_printers_x
,
388 Set the list of pretty-printers of the objfile." },
390 { "current-objfile", 0, 0, 0, gdbscm_get_current_objfile
,
392 Return the current objfile if there is one or #f if there isn't one." },
394 { "objfiles", 0, 0, 0, gdbscm_objfiles
,
396 Return a list of all objfiles in the current program space." },
402 gdbscm_initialize_objfiles (void)
405 = gdbscm_make_smob_type (objfile_smob_name
, sizeof (objfile_smob
));
406 scm_set_smob_mark (objfile_smob_tag
, ofscm_mark_objfile_smob
);
407 scm_set_smob_print (objfile_smob_tag
, ofscm_print_objfile_smob
);
409 gdbscm_define_functions (objfile_functions
, 1);
411 ofscm_objfile_data_key
412 = register_objfile_data_with_cleanup (NULL
, ofscm_handle_objfile_deleted
);