contrib/gdb-7/gdb/ada-typeprint.c

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