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

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