gdb/ada-typeprint.c

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