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