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