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