1/* Scheme interface to types. 2 3 Copyright (C) 2008-2020 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 "arch-utils.h" 25#include "value.h" 26#include "gdbtypes.h" 27#include "objfiles.h" 28#include "language.h" 29#include "bcache.h" 30#include "dwarf2/loc.h" 31#include "typeprint.h" 32#include "guile-internal.h" 33 34/* The <gdb:type> smob. 35 The type is chained with all types associated with its objfile, if any. 36 This lets us copy the underlying struct type when the objfile is 37 deleted. 38 The typedef for this struct is in guile-internal.h. */ 39 40struct _type_smob 41{ 42 /* This always appears first. 43 eqable_gdb_smob is used so that types are eq?-able. 44 Also, a type object can be associated with an objfile. eqable_gdb_smob 45 lets us track the lifetime of all types associated with an objfile. 46 When an objfile is deleted we need to invalidate the type object. */ 47 eqable_gdb_smob base; 48 49 /* The GDB type structure this smob is wrapping. */ 50 struct type *type; 51}; 52 53/* A field smob. */ 54 55typedef struct 56{ 57 /* This always appears first. */ 58 gdb_smob base; 59 60 /* Backlink to the containing <gdb:type> object. */ 61 SCM type_scm; 62 63 /* The field number in TYPE_SCM. */ 64 int field_num; 65} field_smob; 66 67static const char type_smob_name[] = "gdb:type"; 68static const char field_smob_name[] = "gdb:field"; 69 70static const char not_composite_error[] = 71 N_("type is not a structure, union, or enum type"); 72 73/* The tag Guile knows the type smob by. */ 74static scm_t_bits type_smob_tag; 75 76/* The tag Guile knows the field smob by. */ 77static scm_t_bits field_smob_tag; 78 79/* The "next" procedure for field iterators. */ 80static SCM tyscm_next_field_x_proc; 81 82/* Keywords used in argument passing. */ 83static SCM block_keyword; 84 85static const struct objfile_data *tyscm_objfile_data_key; 86 87/* Hash table to uniquify global (non-objfile-owned) types. */ 88static htab_t global_types_map; 89 90static struct type *tyscm_get_composite (struct type *type); 91 92/* Return the type field of T_SMOB. 93 This exists so that we don't have to export the struct's contents. */ 94 95struct type * 96tyscm_type_smob_type (type_smob *t_smob) 97{ 98 return t_smob->type; 99} 100 101/* Return the name of TYPE in expanded form. If there's an error 102 computing the name, throws the gdb exception with scm_throw. */ 103 104static std::string 105tyscm_type_name (struct type *type) 106{ 107 SCM excp; 108 try 109 { 110 string_file stb; 111 112 LA_PRINT_TYPE (type, "", &stb, -1, 0, &type_print_raw_options); 113 return std::move (stb.string ()); 114 } 115 catch (const gdb_exception &except) 116 { 117 excp = gdbscm_scm_from_gdb_exception (unpack (except)); 118 } 119 120 gdbscm_throw (excp); 121} 122 123/* Administrivia for type smobs. */ 124 125/* Helper function to hash a type_smob. */ 126 127static hashval_t 128tyscm_hash_type_smob (const void *p) 129{ 130 const type_smob *t_smob = (const type_smob *) p; 131 132 return htab_hash_pointer (t_smob->type); 133} 134 135/* Helper function to compute equality of type_smobs. */ 136 137static int 138tyscm_eq_type_smob (const void *ap, const void *bp) 139{ 140 const type_smob *a = (const type_smob *) ap; 141 const type_smob *b = (const type_smob *) bp; 142 143 return (a->type == b->type 144 && a->type != NULL); 145} 146 147/* Return the struct type pointer -> SCM mapping table. 148 If type is owned by an objfile, the mapping table is created if necessary. 149 Otherwise, type is not owned by an objfile, and we use 150 global_types_map. */ 151 152static htab_t 153tyscm_type_map (struct type *type) 154{ 155 struct objfile *objfile = TYPE_OBJFILE (type); 156 htab_t htab; 157 158 if (objfile == NULL) 159 return global_types_map; 160 161 htab = (htab_t) objfile_data (objfile, tyscm_objfile_data_key); 162 if (htab == NULL) 163 { 164 htab = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob, 165 tyscm_eq_type_smob); 166 set_objfile_data (objfile, tyscm_objfile_data_key, htab); 167 } 168 169 return htab; 170} 171 172/* The smob "free" function for <gdb:type>. */ 173 174static size_t 175tyscm_free_type_smob (SCM self) 176{ 177 type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self); 178 179 if (t_smob->type != NULL) 180 { 181 htab_t htab = tyscm_type_map (t_smob->type); 182 183 gdbscm_clear_eqable_gsmob_ptr_slot (htab, &t_smob->base); 184 } 185 186 /* Not necessary, done to catch bugs. */ 187 t_smob->type = NULL; 188 189 return 0; 190} 191 192/* The smob "print" function for <gdb:type>. */ 193 194static int 195tyscm_print_type_smob (SCM self, SCM port, scm_print_state *pstate) 196{ 197 type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self); 198 std::string name = tyscm_type_name (t_smob->type); 199 200 /* pstate->writingp = zero if invoked by display/~A, and nonzero if 201 invoked by write/~S. What to do here may need to evolve. 202 IWBN if we could pass an argument to format that would we could use 203 instead of writingp. */ 204 if (pstate->writingp) 205 gdbscm_printf (port, "#<%s ", type_smob_name); 206 207 scm_puts (name.c_str (), port); 208 209 if (pstate->writingp) 210 scm_puts (">", port); 211 212 scm_remember_upto_here_1 (self); 213 214 /* Non-zero means success. */ 215 return 1; 216} 217 218/* The smob "equal?" function for <gdb:type>. */ 219 220static SCM 221tyscm_equal_p_type_smob (SCM type1_scm, SCM type2_scm) 222{ 223 type_smob *type1_smob, *type2_smob; 224 struct type *type1, *type2; 225 bool result = false; 226 227 SCM_ASSERT_TYPE (tyscm_is_type (type1_scm), type1_scm, SCM_ARG1, FUNC_NAME, 228 type_smob_name); 229 SCM_ASSERT_TYPE (tyscm_is_type (type2_scm), type2_scm, SCM_ARG2, FUNC_NAME, 230 type_smob_name); 231 type1_smob = (type_smob *) SCM_SMOB_DATA (type1_scm); 232 type2_smob = (type_smob *) SCM_SMOB_DATA (type2_scm); 233 type1 = type1_smob->type; 234 type2 = type2_smob->type; 235 236 gdbscm_gdb_exception exc {}; 237 try 238 { 239 result = types_deeply_equal (type1, type2); 240 } 241 catch (const gdb_exception &except) 242 { 243 exc = unpack (except); 244 } 245 246 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 247 return scm_from_bool (result); 248} 249 250/* Low level routine to create a <gdb:type> object. */ 251 252static SCM 253tyscm_make_type_smob (void) 254{ 255 type_smob *t_smob = (type_smob *) 256 scm_gc_malloc (sizeof (type_smob), type_smob_name); 257 SCM t_scm; 258 259 /* This must be filled in by the caller. */ 260 t_smob->type = NULL; 261 262 t_scm = scm_new_smob (type_smob_tag, (scm_t_bits) t_smob); 263 gdbscm_init_eqable_gsmob (&t_smob->base, t_scm); 264 265 return t_scm; 266} 267 268/* Return non-zero if SCM is a <gdb:type> object. */ 269 270int 271tyscm_is_type (SCM self) 272{ 273 return SCM_SMOB_PREDICATE (type_smob_tag, self); 274} 275 276/* (type? object) -> boolean */ 277 278static SCM 279gdbscm_type_p (SCM self) 280{ 281 return scm_from_bool (tyscm_is_type (self)); 282} 283 284/* Return the existing object that encapsulates TYPE, or create a new 285 <gdb:type> object. */ 286 287SCM 288tyscm_scm_from_type (struct type *type) 289{ 290 htab_t htab; 291 eqable_gdb_smob **slot; 292 type_smob *t_smob, t_smob_for_lookup; 293 SCM t_scm; 294 295 /* If we've already created a gsmob for this type, return it. 296 This makes types eq?-able. */ 297 htab = tyscm_type_map (type); 298 t_smob_for_lookup.type = type; 299 slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &t_smob_for_lookup.base); 300 if (*slot != NULL) 301 return (*slot)->containing_scm; 302 303 t_scm = tyscm_make_type_smob (); 304 t_smob = (type_smob *) SCM_SMOB_DATA (t_scm); 305 t_smob->type = type; 306 gdbscm_fill_eqable_gsmob_ptr_slot (slot, &t_smob->base); 307 308 return t_scm; 309} 310 311/* Returns the <gdb:type> object in SELF. 312 Throws an exception if SELF is not a <gdb:type> object. */ 313 314static SCM 315tyscm_get_type_arg_unsafe (SCM self, int arg_pos, const char *func_name) 316{ 317 SCM_ASSERT_TYPE (tyscm_is_type (self), self, arg_pos, func_name, 318 type_smob_name); 319 320 return self; 321} 322 323/* Returns a pointer to the type smob of SELF. 324 Throws an exception if SELF is not a <gdb:type> object. */ 325 326type_smob * 327tyscm_get_type_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) 328{ 329 SCM t_scm = tyscm_get_type_arg_unsafe (self, arg_pos, func_name); 330 type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (t_scm); 331 332 return t_smob; 333} 334 335/* Return the type field of T_SCM, an object of type <gdb:type>. 336 This exists so that we don't have to export the struct's contents. */ 337 338struct type * 339tyscm_scm_to_type (SCM t_scm) 340{ 341 type_smob *t_smob; 342 343 gdb_assert (tyscm_is_type (t_scm)); 344 t_smob = (type_smob *) SCM_SMOB_DATA (t_scm); 345 return t_smob->type; 346} 347 348/* Helper function for save_objfile_types to make a deep copy of the type. */ 349 350static int 351tyscm_copy_type_recursive (void **slot, void *info) 352{ 353 type_smob *t_smob = (type_smob *) *slot; 354 htab_t copied_types = (htab_t) info; 355 struct objfile *objfile = TYPE_OBJFILE (t_smob->type); 356 htab_t htab; 357 eqable_gdb_smob **new_slot; 358 type_smob t_smob_for_lookup; 359 360 gdb_assert (objfile != NULL); 361 362 htab_empty (copied_types); 363 t_smob->type = copy_type_recursive (objfile, t_smob->type, copied_types); 364 365 /* The eq?-hashtab that the type lived in is going away. 366 Add the type to its new eq?-hashtab: Otherwise if/when the type is later 367 garbage collected we'll assert-fail if the type isn't in the hashtab. 368 PR 16612. 369 370 Types now live in "arch space", and things like "char" that came from 371 the objfile *could* be considered eq? with the arch "char" type. 372 However, they weren't before the objfile got deleted, so making them 373 eq? now is debatable. */ 374 htab = tyscm_type_map (t_smob->type); 375 t_smob_for_lookup.type = t_smob->type; 376 new_slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &t_smob_for_lookup.base); 377 gdb_assert (*new_slot == NULL); 378 gdbscm_fill_eqable_gsmob_ptr_slot (new_slot, &t_smob->base); 379 380 return 1; 381} 382 383/* Called when OBJFILE is about to be deleted. 384 Make a copy of all types associated with OBJFILE. */ 385 386static void 387save_objfile_types (struct objfile *objfile, void *datum) 388{ 389 htab_t htab = (htab_t) datum; 390 htab_t copied_types; 391 392 if (!gdb_scheme_initialized) 393 return; 394 395 copied_types = create_copied_types_hash (objfile); 396 397 if (htab != NULL) 398 { 399 htab_traverse_noresize (htab, tyscm_copy_type_recursive, copied_types); 400 htab_delete (htab); 401 } 402 403 htab_delete (copied_types); 404} 405 406/* Administrivia for field smobs. */ 407 408/* The smob "print" function for <gdb:field>. */ 409 410static int 411tyscm_print_field_smob (SCM self, SCM port, scm_print_state *pstate) 412{ 413 field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (self); 414 415 gdbscm_printf (port, "#<%s ", field_smob_name); 416 scm_write (f_smob->type_scm, port); 417 gdbscm_printf (port, " %d", f_smob->field_num); 418 scm_puts (">", port); 419 420 scm_remember_upto_here_1 (self); 421 422 /* Non-zero means success. */ 423 return 1; 424} 425 426/* Low level routine to create a <gdb:field> object for field FIELD_NUM 427 of type TYPE_SCM. */ 428 429static SCM 430tyscm_make_field_smob (SCM type_scm, int field_num) 431{ 432 field_smob *f_smob = (field_smob *) 433 scm_gc_malloc (sizeof (field_smob), field_smob_name); 434 SCM result; 435 436 f_smob->type_scm = type_scm; 437 f_smob->field_num = field_num; 438 result = scm_new_smob (field_smob_tag, (scm_t_bits) f_smob); 439 gdbscm_init_gsmob (&f_smob->base); 440 441 return result; 442} 443 444/* Return non-zero if SCM is a <gdb:field> object. */ 445 446static int 447tyscm_is_field (SCM self) 448{ 449 return SCM_SMOB_PREDICATE (field_smob_tag, self); 450} 451 452/* (field? object) -> boolean */ 453 454static SCM 455gdbscm_field_p (SCM self) 456{ 457 return scm_from_bool (tyscm_is_field (self)); 458} 459 460/* Create a new <gdb:field> object that encapsulates field FIELD_NUM 461 in type TYPE_SCM. */ 462 463SCM 464tyscm_scm_from_field (SCM type_scm, int field_num) 465{ 466 return tyscm_make_field_smob (type_scm, field_num); 467} 468 469/* Returns the <gdb:field> object in SELF. 470 Throws an exception if SELF is not a <gdb:field> object. */ 471 472static SCM 473tyscm_get_field_arg_unsafe (SCM self, int arg_pos, const char *func_name) 474{ 475 SCM_ASSERT_TYPE (tyscm_is_field (self), self, arg_pos, func_name, 476 field_smob_name); 477 478 return self; 479} 480 481/* Returns a pointer to the field smob of SELF. 482 Throws an exception if SELF is not a <gdb:field> object. */ 483 484static field_smob * 485tyscm_get_field_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) 486{ 487 SCM f_scm = tyscm_get_field_arg_unsafe (self, arg_pos, func_name); 488 field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (f_scm); 489 490 return f_smob; 491} 492 493/* Returns a pointer to the type struct in F_SMOB 494 (the type the field is in). */ 495 496static struct type * 497tyscm_field_smob_containing_type (field_smob *f_smob) 498{ 499 type_smob *t_smob; 500 501 gdb_assert (tyscm_is_type (f_smob->type_scm)); 502 t_smob = (type_smob *) SCM_SMOB_DATA (f_smob->type_scm); 503 504 return t_smob->type; 505} 506 507/* Returns a pointer to the field struct of F_SMOB. */ 508 509static struct field * 510tyscm_field_smob_to_field (field_smob *f_smob) 511{ 512 struct type *type = tyscm_field_smob_containing_type (f_smob); 513 514 /* This should be non-NULL by construction. */ 515 gdb_assert (type->fields () != NULL); 516 517 return &type->field (f_smob->field_num); 518} 519 520/* Type smob accessors. */ 521 522/* (type-code <gdb:type>) -> integer 523 Return the code for this type. */ 524 525static SCM 526gdbscm_type_code (SCM self) 527{ 528 type_smob *t_smob 529 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 530 struct type *type = t_smob->type; 531 532 return scm_from_int (type->code ()); 533} 534 535/* (type-fields <gdb:type>) -> list 536 Return a list of all fields. Each element is a <gdb:field> object. 537 This also supports arrays, we return a field list of one element, 538 the range type. */ 539 540static SCM 541gdbscm_type_fields (SCM self) 542{ 543 type_smob *t_smob 544 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 545 struct type *type = t_smob->type; 546 struct type *containing_type; 547 SCM containing_type_scm, result; 548 int i; 549 550 containing_type = tyscm_get_composite (type); 551 if (containing_type == NULL) 552 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, 553 _(not_composite_error)); 554 555 /* If SELF is a typedef or reference, we want the underlying type, 556 which is what tyscm_get_composite returns. */ 557 if (containing_type == type) 558 containing_type_scm = self; 559 else 560 containing_type_scm = tyscm_scm_from_type (containing_type); 561 562 result = SCM_EOL; 563 for (i = 0; i < containing_type->num_fields (); ++i) 564 result = scm_cons (tyscm_make_field_smob (containing_type_scm, i), result); 565 566 return scm_reverse_x (result, SCM_EOL); 567} 568 569/* (type-tag <gdb:type>) -> string 570 Return the type's tag, or #f. */ 571 572static SCM 573gdbscm_type_tag (SCM self) 574{ 575 type_smob *t_smob 576 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 577 struct type *type = t_smob->type; 578 const char *tagname = nullptr; 579 580 if (type->code () == TYPE_CODE_STRUCT 581 || type->code () == TYPE_CODE_UNION 582 || type->code () == TYPE_CODE_ENUM) 583 tagname = type->name (); 584 585 if (tagname == nullptr) 586 return SCM_BOOL_F; 587 return gdbscm_scm_from_c_string (tagname); 588} 589 590/* (type-name <gdb:type>) -> string 591 Return the type's name, or #f. */ 592 593static SCM 594gdbscm_type_name (SCM self) 595{ 596 type_smob *t_smob 597 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 598 struct type *type = t_smob->type; 599 600 if (!type->name ()) 601 return SCM_BOOL_F; 602 return gdbscm_scm_from_c_string (type->name ()); 603} 604 605/* (type-print-name <gdb:type>) -> string 606 Return the print name of type. 607 TODO: template support elided for now. */ 608 609static SCM 610gdbscm_type_print_name (SCM self) 611{ 612 type_smob *t_smob 613 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 614 struct type *type = t_smob->type; 615 std::string thetype = tyscm_type_name (type); 616 SCM result = gdbscm_scm_from_c_string (thetype.c_str ()); 617 618 return result; 619} 620 621/* (type-sizeof <gdb:type>) -> integer 622 Return the size of the type represented by SELF, in bytes. */ 623 624static SCM 625gdbscm_type_sizeof (SCM self) 626{ 627 type_smob *t_smob 628 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 629 struct type *type = t_smob->type; 630 631 try 632 { 633 check_typedef (type); 634 } 635 catch (const gdb_exception &except) 636 { 637 } 638 639 /* Ignore exceptions. */ 640 641 return scm_from_long (TYPE_LENGTH (type)); 642} 643 644/* (type-strip-typedefs <gdb:type>) -> <gdb:type> 645 Return the type, stripped of typedefs. */ 646 647static SCM 648gdbscm_type_strip_typedefs (SCM self) 649{ 650 type_smob *t_smob 651 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 652 struct type *type = t_smob->type; 653 654 gdbscm_gdb_exception exc {}; 655 try 656 { 657 type = check_typedef (type); 658 } 659 catch (const gdb_exception &except) 660 { 661 exc = unpack (except); 662 } 663 664 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 665 return tyscm_scm_from_type (type); 666} 667 668/* Strip typedefs and pointers/reference from a type. Then check that 669 it is a struct, union, or enum type. If not, return NULL. */ 670 671static struct type * 672tyscm_get_composite (struct type *type) 673{ 674 675 for (;;) 676 { 677 gdbscm_gdb_exception exc {}; 678 try 679 { 680 type = check_typedef (type); 681 } 682 catch (const gdb_exception &except) 683 { 684 exc = unpack (except); 685 } 686 687 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 688 if (type->code () != TYPE_CODE_PTR 689 && type->code () != TYPE_CODE_REF) 690 break; 691 type = TYPE_TARGET_TYPE (type); 692 } 693 694 /* If this is not a struct, union, or enum type, raise TypeError 695 exception. */ 696 if (type->code () != TYPE_CODE_STRUCT 697 && type->code () != TYPE_CODE_UNION 698 && type->code () != TYPE_CODE_ENUM) 699 return NULL; 700 701 return type; 702} 703 704/* Helper for tyscm_array and tyscm_vector. */ 705 706static SCM 707tyscm_array_1 (SCM self, SCM n1_scm, SCM n2_scm, int is_vector, 708 const char *func_name) 709{ 710 type_smob *t_smob 711 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, func_name); 712 struct type *type = t_smob->type; 713 long n1, n2 = 0; 714 struct type *array = NULL; 715 716 gdbscm_parse_function_args (func_name, SCM_ARG2, NULL, "l|l", 717 n1_scm, &n1, n2_scm, &n2); 718 719 if (SCM_UNBNDP (n2_scm)) 720 { 721 n2 = n1; 722 n1 = 0; 723 } 724 725 if (n2 < n1 - 1) /* Note: An empty array has n2 == n1 - 1. */ 726 { 727 gdbscm_out_of_range_error (func_name, SCM_ARG3, 728 scm_cons (scm_from_long (n1), 729 scm_from_long (n2)), 730 _("Array length must not be negative")); 731 } 732 733 gdbscm_gdb_exception exc {}; 734 try 735 { 736 array = lookup_array_range_type (type, n1, n2); 737 if (is_vector) 738 make_vector_type (array); 739 } 740 catch (const gdb_exception &except) 741 { 742 exc = unpack (except); 743 } 744 745 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 746 return tyscm_scm_from_type (array); 747} 748 749/* (type-array <gdb:type> [low-bound] high-bound) -> <gdb:type> 750 The array has indices [low-bound,high-bound]. 751 If low-bound is not provided zero is used. 752 Return an array type. 753 754 IWBN if the one argument version specified a size, not the high bound. 755 It's too easy to pass one argument thinking it is the size of the array. 756 The current semantics are for compatibility with the Python version. 757 Later we can add #:size. */ 758 759static SCM 760gdbscm_type_array (SCM self, SCM n1, SCM n2) 761{ 762 return tyscm_array_1 (self, n1, n2, 0, FUNC_NAME); 763} 764 765/* (type-vector <gdb:type> [low-bound] high-bound) -> <gdb:type> 766 The array has indices [low-bound,high-bound]. 767 If low-bound is not provided zero is used. 768 Return a vector type. 769 770 IWBN if the one argument version specified a size, not the high bound. 771 It's too easy to pass one argument thinking it is the size of the array. 772 The current semantics are for compatibility with the Python version. 773 Later we can add #:size. */ 774 775static SCM 776gdbscm_type_vector (SCM self, SCM n1, SCM n2) 777{ 778 return tyscm_array_1 (self, n1, n2, 1, FUNC_NAME); 779} 780 781/* (type-pointer <gdb:type>) -> <gdb:type> 782 Return a <gdb:type> object which represents a pointer to SELF. */ 783 784static SCM 785gdbscm_type_pointer (SCM self) 786{ 787 type_smob *t_smob 788 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 789 struct type *type = t_smob->type; 790 791 gdbscm_gdb_exception exc {}; 792 try 793 { 794 type = lookup_pointer_type (type); 795 } 796 catch (const gdb_exception &except) 797 { 798 exc = unpack (except); 799 } 800 801 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 802 return tyscm_scm_from_type (type); 803} 804 805/* (type-range <gdb:type>) -> (low high) 806 Return the range of a type represented by SELF. The return type is 807 a list. The first element is the low bound, and the second element 808 is the high bound. */ 809 810static SCM 811gdbscm_type_range (SCM self) 812{ 813 type_smob *t_smob 814 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 815 struct type *type = t_smob->type; 816 SCM low_scm, high_scm; 817 /* Initialize these to appease GCC warnings. */ 818 LONGEST low = 0, high = 0; 819 820 SCM_ASSERT_TYPE (type->code () == TYPE_CODE_ARRAY 821 || type->code () == TYPE_CODE_STRING 822 || type->code () == TYPE_CODE_RANGE, 823 self, SCM_ARG1, FUNC_NAME, _("ranged type")); 824 825 switch (type->code ()) 826 { 827 case TYPE_CODE_ARRAY: 828 case TYPE_CODE_STRING: 829 case TYPE_CODE_RANGE: 830 low = type->bounds ()->low.const_val (); 831 high = type->bounds ()->high.const_val (); 832 break; 833 } 834 835 low_scm = gdbscm_scm_from_longest (low); 836 high_scm = gdbscm_scm_from_longest (high); 837 838 return scm_list_2 (low_scm, high_scm); 839} 840 841/* (type-reference <gdb:type>) -> <gdb:type> 842 Return a <gdb:type> object which represents a reference to SELF. */ 843 844static SCM 845gdbscm_type_reference (SCM self) 846{ 847 type_smob *t_smob 848 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 849 struct type *type = t_smob->type; 850 851 gdbscm_gdb_exception exc {}; 852 try 853 { 854 type = lookup_lvalue_reference_type (type); 855 } 856 catch (const gdb_exception &except) 857 { 858 exc = unpack (except); 859 } 860 861 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 862 return tyscm_scm_from_type (type); 863} 864 865/* (type-target <gdb:type>) -> <gdb:type> 866 Return a <gdb:type> object which represents the target type of SELF. */ 867 868static SCM 869gdbscm_type_target (SCM self) 870{ 871 type_smob *t_smob 872 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 873 struct type *type = t_smob->type; 874 875 SCM_ASSERT (TYPE_TARGET_TYPE (type), self, SCM_ARG1, FUNC_NAME); 876 877 return tyscm_scm_from_type (TYPE_TARGET_TYPE (type)); 878} 879 880/* (type-const <gdb:type>) -> <gdb:type> 881 Return a const-qualified type variant. */ 882 883static SCM 884gdbscm_type_const (SCM self) 885{ 886 type_smob *t_smob 887 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 888 struct type *type = t_smob->type; 889 890 gdbscm_gdb_exception exc {}; 891 try 892 { 893 type = make_cv_type (1, 0, type, NULL); 894 } 895 catch (const gdb_exception &except) 896 { 897 exc = unpack (except); 898 } 899 900 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 901 return tyscm_scm_from_type (type); 902} 903 904/* (type-volatile <gdb:type>) -> <gdb:type> 905 Return a volatile-qualified type variant. */ 906 907static SCM 908gdbscm_type_volatile (SCM self) 909{ 910 type_smob *t_smob 911 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 912 struct type *type = t_smob->type; 913 914 gdbscm_gdb_exception exc {}; 915 try 916 { 917 type = make_cv_type (0, 1, type, NULL); 918 } 919 catch (const gdb_exception &except) 920 { 921 exc = unpack (except); 922 } 923 924 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 925 return tyscm_scm_from_type (type); 926} 927 928/* (type-unqualified <gdb:type>) -> <gdb:type> 929 Return an unqualified type variant. */ 930 931static SCM 932gdbscm_type_unqualified (SCM self) 933{ 934 type_smob *t_smob 935 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 936 struct type *type = t_smob->type; 937 938 gdbscm_gdb_exception exc {}; 939 try 940 { 941 type = make_cv_type (0, 0, type, NULL); 942 } 943 catch (const gdb_exception &except) 944 { 945 exc = unpack (except); 946 } 947 948 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 949 return tyscm_scm_from_type (type); 950} 951 952/* Field related accessors of types. */ 953 954/* (type-num-fields <gdb:type>) -> integer 955 Return number of fields. */ 956 957static SCM 958gdbscm_type_num_fields (SCM self) 959{ 960 type_smob *t_smob 961 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 962 struct type *type = t_smob->type; 963 964 type = tyscm_get_composite (type); 965 if (type == NULL) 966 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, 967 _(not_composite_error)); 968 969 return scm_from_long (type->num_fields ()); 970} 971 972/* (type-field <gdb:type> string) -> <gdb:field> 973 Return the <gdb:field> object for the field named by the argument. */ 974 975static SCM 976gdbscm_type_field (SCM self, SCM field_scm) 977{ 978 type_smob *t_smob 979 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 980 struct type *type = t_smob->type; 981 982 SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME, 983 _("string")); 984 985 /* We want just fields of this type, not of base types, so instead of 986 using lookup_struct_elt_type, portions of that function are 987 copied here. */ 988 989 type = tyscm_get_composite (type); 990 if (type == NULL) 991 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, 992 _(not_composite_error)); 993 994 { 995 gdb::unique_xmalloc_ptr<char> field = gdbscm_scm_to_c_string (field_scm); 996 997 for (int i = 0; i < type->num_fields (); i++) 998 { 999 const char *t_field_name = TYPE_FIELD_NAME (type, i); 1000 1001 if (t_field_name && (strcmp_iw (t_field_name, field.get ()) == 0)) 1002 { 1003 field.reset (nullptr); 1004 return tyscm_make_field_smob (self, i); 1005 } 1006 } 1007 } 1008 1009 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, field_scm, 1010 _("Unknown field")); 1011} 1012 1013/* (type-has-field? <gdb:type> string) -> boolean 1014 Return boolean indicating if type SELF has FIELD_SCM (a string). */ 1015 1016static SCM 1017gdbscm_type_has_field_p (SCM self, SCM field_scm) 1018{ 1019 type_smob *t_smob 1020 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1021 struct type *type = t_smob->type; 1022 1023 SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME, 1024 _("string")); 1025 1026 /* We want just fields of this type, not of base types, so instead of 1027 using lookup_struct_elt_type, portions of that function are 1028 copied here. */ 1029 1030 type = tyscm_get_composite (type); 1031 if (type == NULL) 1032 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, 1033 _(not_composite_error)); 1034 1035 { 1036 gdb::unique_xmalloc_ptr<char> field 1037 = gdbscm_scm_to_c_string (field_scm); 1038 1039 for (int i = 0; i < type->num_fields (); i++) 1040 { 1041 const char *t_field_name = TYPE_FIELD_NAME (type, i); 1042 1043 if (t_field_name && (strcmp_iw (t_field_name, field.get ()) == 0)) 1044 return SCM_BOOL_T; 1045 } 1046 } 1047 1048 return SCM_BOOL_F; 1049} 1050 1051/* (make-field-iterator <gdb:type>) -> <gdb:iterator> 1052 Make a field iterator object. */ 1053 1054static SCM 1055gdbscm_make_field_iterator (SCM self) 1056{ 1057 type_smob *t_smob 1058 = tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1059 struct type *type = t_smob->type; 1060 struct type *containing_type; 1061 SCM containing_type_scm; 1062 1063 containing_type = tyscm_get_composite (type); 1064 if (containing_type == NULL) 1065 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, 1066 _(not_composite_error)); 1067 1068 /* If SELF is a typedef or reference, we want the underlying type, 1069 which is what tyscm_get_composite returns. */ 1070 if (containing_type == type) 1071 containing_type_scm = self; 1072 else 1073 containing_type_scm = tyscm_scm_from_type (containing_type); 1074 1075 return gdbscm_make_iterator (containing_type_scm, scm_from_int (0), 1076 tyscm_next_field_x_proc); 1077} 1078 1079/* (type-next-field! <gdb:iterator>) -> <gdb:field> 1080 Return the next field in the iteration through the list of fields of the 1081 type, or (end-of-iteration). 1082 SELF is a <gdb:iterator> object created by gdbscm_make_field_iterator. 1083 This is the next! <gdb:iterator> function, not exported to the user. */ 1084 1085static SCM 1086gdbscm_type_next_field_x (SCM self) 1087{ 1088 iterator_smob *i_smob; 1089 type_smob *t_smob; 1090 struct type *type; 1091 SCM it_scm, result, progress, object; 1092 int field; 1093 1094 it_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1095 i_smob = (iterator_smob *) SCM_SMOB_DATA (it_scm); 1096 object = itscm_iterator_smob_object (i_smob); 1097 progress = itscm_iterator_smob_progress (i_smob); 1098 1099 SCM_ASSERT_TYPE (tyscm_is_type (object), object, 1100 SCM_ARG1, FUNC_NAME, type_smob_name); 1101 t_smob = (type_smob *) SCM_SMOB_DATA (object); 1102 type = t_smob->type; 1103 1104 SCM_ASSERT_TYPE (scm_is_signed_integer (progress, 1105 0, type->num_fields ()), 1106 progress, SCM_ARG1, FUNC_NAME, _("integer")); 1107 field = scm_to_int (progress); 1108 1109 if (field < type->num_fields ()) 1110 { 1111 result = tyscm_make_field_smob (object, field); 1112 itscm_set_iterator_smob_progress_x (i_smob, scm_from_int (field + 1)); 1113 return result; 1114 } 1115 1116 return gdbscm_end_of_iteration (); 1117} 1118 1119/* Field smob accessors. */ 1120 1121/* (field-name <gdb:field>) -> string 1122 Return the name of this field or #f if there isn't one. */ 1123 1124static SCM 1125gdbscm_field_name (SCM self) 1126{ 1127 field_smob *f_smob 1128 = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1129 struct field *field = tyscm_field_smob_to_field (f_smob); 1130 1131 if (FIELD_NAME (*field)) 1132 return gdbscm_scm_from_c_string (FIELD_NAME (*field)); 1133 return SCM_BOOL_F; 1134} 1135 1136/* (field-type <gdb:field>) -> <gdb:type> 1137 Return the <gdb:type> object of the field or #f if there isn't one. */ 1138 1139static SCM 1140gdbscm_field_type (SCM self) 1141{ 1142 field_smob *f_smob 1143 = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1144 struct field *field = tyscm_field_smob_to_field (f_smob); 1145 1146 /* A field can have a NULL type in some situations. */ 1147 if (field->type ()) 1148 return tyscm_scm_from_type (field->type ()); 1149 return SCM_BOOL_F; 1150} 1151 1152/* (field-enumval <gdb:field>) -> integer 1153 For enum values, return its value as an integer. */ 1154 1155static SCM 1156gdbscm_field_enumval (SCM self) 1157{ 1158 field_smob *f_smob 1159 = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1160 struct field *field = tyscm_field_smob_to_field (f_smob); 1161 struct type *type = tyscm_field_smob_containing_type (f_smob); 1162 1163 SCM_ASSERT_TYPE (type->code () == TYPE_CODE_ENUM, 1164 self, SCM_ARG1, FUNC_NAME, _("enum type")); 1165 1166 return scm_from_long (FIELD_ENUMVAL (*field)); 1167} 1168 1169/* (field-bitpos <gdb:field>) -> integer 1170 For bitfields, return its offset in bits. */ 1171 1172static SCM 1173gdbscm_field_bitpos (SCM self) 1174{ 1175 field_smob *f_smob 1176 = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1177 struct field *field = tyscm_field_smob_to_field (f_smob); 1178 struct type *type = tyscm_field_smob_containing_type (f_smob); 1179 1180 SCM_ASSERT_TYPE (type->code () != TYPE_CODE_ENUM, 1181 self, SCM_ARG1, FUNC_NAME, _("non-enum type")); 1182 1183 return scm_from_long (FIELD_BITPOS (*field)); 1184} 1185 1186/* (field-bitsize <gdb:field>) -> integer 1187 Return the size of the field in bits. */ 1188 1189static SCM 1190gdbscm_field_bitsize (SCM self) 1191{ 1192 field_smob *f_smob 1193 = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1194 struct field *field = tyscm_field_smob_to_field (f_smob); 1195 1196 return scm_from_long (FIELD_BITPOS (*field)); 1197} 1198 1199/* (field-artificial? <gdb:field>) -> boolean 1200 Return #t if field is artificial. */ 1201 1202static SCM 1203gdbscm_field_artificial_p (SCM self) 1204{ 1205 field_smob *f_smob 1206 = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1207 struct field *field = tyscm_field_smob_to_field (f_smob); 1208 1209 return scm_from_bool (FIELD_ARTIFICIAL (*field)); 1210} 1211 1212/* (field-baseclass? <gdb:field>) -> boolean 1213 Return #t if field is a baseclass. */ 1214 1215static SCM 1216gdbscm_field_baseclass_p (SCM self) 1217{ 1218 field_smob *f_smob 1219 = tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 1220 struct type *type = tyscm_field_smob_containing_type (f_smob); 1221 1222 if (type->code () == TYPE_CODE_STRUCT) 1223 return scm_from_bool (f_smob->field_num < TYPE_N_BASECLASSES (type)); 1224 return SCM_BOOL_F; 1225} 1226 1227/* Return the type named TYPE_NAME in BLOCK. 1228 Returns NULL if not found. 1229 This routine does not throw an error. */ 1230 1231static struct type * 1232tyscm_lookup_typename (const char *type_name, const struct block *block) 1233{ 1234 struct type *type = NULL; 1235 1236 try 1237 { 1238 if (startswith (type_name, "struct ")) 1239 type = lookup_struct (type_name + 7, NULL); 1240 else if (startswith (type_name, "union ")) 1241 type = lookup_union (type_name + 6, NULL); 1242 else if (startswith (type_name, "enum ")) 1243 type = lookup_enum (type_name + 5, NULL); 1244 else 1245 type = lookup_typename (current_language, 1246 type_name, block, 0); 1247 } 1248 catch (const gdb_exception &except) 1249 { 1250 return NULL; 1251 } 1252 1253 return type; 1254} 1255 1256/* (lookup-type name [#:block <gdb:block>]) -> <gdb:type> 1257 TODO: legacy template support left out until needed. */ 1258 1259static SCM 1260gdbscm_lookup_type (SCM name_scm, SCM rest) 1261{ 1262 SCM keywords[] = { block_keyword, SCM_BOOL_F }; 1263 char *name; 1264 SCM block_scm = SCM_BOOL_F; 1265 int block_arg_pos = -1; 1266 const struct block *block = NULL; 1267 struct type *type; 1268 1269 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#O", 1270 name_scm, &name, 1271 rest, &block_arg_pos, &block_scm); 1272 1273 if (block_arg_pos != -1) 1274 { 1275 SCM exception; 1276 1277 block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME, 1278 &exception); 1279 if (block == NULL) 1280 { 1281 xfree (name); 1282 gdbscm_throw (exception); 1283 } 1284 } 1285 type = tyscm_lookup_typename (name, block); 1286 xfree (name); 1287 1288 if (type != NULL) 1289 return tyscm_scm_from_type (type); 1290 return SCM_BOOL_F; 1291} 1292 1293/* Initialize the Scheme type code. */ 1294 1295 1296static const scheme_integer_constant type_integer_constants[] = 1297{ 1298#define X(SYM) { #SYM, SYM } 1299 X (TYPE_CODE_BITSTRING), 1300 X (TYPE_CODE_PTR), 1301 X (TYPE_CODE_ARRAY), 1302 X (TYPE_CODE_STRUCT), 1303 X (TYPE_CODE_UNION), 1304 X (TYPE_CODE_ENUM), 1305 X (TYPE_CODE_FLAGS), 1306 X (TYPE_CODE_FUNC), 1307 X (TYPE_CODE_INT), 1308 X (TYPE_CODE_FLT), 1309 X (TYPE_CODE_VOID), 1310 X (TYPE_CODE_SET), 1311 X (TYPE_CODE_RANGE), 1312 X (TYPE_CODE_STRING), 1313 X (TYPE_CODE_ERROR), 1314 X (TYPE_CODE_METHOD), 1315 X (TYPE_CODE_METHODPTR), 1316 X (TYPE_CODE_MEMBERPTR), 1317 X (TYPE_CODE_REF), 1318 X (TYPE_CODE_CHAR), 1319 X (TYPE_CODE_BOOL), 1320 X (TYPE_CODE_COMPLEX), 1321 X (TYPE_CODE_TYPEDEF), 1322 X (TYPE_CODE_NAMESPACE), 1323 X (TYPE_CODE_DECFLOAT), 1324 X (TYPE_CODE_INTERNAL_FUNCTION), 1325#undef X 1326 1327 END_INTEGER_CONSTANTS 1328}; 1329 1330static const scheme_function type_functions[] = 1331{ 1332 { "type?", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_p), 1333 "\ 1334Return #t if the object is a <gdb:type> object." }, 1335 1336 { "lookup-type", 1, 0, 1, as_a_scm_t_subr (gdbscm_lookup_type), 1337 "\ 1338Return the <gdb:type> object representing string or #f if not found.\n\ 1339If block is given then the type is looked for in that block.\n\ 1340\n\ 1341 Arguments: string [#:block <gdb:block>]" }, 1342 1343 { "type-code", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_code), 1344 "\ 1345Return the code of the type" }, 1346 1347 { "type-tag", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_tag), 1348 "\ 1349Return the tag name of the type, or #f if there isn't one." }, 1350 1351 { "type-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_name), 1352 "\ 1353Return the name of the type as a string, or #f if there isn't one." }, 1354 1355 { "type-print-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_print_name), 1356 "\ 1357Return the print name of the type as a string." }, 1358 1359 { "type-sizeof", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_sizeof), 1360 "\ 1361Return the size of the type, in bytes." }, 1362 1363 { "type-strip-typedefs", 1, 0, 0, 1364 as_a_scm_t_subr (gdbscm_type_strip_typedefs), 1365 "\ 1366Return a type formed by stripping the type of all typedefs." }, 1367 1368 { "type-array", 2, 1, 0, as_a_scm_t_subr (gdbscm_type_array), 1369 "\ 1370Return a type representing an array of objects of the type.\n\ 1371\n\ 1372 Arguments: <gdb:type> [low-bound] high-bound\n\ 1373 If low-bound is not provided zero is used.\n\ 1374 N.B. If only the high-bound parameter is specified, it is not\n\ 1375 the array size.\n\ 1376 Valid bounds for array indices are [low-bound,high-bound]." }, 1377 1378 { "type-vector", 2, 1, 0, as_a_scm_t_subr (gdbscm_type_vector), 1379 "\ 1380Return a type representing a vector of objects of the type.\n\ 1381Vectors differ from arrays in that if the current language has C-style\n\ 1382arrays, vectors don't decay to a pointer to the first element.\n\ 1383They are first class values.\n\ 1384\n\ 1385 Arguments: <gdb:type> [low-bound] high-bound\n\ 1386 If low-bound is not provided zero is used.\n\ 1387 N.B. If only the high-bound parameter is specified, it is not\n\ 1388 the array size.\n\ 1389 Valid bounds for array indices are [low-bound,high-bound]." }, 1390 1391 { "type-pointer", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_pointer), 1392 "\ 1393Return a type of pointer to the type." }, 1394 1395 { "type-range", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_range), 1396 "\ 1397Return (low high) representing the range for the type." }, 1398 1399 { "type-reference", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_reference), 1400 "\ 1401Return a type of reference to the type." }, 1402 1403 { "type-target", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_target), 1404 "\ 1405Return the target type of the type." }, 1406 1407 { "type-const", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_const), 1408 "\ 1409Return a const variant of the type." }, 1410 1411 { "type-volatile", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_volatile), 1412 "\ 1413Return a volatile variant of the type." }, 1414 1415 { "type-unqualified", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_unqualified), 1416 "\ 1417Return a variant of the type without const or volatile attributes." }, 1418 1419 { "type-num-fields", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_num_fields), 1420 "\ 1421Return the number of fields of the type." }, 1422 1423 { "type-fields", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_fields), 1424 "\ 1425Return the list of <gdb:field> objects of fields of the type." }, 1426 1427 { "make-field-iterator", 1, 0, 0, 1428 as_a_scm_t_subr (gdbscm_make_field_iterator), 1429 "\ 1430Return a <gdb:iterator> object for iterating over the fields of the type." }, 1431 1432 { "type-field", 2, 0, 0, as_a_scm_t_subr (gdbscm_type_field), 1433 "\ 1434Return the field named by string of the type.\n\ 1435\n\ 1436 Arguments: <gdb:type> string" }, 1437 1438 { "type-has-field?", 2, 0, 0, as_a_scm_t_subr (gdbscm_type_has_field_p), 1439 "\ 1440Return #t if the type has field named string.\n\ 1441\n\ 1442 Arguments: <gdb:type> string" }, 1443 1444 { "field?", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_p), 1445 "\ 1446Return #t if the object is a <gdb:field> object." }, 1447 1448 { "field-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_name), 1449 "\ 1450Return the name of the field." }, 1451 1452 { "field-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_type), 1453 "\ 1454Return the type of the field." }, 1455 1456 { "field-enumval", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_enumval), 1457 "\ 1458Return the enum value represented by the field." }, 1459 1460 { "field-bitpos", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_bitpos), 1461 "\ 1462Return the offset in bits of the field in its containing type." }, 1463 1464 { "field-bitsize", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_bitsize), 1465 "\ 1466Return the size of the field in bits." }, 1467 1468 { "field-artificial?", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_artificial_p), 1469 "\ 1470Return #t if the field is artificial." }, 1471 1472 { "field-baseclass?", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_baseclass_p), 1473 "\ 1474Return #t if the field is a baseclass." }, 1475 1476 END_FUNCTIONS 1477}; 1478 1479void 1480gdbscm_initialize_types (void) 1481{ 1482 type_smob_tag = gdbscm_make_smob_type (type_smob_name, sizeof (type_smob)); 1483 scm_set_smob_free (type_smob_tag, tyscm_free_type_smob); 1484 scm_set_smob_print (type_smob_tag, tyscm_print_type_smob); 1485 scm_set_smob_equalp (type_smob_tag, tyscm_equal_p_type_smob); 1486 1487 field_smob_tag = gdbscm_make_smob_type (field_smob_name, 1488 sizeof (field_smob)); 1489 scm_set_smob_print (field_smob_tag, tyscm_print_field_smob); 1490 1491 gdbscm_define_integer_constants (type_integer_constants, 1); 1492 gdbscm_define_functions (type_functions, 1); 1493 1494 /* This function is "private". */ 1495 tyscm_next_field_x_proc 1496 = scm_c_define_gsubr ("%type-next-field!", 1, 0, 0, 1497 as_a_scm_t_subr (gdbscm_type_next_field_x)); 1498 scm_set_procedure_property_x (tyscm_next_field_x_proc, 1499 gdbscm_documentation_symbol, 1500 gdbscm_scm_from_c_string ("\ 1501Internal function to assist the type fields iterator.")); 1502 1503 block_keyword = scm_from_latin1_keyword ("block"); 1504 1505 /* Register an objfile "free" callback so we can properly copy types 1506 associated with the objfile when it's about to be deleted. */ 1507 tyscm_objfile_data_key 1508 = register_objfile_data_with_cleanup (save_objfile_types, NULL); 1509 1510 global_types_map = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob, 1511 tyscm_eq_type_smob); 1512} 1513