gdb/guile/scm-type.c

   1 /* Scheme interface to types.
   2
   3    Copyright (C) 2008-2022 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
  39 struct 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
  54 struct 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
  66 static const char type_smob_name[] = "gdb:type";
  67 static const char field_smob_name[] = "gdb:field";
  68
  69 static 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.  */
  73 static scm_t_bits type_smob_tag;
  74
  75 /* The tag Guile knows the field smob by.  */
  76 static scm_t_bits field_smob_tag;
  77
  78 /* The "next" procedure for field iterators.  */
  79 static SCM tyscm_next_field_x_proc;
  80
  81 /* Keywords used in argument passing.  */
  82 static SCM block_keyword;
  83
  84 static 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
  89 struct 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
 103 static const registry<objfile>::key<htab, tyscm_deleter>
 104      tyscm_objfile_data_key;
 105
 106 /* Hash table to uniquify global (non-objfile-owned) types.  */
 107 static htab_t global_types_map;
 108
 109 static 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
 114 struct type *
 115 tyscm_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
 123 static std::string
 124 tyscm_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 \f
 143 /* Administrivia for type smobs.  */
 144
 145 /* Helper function to hash a type_smob.  */
 146
 147 static hashval_t
 148 tyscm_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
 157 static int
 158 tyscm_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
 172 static htab_t
 173 tyscm_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
 194 static size_t
 195 tyscm_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
 214 static int
 215 tyscm_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
 240 static SCM
 241 tyscm_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
 272 static SCM
 273 tyscm_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
 290 int
 291 tyscm_is_type (SCM self)
 292 {
 293   return SCM_SMOB_PREDICATE (type_smob_tag, self);
 294 }
 295
 296 /* (type? object) -> boolean */
 297
 298 static SCM
 299 gdbscm_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
 307 SCM
 308 tyscm_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
 334 static SCM
 335 tyscm_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
 346 type_smob *
 347 tyscm_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
 358 struct type *
 359 tyscm_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
 370 static int
 371 tyscm_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 \f
 401 /* Administrivia for field smobs.  */
 402
 403 /* The smob "print" function for <gdb:field>.  */
 404
 405 static int
 406 tyscm_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
 424 static SCM
 425 tyscm_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
 441 static int
 442 tyscm_is_field (SCM self)
 443 {
 444   return SCM_SMOB_PREDICATE (field_smob_tag, self);
 445 }
 446
 447 /* (field? object) -> boolean */
 448
 449 static SCM
 450 gdbscm_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
 458 SCM
 459 tyscm_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
 467 static SCM
 468 tyscm_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
 479 static field_smob *
 480 tyscm_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
 491 static struct type *
 492 tyscm_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
 504 static struct field *
 505 tyscm_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 \f
 515 /* Type smob accessors.  */
 516
 517 /* (type-code <gdb:type>) -> integer
 518    Return the code for this type.  */
 519
 520 static SCM
 521 gdbscm_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
 535 static SCM
 536 gdbscm_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
 567 static SCM
 568 gdbscm_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
 588 static SCM
 589 gdbscm_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
 604 static SCM
 605 gdbscm_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
 619 static SCM
 620 gdbscm_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
 642 static SCM
 643 gdbscm_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
 666 static struct type *
 667 tyscm_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
 701 static SCM
 702 tyscm_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
 754 static SCM
 755 gdbscm_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
 770 static SCM
 771 gdbscm_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
 779 static SCM
 780 gdbscm_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
 805 static SCM
 806 gdbscm_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
 846 static SCM
 847 gdbscm_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
 870 static SCM
 871 gdbscm_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
 885 static SCM
 886 gdbscm_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
 909 static SCM
 910 gdbscm_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
 933 static SCM
 934 gdbscm_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 \f
 954 /* Field related accessors of types.  */
 955
 956 /* (type-num-fields <gdb:type>) -> integer
 957    Return number of fields.  */
 958
 959 static SCM
 960 gdbscm_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
 977 static SCM
 978 gdbscm_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
1018 static SCM
1019 gdbscm_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
1056 static SCM
1057 gdbscm_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
1087 static SCM
1088 gdbscm_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 \f
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
1126 static SCM
1127 gdbscm_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
1141 static SCM
1142 gdbscm_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
1157 static SCM
1158 gdbscm_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
1174 static SCM
1175 gdbscm_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
1191 static SCM
1192 gdbscm_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
1204 static SCM
1205 gdbscm_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
1217 static SCM
1218 gdbscm_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 \f
1229 /* Return the type named TYPE_NAME in BLOCK.
1230    Returns NULL if not found.
1231    This routine does not throw an error.  */
1232
1233 static struct type *
1234 tyscm_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
1261 static SCM
1262 gdbscm_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 \f
1295 /* Initialize the Scheme type code.  */
1296
1297
1298 static 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
1310 static const scheme_function type_functions[] =
1311 {
1312   { "type?", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_p),
1313     "\
1314 Return #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     "\
1318 Return the <gdb:type> object representing string or #f if not found.\n\
1319 If 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     "\
1325 Return the code of the type" },
1326
1327   { "type-tag", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_tag),
1328     "\
1329 Return 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     "\
1333 Return 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     "\
1337 Return 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     "\
1341 Return 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     "\
1346 Return 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     "\
1350 Return 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     "\
1360 Return a type representing a vector of objects of the type.\n\
1361 Vectors differ from arrays in that if the current language has C-style\n\
1362 arrays, vectors don't decay to a pointer to the first element.\n\
1363 They 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     "\
1373 Return a type of pointer to the type." },
1374
1375   { "type-range", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_range),
1376     "\
1377 Return (low high) representing the range for the type." },
1378
1379   { "type-reference", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_reference),
1380     "\
1381 Return a type of reference to the type." },
1382
1383   { "type-target", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_target),
1384     "\
1385 Return the target type of the type." },
1386
1387   { "type-const", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_const),
1388     "\
1389 Return a const variant of the type." },
1390
1391   { "type-volatile", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_volatile),
1392     "\
1393 Return a volatile variant of the type." },
1394
1395   { "type-unqualified", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_unqualified),
1396     "\
1397 Return 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     "\
1401 Return the number of fields of the type." },
1402
1403   { "type-fields", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_fields),
1404     "\
1405 Return 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     "\
1410 Return 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     "\
1414 Return 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     "\
1420 Return #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     "\
1426 Return #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     "\
1430 Return the name of the field." },
1431
1432   { "field-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_type),
1433     "\
1434 Return the type of the field." },
1435
1436   { "field-enumval", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_enumval),
1437     "\
1438 Return the enum value represented by the field." },
1439
1440   { "field-bitpos", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_bitpos),
1441     "\
1442 Return 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     "\
1446 Return the size of the field in bits." },
1447
1448   { "field-artificial?", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_artificial_p),
1449     "\
1450 Return #t if the field is artificial." },
1451
1452   { "field-baseclass?", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_baseclass_p),
1453     "\
1454 Return #t if the field is a baseclass." },
1455
1456   END_FUNCTIONS
1457 };
1458
1459 void
1460 gdbscm_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 ("\
1481 Internal 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 }