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, 2010 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_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 (show < 0)
 344     fprintf_filtered (stream, "...");
 345   else
 346     {
 347       if (ada_is_simple_array_type (type))
 348         {
 349           struct type *range_desc_type;
 350           struct type *arr_type;
 351
 352           range_desc_type = ada_find_parallel_type (type, "___XA");
 353           ada_fixup_array_indexes_type (range_desc_type);
 354
 355           bitsize = 0;
 356           if (range_desc_type == NULL)
 357             {
 358               for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
 359                    arr_type = TYPE_TARGET_TYPE (arr_type))
 360                 {
 361                   if (arr_type != type)
 362                     fprintf_filtered (stream, ", ");
 363                   print_range (TYPE_INDEX_TYPE (arr_type), stream);
 364                   if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 365                     bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 366                 }
 367             }
 368           else
 369             {
 370               int k;
 371
 372               n_indices = TYPE_NFIELDS (range_desc_type);
 373               for (k = 0, arr_type = type;
 374                    k < n_indices;
 375                    k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
 376                 {
 377                   if (k > 0)
 378                     fprintf_filtered (stream, ", ");
 379                   print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
 380                                     stream);
 381                   if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 382                     bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 383                 }
 384             }
 385         }
 386       else
 387         {
 388           int i, i0;
 389
 390           for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
 391             fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
 392         }
 393     }
 394
 395   fprintf_filtered (stream, ") of ");
 396   wrap_here ("");
 397   ada_print_type (ada_array_element_type (type, n_indices), "", stream,
 398                   show == 0 ? 0 : show - 1, level + 1);
 399   if (bitsize > 0)
 400     fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
 401 }
 402
 403 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
 404    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
 405    values. Returns non-zero if the field is an encoding of
 406    discriminant values, as in a standard variant record, and 0 if the
 407    field is not so encoded (as happens with single-component variants
 408    in types annotated with pragma Unchecked_Variant.)
 409  */
 410
 411 static int
 412 print_choices (struct type *type, int field_num, struct ui_file *stream,
 413                struct type *val_type)
 414 {
 415   int have_output;
 416   int p;
 417   const char *name = TYPE_FIELD_NAME (type, field_num);
 418
 419   have_output = 0;
 420
 421   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 422   if (name[0] == 'V')
 423     {
 424       if (!ada_scan_number (name, 1, NULL, &p))
 425         goto Huh;
 426     }
 427   else
 428     p = 0;
 429
 430   while (1)
 431     {
 432       switch (name[p])
 433         {
 434         default:
 435           goto Huh;
 436         case '_':
 437         case '\0':
 438           fprintf_filtered (stream, " =>");
 439           return 1;
 440         case 'S':
 441         case 'R':
 442         case 'O':
 443           if (have_output)
 444             fprintf_filtered (stream, " | ");
 445           have_output = 1;
 446           break;
 447         }
 448
 449       switch (name[p])
 450         {
 451         case 'S':
 452           {
 453             LONGEST W;
 454
 455             if (!ada_scan_number (name, p + 1, &W, &p))
 456               goto Huh;
 457             ada_print_scalar (val_type, W, stream);
 458             break;
 459           }
 460         case 'R':
 461           {
 462             LONGEST L, U;
 463
 464             if (!ada_scan_number (name, p + 1, &L, &p)
 465                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 466               goto Huh;
 467             ada_print_scalar (val_type, L, stream);
 468             fprintf_filtered (stream, " .. ");
 469             ada_print_scalar (val_type, U, stream);
 470             break;
 471           }
 472         case 'O':
 473           fprintf_filtered (stream, "others");
 474           p += 1;
 475           break;
 476         }
 477     }
 478
 479 Huh:
 480   fprintf_filtered (stream, "?? =>");
 481   return 0;
 482 }
 483
 484 /* Assuming that field FIELD_NUM of TYPE represents variants whose
 485    discriminant is contained in OUTER_TYPE, print its components on STREAM.
 486    LEVEL is the recursion (indentation) level, in case any of the fields
 487    themselves have nested structure, and SHOW is the number of levels of
 488    internal structure to show (see ada_print_type).  For this purpose,
 489    fields nested in a variant part are taken to be at the same level as
 490    the fields immediately outside the variant part.  */
 491
 492 static void
 493 print_variant_clauses (struct type *type, int field_num,
 494                        struct type *outer_type, struct ui_file *stream,
 495                        int show, int level)
 496 {
 497   int i;
 498   struct type *var_type, *par_type;
 499   struct type *discr_type;
 500
 501   var_type = TYPE_FIELD_TYPE (type, field_num);
 502   discr_type = ada_variant_discrim_type (var_type, outer_type);
 503
 504   if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
 505     {
 506       var_type = TYPE_TARGET_TYPE (var_type);
 507       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
 508         return;
 509     }
 510
 511   par_type = ada_find_parallel_type (var_type, "___XVU");
 512   if (par_type != NULL)
 513     var_type = par_type;
 514
 515   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 516     {
 517       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 518       if (print_choices (var_type, i, stream, discr_type))
 519         {
 520           if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 521                                         outer_type, stream, show, level + 4)
 522               <= 0)
 523             fprintf_filtered (stream, " null;");
 524         }
 525       else
 526         print_selected_record_field_types (var_type, outer_type, i, i,
 527                                            stream, show, level + 4);
 528     }
 529 }
 530
 531 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 532    discriminants are contained in OUTER_TYPE, print a description of it
 533    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
 534    the fields themselves have nested structure, and SHOW is the number of
 535    levels of internal structure to show (see ada_print_type).  For this
 536    purpose, fields nested in a variant part are taken to be at the same
 537    level as the fields immediately outside the variant part.  */
 538
 539 static void
 540 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 541                     struct ui_file *stream, int show, int level)
 542 {
 543   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 544                     ada_variant_discrim_name
 545                     (TYPE_FIELD_TYPE (type, field_num)));
 546   print_variant_clauses (type, field_num, outer_type, stream, show,
 547                          level + 4);
 548   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 549 }
 550
 551 /* Print a description on STREAM of the fields FLD0 through FLD1 in
 552    record or union type TYPE, whose discriminants are in OUTER_TYPE.
 553    LEVEL is the recursion (indentation) level, in case any of the
 554    fields themselves have nested structure, and SHOW is the number of
 555    levels of internal structure to show (see ada_print_type).  Does
 556    not print parent type information of TYPE. Returns 0 if no fields
 557    printed, -1 for an incomplete type, else > 0.  Prints each field
 558    beginning on a new line, but does not put a new line at end.  */
 559
 560 static int
 561 print_selected_record_field_types (struct type *type, struct type *outer_type,
 562                                    int fld0, int fld1,
 563                                    struct ui_file *stream, int show, int level)
 564 {
 565   int i, flds;
 566
 567   flds = 0;
 568
 569   if (fld0 > fld1 && TYPE_STUB (type))
 570     return -1;
 571
 572   for (i = fld0; i <= fld1; i += 1)
 573     {
 574       QUIT;
 575
 576       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 577         ;
 578       else if (ada_is_wrapper_field (type, i))
 579         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 580                                           stream, show, level);
 581       else if (ada_is_variant_part (type, i))
 582         {
 583           print_variant_part (type, i, outer_type, stream, show, level);
 584           flds = 1;
 585         }
 586       else
 587         {
 588           flds += 1;
 589           fprintf_filtered (stream, "\n%*s", level + 4, "");
 590           ada_print_type (TYPE_FIELD_TYPE (type, i),
 591                           TYPE_FIELD_NAME (type, i),
 592                           stream, show - 1, level + 4);
 593           fprintf_filtered (stream, ";");
 594         }
 595     }
 596
 597   return flds;
 598 }
 599
 600 /* Print a description on STREAM of all fields of record or union type
 601    TYPE, as for print_selected_record_field_types, above.  */
 602
 603 static int
 604 print_record_field_types (struct type *type, struct type *outer_type,
 605                           struct ui_file *stream, int show, int level)
 606 {
 607   return print_selected_record_field_types (type, outer_type,
 608                                             0, TYPE_NFIELDS (type) - 1,
 609                                             stream, show, level);
 610 }
 611
 612
 613 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
 614    level, in case the element type itself has nested structure, and SHOW is
 615    the number of levels of internal structure to show (see ada_print_type).  */
 616
 617 static void
 618 print_record_type (struct type *type0, struct ui_file *stream, int show,
 619                    int level)
 620 {
 621   struct type *parent_type;
 622   struct type *type;
 623
 624   type = ada_find_parallel_type (type0, "___XVE");
 625   if (type == NULL)
 626     type = type0;
 627
 628   parent_type = ada_parent_type (type);
 629   if (ada_type_name (parent_type) != NULL)
 630     fprintf_filtered (stream, "new %s with record",
 631                       decoded_type_name (parent_type));
 632   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 633     fprintf_filtered (stream, "tagged record");
 634   else
 635     fprintf_filtered (stream, "record");
 636
 637   if (show < 0)
 638     fprintf_filtered (stream, " ... end record");
 639   else
 640     {
 641       int flds;
 642
 643       flds = 0;
 644       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 645         flds += print_record_field_types (parent_type, parent_type,
 646                                           stream, show, level);
 647       flds += print_record_field_types (type, type, stream, show, level);
 648
 649       if (flds > 0)
 650         fprintf_filtered (stream, "\n%*send record", level, "");
 651       else if (flds < 0)
 652         fprintf_filtered (stream, _(" <incomplete type> end record"));
 653       else
 654         fprintf_filtered (stream, " null; end record");
 655     }
 656 }
 657
 658 /* Print the unchecked union type TYPE in something resembling Ada
 659    format on STREAM.  LEVEL is the recursion (indentation) level
 660    in case the element type itself has nested structure, and SHOW is the
 661    number of levels of internal structure to show (see ada_print_type).  */
 662 static void
 663 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 664                             int show, int level)
 665 {
 666   if (show < 0)
 667     fprintf_filtered (stream, "record (?) is ... end record");
 668   else if (TYPE_NFIELDS (type) == 0)
 669     fprintf_filtered (stream, "record (?) is null; end record");
 670   else
 671     {
 672       int i;
 673
 674       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
 675
 676       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 677         {
 678           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
 679                             level + 12, "");
 680           ada_print_type (TYPE_FIELD_TYPE (type, i),
 681                           TYPE_FIELD_NAME (type, i),
 682                           stream, show - 1, level + 12);
 683           fprintf_filtered (stream, ";");
 684         }
 685
 686       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 687                         level + 4, "", level, "");
 688     }
 689 }
 690
 691
 692
 693 /* Print function or procedure type TYPE on STREAM.  Make it a header
 694    for function or procedure NAME if NAME is not null.  */
 695
 696 static void
 697 print_func_type (struct type *type, struct ui_file *stream, const char *name)
 698 {
 699   int i, len = TYPE_NFIELDS (type);
 700
 701   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 702     fprintf_filtered (stream, "procedure");
 703   else
 704     fprintf_filtered (stream, "function");
 705
 706   if (name != NULL && name[0] != '\0')
 707     fprintf_filtered (stream, " %s", name);
 708
 709   if (len > 0)
 710     {
 711       fprintf_filtered (stream, " (");
 712       for (i = 0; i < len; i += 1)
 713         {
 714           if (i > 0)
 715             {
 716               fputs_filtered ("; ", stream);
 717               wrap_here ("    ");
 718             }
 719           fprintf_filtered (stream, "a%d: ", i + 1);
 720           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
 721         }
 722       fprintf_filtered (stream, ")");
 723     }
 724
 725   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 726     {
 727       fprintf_filtered (stream, " return ");
 728       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
 729     }
 730 }
 731
 732
 733 /* Print a description of a type TYPE0.
 734    Output goes to STREAM (via stdio).
 735    If VARSTRING is a non-empty string, print as an Ada variable/field
 736        declaration.
 737    SHOW+1 is the maximum number of levels of internal type structure
 738       to show (this applies to record types, enumerated types, and
 739       array types).
 740    SHOW is the number of levels of internal type structure to show
 741       when there is a type name for the SHOWth deepest level (0th is
 742       outer level).
 743    When SHOW<0, no inner structure is shown.
 744    LEVEL indicates level of recursion (for nested definitions).  */
 745
 746 void
 747 ada_print_type (struct type *type0, const char *varstring,
 748                 struct ui_file *stream, int show, int level)
 749 {
 750   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 751   char *type_name = decoded_type_name (type0);
 752   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 753
 754   if (type == NULL)
 755     {
 756       if (is_var_decl)
 757         fprintf_filtered (stream, "%.*s: ",
 758                           ada_name_prefix_len (varstring), varstring);
 759       fprintf_filtered (stream, "<null type?>");
 760       return;
 761     }
 762
 763   if (show > 0)
 764     type = ada_check_typedef (type);
 765
 766   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 767     fprintf_filtered (stream, "%.*s: ",
 768                       ada_name_prefix_len (varstring), varstring);
 769
 770   if (type_name != NULL && show <= 0)
 771     {
 772       fprintf_filtered (stream, "%.*s",
 773                         ada_name_prefix_len (type_name), type_name);
 774       return;
 775     }
 776
 777   if (ada_is_aligner_type (type))
 778     ada_print_type (ada_aligned_type (type), "", stream, show, level);
 779   else if (ada_is_constrained_packed_array_type (type))
 780     {
 781       if (TYPE_CODE (type) == TYPE_CODE_PTR)
 782         {
 783           fprintf_filtered (stream, "access ");
 784           print_array_type (TYPE_TARGET_TYPE (type), stream, show, level);
 785         }
 786       else
 787         {
 788           print_array_type (type, stream, show, level);
 789         }
 790     }
 791   else
 792     switch (TYPE_CODE (type))
 793       {
 794       default:
 795         fprintf_filtered (stream, "<");
 796         c_print_type (type, "", stream, show, level);
 797         fprintf_filtered (stream, ">");
 798         break;
 799       case TYPE_CODE_PTR:
 800         fprintf_filtered (stream, "access ");
 801         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
 802         break;
 803       case TYPE_CODE_REF:
 804         fprintf_filtered (stream, "<ref> ");
 805         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
 806         break;
 807       case TYPE_CODE_ARRAY:
 808         print_array_type (type, stream, show, level);
 809         break;
 810       case TYPE_CODE_BOOL:
 811         fprintf_filtered (stream, "(false, true)");
 812         break;
 813       case TYPE_CODE_INT:
 814         if (ada_is_fixed_point_type (type))
 815           print_fixed_point_type (type, stream);
 816         else
 817           {
 818             char *name = ada_type_name (type);
 819
 820             if (!ada_is_range_type_name (name))
 821               fprintf_filtered (stream, _("<%d-byte integer>"),
 822                                 TYPE_LENGTH (type));
 823             else
 824               {
 825                 fprintf_filtered (stream, "range ");
 826                 print_range_type (type, stream);
 827               }
 828           }
 829         break;
 830       case TYPE_CODE_RANGE:
 831         if (ada_is_fixed_point_type (type))
 832           print_fixed_point_type (type, stream);
 833         else if (ada_is_modular_type (type))
 834           fprintf_filtered (stream, "mod %s",
 835                             int_string (ada_modulus (type), 10, 0, 0, 1));
 836         else
 837           {
 838             fprintf_filtered (stream, "range ");
 839             print_range (type, stream);
 840           }
 841         break;
 842       case TYPE_CODE_FLT:
 843         fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
 844         break;
 845       case TYPE_CODE_ENUM:
 846         if (show < 0)
 847           fprintf_filtered (stream, "(...)");
 848         else
 849           print_enum_type (type, stream);
 850         break;
 851       case TYPE_CODE_STRUCT:
 852         if (ada_is_array_descriptor_type (type))
 853           print_array_type (type, stream, show, level);
 854         else if (ada_is_bogus_array_descriptor (type))
 855           fprintf_filtered (stream,
 856                             _("array (?) of ? (<mal-formed descriptor>)"));
 857         else
 858           print_record_type (type, stream, show, level);
 859         break;
 860       case TYPE_CODE_UNION:
 861         print_unchecked_union_type (type, stream, show, level);
 862         break;
 863       case TYPE_CODE_FUNC:
 864         print_func_type (type, stream, varstring);
 865         break;
 866       }
 867 }
 868
 869 /* Implement the la_print_typedef language method for Ada.  */
 870
 871 void
 872 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 873                    struct ui_file *stream)
 874 {
 875   type = ada_check_typedef (type);
 876   ada_print_type (type, "", stream, 0, 0);
 877   fprintf_filtered (stream, "\n");
 878 }