gdb/guile/scm-type.c

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