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