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 "free" function for <gdb:symtab>. */
128 stscm_free_symtab_smob (SCM self
)
130 symtab_smob
*st_smob
= (symtab_smob
*) SCM_SMOB_DATA (self
);
132 if (st_smob
->symtab
!= NULL
)
134 htab_t htab
= stscm_objfile_symtab_map (st_smob
->symtab
);
136 gdbscm_clear_eqable_gsmob_ptr_slot (htab
, &st_smob
->base
);
139 /* Not necessary, done to catch bugs. */
140 st_smob
->symtab
= NULL
;
145 /* The smob "print" function for <gdb:symtab>. */
148 stscm_print_symtab_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
150 symtab_smob
*st_smob
= (symtab_smob
*) SCM_SMOB_DATA (self
);
152 gdbscm_printf (port
, "#<%s ", symtab_smob_name
);
153 gdbscm_printf (port
, "%s",
154 st_smob
->symtab
!= NULL
155 ? symtab_to_filename_for_display (st_smob
->symtab
)
157 scm_puts (">", port
);
159 scm_remember_upto_here_1 (self
);
161 /* Non-zero means success. */
165 /* Low level routine to create a <gdb:symtab> object. */
168 stscm_make_symtab_smob (void)
170 symtab_smob
*st_smob
= (symtab_smob
*)
171 scm_gc_malloc (sizeof (symtab_smob
), symtab_smob_name
);
174 st_smob
->symtab
= NULL
;
175 st_scm
= scm_new_smob (symtab_smob_tag
, (scm_t_bits
) st_smob
);
176 gdbscm_init_eqable_gsmob (&st_smob
->base
, st_scm
);
181 /* Return non-zero if SCM is a symbol table smob. */
184 stscm_is_symtab (SCM scm
)
186 return SCM_SMOB_PREDICATE (symtab_smob_tag
, scm
);
189 /* (symtab? object) -> boolean */
192 gdbscm_symtab_p (SCM scm
)
194 return scm_from_bool (stscm_is_symtab (scm
));
197 /* Create a new <gdb:symtab> object that encapsulates SYMTAB. */
200 stscm_scm_from_symtab (struct symtab
*symtab
)
203 eqable_gdb_smob
**slot
;
204 symtab_smob
*st_smob
, st_smob_for_lookup
;
207 /* If we've already created a gsmob for this symtab, return it.
208 This makes symtabs eq?-able. */
209 htab
= stscm_objfile_symtab_map (symtab
);
210 st_smob_for_lookup
.symtab
= symtab
;
211 slot
= gdbscm_find_eqable_gsmob_ptr_slot (htab
, &st_smob_for_lookup
.base
);
213 return (*slot
)->containing_scm
;
215 st_scm
= stscm_make_symtab_smob ();
216 st_smob
= (symtab_smob
*) SCM_SMOB_DATA (st_scm
);
217 st_smob
->symtab
= symtab
;
218 gdbscm_fill_eqable_gsmob_ptr_slot (slot
, &st_smob
->base
);
223 /* Returns the <gdb:symtab> object in SELF.
224 Throws an exception if SELF is not a <gdb:symtab> object. */
227 stscm_get_symtab_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
229 SCM_ASSERT_TYPE (stscm_is_symtab (self
), self
, arg_pos
, func_name
,
235 /* Returns a pointer to the symtab smob of SELF.
236 Throws an exception if SELF is not a <gdb:symtab> object. */
239 stscm_get_symtab_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
241 SCM st_scm
= stscm_get_symtab_arg_unsafe (self
, arg_pos
, func_name
);
242 symtab_smob
*st_smob
= (symtab_smob
*) SCM_SMOB_DATA (st_scm
);
247 /* Return non-zero if symtab ST_SMOB is valid. */
250 stscm_is_valid (symtab_smob
*st_smob
)
252 return st_smob
->symtab
!= NULL
;
255 /* Throw a Scheme error if SELF is not a valid symtab smob.
256 Otherwise return a pointer to the symtab_smob object. */
259 stscm_get_valid_symtab_smob_arg_unsafe (SCM self
, int arg_pos
,
260 const char *func_name
)
263 = stscm_get_symtab_smob_arg_unsafe (self
, arg_pos
, func_name
);
265 if (!stscm_is_valid (st_smob
))
267 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
274 /* Helper function for stscm_del_objfile_symtabs to mark the symtab
278 stscm_mark_symtab_invalid (void **slot
, void *info
)
280 symtab_smob
*st_smob
= (symtab_smob
*) *slot
;
282 st_smob
->symtab
= NULL
;
286 /* This function is called when an objfile is about to be freed.
287 Invalidate the symbol table as further actions on the symbol table
288 would result in bad data. All access to st_smob->symtab should be
289 gated by stscm_get_valid_symtab_smob_arg_unsafe which will raise an
290 exception on invalid symbol tables. */
293 stscm_del_objfile_symtabs (struct objfile
*objfile
, void *datum
)
299 htab_traverse_noresize (htab
, stscm_mark_symtab_invalid
, NULL
);
304 /* Symbol table methods. */
306 /* (symtab-valid? <gdb:symtab>) -> boolean
307 Returns #t if SELF still exists in GDB. */
310 gdbscm_symtab_valid_p (SCM self
)
313 = stscm_get_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
315 return scm_from_bool (stscm_is_valid (st_smob
));
318 /* (symtab-filename <gdb:symtab>) -> string */
321 gdbscm_symtab_filename (SCM self
)
324 = stscm_get_valid_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
325 struct symtab
*symtab
= st_smob
->symtab
;
327 return gdbscm_scm_from_c_string (symtab_to_filename_for_display (symtab
));
330 /* (symtab-fullname <gdb:symtab>) -> string */
333 gdbscm_symtab_fullname (SCM self
)
336 = stscm_get_valid_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
337 struct symtab
*symtab
= st_smob
->symtab
;
339 return gdbscm_scm_from_c_string (symtab_to_fullname (symtab
));
342 /* (symtab-objfile <gdb:symtab>) -> <gdb:objfile> */
345 gdbscm_symtab_objfile (SCM self
)
348 = stscm_get_valid_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
349 const struct symtab
*symtab
= st_smob
->symtab
;
351 return ofscm_scm_from_objfile (symtab
->objfile
);
354 /* (symtab-global-block <gdb:symtab>) -> <gdb:block>
355 Return the GLOBAL_BLOCK of the underlying symtab. */
358 gdbscm_symtab_global_block (SCM self
)
361 = stscm_get_valid_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
362 const struct symtab
*symtab
= st_smob
->symtab
;
363 const struct blockvector
*blockvector
;
364 const struct block
*block
;
366 blockvector
= BLOCKVECTOR (symtab
);
367 block
= BLOCKVECTOR_BLOCK (blockvector
, GLOBAL_BLOCK
);
369 return bkscm_scm_from_block (block
, symtab
->objfile
);
372 /* (symtab-static-block <gdb:symtab>) -> <gdb:block>
373 Return the STATIC_BLOCK of the underlying symtab. */
376 gdbscm_symtab_static_block (SCM self
)
379 = stscm_get_valid_symtab_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
380 const struct symtab
*symtab
= st_smob
->symtab
;
381 const struct blockvector
*blockvector
;
382 const struct block
*block
;
384 blockvector
= BLOCKVECTOR (symtab
);
385 block
= BLOCKVECTOR_BLOCK (blockvector
, STATIC_BLOCK
);
387 return bkscm_scm_from_block (block
, symtab
->objfile
);
390 /* Administrivia for sal (symtab-and-line) smobs. */
392 /* The smob "print" function for <gdb:sal>. */
395 stscm_print_sal_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
397 sal_smob
*s_smob
= (sal_smob
*) SCM_SMOB_DATA (self
);
398 symtab_smob
*st_smob
= (symtab_smob
*) SCM_SMOB_DATA (s_smob
->symtab_scm
);
400 gdbscm_printf (port
, "#<%s ", symtab_smob_name
);
401 scm_write (s_smob
->symtab_scm
, port
);
402 if (s_smob
->sal
.line
!= 0)
403 gdbscm_printf (port
, " line %d", s_smob
->sal
.line
);
404 scm_puts (">", port
);
406 scm_remember_upto_here_1 (self
);
408 /* Non-zero means success. */
412 /* Low level routine to create a <gdb:sal> object. */
415 stscm_make_sal_smob (void)
418 = (sal_smob
*) scm_gc_malloc (sizeof (sal_smob
), sal_smob_name
);
421 s_smob
->symtab_scm
= SCM_BOOL_F
;
422 memset (&s_smob
->sal
, 0, sizeof (s_smob
->sal
));
423 s_scm
= scm_new_smob (sal_smob_tag
, (scm_t_bits
) s_smob
);
424 gdbscm_init_gsmob (&s_smob
->base
);
429 /* Return non-zero if SCM is a <gdb:sal> object. */
432 stscm_is_sal (SCM scm
)
434 return SCM_SMOB_PREDICATE (sal_smob_tag
, scm
);
437 /* (sal? object) -> boolean */
440 gdbscm_sal_p (SCM scm
)
442 return scm_from_bool (stscm_is_sal (scm
));
445 /* Create a new <gdb:sal> object that encapsulates SAL. */
448 stscm_scm_from_sal (struct symtab_and_line sal
)
454 if (sal
.symtab
!= NULL
)
455 st_scm
= stscm_scm_from_symtab (sal
.symtab
);
457 s_scm
= stscm_make_sal_smob ();
458 s_smob
= (sal_smob
*) SCM_SMOB_DATA (s_scm
);
459 s_smob
->symtab_scm
= st_scm
;
465 /* Returns the <gdb:sal> object in SELF.
466 Throws an exception if SELF is not a <gdb:sal> object. */
469 stscm_get_sal_arg (SCM self
, int arg_pos
, const char *func_name
)
471 SCM_ASSERT_TYPE (stscm_is_sal (self
), self
, arg_pos
, func_name
,
477 /* Returns a pointer to the sal smob of SELF.
478 Throws an exception if SELF is not a <gdb:sal> object. */
481 stscm_get_sal_smob_arg (SCM self
, int arg_pos
, const char *func_name
)
483 SCM s_scm
= stscm_get_sal_arg (self
, arg_pos
, func_name
);
484 sal_smob
*s_smob
= (sal_smob
*) SCM_SMOB_DATA (s_scm
);
489 /* Return non-zero if the symtab in S_SMOB is valid. */
492 stscm_sal_is_valid (sal_smob
*s_smob
)
494 symtab_smob
*st_smob
;
496 /* If there's no symtab that's ok, the sal is still valid. */
497 if (gdbscm_is_false (s_smob
->symtab_scm
))
500 st_smob
= (symtab_smob
*) SCM_SMOB_DATA (s_smob
->symtab_scm
);
502 return st_smob
->symtab
!= NULL
;
505 /* Throw a Scheme error if SELF is not a valid sal smob.
506 Otherwise return a pointer to the sal_smob object. */
509 stscm_get_valid_sal_smob_arg (SCM self
, int arg_pos
, const char *func_name
)
511 sal_smob
*s_smob
= stscm_get_sal_smob_arg (self
, arg_pos
, func_name
);
513 if (!stscm_sal_is_valid (s_smob
))
515 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
524 /* (sal-valid? <gdb:sal>) -> boolean
525 Returns #t if the symtab for SELF still exists in GDB. */
528 gdbscm_sal_valid_p (SCM self
)
530 sal_smob
*s_smob
= stscm_get_sal_smob_arg (self
, SCM_ARG1
, FUNC_NAME
);
532 return scm_from_bool (stscm_sal_is_valid (s_smob
));
535 /* (sal-pc <gdb:sal>) -> address */
538 gdbscm_sal_pc (SCM self
)
540 sal_smob
*s_smob
= stscm_get_valid_sal_smob_arg (self
, SCM_ARG1
, FUNC_NAME
);
541 const struct symtab_and_line
*sal
= &s_smob
->sal
;
543 return gdbscm_scm_from_ulongest (sal
->pc
);
546 /* (sal-last <gdb:sal>) -> address
547 Returns #f if no ending address is recorded. */
550 gdbscm_sal_last (SCM self
)
552 sal_smob
*s_smob
= stscm_get_valid_sal_smob_arg (self
, SCM_ARG1
, FUNC_NAME
);
553 const struct symtab_and_line
*sal
= &s_smob
->sal
;
556 return gdbscm_scm_from_ulongest (sal
->end
- 1);
560 /* (sal-line <gdb:sal>) -> integer
561 Returns #f if no line number is recorded. */
564 gdbscm_sal_line (SCM self
)
566 sal_smob
*s_smob
= stscm_get_valid_sal_smob_arg (self
, SCM_ARG1
, FUNC_NAME
);
567 const struct symtab_and_line
*sal
= &s_smob
->sal
;
570 return scm_from_int (sal
->line
);
574 /* (sal-symtab <gdb:sal>) -> <gdb:symtab>
575 Returns #f if no symtab is recorded. */
578 gdbscm_sal_symtab (SCM self
)
580 sal_smob
*s_smob
= stscm_get_valid_sal_smob_arg (self
, SCM_ARG1
, FUNC_NAME
);
581 const struct symtab_and_line
*sal
= &s_smob
->sal
;
583 return s_smob
->symtab_scm
;
586 /* (find-pc-line address) -> <gdb:sal> */
589 gdbscm_find_pc_line (SCM pc_scm
)
592 struct symtab_and_line sal
;
593 volatile struct gdb_exception except
;
595 init_sal (&sal
); /* -Wall */
597 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "U", pc_scm
, &pc_ull
);
599 TRY_CATCH (except
, RETURN_MASK_ALL
)
601 CORE_ADDR pc
= (CORE_ADDR
) pc_ull
;
603 sal
= find_pc_line (pc
, 0);
605 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
607 return stscm_scm_from_sal (sal
);
610 /* Initialize the Scheme symbol support. */
612 static const scheme_function symtab_functions
[] =
614 { "symtab?", 1, 0, 0, gdbscm_symtab_p
,
616 Return #t if the object is a <gdb:symtab> object." },
618 { "symtab-valid?", 1, 0, 0, gdbscm_symtab_valid_p
,
620 Return #t if the symtab still exists in GDB.\n\
621 Symtabs are deleted when the corresponding objfile is freed." },
623 { "symtab-filename", 1, 0, 0, gdbscm_symtab_filename
,
625 Return the symtab's source file name." },
627 { "symtab-fullname", 1, 0, 0, gdbscm_symtab_fullname
,
629 Return the symtab's full source file name." },
631 { "symtab-objfile", 1, 0, 0, gdbscm_symtab_objfile
,
633 Return the symtab's objfile." },
635 { "symtab-global-block", 1, 0, 0, gdbscm_symtab_global_block
,
637 Return the symtab's global block." },
639 { "symtab-static-block", 1, 0, 0, gdbscm_symtab_static_block
,
641 Return the symtab's static block." },
643 { "sal?", 1, 0, 0, gdbscm_sal_p
,
645 Return #t if the object is a <gdb:sal> (symtab-and-line) object." },
647 { "sal-valid?", 1, 0, 0, gdbscm_sal_valid_p
,
649 Return #t if the symtab for the sal still exists in GDB.\n\
650 Symtabs are deleted when the corresponding objfile is freed." },
652 { "sal-symtab", 1, 0, 0, gdbscm_sal_symtab
,
654 Return the sal's symtab." },
656 { "sal-line", 1, 0, 0, gdbscm_sal_line
,
658 Return the sal's line number, or #f if there is none." },
660 { "sal-pc", 1, 0, 0, gdbscm_sal_pc
,
662 Return the sal's address." },
664 { "sal-last", 1, 0, 0, gdbscm_sal_last
,
666 Return the last address specified by the sal, or #f if there is none." },
668 { "find-pc-line", 1, 0, 0, gdbscm_find_pc_line
,
670 Return the sal corresponding to the address, or #f if there isn't one.\n\
672 Arguments: address" },
678 gdbscm_initialize_symtabs (void)
681 = gdbscm_make_smob_type (symtab_smob_name
, sizeof (symtab_smob
));
682 scm_set_smob_free (symtab_smob_tag
, stscm_free_symtab_smob
);
683 scm_set_smob_print (symtab_smob_tag
, stscm_print_symtab_smob
);
685 sal_smob_tag
= gdbscm_make_smob_type (sal_smob_name
, sizeof (sal_smob
));
686 scm_set_smob_print (sal_smob_tag
, stscm_print_sal_smob
);
688 gdbscm_define_functions (symtab_functions
, 1);
690 /* Register an objfile "free" callback so we can properly
691 invalidate symbol tables, and symbol table and line data
692 structures when an object file that is about to be deleted. */
693 stscm_objfile_data_key
694 = register_objfile_data_with_cleanup (NULL
, stscm_del_objfile_symtabs
);