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