gdb/ada-typeprint.c

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