Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* Scheme interface to symbol tables. |
2 | ||
3 | Copyright (C) 2008-2014 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 "symtab.h" | |
25 | #include "source.h" | |
26 | #include "objfiles.h" | |
27 | #include "block.h" | |
28 | #include "guile-internal.h" | |
29 | ||
30 | /* A <gdb:symtab> smob. */ | |
31 | ||
32 | typedef struct | |
33 | { | |
34 | /* This always appears first. | |
35 | eqable_gdb_smob is used so that symtabs are eq?-able. | |
36 | Also, a symtab object is associated with an objfile. eqable_gdb_smob | |
37 | lets us track the lifetime of all symtabs associated with an objfile. | |
38 | When an objfile is deleted we need to invalidate the symtab object. */ | |
39 | eqable_gdb_smob base; | |
40 | ||
41 | /* The GDB symbol table structure. | |
42 | If this is NULL the symtab is invalid. This can happen when the | |
43 | underlying objfile is freed. */ | |
44 | struct symtab *symtab; | |
45 | } symtab_smob; | |
46 | ||
47 | /* A <gdb:sal> smob. | |
48 | A smob describing a gdb symtab-and-line object. | |
49 | A sal is associated with an objfile. All access must be gated by checking | |
50 | the validity of symtab_scm. | |
51 | TODO: Sals are not eq?-able at the moment, or even comparable. */ | |
52 | ||
53 | typedef struct | |
54 | { | |
55 | /* This always appears first. */ | |
56 | gdb_smob base; | |
57 | ||
58 | /* The <gdb:symtab> object of the symtab. | |
59 | We store this instead of a pointer to the symtab_smob because it's not | |
60 | clear GC will know the symtab_smob is referenced by us otherwise, and we | |
61 | need quick access to symtab_smob->symtab to know if this sal is valid. */ | |
62 | SCM symtab_scm; | |
63 | ||
64 | /* The GDB symbol table and line structure. | |
65 | This object is ephemeral in GDB, so keep our own copy. | |
66 | The symtab pointer in this struct is not usable: If the symtab is deleted | |
67 | this pointer will not be updated. Use symtab_scm instead to determine | |
68 | if this sal is valid. */ | |
69 | struct symtab_and_line sal; | |
70 | } sal_smob; | |
71 | ||
72 | static const char symtab_smob_name[] = "gdb:symtab"; | |
73 | /* "symtab-and-line" is pretty long, and "sal" is short and unique. */ | |
74 | static const char sal_smob_name[] = "gdb:sal"; | |
75 | ||
76 | /* The tags Guile knows the symbol table smobs by. */ | |
77 | static scm_t_bits symtab_smob_tag; | |
78 | static scm_t_bits sal_smob_tag; | |
79 | ||
80 | static const struct objfile_data *stscm_objfile_data_key; | |
81 | \f | |
82 | /* Administrivia for symtab smobs. */ | |
83 | ||
84 | /* Helper function to hash a symbol_smob. */ | |
85 | ||
86 | static hashval_t | |
87 | stscm_hash_symtab_smob (const void *p) | |
88 | { | |
89 | const symtab_smob *st_smob = p; | |
90 | ||
91 | return htab_hash_pointer (st_smob->symtab); | |
92 | } | |
93 | ||
94 | /* Helper function to compute equality of symtab_smobs. */ | |
95 | ||
96 | static int | |
97 | stscm_eq_symtab_smob (const void *ap, const void *bp) | |
98 | { | |
99 | const symtab_smob *a = ap; | |
100 | const symtab_smob *b = bp; | |
101 | ||
102 | return (a->symtab == b->symtab | |
103 | && a->symtab != NULL); | |
104 | } | |
105 | ||
106 | /* Return the struct symtab pointer -> SCM mapping table. | |
107 | It is created if necessary. */ | |
108 | ||
109 | static htab_t | |
110 | stscm_objfile_symtab_map (struct symtab *symtab) | |
111 | { | |
112 | struct objfile *objfile = symtab->objfile; | |
113 | htab_t htab = objfile_data (objfile, stscm_objfile_data_key); | |
114 | ||
115 | if (htab == NULL) | |
116 | { | |
117 | htab = gdbscm_create_eqable_gsmob_ptr_map (stscm_hash_symtab_smob, | |
118 | stscm_eq_symtab_smob); | |
119 | set_objfile_data (objfile, stscm_objfile_data_key, htab); | |
120 | } | |
121 | ||
122 | return htab; | |
123 | } | |
124 | ||
125 | /* The smob "mark" function for <gdb:symtab>. */ | |
126 | ||
127 | static SCM | |
128 | stscm_mark_symtab_smob (SCM self) | |
129 | { | |
130 | symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self); | |
131 | ||
132 | /* Do this last. */ | |
133 | return gdbscm_mark_eqable_gsmob (&st_smob->base); | |
134 | } | |
135 | ||
136 | /* The smob "free" function for <gdb:symtab>. */ | |
137 | ||
138 | static size_t | |
139 | stscm_free_symtab_smob (SCM self) | |
140 | { | |
141 | symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self); | |
142 | ||
143 | if (st_smob->symtab != NULL) | |
144 | { | |
145 | htab_t htab = stscm_objfile_symtab_map (st_smob->symtab); | |
146 | ||
147 | gdbscm_clear_eqable_gsmob_ptr_slot (htab, &st_smob->base); | |
148 | } | |
149 | ||
150 | /* Not necessary, done to catch bugs. */ | |
151 | st_smob->symtab = NULL; | |
152 | ||
153 | return 0; | |
154 | } | |
155 | ||
156 | /* The smob "print" function for <gdb:symtab>. */ | |
157 | ||
158 | static int | |
159 | stscm_print_symtab_smob (SCM self, SCM port, scm_print_state *pstate) | |
160 | { | |
161 | symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self); | |
162 | ||
163 | gdbscm_printf (port, "#<%s ", symtab_smob_name); | |
164 | gdbscm_printf (port, "%s", | |
165 | st_smob->symtab != NULL | |
166 | ? symtab_to_filename_for_display (st_smob->symtab) | |
167 | : "<invalid>"); | |
168 | scm_puts (">", port); | |
169 | ||
170 | scm_remember_upto_here_1 (self); | |
171 | ||
172 | /* Non-zero means success. */ | |
173 | return 1; | |
174 | } | |
175 | ||
176 | /* Low level routine to create a <gdb:symtab> object. */ | |
177 | ||
178 | static SCM | |
179 | stscm_make_symtab_smob (void) | |
180 | { | |
181 | symtab_smob *st_smob = (symtab_smob *) | |
182 | scm_gc_malloc (sizeof (symtab_smob), symtab_smob_name); | |
183 | SCM st_scm; | |
184 | ||
185 | st_smob->symtab = NULL; | |
186 | st_scm = scm_new_smob (symtab_smob_tag, (scm_t_bits) st_smob); | |
187 | gdbscm_init_eqable_gsmob (&st_smob->base); | |
188 | ||
189 | return st_scm; | |
190 | } | |
191 | ||
192 | /* Return non-zero if SCM is a symbol table smob. */ | |
193 | ||
194 | static int | |
195 | stscm_is_symtab (SCM scm) | |
196 | { | |
197 | return SCM_SMOB_PREDICATE (symtab_smob_tag, scm); | |
198 | } | |
199 | ||
200 | /* (symtab? object) -> boolean */ | |
201 | ||
202 | static SCM | |
203 | gdbscm_symtab_p (SCM scm) | |
204 | { | |
205 | return scm_from_bool (stscm_is_symtab (scm)); | |
206 | } | |
207 | ||
208 | /* Create a new <gdb:symtab> object that encapsulates SYMTAB. */ | |
209 | ||
210 | SCM | |
211 | stscm_scm_from_symtab (struct symtab *symtab) | |
212 | { | |
213 | htab_t htab; | |
214 | eqable_gdb_smob **slot; | |
215 | symtab_smob *st_smob, st_smob_for_lookup; | |
216 | SCM st_scm; | |
217 | ||
218 | /* If we've already created a gsmob for this symtab, return it. | |
219 | This makes symtabs eq?-able. */ | |
220 | htab = stscm_objfile_symtab_map (symtab); | |
221 | st_smob_for_lookup.symtab = symtab; | |
222 | slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &st_smob_for_lookup.base); | |
223 | if (*slot != NULL) | |
224 | return (*slot)->containing_scm; | |
225 | ||
226 | st_scm = stscm_make_symtab_smob (); | |
227 | st_smob = (symtab_smob *) SCM_SMOB_DATA (st_scm); | |
228 | st_smob->symtab = symtab; | |
229 | gdbscm_fill_eqable_gsmob_ptr_slot (slot, &st_smob->base, st_scm); | |
230 | ||
231 | return st_scm; | |
232 | } | |
233 | ||
234 | /* Returns the <gdb:symtab> object in SELF. | |
235 | Throws an exception if SELF is not a <gdb:symtab> object. */ | |
236 | ||
237 | static SCM | |
238 | stscm_get_symtab_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
239 | { | |
240 | SCM_ASSERT_TYPE (stscm_is_symtab (self), self, arg_pos, func_name, | |
241 | symtab_smob_name); | |
242 | ||
243 | return self; | |
244 | } | |
245 | ||
246 | /* Returns a pointer to the symtab smob of SELF. | |
247 | Throws an exception if SELF is not a <gdb:symtab> object. */ | |
248 | ||
249 | static symtab_smob * | |
250 | stscm_get_symtab_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
251 | { | |
252 | SCM st_scm = stscm_get_symtab_arg_unsafe (self, arg_pos, func_name); | |
253 | symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (st_scm); | |
254 | ||
255 | return st_smob; | |
256 | } | |
257 | ||
258 | /* Return non-zero if symtab ST_SMOB is valid. */ | |
259 | ||
260 | static int | |
261 | stscm_is_valid (symtab_smob *st_smob) | |
262 | { | |
263 | return st_smob->symtab != NULL; | |
264 | } | |
265 | ||
266 | /* Throw a Scheme error if SELF is not a valid symtab smob. | |
267 | Otherwise return a pointer to the symtab_smob object. */ | |
268 | ||
269 | static symtab_smob * | |
270 | stscm_get_valid_symtab_smob_arg_unsafe (SCM self, int arg_pos, | |
271 | const char *func_name) | |
272 | { | |
273 | symtab_smob *st_smob | |
274 | = stscm_get_symtab_smob_arg_unsafe (self, arg_pos, func_name); | |
275 | ||
276 | if (!stscm_is_valid (st_smob)) | |
277 | { | |
278 | gdbscm_invalid_object_error (func_name, arg_pos, self, | |
279 | _("<gdb:symtab>")); | |
280 | } | |
281 | ||
282 | return st_smob; | |
283 | } | |
284 | ||
285 | /* Helper function for stscm_del_objfile_symtabs to mark the symtab | |
286 | as invalid. */ | |
287 | ||
288 | static int | |
289 | stscm_mark_symtab_invalid (void **slot, void *info) | |
290 | { | |
291 | symtab_smob *st_smob = (symtab_smob *) *slot; | |
292 | ||
293 | st_smob->symtab = NULL; | |
294 | return 1; | |
295 | } | |
296 | ||
297 | /* This function is called when an objfile is about to be freed. | |
298 | Invalidate the symbol table as further actions on the symbol table | |
299 | would result in bad data. All access to st_smob->symtab should be | |
300 | gated by stscm_get_valid_symtab_smob_arg_unsafe which will raise an | |
301 | exception on invalid symbol tables. */ | |
302 | ||
303 | static void | |
304 | stscm_del_objfile_symtabs (struct objfile *objfile, void *datum) | |
305 | { | |
306 | htab_t htab = datum; | |
307 | ||
308 | if (htab != NULL) | |
309 | { | |
310 | htab_traverse_noresize (htab, stscm_mark_symtab_invalid, NULL); | |
311 | htab_delete (htab); | |
312 | } | |
313 | } | |
314 | \f | |
315 | /* Symbol table methods. */ | |
316 | ||
317 | /* (symtab-valid? <gdb:symtab>) -> boolean | |
318 | Returns #t if SELF still exists in GDB. */ | |
319 | ||
320 | static SCM | |
321 | gdbscm_symtab_valid_p (SCM self) | |
322 | { | |
323 | symtab_smob *st_smob | |
324 | = stscm_get_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
325 | ||
326 | return scm_from_bool (stscm_is_valid (st_smob)); | |
327 | } | |
328 | ||
329 | /* (symtab-filename <gdb:symtab>) -> string */ | |
330 | ||
331 | static SCM | |
332 | gdbscm_symtab_filename (SCM self) | |
333 | { | |
334 | symtab_smob *st_smob | |
335 | = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
336 | struct symtab *symtab = st_smob->symtab; | |
337 | ||
338 | return gdbscm_scm_from_c_string (symtab_to_filename_for_display (symtab)); | |
339 | } | |
340 | ||
341 | /* (symtab-fullname <gdb:symtab>) -> string */ | |
342 | ||
343 | static SCM | |
344 | gdbscm_symtab_fullname (SCM self) | |
345 | { | |
346 | symtab_smob *st_smob | |
347 | = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
348 | struct symtab *symtab = st_smob->symtab; | |
349 | ||
350 | return gdbscm_scm_from_c_string (symtab_to_fullname (symtab)); | |
351 | } | |
352 | ||
353 | /* (symtab-objfile <gdb:symtab>) -> <gdb:objfile> */ | |
354 | ||
355 | static SCM | |
356 | gdbscm_symtab_objfile (SCM self) | |
357 | { | |
358 | symtab_smob *st_smob | |
359 | = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
360 | const struct symtab *symtab = st_smob->symtab; | |
361 | ||
362 | return ofscm_scm_from_objfile (symtab->objfile); | |
363 | } | |
364 | ||
365 | /* (symtab-global-block <gdb:symtab>) -> <gdb:block> | |
366 | Return the GLOBAL_BLOCK of the underlying symtab. */ | |
367 | ||
368 | static SCM | |
369 | gdbscm_symtab_global_block (SCM self) | |
370 | { | |
371 | symtab_smob *st_smob | |
372 | = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
373 | const struct symtab *symtab = st_smob->symtab; | |
374 | const struct blockvector *blockvector; | |
375 | const struct block *block; | |
376 | ||
377 | blockvector = BLOCKVECTOR (symtab); | |
378 | block = BLOCKVECTOR_BLOCK (blockvector, GLOBAL_BLOCK); | |
379 | ||
380 | return bkscm_scm_from_block (block, symtab->objfile); | |
381 | } | |
382 | ||
383 | /* (symtab-static-block <gdb:symtab>) -> <gdb:block> | |
384 | Return the STATIC_BLOCK of the underlying symtab. */ | |
385 | ||
386 | static SCM | |
387 | gdbscm_symtab_static_block (SCM self) | |
388 | { | |
389 | symtab_smob *st_smob | |
390 | = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
391 | const struct symtab *symtab = st_smob->symtab; | |
392 | const struct blockvector *blockvector; | |
393 | const struct block *block; | |
394 | ||
395 | blockvector = BLOCKVECTOR (symtab); | |
396 | block = BLOCKVECTOR_BLOCK (blockvector, STATIC_BLOCK); | |
397 | ||
398 | return bkscm_scm_from_block (block, symtab->objfile); | |
399 | } | |
400 | \f | |
401 | /* Administrivia for sal (symtab-and-line) smobs. */ | |
402 | ||
403 | /* The smob "mark" function for <gdb:sal>. */ | |
404 | ||
405 | static SCM | |
406 | stscm_mark_sal_smob (SCM self) | |
407 | { | |
408 | sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (self); | |
409 | ||
410 | scm_gc_mark (s_smob->symtab_scm); | |
411 | ||
412 | /* Do this last. */ | |
413 | return gdbscm_mark_gsmob (&s_smob->base); | |
414 | } | |
415 | ||
416 | /* The smob "free" function for <gdb:sal>. */ | |
417 | ||
418 | static size_t | |
419 | stscm_free_sal_smob (SCM self) | |
420 | { | |
421 | sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (self); | |
422 | ||
423 | /* Not necessary, done to catch bugs. */ | |
424 | s_smob->symtab_scm = SCM_UNDEFINED; | |
425 | ||
426 | return 0; | |
427 | } | |
428 | ||
429 | /* The smob "print" function for <gdb:sal>. */ | |
430 | ||
431 | static int | |
432 | stscm_print_sal_smob (SCM self, SCM port, scm_print_state *pstate) | |
433 | { | |
434 | sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (self); | |
435 | symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (s_smob->symtab_scm); | |
436 | ||
437 | gdbscm_printf (port, "#<%s ", symtab_smob_name); | |
438 | scm_write (s_smob->symtab_scm, port); | |
439 | if (s_smob->sal.line != 0) | |
440 | gdbscm_printf (port, " line %d", s_smob->sal.line); | |
441 | scm_puts (">", port); | |
442 | ||
443 | scm_remember_upto_here_1 (self); | |
444 | ||
445 | /* Non-zero means success. */ | |
446 | return 1; | |
447 | } | |
448 | ||
449 | /* Low level routine to create a <gdb:sal> object. */ | |
450 | ||
451 | static SCM | |
452 | stscm_make_sal_smob (void) | |
453 | { | |
454 | sal_smob *s_smob | |
455 | = (sal_smob *) scm_gc_malloc (sizeof (sal_smob), sal_smob_name); | |
456 | SCM s_scm; | |
457 | ||
458 | s_smob->symtab_scm = SCM_BOOL_F; | |
459 | memset (&s_smob->sal, 0, sizeof (s_smob->sal)); | |
460 | s_scm = scm_new_smob (sal_smob_tag, (scm_t_bits) s_smob); | |
461 | gdbscm_init_gsmob (&s_smob->base); | |
462 | ||
463 | return s_scm; | |
464 | } | |
465 | ||
466 | /* Return non-zero if SCM is a <gdb:sal> object. */ | |
467 | ||
468 | static int | |
469 | stscm_is_sal (SCM scm) | |
470 | { | |
471 | return SCM_SMOB_PREDICATE (sal_smob_tag, scm); | |
472 | } | |
473 | ||
474 | /* (sal? object) -> boolean */ | |
475 | ||
476 | static SCM | |
477 | gdbscm_sal_p (SCM scm) | |
478 | { | |
479 | return scm_from_bool (stscm_is_sal (scm)); | |
480 | } | |
481 | ||
482 | /* Create a new <gdb:sal> object that encapsulates SAL. */ | |
483 | ||
484 | SCM | |
485 | stscm_scm_from_sal (struct symtab_and_line sal) | |
486 | { | |
487 | SCM st_scm, s_scm; | |
488 | sal_smob *s_smob; | |
489 | ||
490 | st_scm = SCM_BOOL_F; | |
491 | if (sal.symtab != NULL) | |
492 | st_scm = stscm_scm_from_symtab (sal.symtab); | |
493 | ||
494 | s_scm = stscm_make_sal_smob (); | |
495 | s_smob = (sal_smob *) SCM_SMOB_DATA (s_scm); | |
496 | s_smob->symtab_scm = st_scm; | |
497 | s_smob->sal = sal; | |
498 | ||
499 | return s_scm; | |
500 | } | |
501 | ||
502 | /* Returns the <gdb:sal> object in SELF. | |
503 | Throws an exception if SELF is not a <gdb:sal> object. */ | |
504 | ||
505 | static SCM | |
506 | stscm_get_sal_arg (SCM self, int arg_pos, const char *func_name) | |
507 | { | |
508 | SCM_ASSERT_TYPE (stscm_is_sal (self), self, arg_pos, func_name, | |
509 | sal_smob_name); | |
510 | ||
511 | return self; | |
512 | } | |
513 | ||
514 | /* Returns a pointer to the sal smob of SELF. | |
515 | Throws an exception if SELF is not a <gdb:sal> object. */ | |
516 | ||
517 | static sal_smob * | |
518 | stscm_get_sal_smob_arg (SCM self, int arg_pos, const char *func_name) | |
519 | { | |
520 | SCM s_scm = stscm_get_sal_arg (self, arg_pos, func_name); | |
521 | sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (s_scm); | |
522 | ||
523 | return s_smob; | |
524 | } | |
525 | ||
526 | /* Return non-zero if the symtab in S_SMOB is valid. */ | |
527 | ||
528 | static int | |
529 | stscm_sal_is_valid (sal_smob *s_smob) | |
530 | { | |
531 | symtab_smob *st_smob; | |
532 | ||
533 | /* If there's no symtab that's ok, the sal is still valid. */ | |
534 | if (gdbscm_is_false (s_smob->symtab_scm)) | |
535 | return 1; | |
536 | ||
537 | st_smob = (symtab_smob *) SCM_SMOB_DATA (s_smob->symtab_scm); | |
538 | ||
539 | return st_smob->symtab != NULL; | |
540 | } | |
541 | ||
542 | /* Throw a Scheme error if SELF is not a valid sal smob. | |
543 | Otherwise return a pointer to the sal_smob object. */ | |
544 | ||
545 | static sal_smob * | |
546 | stscm_get_valid_sal_smob_arg (SCM self, int arg_pos, const char *func_name) | |
547 | { | |
548 | sal_smob *s_smob = stscm_get_sal_smob_arg (self, arg_pos, func_name); | |
549 | ||
550 | if (!stscm_sal_is_valid (s_smob)) | |
551 | { | |
552 | gdbscm_invalid_object_error (func_name, arg_pos, self, | |
553 | _("<gdb:sal>")); | |
554 | } | |
555 | ||
556 | return s_smob; | |
557 | } | |
558 | \f | |
559 | /* sal methods */ | |
560 | ||
561 | /* (sal-valid? <gdb:sal>) -> boolean | |
562 | Returns #t if the symtab for SELF still exists in GDB. */ | |
563 | ||
564 | static SCM | |
565 | gdbscm_sal_valid_p (SCM self) | |
566 | { | |
567 | sal_smob *s_smob = stscm_get_sal_smob_arg (self, SCM_ARG1, FUNC_NAME); | |
568 | ||
569 | return scm_from_bool (stscm_sal_is_valid (s_smob)); | |
570 | } | |
571 | ||
572 | /* (sal-pc <gdb:sal>) -> address */ | |
573 | ||
574 | static SCM | |
575 | gdbscm_sal_pc (SCM self) | |
576 | { | |
577 | sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME); | |
578 | const struct symtab_and_line *sal = &s_smob->sal; | |
579 | ||
580 | return gdbscm_scm_from_ulongest (sal->pc); | |
581 | } | |
582 | ||
583 | /* (sal-last <gdb:sal>) -> address | |
584 | Returns #f if no ending address is recorded. */ | |
585 | ||
586 | static SCM | |
587 | gdbscm_sal_last (SCM self) | |
588 | { | |
589 | sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME); | |
590 | const struct symtab_and_line *sal = &s_smob->sal; | |
591 | ||
592 | if (sal->end > 0) | |
593 | return gdbscm_scm_from_ulongest (sal->end - 1); | |
594 | return SCM_BOOL_F; | |
595 | } | |
596 | ||
597 | /* (sal-line <gdb:sal>) -> integer | |
598 | Returns #f if no line number is recorded. */ | |
599 | ||
600 | static SCM | |
601 | gdbscm_sal_line (SCM self) | |
602 | { | |
603 | sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME); | |
604 | const struct symtab_and_line *sal = &s_smob->sal; | |
605 | ||
606 | if (sal->line > 0) | |
607 | return scm_from_int (sal->line); | |
608 | return SCM_BOOL_F; | |
609 | } | |
610 | ||
611 | /* (sal-symtab <gdb:sal>) -> <gdb:symtab> | |
612 | Returns #f if no symtab is recorded. */ | |
613 | ||
614 | static SCM | |
615 | gdbscm_sal_symtab (SCM self) | |
616 | { | |
617 | sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME); | |
618 | const struct symtab_and_line *sal = &s_smob->sal; | |
619 | ||
620 | return s_smob->symtab_scm; | |
621 | } | |
622 | ||
623 | /* (find-pc-line address) -> <gdb:sal> */ | |
624 | ||
625 | static SCM | |
626 | gdbscm_find_pc_line (SCM pc_scm) | |
627 | { | |
628 | ULONGEST pc_ull; | |
629 | struct symtab_and_line sal; | |
630 | volatile struct gdb_exception except; | |
631 | ||
632 | init_sal (&sal); /* -Wall */ | |
633 | ||
634 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc_ull); | |
635 | ||
636 | TRY_CATCH (except, RETURN_MASK_ALL) | |
637 | { | |
638 | CORE_ADDR pc = (CORE_ADDR) pc_ull; | |
639 | ||
640 | sal = find_pc_line (pc, 0); | |
641 | } | |
642 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
643 | ||
644 | return stscm_scm_from_sal (sal); | |
645 | } | |
646 | \f | |
647 | /* Initialize the Scheme symbol support. */ | |
648 | ||
649 | static const scheme_function symtab_functions[] = | |
650 | { | |
651 | { "symtab?", 1, 0, 0, gdbscm_symtab_p, | |
652 | "\ | |
653 | Return #t if the object is a <gdb:symtab> object." }, | |
654 | ||
655 | { "symtab-valid?", 1, 0, 0, gdbscm_symtab_valid_p, | |
656 | "\ | |
657 | Return #t if the symtab still exists in GDB.\n\ | |
658 | Symtabs are deleted when the corresponding objfile is freed." }, | |
659 | ||
660 | { "symtab-filename", 1, 0, 0, gdbscm_symtab_filename, | |
661 | "\ | |
662 | Return the symtab's source file name." }, | |
663 | ||
664 | { "symtab-fullname", 1, 0, 0, gdbscm_symtab_fullname, | |
665 | "\ | |
666 | Return the symtab's full source file name." }, | |
667 | ||
668 | { "symtab-objfile", 1, 0, 0, gdbscm_symtab_objfile, | |
669 | "\ | |
670 | Return the symtab's objfile." }, | |
671 | ||
672 | { "symtab-global-block", 1, 0, 0, gdbscm_symtab_global_block, | |
673 | "\ | |
674 | Return the symtab's global block." }, | |
675 | ||
676 | { "symtab-static-block", 1, 0, 0, gdbscm_symtab_static_block, | |
677 | "\ | |
678 | Return the symtab's static block." }, | |
679 | ||
680 | { "sal?", 1, 0, 0, gdbscm_sal_p, | |
681 | "\ | |
682 | Return #t if the object is a <gdb:sal> (symtab-and-line) object." }, | |
683 | ||
684 | { "sal-valid?", 1, 0, 0, gdbscm_sal_valid_p, | |
685 | "\ | |
686 | Return #t if the symtab for the sal still exists in GDB.\n\ | |
687 | Symtabs are deleted when the corresponding objfile is freed." }, | |
688 | ||
689 | { "sal-symtab", 1, 0, 0, gdbscm_sal_symtab, | |
690 | "\ | |
691 | Return the sal's symtab." }, | |
692 | ||
693 | { "sal-line", 1, 0, 0, gdbscm_sal_line, | |
694 | "\ | |
695 | Return the sal's line number, or #f if there is none." }, | |
696 | ||
697 | { "sal-pc", 1, 0, 0, gdbscm_sal_pc, | |
698 | "\ | |
699 | Return the sal's address." }, | |
700 | ||
701 | { "sal-last", 1, 0, 0, gdbscm_sal_last, | |
702 | "\ | |
703 | Return the last address specified by the sal, or #f if there is none." }, | |
704 | ||
705 | { "find-pc-line", 1, 0, 0, gdbscm_find_pc_line, | |
706 | "\ | |
707 | Return the sal corresponding to the address, or #f if there isn't one.\n\ | |
708 | \n\ | |
709 | Arguments: address" }, | |
710 | ||
711 | END_FUNCTIONS | |
712 | }; | |
713 | ||
714 | void | |
715 | gdbscm_initialize_symtabs (void) | |
716 | { | |
717 | symtab_smob_tag | |
718 | = gdbscm_make_smob_type (symtab_smob_name, sizeof (symtab_smob)); | |
719 | scm_set_smob_mark (symtab_smob_tag, stscm_mark_symtab_smob); | |
720 | scm_set_smob_free (symtab_smob_tag, stscm_free_symtab_smob); | |
721 | scm_set_smob_print (symtab_smob_tag, stscm_print_symtab_smob); | |
722 | ||
723 | sal_smob_tag = gdbscm_make_smob_type (sal_smob_name, sizeof (sal_smob)); | |
724 | scm_set_smob_mark (sal_smob_tag, stscm_mark_sal_smob); | |
725 | scm_set_smob_free (sal_smob_tag, stscm_free_sal_smob); | |
726 | scm_set_smob_print (sal_smob_tag, stscm_print_sal_smob); | |
727 | ||
728 | gdbscm_define_functions (symtab_functions, 1); | |
729 | ||
730 | /* Register an objfile "free" callback so we can properly | |
731 | invalidate symbol tables, and symbol table and line data | |
732 | structures when an object file that is about to be deleted. */ | |
733 | stscm_objfile_data_key | |
734 | = register_objfile_data_with_cleanup (NULL, stscm_del_objfile_symtabs); | |
735 | } |