gdb/guile/scm-type.c

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