GDB (xrefs)
scm-objfile.c
Go to the documentation of this file.
1 /* Scheme interface to objfiles.
2 
3  Copyright (C) 2008-2015 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 
32 {
33  /* This always appears first. */
35 
36  /* The corresponding objfile. */
37  struct objfile *objfile;
38 
39  /* The pretty-printer list of functions. */
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). */
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
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
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
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
118 {
119  objfile_smob *o_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
130 {
131  return SCM_SMOB_PREDICATE (objfile_smob_tag, scm);
132 }
133 
134 /* (objfile? object) -> boolean */
135 
136 static 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 *
148 {
149  objfile_smob *o_smob;
150 
151  o_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
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,
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
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 *
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
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
248 {
249  objfile_smob *o_smob
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
261 {
262  objfile_smob *o_smob
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
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. */
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
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
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
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
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, gdbscm_objfile_p,
393  "\
394 Return #t if the object is a <gdb:objfile> object." },
395 
396  { "objfile-valid?", 1, 0, 0, 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, gdbscm_objfile_filename,
401  "\
402 Return the file name of the objfile." },
403 
404  { "objfile-progspace", 1, 0, 0, gdbscm_objfile_progspace,
405  "\
406 Return the progspace that the objfile lives in." },
407 
408  { "objfile-pretty-printers", 1, 0, 0, gdbscm_objfile_pretty_printers,
409  "\
410 Return a list of pretty-printers of the objfile." },
411 
412  { "set-objfile-pretty-printers!", 2, 0, 0,
414  "\
415 Set the list of pretty-printers of the objfile." },
416 
417  { "current-objfile", 0, 0, 0, gdbscm_get_current_objfile,
418  "\
419 Return the current objfile if there is one or #f if there isn't one." },
420 
421  { "objfiles", 0, 0, 0, gdbscm_objfiles,
422  "\
423 Return a list of all objfiles in the current program space." },
424 
426 };
427 
428 void
430 {
433  scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob);
434 
435  gdbscm_define_functions (objfile_functions, 1);
436 
438  = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted);
439 }
static objfile_smob * ofscm_get_objfile_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-objfile.c:192
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
static int ofscm_is_valid(objfile_smob *o_smob)
Definition: scm-objfile.c:204
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
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
void xfree(void *)
Definition: common-utils.c:97
struct program_space * pspace
Definition: objfiles.h:286
static SCM gdbscm_objfile_filename(SCM self)
Definition: scm-objfile.c:247
static SCM gdbscm_objfile_pretty_printers(SCM self)
Definition: scm-objfile.c:272
#define FUNC_NAME
static SCM gdbscm_objfile_valid_p(SCM self)
Definition: scm-objfile.c:234
void gdbscm_source_objfile_script(const struct extension_language_defn *extlang, struct objfile *objfile, FILE *file, const char *filename)
Definition: scm-objfile.c:310
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
struct objfile * objfile
Definition: scm-objfile.c:37
#define _(String)
Definition: gdb_locale.h:40
char * gdbscm_safe_source_script(const char *filename)
static int ofscm_is_objfile(SCM scm)
Definition: scm-objfile.c:129
static void ofscm_release_objfile(objfile_smob *o_smob)
Definition: scm-objfile.c:108
#define gdbscm_is_true(scm)
static SCM gdbscm_get_current_objfile(void)
Definition: scm-objfile.c:359
const char *const name
Definition: aarch64-tdep.c:68
#define ALL_OBJFILES(obj)
Definition: objfiles.h:579
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:113
SCM psscm_scm_from_pspace(struct program_space *)
static struct parser_state * pstate
Definition: ada-exp.c:149
SCM gdbscm_scm_from_c_string(const char *string)
Definition: scm-string.c:44
void fprintf_filtered(struct ui_file *stream, const char *format,...)
Definition: utils.c:2351
static const char objfile_smob_name[]
Definition: scm-objfile.c:48
gdb_smob base
Definition: scm-objfile.c:34
SCM containing_scm
Definition: scm-objfile.c:45
static SCM ofscm_make_objfile_smob(void)
Definition: scm-objfile.c:90
#define gdb_assert(expr)
Definition: gdb_assert.h:33
static const struct objfile_data * ofscm_objfile_data_key
Definition: scm-objfile.c:53
SCM ofscm_scm_from_objfile(struct objfile *objfile)
Definition: scm-objfile.c:169
objfile_smob * ofscm_objfile_smob_from_objfile(struct objfile *objfile)
Definition: scm-objfile.c:147
static void ofscm_handle_objfile_deleted(struct objfile *objfile, void *datum)
Definition: scm-objfile.c:117
static SCM ofscm_get_objfile_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-objfile.c:180
const char * objfile_name(const struct objfile *objfile)
Definition: objfiles.c:1499
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
static SCM gdbscm_objfile_progspace(SCM self)
Definition: scm-objfile.c:260
static struct objfile * ofscm_current_objfile
Definition: scm-objfile.c:301
void gdbscm_initialize_objfiles(void)
Definition: scm-objfile.c:429
char * gdbscm_safe_eval_string(const char *string, int display_result)
static scm_t_bits objfile_smob_tag
Definition: scm-objfile.c:51
#define END_FUNCTIONS
void gdbscm_invalid_object_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
static SCM gdbscm_objfiles(void)
Definition: scm-objfile.c:371
static SCM gdbscm_objfile_p(SCM scm)
Definition: scm-objfile.c:137
static objfile_smob * ofscm_get_valid_objfile_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-objfile.c:213
struct ui_file * gdb_stderr
Definition: main.c:72
static int ofscm_print_objfile_smob(SCM self, SCM port, scm_print_state *pstate)
Definition: scm-objfile.c:68
SCM ofscm_objfile_smob_pretty_printers(objfile_smob *o_smob)
Definition: scm-objfile.c:58
static SCM gdbscm_set_objfile_pretty_printers_x(SCM self, SCM printers)
Definition: scm-objfile.c:284
SCM pretty_printers
Definition: scm-objfile.c:40