gdb/ada-typeprint.c

   1 /* Support for printing Ada types for GDB, the GNU debugger.
   2    Copyright (C) 1986, 1988, 1989, 1991, 1997, 1998, 1999, 2000, 2001, 2002,
   3    2003, 2004, 2007, 2008, 2009, 2010, 2011 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 #include "defs.h"
  21 #include "gdb_obstack.h"
  22 #include "bfd.h"                /* Binary File Description */
  23 #include "symtab.h"
  24 #include "gdbtypes.h"
  25 #include "expression.h"
  26 #include "value.h"
  27 #include "gdbcore.h"
  28 #include "target.h"
  29 #include "command.h"
  30 #include "gdbcmd.h"
  31 #include "language.h"
  32 #include "demangle.h"
  33 #include "c-lang.h"
  34 #include "typeprint.h"
  35 #include "ada-lang.h"
  36
  37 #include <ctype.h>
  38 #include "gdb_string.h"
  39 #include <errno.h>
  40
  41 static int print_selected_record_field_types (struct type *, struct type *,
  42                                               int, int,
  43                                               struct ui_file *, int, int);
  44
  45 static int print_record_field_types (struct type *, struct type *,
  46                                      struct ui_file *, int, int);
  47
  48 static void print_array_type (struct type *, struct ui_file *, int, int);
  49
  50 static int print_choices (struct type *, int, struct ui_file *,
  51                           struct type *);
  52
  53 static void print_range (struct type *, struct ui_file *);
  54
  55 static void print_range_bound (struct type *, char *, int *,
  56                                struct ui_file *);
  57
  58 static void
  59 print_dynamic_range_bound (struct type *, const char *, int,
  60                            const char *, struct ui_file *);
  61
  62 static void print_range_type (struct type *, struct ui_file *);
  63 \f
  64
  65
  66 static char *name_buffer;
  67 static int name_buffer_len;
  68
  69 /* The (decoded) Ada name of TYPE.  This value persists until the
  70    next call.  */
  71
  72 static char *
  73 decoded_type_name (struct type *type)
  74 {
  75   if (ada_type_name (type) == NULL)
  76     return NULL;
  77   else
  78     {
  79       char *raw_name = ada_type_name (type);
  80       char *s, *q;
  81
  82       if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
  83         {
  84           name_buffer_len = 16 + 2 * strlen (raw_name);
  85           name_buffer = xrealloc (name_buffer, name_buffer_len);
  86         }
  87       strcpy (name_buffer, raw_name);
  88
  89       s = (char *) strstr (name_buffer, "___");
  90       if (s != NULL)
  91         *s = '\0';
  92
  93       s = name_buffer + strlen (name_buffer) - 1;
  94       while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
  95         s -= 1;
  96
  97       if (s == name_buffer)
  98         return name_buffer;
  99
 100       if (!islower (s[1]))
 101         return NULL;
 102
 103       for (s = q = name_buffer; *s != '\0'; q += 1)
 104         {
 105           if (s[0] == '_' && s[1] == '_')
 106             {
 107               *q = '.';
 108               s += 2;
 109             }
 110           else
 111             {
 112               *q = *s;
 113               s += 1;
 114             }
 115         }
 116       *q = '\0';
 117       return name_buffer;
 118     }
 119 }
 120
 121 /* Print TYPE on STREAM, preferably as a range.  */
 122
 123 static void
 124 print_range (struct type *type, struct ui_file *stream)
 125 {
 126   switch (TYPE_CODE (type))
 127     {
 128     case TYPE_CODE_RANGE:
 129     case TYPE_CODE_ENUM:
 130       {
 131         struct type *target_type;
 132         target_type = TYPE_TARGET_TYPE (type);
 133         if (target_type == NULL)
 134           target_type = type;
 135         ada_print_scalar (target_type, ada_discrete_type_low_bound (type),
 136                           stream);
 137         fprintf_filtered (stream, " .. ");
 138         ada_print_scalar (target_type, ada_discrete_type_high_bound (type),
 139                           stream);
 140       }
 141       break;
 142     default:
 143       fprintf_filtered (stream, "%.*s",
 144                         ada_name_prefix_len (TYPE_NAME (type)),
 145                         TYPE_NAME (type));
 146       break;
 147     }
 148 }
 149
 150 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
 151    set *N past the bound and its delimiter, if any.  */
 152
 153 static void
 154 print_range_bound (struct type *type, char *bounds, int *n,
 155                    struct ui_file *stream)
 156 {
 157   LONGEST B;
 158
 159   if (ada_scan_number (bounds, *n, &B, n))
 160     {
 161       /* STABS decodes all range types which bounds are 0 .. -1 as
 162          unsigned integers (ie. the type code is TYPE_CODE_INT, not
 163          TYPE_CODE_RANGE).  Unfortunately, ada_print_scalar() relies
 164          on the unsigned flag to determine whether the bound should
 165          be printed as a signed or an unsigned value.  This causes
 166          the upper bound of the 0 .. -1 range types to be printed as
 167          a very large unsigned number instead of -1.
 168          To workaround this stabs deficiency, we replace the TYPE by NULL
 169          to indicate default output when we detect that the bound is negative,
 170          and the type is a TYPE_CODE_INT.  The bound is negative when
 171          'm' is the last character of the number scanned in BOUNDS.  */
 172       if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
 173         type = NULL;
 174       ada_print_scalar (type, B, stream);
 175       if (bounds[*n] == '_')
 176         *n += 2;
 177     }
 178   else
 179     {
 180       int bound_len;
 181       char *bound = bounds + *n;
 182       char *pend;
 183
 184       pend = strstr (bound, "__");
 185       if (pend == NULL)
 186         *n += bound_len = strlen (bound);
 187       else
 188         {
 189           bound_len = pend - bound;
 190           *n += bound_len + 2;
 191         }
 192       fprintf_filtered (stream, "%.*s", bound_len, bound);
 193     }
 194 }
 195
 196 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
 197    the value (if found) of the bound indicated by SUFFIX ("___L" or
 198    "___U") according to the ___XD conventions.  */
 199
 200 static void
 201 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
 202                            const char *suffix, struct ui_file *stream)
 203 {
 204   static char *name_buf = NULL;
 205   static size_t name_buf_len = 0;
 206   LONGEST B;
 207   int OK;
 208
 209   GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
 210   strncpy (name_buf, name, name_len);
 211   strcpy (name_buf + name_len, suffix);
 212
 213   B = get_int_var_value (name_buf, &OK);
 214   if (OK)
 215     ada_print_scalar (type, B, stream);
 216   else
 217     fprintf_filtered (stream, "?");
 218 }
 219
 220 /* Print RAW_TYPE as a range type, using any bound information
 221    following the GNAT encoding (if available).  */
 222
 223 static void
 224 print_range_type (struct type *raw_type, struct ui_file *stream)
 225 {
 226   char *name;
 227   struct type *base_type;
 228   char *subtype_info;
 229
 230   gdb_assert (raw_type != NULL);
 231   name = TYPE_NAME (raw_type);
 232   gdb_assert (name != NULL);
 233
 234   if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
 235     base_type = TYPE_TARGET_TYPE (raw_type);
 236   else
 237     base_type = raw_type;
 238
 239   subtype_info = strstr (name, "___XD");
 240   if (subtype_info == NULL)
 241     print_range (raw_type, stream);
 242   else
 243     {
 244       int prefix_len = subtype_info - name;
 245       char *bounds_str;
 246       int n;
 247
 248       subtype_info += 5;
 249       bounds_str = strchr (subtype_info, '_');
 250       n = 1;
 251
 252       if (*subtype_info == 'L')
 253         {
 254           print_range_bound (base_type, bounds_str, &n, stream);
 255           subtype_info += 1;
 256         }
 257       else
 258         print_dynamic_range_bound (base_type, name, prefix_len, "___L",
 259                                    stream);
 260
 261       fprintf_filtered (stream, " .. ");
 262
 263       if (*subtype_info == 'U')
 264         print_range_bound (base_type, bounds_str, &n, stream);
 265       else
 266         print_dynamic_range_bound (base_type, name, prefix_len, "___U",
 267                                    stream);
 268     }
 269 }
 270
 271 /* Print enumerated type TYPE on STREAM.  */
 272
 273 static void
 274 print_enum_type (struct type *type, struct ui_file *stream)
 275 {
 276   int len = TYPE_NFIELDS (type);
 277   int i, lastval;
 278
 279   fprintf_filtered (stream, "(");
 280   wrap_here (" ");
 281
 282   lastval = 0;
 283   for (i = 0; i < len; i++)
 284     {
 285       QUIT;
 286       if (i)
 287         fprintf_filtered (stream, ", ");
 288       wrap_here ("    ");
 289       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 290       if (lastval != TYPE_FIELD_BITPOS (type, i))
 291         {
 292           fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
 293           lastval = TYPE_FIELD_BITPOS (type, i);
 294         }
 295       lastval += 1;
 296     }
 297   fprintf_filtered (stream, ")");
 298 }
 299
 300 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
 301
 302 static void
 303 print_fixed_point_type (struct type *type, struct ui_file *stream)
 304 {
 305   DOUBLEST delta = ada_delta (type);
 306   DOUBLEST small = ada_fixed_to_float (type, 1.0);
 307
 308   if (delta < 0.0)
 309     fprintf_filtered (stream, "delta ??");
 310   else
 311     {
 312       fprintf_filtered (stream, "delta %g", (double) delta);
 313       if (delta != small)
 314         fprintf_filtered (stream, " <'small = %g>", (double) small);
 315     }
 316 }
 317
 318 /* Print simple (constrained) array type TYPE on STREAM.  LEVEL is the
 319    recursion (indentation) level, in case the element type itself has
 320    nested structure, and SHOW is the number of levels of internal
 321    structure to show (see ada_print_type).  */
 322
 323 static void
 324 print_array_type (struct type *type, struct ui_file *stream, int show,
 325                   int level)
 326 {
 327   int bitsize;
 328   int n_indices;
 329
 330   if (ada_is_constrained_packed_array_type (type))
 331     type = ada_coerce_to_simple_array_type (type);
 332
 333   bitsize = 0;
 334   fprintf_filtered (stream, "array (");
 335
 336   if (type == NULL)
 337     {
 338       fprintf_filtered (stream, _("<undecipherable array type>"));
 339       return;
 340     }
 341
 342   n_indices = -1;
 343   if (ada_is_simple_array_type (type))
 344     {
 345       struct type *range_desc_type;
 346       struct type *arr_type;
 347
 348       range_desc_type = ada_find_parallel_type (type, "___XA");
 349       ada_fixup_array_indexes_type (range_desc_type);
 350
 351       bitsize = 0;
 352       if (range_desc_type == NULL)
 353         {
 354           for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
 355                arr_type = TYPE_TARGET_TYPE (arr_type))
 356             {
 357               if (arr_type != type)
 358                 fprintf_filtered (stream, ", ");
 359               print_range (TYPE_INDEX_TYPE (arr_type), stream);
 360               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 361                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 362             }
 363         }
 364       else
 365         {
 366           int k;
 367
 368           n_indices = TYPE_NFIELDS (range_desc_type);
 369           for (k = 0, arr_type = type;
 370                k < n_indices;
 371                k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
 372             {
 373               if (k > 0)
 374                 fprintf_filtered (stream, ", ");
 375               print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
 376                                 stream);
 377               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 378                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 379             }
 380         }
 381     }
 382   else
 383     {
 384       int i, i0;
 385
 386       for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
 387         fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
 388     }
 389
 390   fprintf_filtered (stream, ") of ");
 391   wrap_here ("");
 392   ada_print_type (ada_array_element_type (type, n_indices), "", stream,
 393                   show == 0 ? 0 : show - 1, level + 1);
 394   if (bitsize > 0)
 395     fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
 396 }
 397
 398 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
 399    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
 400    values.  Return non-zero if the field is an encoding of
 401    discriminant values, as in a standard variant record, and 0 if the
 402    field is not so encoded (as happens with single-component variants
 403    in types annotated with pragma Unchecked_Variant).  */
 404
 405 static int
 406 print_choices (struct type *type, int field_num, struct ui_file *stream,
 407                struct type *val_type)
 408 {
 409   int have_output;
 410   int p;
 411   const char *name = TYPE_FIELD_NAME (type, field_num);
 412
 413   have_output = 0;
 414
 415   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 416   if (name[0] == 'V')
 417     {
 418       if (!ada_scan_number (name, 1, NULL, &p))
 419         goto Huh;
 420     }
 421   else
 422     p = 0;
 423
 424   while (1)
 425     {
 426       switch (name[p])
 427         {
 428         default:
 429           goto Huh;
 430         case '_':
 431         case '\0':
 432           fprintf_filtered (stream, " =>");
 433           return 1;
 434         case 'S':
 435         case 'R':
 436         case 'O':
 437           if (have_output)
 438             fprintf_filtered (stream, " | ");
 439           have_output = 1;
 440           break;
 441         }
 442
 443       switch (name[p])
 444         {
 445         case 'S':
 446           {
 447             LONGEST W;
 448
 449             if (!ada_scan_number (name, p + 1, &W, &p))
 450               goto Huh;
 451             ada_print_scalar (val_type, W, stream);
 452             break;
 453           }
 454         case 'R':
 455           {
 456             LONGEST L, U;
 457
 458             if (!ada_scan_number (name, p + 1, &L, &p)
 459                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 460               goto Huh;
 461             ada_print_scalar (val_type, L, stream);
 462             fprintf_filtered (stream, " .. ");
 463             ada_print_scalar (val_type, U, stream);
 464             break;
 465           }
 466         case 'O':
 467           fprintf_filtered (stream, "others");
 468           p += 1;
 469           break;
 470         }
 471     }
 472
 473 Huh:
 474   fprintf_filtered (stream, "?? =>");
 475   return 0;
 476 }
 477
 478 /* Assuming that field FIELD_NUM of TYPE represents variants whose
 479    discriminant is contained in OUTER_TYPE, print its components on STREAM.
 480    LEVEL is the recursion (indentation) level, in case any of the fields
 481    themselves have nested structure, and SHOW is the number of levels of
 482    internal structure to show (see ada_print_type).  For this purpose,
 483    fields nested in a variant part are taken to be at the same level as
 484    the fields immediately outside the variant part.  */
 485
 486 static void
 487 print_variant_clauses (struct type *type, int field_num,
 488                        struct type *outer_type, struct ui_file *stream,
 489                        int show, int level)
 490 {
 491   int i;
 492   struct type *var_type, *par_type;
 493   struct type *discr_type;
 494
 495   var_type = TYPE_FIELD_TYPE (type, field_num);
 496   discr_type = ada_variant_discrim_type (var_type, outer_type);
 497
 498   if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
 499     {
 500       var_type = TYPE_TARGET_TYPE (var_type);
 501       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
 502         return;
 503     }
 504
 505   par_type = ada_find_parallel_type (var_type, "___XVU");
 506   if (par_type != NULL)
 507     var_type = par_type;
 508
 509   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 510     {
 511       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 512       if (print_choices (var_type, i, stream, discr_type))
 513         {
 514           if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 515                                         outer_type, stream, show, level + 4)
 516               <= 0)
 517             fprintf_filtered (stream, " null;");
 518         }
 519       else
 520         print_selected_record_field_types (var_type, outer_type, i, i,
 521                                            stream, show, level + 4);
 522     }
 523 }
 524
 525 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 526    discriminants are contained in OUTER_TYPE, print a description of it
 527    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
 528    the fields themselves have nested structure, and SHOW is the number of
 529    levels of internal structure to show (see ada_print_type).  For this
 530    purpose, fields nested in a variant part are taken to be at the same
 531    level as the fields immediately outside the variant part.  */
 532
 533 static void
 534 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 535                     struct ui_file *stream, int show, int level)
 536 {
 537   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 538                     ada_variant_discrim_name
 539                     (TYPE_FIELD_TYPE (type, field_num)));
 540   print_variant_clauses (type, field_num, outer_type, stream, show,
 541                          level + 4);
 542   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 543 }
 544
 545 /* Print a description on STREAM of the fields FLD0 through FLD1 in
 546    record or union type TYPE, whose discriminants are in OUTER_TYPE.
 547    LEVEL is the recursion (indentation) level, in case any of the
 548    fields themselves have nested structure, and SHOW is the number of
 549    levels of internal structure to show (see ada_print_type).  Does
 550    not print parent type information of TYPE.  Returns 0 if no fields
 551    printed, -1 for an incomplete type, else > 0.  Prints each field
 552    beginning on a new line, but does not put a new line at end.  */
 553
 554 static int
 555 print_selected_record_field_types (struct type *type, struct type *outer_type,
 556                                    int fld0, int fld1,
 557                                    struct ui_file *stream, int show, int level)
 558 {
 559   int i, flds;
 560
 561   flds = 0;
 562
 563   if (fld0 > fld1 && TYPE_STUB (type))
 564     return -1;
 565
 566   for (i = fld0; i <= fld1; i += 1)
 567     {
 568       QUIT;
 569
 570       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 571         ;
 572       else if (ada_is_wrapper_field (type, i))
 573         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 574                                           stream, show, level);
 575       else if (ada_is_variant_part (type, i))
 576         {
 577           print_variant_part (type, i, outer_type, stream, show, level);
 578           flds = 1;
 579         }
 580       else
 581         {
 582           flds += 1;
 583           fprintf_filtered (stream, "\n%*s", level + 4, "");
 584           ada_print_type (TYPE_FIELD_TYPE (type, i),
 585                           TYPE_FIELD_NAME (type, i),
 586                           stream, show - 1, level + 4);
 587           fprintf_filtered (stream, ";");
 588         }
 589     }
 590
 591   return flds;
 592 }
 593
 594 /* Print a description on STREAM of all fields of record or union type
 595    TYPE, as for print_selected_record_field_types, above.  */
 596
 597 static int
 598 print_record_field_types (struct type *type, struct type *outer_type,
 599                           struct ui_file *stream, int show, int level)
 600 {
 601   return print_selected_record_field_types (type, outer_type,
 602                                             0, TYPE_NFIELDS (type) - 1,
 603                                             stream, show, level);
 604 }
 605
 606
 607 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
 608    level, in case the element type itself has nested structure, and SHOW is
 609    the number of levels of internal structure to show (see ada_print_type).  */
 610
 611 static void
 612 print_record_type (struct type *type0, struct ui_file *stream, int show,
 613                    int level)
 614 {
 615   struct type *parent_type;
 616   struct type *type;
 617
 618   type = ada_find_parallel_type (type0, "___XVE");
 619   if (type == NULL)
 620     type = type0;
 621
 622   parent_type = ada_parent_type (type);
 623   if (ada_type_name (parent_type) != NULL)
 624     fprintf_filtered (stream, "new %s with record",
 625                       decoded_type_name (parent_type));
 626   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 627     fprintf_filtered (stream, "tagged record");
 628   else
 629     fprintf_filtered (stream, "record");
 630
 631   if (show < 0)
 632     fprintf_filtered (stream, " ... end record");
 633   else
 634     {
 635       int flds;
 636
 637       flds = 0;
 638       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 639         flds += print_record_field_types (parent_type, parent_type,
 640                                           stream, show, level);
 641       flds += print_record_field_types (type, type, stream, show, level);
 642
 643       if (flds > 0)
 644         fprintf_filtered (stream, "\n%*send record", level, "");
 645       else if (flds < 0)
 646         fprintf_filtered (stream, _(" <incomplete type> end record"));
 647       else
 648         fprintf_filtered (stream, " null; end record");
 649     }
 650 }
 651
 652 /* Print the unchecked union type TYPE in something resembling Ada
 653    format on STREAM.  LEVEL is the recursion (indentation) level
 654    in case the element type itself has nested structure, and SHOW is the
 655    number of levels of internal structure to show (see ada_print_type).  */
 656 static void
 657 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 658                             int show, int level)
 659 {
 660   if (show < 0)
 661     fprintf_filtered (stream, "record (?) is ... end record");
 662   else if (TYPE_NFIELDS (type) == 0)
 663     fprintf_filtered (stream, "record (?) is null; end record");
 664   else
 665     {
 666       int i;
 667
 668       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
 669
 670       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 671         {
 672           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
 673                             level + 12, "");
 674           ada_print_type (TYPE_FIELD_TYPE (type, i),
 675                           TYPE_FIELD_NAME (type, i),
 676                           stream, show - 1, level + 12);
 677           fprintf_filtered (stream, ";");
 678         }
 679
 680       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 681                         level + 4, "", level, "");
 682     }
 683 }
 684
 685
 686
 687 /* Print function or procedure type TYPE on STREAM.  Make it a header
 688    for function or procedure NAME if NAME is not null.  */
 689
 690 static void
 691 print_func_type (struct type *type, struct ui_file *stream, const char *name)
 692 {
 693   int i, len = TYPE_NFIELDS (type);
 694
 695   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 696     fprintf_filtered (stream, "procedure");
 697   else
 698     fprintf_filtered (stream, "function");
 699
 700   if (name != NULL && name[0] != '\0')
 701     fprintf_filtered (stream, " %s", name);
 702
 703   if (len > 0)
 704     {
 705       fprintf_filtered (stream, " (");
 706       for (i = 0; i < len; i += 1)
 707         {
 708           if (i > 0)
 709             {
 710               fputs_filtered ("; ", stream);
 711               wrap_here ("    ");
 712             }
 713           fprintf_filtered (stream, "a%d: ", i + 1);
 714           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
 715         }
 716       fprintf_filtered (stream, ")");
 717     }
 718
 719   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 720     {
 721       fprintf_filtered (stream, " return ");
 722       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
 723     }
 724 }
 725
 726
 727 /* Print a description of a type TYPE0.
 728    Output goes to STREAM (via stdio).
 729    If VARSTRING is a non-empty string, print as an Ada variable/field
 730        declaration.
 731    SHOW+1 is the maximum number of levels of internal type structure
 732       to show (this applies to record types, enumerated types, and
 733       array types).
 734    SHOW is the number of levels of internal type structure to show
 735       when there is a type name for the SHOWth deepest level (0th is
 736       outer level).
 737    When SHOW<0, no inner structure is shown.
 738    LEVEL indicates level of recursion (for nested definitions).  */
 739
 740 void
 741 ada_print_type (struct type *type0, const char *varstring,
 742                 struct ui_file *stream, int show, int level)
 743 {
 744   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 745   char *type_name = decoded_type_name (type0);
 746   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 747
 748   if (type == NULL)
 749     {
 750       if (is_var_decl)
 751         fprintf_filtered (stream, "%.*s: ",
 752                           ada_name_prefix_len (varstring), varstring);
 753       fprintf_filtered (stream, "<null type?>");
 754       return;
 755     }
 756
 757   if (show > 0)
 758     type = ada_check_typedef (type);
 759
 760   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 761     fprintf_filtered (stream, "%.*s: ",
 762                       ada_name_prefix_len (varstring), varstring);
 763
 764   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 765     {
 766       fprintf_filtered (stream, "%.*s",
 767                         ada_name_prefix_len (type_name), type_name);
 768       return;
 769     }
 770
 771   if (ada_is_aligner_type (type))
 772     ada_print_type (ada_aligned_type (type), "", stream, show, level);
 773   else if (ada_is_constrained_packed_array_type (type)
 774            && TYPE_CODE (type) != TYPE_CODE_PTR)
 775     print_array_type (type, stream, show, level);
 776   else
 777     switch (TYPE_CODE (type))
 778       {
 779       default:
 780         fprintf_filtered (stream, "<");
 781         c_print_type (type, "", stream, show, level);
 782         fprintf_filtered (stream, ">");
 783         break;
 784       case TYPE_CODE_PTR:
 785       case TYPE_CODE_TYPEDEF:
 786         fprintf_filtered (stream, "access ");
 787         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
 788         break;
 789       case TYPE_CODE_REF:
 790         fprintf_filtered (stream, "<ref> ");
 791         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
 792         break;
 793       case TYPE_CODE_ARRAY:
 794         print_array_type (type, stream, show, level);
 795         break;
 796       case TYPE_CODE_BOOL:
 797         fprintf_filtered (stream, "(false, true)");
 798         break;
 799       case TYPE_CODE_INT:
 800         if (ada_is_fixed_point_type (type))
 801           print_fixed_point_type (type, stream);
 802         else
 803           {
 804             char *name = ada_type_name (type);
 805
 806             if (!ada_is_range_type_name (name))
 807               fprintf_filtered (stream, _("<%d-byte integer>"),
 808                                 TYPE_LENGTH (type));
 809             else
 810               {
 811                 fprintf_filtered (stream, "range ");
 812                 print_range_type (type, stream);
 813               }
 814           }
 815         break;
 816       case TYPE_CODE_RANGE:
 817         if (ada_is_fixed_point_type (type))
 818           print_fixed_point_type (type, stream);
 819         else if (ada_is_modular_type (type))
 820           fprintf_filtered (stream, "mod %s",
 821                             int_string (ada_modulus (type), 10, 0, 0, 1));
 822         else
 823           {
 824             fprintf_filtered (stream, "range ");
 825             print_range (type, stream);
 826           }
 827         break;
 828       case TYPE_CODE_FLT:
 829         fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
 830         break;
 831       case TYPE_CODE_ENUM:
 832         if (show < 0)
 833           fprintf_filtered (stream, "(...)");
 834         else
 835           print_enum_type (type, stream);
 836         break;
 837       case TYPE_CODE_STRUCT:
 838         if (ada_is_array_descriptor_type (type))
 839           print_array_type (type, stream, show, level);
 840         else if (ada_is_bogus_array_descriptor (type))
 841           fprintf_filtered (stream,
 842                             _("array (?) of ? (<mal-formed descriptor>)"));
 843         else
 844           print_record_type (type, stream, show, level);
 845         break;
 846       case TYPE_CODE_UNION:
 847         print_unchecked_union_type (type, stream, show, level);
 848         break;
 849       case TYPE_CODE_FUNC:
 850         print_func_type (type, stream, varstring);
 851         break;
 852       }
 853 }
 854
 855 /* Implement the la_print_typedef language method for Ada.  */
 856
 857 void
 858 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 859                    struct ui_file *stream)
 860 {
 861   type = ada_check_typedef (type);
 862   ada_print_type (type, "", stream, 0, 0);
 863   fprintf_filtered (stream, "\n");
 864 }