1 /* Scheme interface to symbol tables.
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. */
28 #include "guile-internal.h"
30 /* A <gdb:symtab> smob. */
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. */
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
;
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. */
55 /* This always appears first. */
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. */
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
;
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";
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
;
80 static const struct objfile_data
*stscm_objfile_data_key
;
82 /* Administrivia for symtab smobs. */
84 /* Helper function to hash a symbol_smob. */
87 stscm_hash_symtab_smob (const void *p
)
89 const symtab_smob
*st_smob
= p
;
91 return htab_hash_pointer (st_smob
->symtab
);
94 /* Helper function to compute equality of symtab_smobs. */
97 stscm_eq_symtab_smob (const void *ap
, const void *bp
)
99 const symtab_smob
*a
= ap
;
100 const symtab_smob
*b
= bp
;
102 return (a
->symtab
== b
->symtab
103 && a
->symtab
!= NULL
);
106 /* Return the struct symtab pointer -> SCM mapping table.
107 It is created if necessary. */
110 stscm_objfile_symtab_map (struct symtab
*symtab
)
112 struct objfile
*objfile
= symtab
->objfile
;
113 htab_t htab
= objfile_data (objfile
, stscm_objfile_data_key
);
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
);
125 /* The smob "mark" function for <gdb:symtab>. */
128 stscm_mark_symtab_smob (SCM self
)
130 symtab_smob
*st_smob
= (symtab_smob
*) SCM_SMOB_DATA (self
);
133 return gdbscm_mark_eqable_gsmob (&st_smob
->base
);
136 /* The smob "free" function for <gdb:symtab>. */
139 stscm_free_symtab_smob (SCM self
)
141 symtab_smob
*st_smob
= (symtab_smob
*) SCM_SMOB_DATA (self
);
143 if (st_smob
->symtab
!= NULL
)
145 htab_t htab
= stscm_objfile_symtab_map (st_smob
->symtab
);
147 gdbscm_clear_eqable_gsmob_ptr_slot (htab
, &st_smob
->base
);
150 /* Not necessary, done to catch bugs. */
151 st_smob
->symtab
= NULL
;
156 /* The smob "print" function for <gdb:symtab>. */
159 stscm_print_symtab_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
161 symtab_smob
*st_smob
= (symtab_smob
*) SCM_SMOB_DATA (self
);
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
)
168 scm_puts (">", port
);
170 scm_remember_upto_here_1 (self
);
172 /* Non-zero means success. */
176 /* Low level routine to create a <gdb:symtab> object. */
179 stscm_make_symtab_smob (void)
181 symtab_smob
*st_smob
= (symtab_smob
*)
182 scm_gc_malloc (sizeof (symtab_smob
), symtab_smob_name
);
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
);
192 /* Return non-zero if SCM is a symbol table smob. */
195 stscm_is_symtab (SCM scm
)
197 return SCM_SMOB_PREDICATE (symtab_smob_tag
, scm
);
200 /* (symtab? object) -> boolean */
203 gdbscm_symtab_p (SCM scm
)
205 return scm_from_bool (stscm_is_symtab (scm
));
208 /* Create a new <gdb:symtab> object that encapsulates SYMTAB. */
211 stscm_scm_from_symtab (struct symtab
*symtab
)
214 eqable_gdb_smob
**slot
;
215 symtab_smob
*st_smob
, st_smob_for_lookup
;
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
);
224 return (*slot
)->containing_scm
;
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
);
234 /* Returns the <gdb:symtab> object in SELF.
235 Throws an exception if SELF is not a <gdb:symtab> object. */
238 stscm_get_symtab_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
240 SCM_ASSERT_TYPE (stscm_is_symtab (self
), self
, arg_pos
, func_name
,
246 /* Returns a pointer to the symtab smob of SELF.
247 Throws an exception if SELF is not a <gdb:symtab> object. */
250 stscm_get_symtab_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
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
);
258 /* Return non-zero if symtab ST_SMOB is valid. */
261 stscm_is_valid (symtab_smob
*st_smob
)
263 return st_smob
->symtab
!= NULL
;
266 /* Throw a Scheme error if SELF is not a valid symtab smob.
267 Otherwise return a pointer to the symtab_smob object. */
270 stscm_get_valid_symtab_smob_arg_unsafe (SCM self
, int arg_pos
,
271 const char *func_name
)
274 = stscm_get_symtab_smob_arg_unsafe (self
, arg_pos
, func_name
);
276 if (!stscm_is_valid (st_smob
))
278 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
285 /* Helper function for stscm_del_objfile_symtabs to mark the symtab
289 stscm_mark_symtab_invalid (void **slot
, void *info
)
291 symtab_smob
*st_smob
= (symtab_smob
*) *slot
;
293 st_smob
->symtab
= NULL
;
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. */
304 stscm_del_objfile_symtabs (struct objfile
*objfile
, void *datum
)
310 htab_traverse_noresize (htab
, stscm_mark_symtab_invalid
, NULL
);
315 /* Symbol table methods. */
317 /* (symtab-valid? <gdb:symtab>) -> boolean
318 Returns #t if SELF still exists in GDB. */
321 gdbscm_symtab_valid_p (SCM self
)
324 = stscm_get_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
326 return scm_from_bool (stscm_is_valid (st_smob
));
329 /* (symtab-filename <gdb:symtab>) -> string */
332 gdbscm_symtab_filename (SCM self
)
335 = stscm_get_valid_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
336 struct symtab
*symtab
= st_smob
->symtab
;
338 return gdbscm_scm_from_c_string (symtab_to_filename_for_display (symtab
));
341 /* (symtab-fullname <gdb:symtab>) -> string */
344 gdbscm_symtab_fullname (SCM self
)
347 = stscm_get_valid_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
348 struct symtab
*symtab
= st_smob
->symtab
;
350 return gdbscm_scm_from_c_string (symtab_to_fullname (symtab
));
353 /* (symtab-objfile <gdb:symtab>) -> <gdb:objfile> */
356 gdbscm_symtab_objfile (SCM self
)
359 = stscm_get_valid_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
360 const struct symtab
*symtab
= st_smob
->symtab
;
362 return ofscm_scm_from_objfile (symtab
->objfile
);
365 /* (symtab-global-block <gdb:symtab>) -> <gdb:block>
366 Return the GLOBAL_BLOCK of the underlying symtab. */
369 gdbscm_symtab_global_block (SCM self
)
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
;
377 blockvector
= BLOCKVECTOR (symtab
);
378 block
= BLOCKVECTOR_BLOCK (blockvector
, GLOBAL_BLOCK
);
380 return bkscm_scm_from_block (block
, symtab
->objfile
);
383 /* (symtab-static-block <gdb:symtab>) -> <gdb:block>
384 Return the STATIC_BLOCK of the underlying symtab. */
387 gdbscm_symtab_static_block (SCM self
)
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
;
395 blockvector
= BLOCKVECTOR (symtab
);
396 block
= BLOCKVECTOR_BLOCK (blockvector
, STATIC_BLOCK
);
398 return bkscm_scm_from_block (block
, symtab
->objfile
);
401 /* Administrivia for sal (symtab-and-line) smobs. */
403 /* The smob "mark" function for <gdb:sal>. */
406 stscm_mark_sal_smob (SCM self
)
408 sal_smob
*s_smob
= (sal_smob
*) SCM_SMOB_DATA (self
);
410 scm_gc_mark (s_smob
->symtab_scm
);
413 return gdbscm_mark_gsmob (&s_smob
->base
);
416 /* The smob "free" function for <gdb:sal>. */
419 stscm_free_sal_smob (SCM self
)
421 sal_smob
*s_smob
= (sal_smob
*) SCM_SMOB_DATA (self
);
423 /* Not necessary, done to catch bugs. */
424 s_smob
->symtab_scm
= SCM_UNDEFINED
;
429 /* The smob "print" function for <gdb:sal>. */
432 stscm_print_sal_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
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
);
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
);
443 scm_remember_upto_here_1 (self
);
445 /* Non-zero means success. */
449 /* Low level routine to create a <gdb:sal> object. */
452 stscm_make_sal_smob (void)
455 = (sal_smob
*) scm_gc_malloc (sizeof (sal_smob
), sal_smob_name
);
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
);
466 /* Return non-zero if SCM is a <gdb:sal> object. */
469 stscm_is_sal (SCM scm
)
471 return SCM_SMOB_PREDICATE (sal_smob_tag
, scm
);
474 /* (sal? object) -> boolean */
477 gdbscm_sal_p (SCM scm
)
479 return scm_from_bool (stscm_is_sal (scm
));
482 /* Create a new <gdb:sal> object that encapsulates SAL. */
485 stscm_scm_from_sal (struct symtab_and_line sal
)
491 if (sal
.symtab
!= NULL
)
492 st_scm
= stscm_scm_from_symtab (sal
.symtab
);
494 s_scm
= stscm_make_sal_smob ();
495 s_smob
= (sal_smob
*) SCM_SMOB_DATA (s_scm
);
496 s_smob
->symtab_scm
= st_scm
;
502 /* Returns the <gdb:sal> object in SELF.
503 Throws an exception if SELF is not a <gdb:sal> object. */
506 stscm_get_sal_arg (SCM self
, int arg_pos
, const char *func_name
)
508 SCM_ASSERT_TYPE (stscm_is_sal (self
), self
, arg_pos
, func_name
,
514 /* Returns a pointer to the sal smob of SELF.
515 Throws an exception if SELF is not a <gdb:sal> object. */
518 stscm_get_sal_smob_arg (SCM self
, int arg_pos
, const char *func_name
)
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
);
526 /* Return non-zero if the symtab in S_SMOB is valid. */
529 stscm_sal_is_valid (sal_smob
*s_smob
)
531 symtab_smob
*st_smob
;
533 /* If there's no symtab that's ok, the sal is still valid. */
534 if (gdbscm_is_false (s_smob
->symtab_scm
))
537 st_smob
= (symtab_smob
*) SCM_SMOB_DATA (s_smob
->symtab_scm
);
539 return st_smob
->symtab
!= NULL
;
542 /* Throw a Scheme error if SELF is not a valid sal smob.
543 Otherwise return a pointer to the sal_smob object. */
546 stscm_get_valid_sal_smob_arg (SCM self
, int arg_pos
, const char *func_name
)
548 sal_smob
*s_smob
= stscm_get_sal_smob_arg (self
, arg_pos
, func_name
);
550 if (!stscm_sal_is_valid (s_smob
))
552 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
561 /* (sal-valid? <gdb:sal>) -> boolean
562 Returns #t if the symtab for SELF still exists in GDB. */
565 gdbscm_sal_valid_p (SCM self
)
567 sal_smob
*s_smob
= stscm_get_sal_smob_arg (self
, SCM_ARG1
, FUNC_NAME
);
569 return scm_from_bool (stscm_sal_is_valid (s_smob
));
572 /* (sal-pc <gdb:sal>) -> address */
575 gdbscm_sal_pc (SCM self
)
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
;
580 return gdbscm_scm_from_ulongest (sal
->pc
);
583 /* (sal-last <gdb:sal>) -> address
584 Returns #f if no ending address is recorded. */
587 gdbscm_sal_last (SCM self
)
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
;
593 return gdbscm_scm_from_ulongest (sal
->end
- 1);
597 /* (sal-line <gdb:sal>) -> integer
598 Returns #f if no line number is recorded. */
601 gdbscm_sal_line (SCM self
)
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
;
607 return scm_from_int (sal
->line
);
611 /* (sal-symtab <gdb:sal>) -> <gdb:symtab>
612 Returns #f if no symtab is recorded. */
615 gdbscm_sal_symtab (SCM self
)
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
;
620 return s_smob
->symtab_scm
;
623 /* (find-pc-line address) -> <gdb:sal> */
626 gdbscm_find_pc_line (SCM pc_scm
)
629 struct symtab_and_line sal
;
630 volatile struct gdb_exception except
;
632 init_sal (&sal
); /* -Wall */
634 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "U", pc_scm
, &pc_ull
);
636 TRY_CATCH (except
, RETURN_MASK_ALL
)
638 CORE_ADDR pc
= (CORE_ADDR
) pc_ull
;
640 sal
= find_pc_line (pc
, 0);
642 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
644 return stscm_scm_from_sal (sal
);
647 /* Initialize the Scheme symbol support. */
649 static const scheme_function symtab_functions
[] =
651 { "symtab?", 1, 0, 0, gdbscm_symtab_p
,
653 Return #t if the object is a <gdb:symtab> object." },
655 { "symtab-valid?", 1, 0, 0, gdbscm_symtab_valid_p
,
657 Return #t if the symtab still exists in GDB.\n\
658 Symtabs are deleted when the corresponding objfile is freed." },
660 { "symtab-filename", 1, 0, 0, gdbscm_symtab_filename
,
662 Return the symtab's source file name." },
664 { "symtab-fullname", 1, 0, 0, gdbscm_symtab_fullname
,
666 Return the symtab's full source file name." },
668 { "symtab-objfile", 1, 0, 0, gdbscm_symtab_objfile
,
670 Return the symtab's objfile." },
672 { "symtab-global-block", 1, 0, 0, gdbscm_symtab_global_block
,
674 Return the symtab's global block." },
676 { "symtab-static-block", 1, 0, 0, gdbscm_symtab_static_block
,
678 Return the symtab's static block." },
680 { "sal?", 1, 0, 0, gdbscm_sal_p
,
682 Return #t if the object is a <gdb:sal> (symtab-and-line) object." },
684 { "sal-valid?", 1, 0, 0, gdbscm_sal_valid_p
,
686 Return #t if the symtab for the sal still exists in GDB.\n\
687 Symtabs are deleted when the corresponding objfile is freed." },
689 { "sal-symtab", 1, 0, 0, gdbscm_sal_symtab
,
691 Return the sal's symtab." },
693 { "sal-line", 1, 0, 0, gdbscm_sal_line
,
695 Return the sal's line number, or #f if there is none." },
697 { "sal-pc", 1, 0, 0, gdbscm_sal_pc
,
699 Return the sal's address." },
701 { "sal-last", 1, 0, 0, gdbscm_sal_last
,
703 Return the last address specified by the sal, or #f if there is none." },
705 { "find-pc-line", 1, 0, 0, gdbscm_find_pc_line
,
707 Return the sal corresponding to the address, or #f if there isn't one.\n\
709 Arguments: address" },
715 gdbscm_initialize_symtabs (void)
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
);
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
);
728 gdbscm_define_functions (symtab_functions
, 1);
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
);