gdb/ada-typeprint.c

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