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