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.  Return 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 static int
 411 print_choices (struct type *type, int field_num, struct ui_file *stream,
 412                struct type *val_type)
 413 {
 414   int have_output;
 415   int p;
 416   const char *name = TYPE_FIELD_NAME (type, field_num);
 417
 418   have_output = 0;
 419
 420   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 421   if (name[0] == 'V')
 422     {
 423       if (!ada_scan_number (name, 1, NULL, &p))
 424         goto Huh;
 425     }
 426   else
 427     p = 0;
 428
 429   while (1)
 430     {
 431       switch (name[p])
 432         {
 433         default:
 434           goto Huh;
 435         case '_':
 436         case '\0':
 437           fprintf_filtered (stream, " =>");
 438           return 1;
 439         case 'S':
 440         case 'R':
 441         case 'O':
 442           if (have_output)
 443             fprintf_filtered (stream, " | ");
 444           have_output = 1;
 445           break;
 446         }
 447
 448       switch (name[p])
 449         {
 450         case 'S':
 451           {
 452             LONGEST W;
 453
 454             if (!ada_scan_number (name, p + 1, &W, &p))
 455               goto Huh;
 456             ada_print_scalar (val_type, W, stream);
 457             break;
 458           }
 459         case 'R':
 460           {
 461             LONGEST L, U;
 462
 463             if (!ada_scan_number (name, p + 1, &L, &p)
 464                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 465               goto Huh;
 466             ada_print_scalar (val_type, L, stream);
 467             fprintf_filtered (stream, " .. ");
 468             ada_print_scalar (val_type, U, stream);
 469             break;
 470           }
 471         case 'O':
 472           fprintf_filtered (stream, "others");
 473           p += 1;
 474           break;
 475         }
 476     }
 477
 478 Huh:
 479   fprintf_filtered (stream, "?? =>");
 480   return 0;
 481 }
 482
 483 /* Assuming that field FIELD_NUM of TYPE represents variants whose
 484    discriminant is contained in OUTER_TYPE, print its components on STREAM.
 485    LEVEL is the recursion (indentation) level, in case any of the fields
 486    themselves have nested structure, and SHOW is the number of levels of
 487    internal structure to show (see ada_print_type).  For this purpose,
 488    fields nested in a variant part are taken to be at the same level as
 489    the fields immediately outside the variant part.  */
 490
 491 static void
 492 print_variant_clauses (struct type *type, int field_num,
 493                        struct type *outer_type, struct ui_file *stream,
 494                        int show, int level)
 495 {
 496   int i;
 497   struct type *var_type, *par_type;
 498   struct type *discr_type;
 499
 500   var_type = TYPE_FIELD_TYPE (type, field_num);
 501   discr_type = ada_variant_discrim_type (var_type, outer_type);
 502
 503   if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
 504     {
 505       var_type = TYPE_TARGET_TYPE (var_type);
 506       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
 507         return;
 508     }
 509
 510   par_type = ada_find_parallel_type (var_type, "___XVU");
 511   if (par_type != NULL)
 512     var_type = par_type;
 513
 514   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 515     {
 516       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 517       if (print_choices (var_type, i, stream, discr_type))
 518         {
 519           if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 520                                         outer_type, stream, show, level + 4)
 521               <= 0)
 522             fprintf_filtered (stream, " null;");
 523         }
 524       else
 525         print_selected_record_field_types (var_type, outer_type, i, i,
 526                                            stream, show, level + 4);
 527     }
 528 }
 529
 530 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 531    discriminants are contained in OUTER_TYPE, print a description of it
 532    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
 533    the fields themselves have nested structure, and SHOW is the number of
 534    levels of internal structure to show (see ada_print_type).  For this
 535    purpose, fields nested in a variant part are taken to be at the same
 536    level as the fields immediately outside the variant part.  */
 537
 538 static void
 539 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 540                     struct ui_file *stream, int show, int level)
 541 {
 542   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 543                     ada_variant_discrim_name
 544                     (TYPE_FIELD_TYPE (type, field_num)));
 545   print_variant_clauses (type, field_num, outer_type, stream, show,
 546                          level + 4);
 547   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 548 }
 549
 550 /* Print a description on STREAM of the fields FLD0 through FLD1 in
 551    record or union type TYPE, whose discriminants are in OUTER_TYPE.
 552    LEVEL is the recursion (indentation) level, in case any of the
 553    fields themselves have nested structure, and SHOW is the number of
 554    levels of internal structure to show (see ada_print_type).  Does
 555    not print parent type information of TYPE.  Returns 0 if no fields
 556    printed, -1 for an incomplete type, else > 0.  Prints each field
 557    beginning on a new line, but does not put a new line at end.  */
 558
 559 static int
 560 print_selected_record_field_types (struct type *type, struct type *outer_type,
 561                                    int fld0, int fld1,
 562                                    struct ui_file *stream, int show, int level)
 563 {
 564   int i, flds;
 565
 566   flds = 0;
 567
 568   if (fld0 > fld1 && TYPE_STUB (type))
 569     return -1;
 570
 571   for (i = fld0; i <= fld1; i += 1)
 572     {
 573       QUIT;
 574
 575       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 576         ;
 577       else if (ada_is_wrapper_field (type, i))
 578         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 579                                           stream, show, level);
 580       else if (ada_is_variant_part (type, i))
 581         {
 582           print_variant_part (type, i, outer_type, stream, show, level);
 583           flds = 1;
 584         }
 585       else
 586         {
 587           flds += 1;
 588           fprintf_filtered (stream, "\n%*s", level + 4, "");
 589           ada_print_type (TYPE_FIELD_TYPE (type, i),
 590                           TYPE_FIELD_NAME (type, i),
 591                           stream, show - 1, level + 4);
 592           fprintf_filtered (stream, ";");
 593         }
 594     }
 595
 596   return flds;
 597 }
 598
 599 /* Print a description on STREAM of all fields of record or union type
 600    TYPE, as for print_selected_record_field_types, above.  */
 601
 602 static int
 603 print_record_field_types (struct type *type, struct type *outer_type,
 604                           struct ui_file *stream, int show, int level)
 605 {
 606   return print_selected_record_field_types (type, outer_type,
 607                                             0, TYPE_NFIELDS (type) - 1,
 608                                             stream, show, level);
 609 }
 610
 611
 612 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
 613    level, in case the element type itself has nested structure, and SHOW is
 614    the number of levels of internal structure to show (see ada_print_type).  */
 615
 616 static void
 617 print_record_type (struct type *type0, struct ui_file *stream, int show,
 618                    int level)
 619 {
 620   struct type *parent_type;
 621   struct type *type;
 622
 623   type = ada_find_parallel_type (type0, "___XVE");
 624   if (type == NULL)
 625     type = type0;
 626
 627   parent_type = ada_parent_type (type);
 628   if (ada_type_name (parent_type) != NULL)
 629     fprintf_filtered (stream, "new %s with record",
 630                       decoded_type_name (parent_type));
 631   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 632     fprintf_filtered (stream, "tagged record");
 633   else
 634     fprintf_filtered (stream, "record");
 635
 636   if (show < 0)
 637     fprintf_filtered (stream, " ... end record");
 638   else
 639     {
 640       int flds;
 641
 642       flds = 0;
 643       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 644         flds += print_record_field_types (parent_type, parent_type,
 645                                           stream, show, level);
 646       flds += print_record_field_types (type, type, stream, show, level);
 647
 648       if (flds > 0)
 649         fprintf_filtered (stream, "\n%*send record", level, "");
 650       else if (flds < 0)
 651         fprintf_filtered (stream, _(" <incomplete type> end record"));
 652       else
 653         fprintf_filtered (stream, " null; end record");
 654     }
 655 }
 656
 657 /* Print the unchecked union type TYPE in something resembling Ada
 658    format on STREAM.  LEVEL is the recursion (indentation) level
 659    in case the element type itself has nested structure, and SHOW is the
 660    number of levels of internal structure to show (see ada_print_type).  */
 661 static void
 662 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 663                             int show, int level)
 664 {
 665   if (show < 0)
 666     fprintf_filtered (stream, "record (?) is ... end record");
 667   else if (TYPE_NFIELDS (type) == 0)
 668     fprintf_filtered (stream, "record (?) is null; end record");
 669   else
 670     {
 671       int i;
 672
 673       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
 674
 675       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 676         {
 677           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
 678                             level + 12, "");
 679           ada_print_type (TYPE_FIELD_TYPE (type, i),
 680                           TYPE_FIELD_NAME (type, i),
 681                           stream, show - 1, level + 12);
 682           fprintf_filtered (stream, ";");
 683         }
 684
 685       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 686                         level + 4, "", level, "");
 687     }
 688 }
 689
 690
 691
 692 /* Print function or procedure type TYPE on STREAM.  Make it a header
 693    for function or procedure NAME if NAME is not null.  */
 694
 695 static void
 696 print_func_type (struct type *type, struct ui_file *stream, const char *name)
 697 {
 698   int i, len = TYPE_NFIELDS (type);
 699
 700   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 701     fprintf_filtered (stream, "procedure");
 702   else
 703     fprintf_filtered (stream, "function");
 704
 705   if (name != NULL && name[0] != '\0')
 706     fprintf_filtered (stream, " %s", name);
 707
 708   if (len > 0)
 709     {
 710       fprintf_filtered (stream, " (");
 711       for (i = 0; i < len; i += 1)
 712         {
 713           if (i > 0)
 714             {
 715               fputs_filtered ("; ", stream);
 716               wrap_here ("    ");
 717             }
 718           fprintf_filtered (stream, "a%d: ", i + 1);
 719           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
 720         }
 721       fprintf_filtered (stream, ")");
 722     }
 723
 724   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 725     {
 726       fprintf_filtered (stream, " return ");
 727       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
 728     }
 729 }
 730
 731
 732 /* Print a description of a type TYPE0.
 733    Output goes to STREAM (via stdio).
 734    If VARSTRING is a non-empty string, print as an Ada variable/field
 735        declaration.
 736    SHOW+1 is the maximum number of levels of internal type structure
 737       to show (this applies to record types, enumerated types, and
 738       array types).
 739    SHOW is the number of levels of internal type structure to show
 740       when there is a type name for the SHOWth deepest level (0th is
 741       outer level).
 742    When SHOW<0, no inner structure is shown.
 743    LEVEL indicates level of recursion (for nested definitions).  */
 744
 745 void
 746 ada_print_type (struct type *type0, const char *varstring,
 747                 struct ui_file *stream, int show, int level)
 748 {
 749   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 750   char *type_name = decoded_type_name (type0);
 751   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 752
 753   if (type == NULL)
 754     {
 755       if (is_var_decl)
 756         fprintf_filtered (stream, "%.*s: ",
 757                           ada_name_prefix_len (varstring), varstring);
 758       fprintf_filtered (stream, "<null type?>");
 759       return;
 760     }
 761
 762   if (show > 0)
 763     type = ada_check_typedef (type);
 764
 765   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 766     fprintf_filtered (stream, "%.*s: ",
 767                       ada_name_prefix_len (varstring), varstring);
 768
 769   if (type_name != NULL && show <= 0)
 770     {
 771       fprintf_filtered (stream, "%.*s",
 772                         ada_name_prefix_len (type_name), type_name);
 773       return;
 774     }
 775
 776   if (ada_is_aligner_type (type))
 777     ada_print_type (ada_aligned_type (type), "", stream, show, level);
 778   else if (ada_is_constrained_packed_array_type (type))
 779     {
 780       if (TYPE_CODE (type) == TYPE_CODE_PTR)
 781         {
 782           fprintf_filtered (stream, "access ");
 783           print_array_type (TYPE_TARGET_TYPE (type), stream, show, level);
 784         }
 785       else
 786         {
 787           print_array_type (type, stream, show, level);
 788         }
 789     }
 790   else
 791     switch (TYPE_CODE (type))
 792       {
 793       default:
 794         fprintf_filtered (stream, "<");
 795         c_print_type (type, "", stream, show, level);
 796         fprintf_filtered (stream, ">");
 797         break;
 798       case TYPE_CODE_PTR:
 799       case TYPE_CODE_TYPEDEF:
 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 }