gdb/guile/scm-type.c

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