Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* Scheme interface to objfiles. |
2 | ||
3666a048 | 3 | Copyright (C) 2008-2021 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 | ||
f99b5177 | 28 | /* The <gdb:objfile> smob. */ |
ed3ef339 | 29 | |
f99b5177 | 30 | struct objfile_smob |
ed3ef339 DE |
31 | { |
32 | /* This always appears first. */ | |
33 | gdb_smob base; | |
34 | ||
35 | /* The corresponding objfile. */ | |
36 | struct objfile *objfile; | |
37 | ||
38 | /* The pretty-printer list of functions. */ | |
39 | SCM pretty_printers; | |
40 | ||
41 | /* The <gdb:objfile> object we are contained in, needed to protect/unprotect | |
42 | the object since a reference to it comes from non-gc-managed space | |
43 | (the objfile). */ | |
44 | SCM containing_scm; | |
45 | }; | |
46 | ||
47 | static const char objfile_smob_name[] = "gdb:objfile"; | |
48 | ||
49 | /* The tag Guile knows the objfile smob by. */ | |
50 | static scm_t_bits objfile_smob_tag; | |
51 | ||
52 | static const struct objfile_data *ofscm_objfile_data_key; | |
53 | ||
54 | /* Return the list of pretty-printers registered with O_SMOB. */ | |
55 | ||
56 | SCM | |
57 | ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob) | |
58 | { | |
59 | return o_smob->pretty_printers; | |
60 | } | |
61 | \f | |
62 | /* Administrivia for objfile smobs. */ | |
63 | ||
ed3ef339 DE |
64 | /* The smob "print" function for <gdb:objfile>. */ |
65 | ||
66 | static int | |
67 | ofscm_print_objfile_smob (SCM self, SCM port, scm_print_state *pstate) | |
68 | { | |
69 | objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self); | |
70 | ||
71 | gdbscm_printf (port, "#<%s ", objfile_smob_name); | |
72 | gdbscm_printf (port, "%s", | |
73 | o_smob->objfile != NULL | |
74 | ? objfile_name (o_smob->objfile) | |
75 | : "{invalid}"); | |
76 | scm_puts (">", port); | |
77 | ||
78 | scm_remember_upto_here_1 (self); | |
79 | ||
80 | /* Non-zero means success. */ | |
81 | return 1; | |
82 | } | |
83 | ||
84 | /* Low level routine to create a <gdb:objfile> object. | |
85 | It's empty in the sense that an OBJFILE still needs to be associated | |
86 | with it. */ | |
87 | ||
88 | static SCM | |
89 | ofscm_make_objfile_smob (void) | |
90 | { | |
91 | objfile_smob *o_smob = (objfile_smob *) | |
92 | scm_gc_malloc (sizeof (objfile_smob), objfile_smob_name); | |
93 | SCM o_scm; | |
94 | ||
95 | o_smob->objfile = NULL; | |
96 | o_smob->pretty_printers = SCM_EOL; | |
97 | o_scm = scm_new_smob (objfile_smob_tag, (scm_t_bits) o_smob); | |
98 | o_smob->containing_scm = o_scm; | |
99 | gdbscm_init_gsmob (&o_smob->base); | |
100 | ||
101 | return o_scm; | |
102 | } | |
103 | ||
104 | /* Clear the OBJFILE pointer in O_SMOB and unprotect the object from GC. */ | |
105 | ||
106 | static void | |
107 | ofscm_release_objfile (objfile_smob *o_smob) | |
108 | { | |
109 | o_smob->objfile = NULL; | |
110 | scm_gc_unprotect_object (o_smob->containing_scm); | |
111 | } | |
112 | ||
113 | /* Objfile registry cleanup handler for when an objfile is deleted. */ | |
114 | ||
115 | static void | |
116 | ofscm_handle_objfile_deleted (struct objfile *objfile, void *datum) | |
117 | { | |
9a3c8263 | 118 | objfile_smob *o_smob = (objfile_smob *) datum; |
ed3ef339 DE |
119 | |
120 | gdb_assert (o_smob->objfile == objfile); | |
121 | ||
122 | ofscm_release_objfile (o_smob); | |
123 | } | |
124 | ||
125 | /* Return non-zero if SCM is a <gdb:objfile> object. */ | |
126 | ||
127 | static int | |
128 | ofscm_is_objfile (SCM scm) | |
129 | { | |
130 | return SCM_SMOB_PREDICATE (objfile_smob_tag, scm); | |
131 | } | |
132 | ||
133 | /* (objfile? object) -> boolean */ | |
134 | ||
135 | static SCM | |
136 | gdbscm_objfile_p (SCM scm) | |
137 | { | |
138 | return scm_from_bool (ofscm_is_objfile (scm)); | |
139 | } | |
140 | ||
141 | /* Return a pointer to the objfile_smob that encapsulates OBJFILE, | |
142 | creating one if necessary. | |
143 | The result is cached so that we have only one copy per objfile. */ | |
144 | ||
145 | objfile_smob * | |
146 | ofscm_objfile_smob_from_objfile (struct objfile *objfile) | |
147 | { | |
148 | objfile_smob *o_smob; | |
149 | ||
9a3c8263 | 150 | o_smob = (objfile_smob *) objfile_data (objfile, ofscm_objfile_data_key); |
ed3ef339 DE |
151 | if (o_smob == NULL) |
152 | { | |
153 | SCM o_scm = ofscm_make_objfile_smob (); | |
154 | ||
155 | o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm); | |
156 | o_smob->objfile = objfile; | |
157 | ||
158 | set_objfile_data (objfile, ofscm_objfile_data_key, o_smob); | |
159 | scm_gc_protect_object (o_smob->containing_scm); | |
160 | } | |
161 | ||
162 | return o_smob; | |
163 | } | |
164 | ||
165 | /* Return the <gdb:objfile> object that encapsulates OBJFILE. */ | |
166 | ||
167 | SCM | |
168 | ofscm_scm_from_objfile (struct objfile *objfile) | |
169 | { | |
170 | objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile); | |
171 | ||
172 | return o_smob->containing_scm; | |
173 | } | |
174 | ||
175 | /* Returns the <gdb:objfile> object in SELF. | |
176 | Throws an exception if SELF is not a <gdb:objfile> object. */ | |
177 | ||
178 | static SCM | |
179 | ofscm_get_objfile_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
180 | { | |
181 | SCM_ASSERT_TYPE (ofscm_is_objfile (self), self, arg_pos, func_name, | |
182 | objfile_smob_name); | |
183 | ||
184 | return self; | |
185 | } | |
186 | ||
187 | /* Returns a pointer to the objfile smob of SELF. | |
188 | Throws an exception if SELF is not a <gdb:objfile> object. */ | |
189 | ||
190 | static objfile_smob * | |
191 | ofscm_get_objfile_smob_arg_unsafe (SCM self, int arg_pos, | |
192 | const char *func_name) | |
193 | { | |
194 | SCM o_scm = ofscm_get_objfile_arg_unsafe (self, arg_pos, func_name); | |
195 | objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm); | |
196 | ||
197 | return o_smob; | |
198 | } | |
199 | ||
200 | /* Return non-zero if objfile O_SMOB is valid. */ | |
201 | ||
202 | static int | |
203 | ofscm_is_valid (objfile_smob *o_smob) | |
204 | { | |
205 | return o_smob->objfile != NULL; | |
206 | } | |
207 | ||
208 | /* Return the objfile smob in SELF, verifying it's valid. | |
209 | Throws an exception if SELF is not a <gdb:objfile> object or is invalid. */ | |
210 | ||
211 | static objfile_smob * | |
212 | ofscm_get_valid_objfile_smob_arg_unsafe (SCM self, int arg_pos, | |
213 | const char *func_name) | |
214 | { | |
215 | objfile_smob *o_smob | |
216 | = ofscm_get_objfile_smob_arg_unsafe (self, arg_pos, func_name); | |
217 | ||
218 | if (!ofscm_is_valid (o_smob)) | |
219 | { | |
220 | gdbscm_invalid_object_error (func_name, arg_pos, self, | |
221 | _("<gdb:objfile>")); | |
222 | } | |
223 | ||
224 | return o_smob; | |
225 | } | |
226 | \f | |
227 | /* Objfile methods. */ | |
228 | ||
229 | /* (objfile-valid? <gdb:objfile>) -> boolean | |
230 | Returns #t if this object file still exists in GDB. */ | |
231 | ||
232 | static SCM | |
233 | gdbscm_objfile_valid_p (SCM self) | |
234 | { | |
235 | objfile_smob *o_smob | |
236 | = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
237 | ||
238 | return scm_from_bool (o_smob->objfile != NULL); | |
239 | } | |
240 | ||
241 | /* (objfile-filename <gdb:objfile>) -> string | |
242 | Returns the objfile's file name. | |
243 | Throw's an exception if the underlying objfile is invalid. */ | |
244 | ||
245 | static SCM | |
246 | gdbscm_objfile_filename (SCM self) | |
247 | { | |
248 | objfile_smob *o_smob | |
249 | = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
250 | ||
251 | return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile)); | |
252 | } | |
253 | ||
85642ba0 AW |
254 | /* (objfile-progspace <gdb:objfile>) -> <gdb:progspace> |
255 | Returns the objfile's progspace. | |
256 | Throw's an exception if the underlying objfile is invalid. */ | |
257 | ||
258 | static SCM | |
259 | gdbscm_objfile_progspace (SCM self) | |
260 | { | |
261 | objfile_smob *o_smob | |
262 | = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
263 | ||
264 | return psscm_scm_from_pspace (o_smob->objfile->pspace); | |
265 | } | |
266 | ||
ed3ef339 DE |
267 | /* (objfile-pretty-printers <gdb:objfile>) -> list |
268 | Returns the list of pretty-printers for this objfile. */ | |
269 | ||
270 | static SCM | |
271 | gdbscm_objfile_pretty_printers (SCM self) | |
272 | { | |
273 | objfile_smob *o_smob | |
274 | = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
275 | ||
276 | return o_smob->pretty_printers; | |
277 | } | |
278 | ||
279 | /* (set-objfile-pretty-printers! <gdb:objfile> list) -> unspecified | |
280 | Set the pretty-printers for this objfile. */ | |
281 | ||
282 | static SCM | |
283 | gdbscm_set_objfile_pretty_printers_x (SCM self, SCM printers) | |
284 | { | |
285 | objfile_smob *o_smob | |
286 | = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
287 | ||
288 | SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers, | |
289 | SCM_ARG2, FUNC_NAME, _("list")); | |
290 | ||
291 | o_smob->pretty_printers = printers; | |
292 | ||
293 | return SCM_UNSPECIFIED; | |
294 | } | |
295 | \f | |
296 | /* The "current" objfile. This is set when gdb detects that a new | |
297 | objfile has been loaded. It is only set for the duration of a call to | |
9f050062 DE |
298 | gdbscm_source_objfile_script and gdbscm_execute_objfile_script; it is NULL |
299 | at other times. */ | |
ed3ef339 DE |
300 | static struct objfile *ofscm_current_objfile; |
301 | ||
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 | |
306 | "method". */ | |
307 | ||
308 | void | |
309 | gdbscm_source_objfile_script (const struct extension_language_defn *extlang, | |
310 | struct objfile *objfile, FILE *file, | |
311 | const char *filename) | |
312 | { | |
ed3ef339 DE |
313 | ofscm_current_objfile = objfile; |
314 | ||
9589edb8 | 315 | gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_source_script (filename); |
ed3ef339 | 316 | if (msg != NULL) |
9589edb8 | 317 | fprintf_filtered (gdb_stderr, "%s", msg.get ()); |
ed3ef339 DE |
318 | |
319 | ofscm_current_objfile = NULL; | |
320 | } | |
321 | ||
9f050062 DE |
322 | /* Set the current objfile to OBJFILE and then read FILE named FILENAME |
323 | as Guile code. This does not throw any errors. If an exception | |
324 | occurs Guile will print the backtrace. | |
325 | This is the extension_language_script_ops.objfile_script_sourcer | |
326 | "method". */ | |
327 | ||
328 | void | |
329 | gdbscm_execute_objfile_script (const struct extension_language_defn *extlang, | |
330 | struct objfile *objfile, const char *name, | |
331 | const char *script) | |
332 | { | |
9f050062 DE |
333 | ofscm_current_objfile = objfile; |
334 | ||
a1a31cb8 TT |
335 | gdb::unique_xmalloc_ptr<char> msg |
336 | = gdbscm_safe_eval_string (script, 0 /* display_result */); | |
9f050062 | 337 | if (msg != NULL) |
a1a31cb8 | 338 | fprintf_filtered (gdb_stderr, "%s", msg.get ()); |
9f050062 DE |
339 | |
340 | ofscm_current_objfile = NULL; | |
341 | } | |
342 | ||
30baf67b | 343 | /* (current-objfile) -> <gdb:objfile> |
ed3ef339 DE |
344 | Return the current objfile, or #f if there isn't one. |
345 | Ideally this would be named ofscm_current_objfile, but that name is | |
346 | taken by the variable recording the current objfile. */ | |
347 | ||
348 | static SCM | |
349 | gdbscm_get_current_objfile (void) | |
350 | { | |
351 | if (ofscm_current_objfile == NULL) | |
352 | return SCM_BOOL_F; | |
353 | ||
354 | return ofscm_scm_from_objfile (ofscm_current_objfile); | |
355 | } | |
356 | ||
357 | /* (objfiles) -> list | |
358 | Return a list of all objfiles in the current program space. */ | |
359 | ||
360 | static SCM | |
361 | gdbscm_objfiles (void) | |
362 | { | |
ed3ef339 DE |
363 | SCM result; |
364 | ||
365 | result = SCM_EOL; | |
366 | ||
2030c079 | 367 | for (objfile *objf : current_program_space->objfiles ()) |
aed57c53 TT |
368 | { |
369 | SCM item = ofscm_scm_from_objfile (objf); | |
ed3ef339 | 370 | |
aed57c53 TT |
371 | result = scm_cons (item, result); |
372 | } | |
ed3ef339 DE |
373 | |
374 | return scm_reverse_x (result, SCM_EOL); | |
375 | } | |
376 | \f | |
377 | /* Initialize the Scheme objfile support. */ | |
378 | ||
379 | static const scheme_function objfile_functions[] = | |
380 | { | |
72e02483 | 381 | { "objfile?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_p), |
ed3ef339 DE |
382 | "\ |
383 | Return #t if the object is a <gdb:objfile> object." }, | |
384 | ||
72e02483 | 385 | { "objfile-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_valid_p), |
ed3ef339 DE |
386 | "\ |
387 | Return #t if the objfile is valid (hasn't been deleted from gdb)." }, | |
388 | ||
72e02483 | 389 | { "objfile-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_filename), |
ed3ef339 DE |
390 | "\ |
391 | Return the file name of the objfile." }, | |
392 | ||
72e02483 | 393 | { "objfile-progspace", 1, 0, 0, as_a_scm_t_subr (gdbscm_objfile_progspace), |
85642ba0 AW |
394 | "\ |
395 | Return the progspace that the objfile lives in." }, | |
396 | ||
72e02483 PA |
397 | { "objfile-pretty-printers", 1, 0, 0, |
398 | as_a_scm_t_subr (gdbscm_objfile_pretty_printers), | |
ed3ef339 DE |
399 | "\ |
400 | Return a list of pretty-printers of the objfile." }, | |
401 | ||
402 | { "set-objfile-pretty-printers!", 2, 0, 0, | |
72e02483 | 403 | as_a_scm_t_subr (gdbscm_set_objfile_pretty_printers_x), |
ed3ef339 DE |
404 | "\ |
405 | Set the list of pretty-printers of the objfile." }, | |
406 | ||
72e02483 | 407 | { "current-objfile", 0, 0, 0, as_a_scm_t_subr (gdbscm_get_current_objfile), |
ed3ef339 DE |
408 | "\ |
409 | Return the current objfile if there is one or #f if there isn't one." }, | |
410 | ||
72e02483 | 411 | { "objfiles", 0, 0, 0, as_a_scm_t_subr (gdbscm_objfiles), |
ed3ef339 DE |
412 | "\ |
413 | Return a list of all objfiles in the current program space." }, | |
414 | ||
415 | END_FUNCTIONS | |
416 | }; | |
417 | ||
418 | void | |
419 | gdbscm_initialize_objfiles (void) | |
420 | { | |
421 | objfile_smob_tag | |
422 | = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob)); | |
ed3ef339 DE |
423 | scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob); |
424 | ||
425 | gdbscm_define_functions (objfile_functions, 1); | |
880ae75a | 426 | } |
ed3ef339 | 427 | |
880ae75a AB |
428 | void _initialize_scm_objfile (); |
429 | void | |
430 | _initialize_scm_objfile () | |
431 | { | |
ed3ef339 DE |
432 | ofscm_objfile_data_key |
433 | = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted); | |
434 | } |