gdb/guile/scm-type.c

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