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