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