contrib/gdb-7/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       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   char *name;
 227   struct type *base_type;
 228   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, lastval;
 278
 279   fprintf_filtered (stream, "(");
 280   wrap_here (" ");
 281
 282   lastval = 0;
 283   for (i = 0; i < len; i++)
 284     {
 285       QUIT;
 286       if (i)
 287         fprintf_filtered (stream, ", ");
 288       wrap_here ("    ");
 289       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 290       if (lastval != TYPE_FIELD_BITPOS (type, i))
 291         {
 292           fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
 293           lastval = TYPE_FIELD_BITPOS (type, i);
 294         }
 295       lastval += 1;
 296     }
 297   fprintf_filtered (stream, ")");
 298 }
 299
 300 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
 301
 302 static void
 303 print_fixed_point_type (struct type *type, struct ui_file *stream)
 304 {
 305   DOUBLEST delta = ada_delta (type);
 306   DOUBLEST small = ada_fixed_to_float (type, 1.0);
 307
 308   if (delta < 0.0)
 309     fprintf_filtered (stream, "delta ??");
 310   else
 311     {
 312       fprintf_filtered (stream, "delta %g", (double) delta);
 313       if (delta != small)
 314         fprintf_filtered (stream, " <'small = %g>", (double) small);
 315     }
 316 }
 317
 318 /* Print simple (constrained) array type TYPE on STREAM.  LEVEL is the
 319    recursion (indentation) level, in case the element type itself has
 320    nested structure, and SHOW is the number of levels of internal
 321    structure to show (see ada_print_type).  */
 322
 323 static void
 324 print_array_type (struct type *type, struct ui_file *stream, int show,
 325                   int level)
 326 {
 327   int bitsize;
 328   int n_indices;
 329
 330   if (ada_is_constrained_packed_array_type (type))
 331     type = ada_coerce_to_simple_array_type (type);
 332
 333   bitsize = 0;
 334   fprintf_filtered (stream, "array (");
 335
 336   if (type == NULL)
 337     {
 338       fprintf_filtered (stream, _("<undecipherable array type>"));
 339       return;
 340     }
 341
 342   n_indices = -1;
 343   if (ada_is_simple_array_type (type))
 344     {
 345       struct type *range_desc_type;
 346       struct type *arr_type;
 347
 348       range_desc_type = ada_find_parallel_type (type, "___XA");
 349       ada_fixup_array_indexes_type (range_desc_type);
 350
 351       bitsize = 0;
 352       if (range_desc_type == NULL)
 353         {
 354           for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
 355                arr_type = TYPE_TARGET_TYPE (arr_type))
 356             {
 357               if (arr_type != type)
 358                 fprintf_filtered (stream, ", ");
 359               print_range (TYPE_INDEX_TYPE (arr_type), stream);
 360               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 361                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 362             }
 363         }
 364       else
 365         {
 366           int k;
 367
 368           n_indices = TYPE_NFIELDS (range_desc_type);
 369           for (k = 0, arr_type = type;
 370                k < n_indices;
 371                k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
 372             {
 373               if (k > 0)
 374                 fprintf_filtered (stream, ", ");
 375               print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
 376                                 stream);
 377               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 378                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 379             }
 380         }
 381     }
 382   else
 383     {
 384       int i, i0;
 385
 386       for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
 387         fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
 388     }
 389
 390   fprintf_filtered (stream, ") of ");
 391   wrap_here ("");
 392   ada_print_type (ada_array_element_type (type, n_indices), "", stream,
 393                   show == 0 ? 0 : show - 1, level + 1);
 394   if (bitsize > 0)
 395     fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
 396 }
 397
 398 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
 399    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
 400    values.  Return non-zero if the field is an encoding of
 401    discriminant values, as in a standard variant record, and 0 if the
 402    field is not so encoded (as happens with single-component variants
 403    in types annotated with pragma Unchecked_Variant).  */
 404
 405 static int
 406 print_choices (struct type *type, int field_num, struct ui_file *stream,
 407                struct type *val_type)
 408 {
 409   int have_output;
 410   int p;
 411   const char *name = TYPE_FIELD_NAME (type, field_num);
 412
 413   have_output = 0;
 414
 415   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 416   if (name[0] == 'V')
 417     {
 418       if (!ada_scan_number (name, 1, NULL, &p))
 419         goto Huh;
 420     }
 421   else
 422     p = 0;
 423
 424   while (1)
 425     {
 426       switch (name[p])
 427         {
 428         default:
 429           goto Huh;
 430         case '_':
 431         case '\0':
 432           fprintf_filtered (stream, " =>");
 433           return 1;
 434         case 'S':
 435         case 'R':
 436         case 'O':
 437           if (have_output)
 438             fprintf_filtered (stream, " | ");
 439           have_output = 1;
 440           break;
 441         }
 442
 443       switch (name[p])
 444         {
 445         case 'S':
 446           {
 447             LONGEST W;
 448
 449             if (!ada_scan_number (name, p + 1, &W, &p))
 450               goto Huh;
 451             ada_print_scalar (val_type, W, stream);
 452             break;
 453           }
 454         case 'R':
 455           {
 456             LONGEST L, U;
 457
 458             if (!ada_scan_number (name, p + 1, &L, &p)
 459                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 460               goto Huh;
 461             ada_print_scalar (val_type, L, stream);
 462             fprintf_filtered (stream, " .. ");
 463             ada_print_scalar (val_type, U, stream);
 464             break;
 465           }
 466         case 'O':
 467           fprintf_filtered (stream, "others");
 468           p += 1;
 469           break;
 470         }
 471     }
 472
 473 Huh:
 474   fprintf_filtered (stream, "?? =>");
 475   return 0;
 476 }
 477
 478 /* Assuming that field FIELD_NUM of TYPE represents variants whose
 479    discriminant is contained in OUTER_TYPE, print its components on STREAM.
 480    LEVEL is the recursion (indentation) level, in case any of the fields
 481    themselves have nested structure, and SHOW is the number of levels of
 482    internal structure to show (see ada_print_type).  For this purpose,
 483    fields nested in a variant part are taken to be at the same level as
 484    the fields immediately outside the variant part.  */
 485
 486 static void
 487 print_variant_clauses (struct type *type, int field_num,
 488                        struct type *outer_type, struct ui_file *stream,
 489                        int show, int level)
 490 {
 491   int i;
 492   struct type *var_type, *par_type;
 493   struct type *discr_type;
 494
 495   var_type = TYPE_FIELD_TYPE (type, field_num);
 496   discr_type = ada_variant_discrim_type (var_type, outer_type);
 497
 498   if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
 499     {
 500       var_type = TYPE_TARGET_TYPE (var_type);
 501       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
 502         return;
 503     }
 504
 505   par_type = ada_find_parallel_type (var_type, "___XVU");
 506   if (par_type != NULL)
 507     var_type = par_type;
 508
 509   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 510     {
 511       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 512       if (print_choices (var_type, i, stream, discr_type))
 513         {
 514           if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 515                                         outer_type, stream, show, level + 4)
 516               <= 0)
 517             fprintf_filtered (stream, " null;");
 518         }
 519       else
 520         print_selected_record_field_types (var_type, outer_type, i, i,
 521                                            stream, show, level + 4);
 522     }
 523 }
 524
 525 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 526    discriminants are contained in OUTER_TYPE, print a description of it
 527    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
 528    the fields themselves have nested structure, and SHOW is the number of
 529    levels of internal structure to show (see ada_print_type).  For this
 530    purpose, fields nested in a variant part are taken to be at the same
 531    level as the fields immediately outside the variant part.  */
 532
 533 static void
 534 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 535                     struct ui_file *stream, int show, int level)
 536 {
 537   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 538                     ada_variant_discrim_name
 539                     (TYPE_FIELD_TYPE (type, field_num)));
 540   print_variant_clauses (type, field_num, outer_type, stream, show,
 541                          level + 4);
 542   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 543 }
 544
 545 /* Print a description on STREAM of the fields FLD0 through FLD1 in
 546    record or union type TYPE, whose discriminants are in OUTER_TYPE.
 547    LEVEL is the recursion (indentation) level, in case any of the
 548    fields themselves have nested structure, and SHOW is the number of
 549    levels of internal structure to show (see ada_print_type).  Does
 550    not print parent type information of TYPE.  Returns 0 if no fields
 551    printed, -1 for an incomplete type, else > 0.  Prints each field
 552    beginning on a new line, but does not put a new line at end.  */
 553
 554 static int
 555 print_selected_record_field_types (struct type *type, struct type *outer_type,
 556                                    int fld0, int fld1,
 557                                    struct ui_file *stream, int show, int level)
 558 {
 559   int i, flds;
 560
 561   flds = 0;
 562
 563   if (fld0 > fld1 && TYPE_STUB (type))
 564     return -1;
 565
 566   for (i = fld0; i <= fld1; i += 1)
 567     {
 568       QUIT;
 569
 570       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 571         ;
 572       else if (ada_is_wrapper_field (type, i))
 573         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 574                                           stream, show, level);
 575       else if (ada_is_variant_part (type, i))
 576         {
 577           print_variant_part (type, i, outer_type, stream, show, level);
 578           flds = 1;
 579         }
 580       else
 581         {
 582           flds += 1;
 583           fprintf_filtered (stream, "\n%*s", level + 4, "");
 584           ada_print_type (TYPE_FIELD_TYPE (type, i),
 585                           TYPE_FIELD_NAME (type, i),
 586                           stream, show - 1, level + 4);
 587           fprintf_filtered (stream, ";");
 588         }
 589     }
 590
 591   return flds;
 592 }
 593
 594 /* Print a description on STREAM of all fields of record or union type
 595    TYPE, as for print_selected_record_field_types, above.  */
 596
 597 static int
 598 print_record_field_types (struct type *type, struct type *outer_type,
 599                           struct ui_file *stream, int show, int level)
 600 {
 601   return print_selected_record_field_types (type, outer_type,
 602                                             0, TYPE_NFIELDS (type) - 1,
 603                                             stream, show, level);
 604 }
 605
 606
 607 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
 608    level, in case the element type itself has nested structure, and SHOW is
 609    the number of levels of internal structure to show (see ada_print_type).  */
 610
 611 static void
 612 print_record_type (struct type *type0, struct ui_file *stream, int show,
 613                    int level)
 614 {
 615   struct type *parent_type;
 616   struct type *type;
 617
 618   type = ada_find_parallel_type (type0, "___XVE");
 619   if (type == NULL)
 620     type = type0;
 621
 622   parent_type = ada_parent_type (type);
 623   if (ada_type_name (parent_type) != NULL)
 624     {
 625       const char *parent_name = decoded_type_name (parent_type);
 626
 627       /* If we fail to decode the parent type name, then use the parent
 628          type name as is.  Not pretty, but should never happen except
 629          when the debugging info is incomplete or incorrect.  This
 630          prevents a crash trying to print a NULL pointer.  */
 631       if (parent_name == NULL)
 632         parent_name = ada_type_name (parent_type);
 633       fprintf_filtered (stream, "new %s with record", parent_name);
 634     }
 635   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 636     fprintf_filtered (stream, "tagged record");
 637   else
 638     fprintf_filtered (stream, "record");
 639
 640   if (show < 0)
 641     fprintf_filtered (stream, " ... end record");
 642   else
 643     {
 644       int flds;
 645
 646       flds = 0;
 647       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 648         flds += print_record_field_types (parent_type, parent_type,
 649                                           stream, show, level);
 650       flds += print_record_field_types (type, type, stream, show, level);
 651
 652       if (flds > 0)
 653         fprintf_filtered (stream, "\n%*send record", level, "");
 654       else if (flds < 0)
 655         fprintf_filtered (stream, _(" <incomplete type> end record"));
 656       else
 657         fprintf_filtered (stream, " null; end record");
 658     }
 659 }
 660
 661 /* Print the unchecked union type TYPE in something resembling Ada
 662    format on STREAM.  LEVEL is the recursion (indentation) level
 663    in case the element type itself has nested structure, and SHOW is the
 664    number of levels of internal structure to show (see ada_print_type).  */
 665 static void
 666 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 667                             int show, int level)
 668 {
 669   if (show < 0)
 670     fprintf_filtered (stream, "record (?) is ... end record");
 671   else if (TYPE_NFIELDS (type) == 0)
 672     fprintf_filtered (stream, "record (?) is null; end record");
 673   else
 674     {
 675       int i;
 676
 677       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
 678
 679       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 680         {
 681           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
 682                             level + 12, "");
 683           ada_print_type (TYPE_FIELD_TYPE (type, i),
 684                           TYPE_FIELD_NAME (type, i),
 685                           stream, show - 1, level + 12);
 686           fprintf_filtered (stream, ";");
 687         }
 688
 689       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 690                         level + 4, "", level, "");
 691     }
 692 }
 693
 694
 695
 696 /* Print function or procedure type TYPE on STREAM.  Make it a header
 697    for function or procedure NAME if NAME is not null.  */
 698
 699 static void
 700 print_func_type (struct type *type, struct ui_file *stream, const char *name)
 701 {
 702   int i, len = TYPE_NFIELDS (type);
 703
 704   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 705     fprintf_filtered (stream, "procedure");
 706   else
 707     fprintf_filtered (stream, "function");
 708
 709   if (name != NULL && name[0] != '\0')
 710     fprintf_filtered (stream, " %s", name);
 711
 712   if (len > 0)
 713     {
 714       fprintf_filtered (stream, " (");
 715       for (i = 0; i < len; i += 1)
 716         {
 717           if (i > 0)
 718             {
 719               fputs_filtered ("; ", stream);
 720               wrap_here ("    ");
 721             }
 722           fprintf_filtered (stream, "a%d: ", i + 1);
 723           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
 724         }
 725       fprintf_filtered (stream, ")");
 726     }
 727
 728   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 729     {
 730       fprintf_filtered (stream, " return ");
 731       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
 732     }
 733 }
 734
 735
 736 /* Print a description of a type TYPE0.
 737    Output goes to STREAM (via stdio).
 738    If VARSTRING is a non-empty string, print as an Ada variable/field
 739        declaration.
 740    SHOW+1 is the maximum number of levels of internal type structure
 741       to show (this applies to record types, enumerated types, and
 742       array types).
 743    SHOW is the number of levels of internal type structure to show
 744       when there is a type name for the SHOWth deepest level (0th is
 745       outer level).
 746    When SHOW<0, no inner structure is shown.
 747    LEVEL indicates level of recursion (for nested definitions).  */
 748
 749 void
 750 ada_print_type (struct type *type0, const char *varstring,
 751                 struct ui_file *stream, int show, int level)
 752 {
 753   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 754   char *type_name = decoded_type_name (type0);
 755   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 756
 757   if (type == NULL)
 758     {
 759       if (is_var_decl)
 760         fprintf_filtered (stream, "%.*s: ",
 761                           ada_name_prefix_len (varstring), varstring);
 762       fprintf_filtered (stream, "<null type?>");
 763       return;
 764     }
 765
 766   if (show > 0)
 767     type = ada_check_typedef (type);
 768
 769   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 770     fprintf_filtered (stream, "%.*s: ",
 771                       ada_name_prefix_len (varstring), varstring);
 772
 773   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 774     {
 775       fprintf_filtered (stream, "%.*s",
 776                         ada_name_prefix_len (type_name), type_name);
 777       return;
 778     }
 779
 780   if (ada_is_aligner_type (type))
 781     ada_print_type (ada_aligned_type (type), "", stream, show, level);
 782   else if (ada_is_constrained_packed_array_type (type)
 783            && TYPE_CODE (type) != TYPE_CODE_PTR)
 784     print_array_type (type, stream, show, level);
 785   else
 786     switch (TYPE_CODE (type))
 787       {
 788       default:
 789         fprintf_filtered (stream, "<");
 790         c_print_type (type, "", stream, show, level);
 791         fprintf_filtered (stream, ">");
 792         break;
 793       case TYPE_CODE_PTR:
 794       case TYPE_CODE_TYPEDEF:
 795         fprintf_filtered (stream, "access ");
 796         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
 797         break;
 798       case TYPE_CODE_REF:
 799         fprintf_filtered (stream, "<ref> ");
 800         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
 801         break;
 802       case TYPE_CODE_ARRAY:
 803         print_array_type (type, stream, show, level);
 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             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);
 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);
 854         break;
 855       case TYPE_CODE_UNION:
 856         print_unchecked_union_type (type, stream, show, level);
 857         break;
 858       case TYPE_CODE_FUNC:
 859         print_func_type (type, stream, varstring);
 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);
 872   fprintf_filtered (stream, "\n");
 873 }