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