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