Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* Scheme interface to objfiles. |
2 | ||
32d0add0 | 3 | Copyright (C) 2008-2015 Free Software Foundation, Inc. |
ed3ef339 DE |
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 | ||
31 | struct _objfile_smob | |
32 | { | |
33 | /* This always appears first. */ | |
34 | gdb_smob base; | |
35 | ||
36 | /* The corresponding objfile. */ | |
37 | struct objfile *objfile; | |
38 | ||
39 | /* The pretty-printer list of functions. */ | |
40 | SCM pretty_printers; | |
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). */ | |
45 | SCM containing_scm; | |
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 | |
58 | ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob) | |
59 | { | |
60 | return o_smob->pretty_printers; | |
61 | } | |
62 | \f | |
63 | /* Administrivia for objfile smobs. */ | |
64 | ||
ed3ef339 DE |
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 | |
90 | ofscm_make_objfile_smob (void) | |
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 | |
108 | ofscm_release_objfile (objfile_smob *o_smob) | |
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 | |
117 | ofscm_handle_objfile_deleted (struct objfile *objfile, void *datum) | |
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 | |
129 | ofscm_is_objfile (SCM scm) | |
130 | { | |
131 | return SCM_SMOB_PREDICATE (objfile_smob_tag, scm); | |
132 | } | |
133 | ||
134 | /* (objfile? object) -> boolean */ | |
135 | ||
136 | static SCM | |
137 | gdbscm_objfile_p (SCM 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 * | |
147 | ofscm_objfile_smob_from_objfile (struct objfile *objfile) | |
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 | |
169 | ofscm_scm_from_objfile (struct objfile *objfile) | |
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, | |
183 | objfile_smob_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 | |
204 | ofscm_is_valid (objfile_smob *o_smob) | |
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 * | |
213 | ofscm_get_valid_objfile_smob_arg_unsafe (SCM self, int arg_pos, | |
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 | \f | |
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 | |
234 | gdbscm_objfile_valid_p (SCM self) | |
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 | |
247 | gdbscm_objfile_filename (SCM self) | |
248 | { | |
249 | objfile_smob *o_smob | |
250 | = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
251 | ||
252 | return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile)); | |
253 | } | |
254 | ||
85642ba0 AW |
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 | |
260 | gdbscm_objfile_progspace (SCM self) | |
261 | { | |
262 | objfile_smob *o_smob | |
263 | = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
264 | ||
265 | return psscm_scm_from_pspace (o_smob->objfile->pspace); | |
266 | } | |
267 | ||
ed3ef339 DE |
268 | /* (objfile-pretty-printers <gdb:objfile>) -> list |
269 | Returns the list of pretty-printers for this objfile. */ | |
270 | ||
271 | static SCM | |
272 | gdbscm_objfile_pretty_printers (SCM self) | |
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 | \f | |
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 | |
9f050062 DE |
299 | gdbscm_source_objfile_script and gdbscm_execute_objfile_script; it is NULL |
300 | at other times. */ | |
ed3ef339 DE |
301 | static struct objfile *ofscm_current_objfile; |
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 | |
310 | gdbscm_source_objfile_script (const struct extension_language_defn *extlang, | |
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 | ||
9f050062 DE |
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 | |
335 | gdbscm_execute_objfile_script (const struct extension_language_defn *extlang, | |
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 | ||
ed3ef339 DE |
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 | |
359 | gdbscm_get_current_objfile (void) | |
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 | |
371 | gdbscm_objfiles (void) | |
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 | \f | |
388 | /* Initialize the Scheme objfile support. */ | |
389 | ||
390 | static const scheme_function objfile_functions[] = | |
391 | { | |
72e02483 | 392 | { "objfile?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_p), |
ed3ef339 DE |
393 | "\ |
394 | Return #t if the object is a <gdb:objfile> object." }, | |
395 | ||
72e02483 | 396 | { "objfile-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_valid_p), |
ed3ef339 DE |
397 | "\ |
398 | Return #t if the objfile is valid (hasn't been deleted from gdb)." }, | |
399 | ||
72e02483 | 400 | { "objfile-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_filename), |
ed3ef339 DE |
401 | "\ |
402 | Return the file name of the objfile." }, | |
403 | ||
72e02483 | 404 | { "objfile-progspace", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_progspace), |
85642ba0 AW |
405 | "\ |
406 | Return the progspace that the objfile lives in." }, | |
407 | ||
72e02483 PA |
408 | { "objfile-pretty-printers", 1, 0, 0, |
409 | as_a_scm_t_subr (gdbscm_objfile_pretty_printers), | |
ed3ef339 DE |
410 | "\ |
411 | Return a list of pretty-printers of the objfile." }, | |
412 | ||
413 | { "set-objfile-pretty-printers!", 2, 0, 0, | |
72e02483 | 414 | as_a_scm_t_subr (gdbscm_set_objfile_pretty_printers_x), |
ed3ef339 DE |
415 | "\ |
416 | Set the list of pretty-printers of the objfile." }, | |
417 | ||
72e02483 | 418 | { "current-objfile", 0, 0, 0, as_a_scm_t_subr (gdbscm_get_current_objfile), |
ed3ef339 DE |
419 | "\ |
420 | Return the current objfile if there is one or #f if there isn't one." }, | |
421 | ||
72e02483 | 422 | { "objfiles", 0, 0, 0, as_a_scm_t_subr (gdbscm_objfiles), |
ed3ef339 DE |
423 | "\ |
424 | Return a list of all objfiles in the current program space." }, | |
425 | ||
426 | END_FUNCTIONS | |
427 | }; | |
428 | ||
429 | void | |
430 | gdbscm_initialize_objfiles (void) | |
431 | { | |
432 | objfile_smob_tag | |
433 | = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob)); | |
ed3ef339 DE |
434 | scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob); |
435 | ||
436 | gdbscm_define_functions (objfile_functions, 1); | |
437 | ||
438 | ofscm_objfile_data_key | |
439 | = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted); | |
440 | } |