gdb/ada-typeprint.c

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