gdb/ada-typeprint.c

   1 /* Support for printing Ada types for GDB, the GNU debugger.
   2    Copyright (C) 1986, 1988-1989, 1991, 1997-2004, 2007-2012 Free
   3    Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 #include "defs.h"
  21 #include "gdb_obstack.h"
  22 #include "bfd.h"                /* Binary File Description */
  23 #include "symtab.h"
  24 #include "gdbtypes.h"
  25 #include "expression.h"
  26 #include "value.h"
  27 #include "gdbcore.h"
  28 #include "target.h"
  29 #include "command.h"
  30 #include "gdbcmd.h"
  31 #include "language.h"
  32 #include "demangle.h"
  33 #include "c-lang.h"
  34 #include "typeprint.h"
  35 #include "ada-lang.h"
  36
  37 #include <ctype.h>
  38 #include "gdb_string.h"
  39 #include <errno.h>
  40
  41 static int print_selected_record_field_types (struct type *, struct type *,
  42                                               int, int,
  43                                               struct ui_file *, int, int,
  44                                               const struct type_print_options *);
  45
  46 static int print_record_field_types (struct type *, struct type *,
  47                                      struct ui_file *, int, int,
  48                                      const struct type_print_options *);
  49
  50 static void print_array_type (struct type *, struct ui_file *, int, int,
  51                               const struct type_print_options *);
  52
  53 static int print_choices (struct type *, int, struct ui_file *,
  54                           struct type *);
  55
  56 static void print_range (struct type *, struct ui_file *);
  57
  58 static void print_range_bound (struct type *, char *, int *,
  59                                struct ui_file *);
  60
  61 static void
  62 print_dynamic_range_bound (struct type *, const char *, int,
  63                            const char *, struct ui_file *);
  64
  65 static void print_range_type (struct type *, struct ui_file *);
  66 \f
  67
  68
  69 static char *name_buffer;
  70 static int name_buffer_len;
  71
  72 /* The (decoded) Ada name of TYPE.  This value persists until the
  73    next call.  */
  74
  75 static char *
  76 decoded_type_name (struct type *type)
  77 {
  78   if (ada_type_name (type) == NULL)
  79     return NULL;
  80   else
  81     {
  82       const char *raw_name = ada_type_name (type);
  83       char *s, *q;
  84
  85       if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
  86         {
  87           name_buffer_len = 16 + 2 * strlen (raw_name);
  88           name_buffer = xrealloc (name_buffer, name_buffer_len);
  89         }
  90       strcpy (name_buffer, raw_name);
  91
  92       s = (char *) strstr (name_buffer, "___");
  93       if (s != NULL)
  94         *s = '\0';
  95
  96       s = name_buffer + strlen (name_buffer) - 1;
  97       while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
  98         s -= 1;
  99
 100       if (s == name_buffer)
 101         return name_buffer;
 102
 103       if (!islower (s[1]))
 104         return NULL;
 105
 106       for (s = q = name_buffer; *s != '\0'; q += 1)
 107         {
 108           if (s[0] == '_' && s[1] == '_')
 109             {
 110               *q = '.';
 111               s += 2;
 112             }
 113           else
 114             {
 115               *q = *s;
 116               s += 1;
 117             }
 118         }
 119       *q = '\0';
 120       return name_buffer;
 121     }
 122 }
 123
 124 /* Print TYPE on STREAM, preferably as a range.  */
 125
 126 static void
 127 print_range (struct type *type, struct ui_file *stream)
 128 {
 129   switch (TYPE_CODE (type))
 130     {
 131     case TYPE_CODE_RANGE:
 132     case TYPE_CODE_ENUM:
 133       {
 134         struct type *target_type;
 135         target_type = TYPE_TARGET_TYPE (type);
 136         if (target_type == NULL)
 137           target_type = type;
 138         ada_print_scalar (target_type, ada_discrete_type_low_bound (type),
 139                           stream);
 140         fprintf_filtered (stream, " .. ");
 141         ada_print_scalar (target_type, ada_discrete_type_high_bound (type),
 142                           stream);
 143       }
 144       break;
 145     default:
 146       fprintf_filtered (stream, "%.*s",
 147                         ada_name_prefix_len (TYPE_NAME (type)),
 148                         TYPE_NAME (type));
 149       break;
 150     }
 151 }
 152
 153 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
 154    set *N past the bound and its delimiter, if any.  */
 155
 156 static void
 157 print_range_bound (struct type *type, char *bounds, int *n,
 158                    struct ui_file *stream)
 159 {
 160   LONGEST B;
 161
 162   if (ada_scan_number (bounds, *n, &B, n))
 163     {
 164       /* STABS decodes all range types which bounds are 0 .. -1 as
 165          unsigned integers (ie. the type code is TYPE_CODE_INT, not
 166          TYPE_CODE_RANGE).  Unfortunately, ada_print_scalar() relies
 167          on the unsigned flag to determine whether the bound should
 168          be printed as a signed or an unsigned value.  This causes
 169          the upper bound of the 0 .. -1 range types to be printed as
 170          a very large unsigned number instead of -1.
 171          To workaround this stabs deficiency, we replace the TYPE by NULL
 172          to indicate default output when we detect that the bound is negative,
 173          and the type is a TYPE_CODE_INT.  The bound is negative when
 174          'm' is the last character of the number scanned in BOUNDS.  */
 175       if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
 176         type = NULL;
 177       ada_print_scalar (type, B, stream);
 178       if (bounds[*n] == '_')
 179         *n += 2;
 180     }
 181   else
 182     {
 183       int bound_len;
 184       char *bound = bounds + *n;
 185       char *pend;
 186
 187       pend = strstr (bound, "__");
 188       if (pend == NULL)
 189         *n += bound_len = strlen (bound);
 190       else
 191         {
 192           bound_len = pend - bound;
 193           *n += bound_len + 2;
 194         }
 195       fprintf_filtered (stream, "%.*s", bound_len, bound);
 196     }
 197 }
 198
 199 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
 200    the value (if found) of the bound indicated by SUFFIX ("___L" or
 201    "___U") according to the ___XD conventions.  */
 202
 203 static void
 204 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
 205                            const char *suffix, struct ui_file *stream)
 206 {
 207   static char *name_buf = NULL;
 208   static size_t name_buf_len = 0;
 209   LONGEST B;
 210   int OK;
 211
 212   GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
 213   strncpy (name_buf, name, name_len);
 214   strcpy (name_buf + name_len, suffix);
 215
 216   B = get_int_var_value (name_buf, &OK);
 217   if (OK)
 218     ada_print_scalar (type, B, stream);
 219   else
 220     fprintf_filtered (stream, "?");
 221 }
 222
 223 /* Print RAW_TYPE as a range type, using any bound information
 224    following the GNAT encoding (if available).  */
 225
 226 static void
 227 print_range_type (struct type *raw_type, struct ui_file *stream)
 228 {
 229   const char *name;
 230   struct type *base_type;
 231   const char *subtype_info;
 232
 233   gdb_assert (raw_type != NULL);
 234   name = TYPE_NAME (raw_type);
 235   gdb_assert (name != NULL);
 236
 237   if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
 238     base_type = TYPE_TARGET_TYPE (raw_type);
 239   else
 240     base_type = raw_type;
 241
 242   subtype_info = strstr (name, "___XD");
 243   if (subtype_info == NULL)
 244     print_range (raw_type, stream);
 245   else
 246     {
 247       int prefix_len = subtype_info - name;
 248       char *bounds_str;
 249       int n;
 250
 251       subtype_info += 5;
 252       bounds_str = strchr (subtype_info, '_');
 253       n = 1;
 254
 255       if (*subtype_info == 'L')
 256         {
 257           print_range_bound (base_type, bounds_str, &n, stream);
 258           subtype_info += 1;
 259         }
 260       else
 261         print_dynamic_range_bound (base_type, name, prefix_len, "___L",
 262                                    stream);
 263
 264       fprintf_filtered (stream, " .. ");
 265
 266       if (*subtype_info == 'U')
 267         print_range_bound (base_type, bounds_str, &n, stream);
 268       else
 269         print_dynamic_range_bound (base_type, name, prefix_len, "___U",
 270                                    stream);
 271     }
 272 }
 273
 274 /* Print enumerated type TYPE on STREAM.  */
 275
 276 static void
 277 print_enum_type (struct type *type, struct ui_file *stream)
 278 {
 279   int len = TYPE_NFIELDS (type);
 280   int i;
 281   LONGEST lastval;
 282
 283   fprintf_filtered (stream, "(");
 284   wrap_here (" ");
 285
 286   lastval = 0;
 287   for (i = 0; i < len; i++)
 288     {
 289       QUIT;
 290       if (i)
 291         fprintf_filtered (stream, ", ");
 292       wrap_here ("    ");
 293       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 294       if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 295         {
 296           fprintf_filtered (stream, " => %s",
 297                             plongest (TYPE_FIELD_ENUMVAL (type, i)));
 298           lastval = TYPE_FIELD_ENUMVAL (type, i);
 299         }
 300       lastval += 1;
 301     }
 302   fprintf_filtered (stream, ")");
 303 }
 304
 305 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
 306
 307 static void
 308 print_fixed_point_type (struct type *type, struct ui_file *stream)
 309 {
 310   DOUBLEST delta = ada_delta (type);
 311   DOUBLEST small = ada_fixed_to_float (type, 1.0);
 312
 313   if (delta < 0.0)
 314     fprintf_filtered (stream, "delta ??");
 315   else
 316     {
 317       fprintf_filtered (stream, "delta %g", (double) delta);
 318       if (delta != small)
 319         fprintf_filtered (stream, " <'small = %g>", (double) small);
 320     }
 321 }
 322
 323 /* Print simple (constrained) array type TYPE on STREAM.  LEVEL is the
 324    recursion (indentation) level, in case the element type itself has
 325    nested structure, and SHOW is the number of levels of internal
 326    structure to show (see ada_print_type).  */
 327
 328 static void
 329 print_array_type (struct type *type, struct ui_file *stream, int show,
 330                   int level, const struct type_print_options *flags)
 331 {
 332   int bitsize;
 333   int n_indices;
 334
 335   if (ada_is_constrained_packed_array_type (type))
 336     type = ada_coerce_to_simple_array_type (type);
 337
 338   bitsize = 0;
 339   fprintf_filtered (stream, "array (");
 340
 341   if (type == NULL)
 342     {
 343       fprintf_filtered (stream, _("<undecipherable array type>"));
 344       return;
 345     }
 346
 347   n_indices = -1;
 348   if (ada_is_simple_array_type (type))
 349     {
 350       struct type *range_desc_type;
 351       struct type *arr_type;
 352
 353       range_desc_type = ada_find_parallel_type (type, "___XA");
 354       ada_fixup_array_indexes_type (range_desc_type);
 355
 356       bitsize = 0;
 357       if (range_desc_type == NULL)
 358         {
 359           for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
 360                arr_type = TYPE_TARGET_TYPE (arr_type))
 361             {
 362               if (arr_type != type)
 363                 fprintf_filtered (stream, ", ");
 364               print_range (TYPE_INDEX_TYPE (arr_type), stream);
 365               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 366                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 367             }
 368         }
 369       else
 370         {
 371           int k;
 372
 373           n_indices = TYPE_NFIELDS (range_desc_type);
 374           for (k = 0, arr_type = type;
 375                k < n_indices;
 376                k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
 377             {
 378               if (k > 0)
 379                 fprintf_filtered (stream, ", ");
 380               print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
 381                                 stream);
 382               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 383                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 384             }
 385         }
 386     }
 387   else
 388     {
 389       int i, i0;
 390
 391       for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
 392         fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
 393     }
 394
 395   fprintf_filtered (stream, ") of ");
 396   wrap_here ("");
 397   ada_print_type (ada_array_element_type (type, n_indices), "", stream,
 398                   show == 0 ? 0 : show - 1, level + 1, flags);
 399   if (bitsize > 0)
 400     fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
 401 }
 402
 403 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
 404    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
 405    values.  Return non-zero if the field is an encoding of
 406    discriminant values, as in a standard variant record, and 0 if the
 407    field is not so encoded (as happens with single-component variants
 408    in types annotated with pragma Unchecked_Variant).  */
 409
 410 static int
 411 print_choices (struct type *type, int field_num, struct ui_file *stream,
 412                struct type *val_type)
 413 {
 414   int have_output;
 415   int p;
 416   const char *name = TYPE_FIELD_NAME (type, field_num);
 417
 418   have_output = 0;
 419
 420   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 421   if (name[0] == 'V')
 422     {
 423       if (!ada_scan_number (name, 1, NULL, &p))
 424         goto Huh;
 425     }
 426   else
 427     p = 0;
 428
 429   while (1)
 430     {
 431       switch (name[p])
 432         {
 433         default:
 434           goto Huh;
 435         case '_':
 436         case '\0':
 437           fprintf_filtered (stream, " =>");
 438           return 1;
 439         case 'S':
 440         case 'R':
 441         case 'O':
 442           if (have_output)
 443             fprintf_filtered (stream, " | ");
 444           have_output = 1;
 445           break;
 446         }
 447
 448       switch (name[p])
 449         {
 450         case 'S':
 451           {
 452             LONGEST W;
 453
 454             if (!ada_scan_number (name, p + 1, &W, &p))
 455               goto Huh;
 456             ada_print_scalar (val_type, W, stream);
 457             break;
 458           }
 459         case 'R':
 460           {
 461             LONGEST L, U;
 462
 463             if (!ada_scan_number (name, p + 1, &L, &p)
 464                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 465               goto Huh;
 466             ada_print_scalar (val_type, L, stream);
 467             fprintf_filtered (stream, " .. ");
 468             ada_print_scalar (val_type, U, stream);
 469             break;
 470           }
 471         case 'O':
 472           fprintf_filtered (stream, "others");
 473           p += 1;
 474           break;
 475         }
 476     }
 477
 478 Huh:
 479   fprintf_filtered (stream, "?? =>");
 480   return 0;
 481 }
 482
 483 /* Assuming that field FIELD_NUM of TYPE represents variants whose
 484    discriminant is contained in OUTER_TYPE, print its components on STREAM.
 485    LEVEL is the recursion (indentation) level, in case any of the fields
 486    themselves have nested structure, and SHOW is the number of levels of
 487    internal structure to show (see ada_print_type).  For this purpose,
 488    fields nested in a variant part are taken to be at the same level as
 489    the fields immediately outside the variant part.  */
 490
 491 static void
 492 print_variant_clauses (struct type *type, int field_num,
 493                        struct type *outer_type, struct ui_file *stream,
 494                        int show, int level,
 495                        const struct type_print_options *flags)
 496 {
 497   int i;
 498   struct type *var_type, *par_type;
 499   struct type *discr_type;
 500
 501   var_type = TYPE_FIELD_TYPE (type, field_num);
 502   discr_type = ada_variant_discrim_type (var_type, outer_type);
 503
 504   if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
 505     {
 506       var_type = TYPE_TARGET_TYPE (var_type);
 507       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
 508         return;
 509     }
 510
 511   par_type = ada_find_parallel_type (var_type, "___XVU");
 512   if (par_type != NULL)
 513     var_type = par_type;
 514
 515   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 516     {
 517       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 518       if (print_choices (var_type, i, stream, discr_type))
 519         {
 520           if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 521                                         outer_type, stream, show, level + 4,
 522                                         flags)
 523               <= 0)
 524             fprintf_filtered (stream, " null;");
 525         }
 526       else
 527         print_selected_record_field_types (var_type, outer_type, i, i,
 528                                            stream, show, level + 4, flags);
 529     }
 530 }
 531
 532 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 533    discriminants are contained in OUTER_TYPE, print a description of it
 534    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
 535    the fields themselves have nested structure, and SHOW is the number of
 536    levels of internal structure to show (see ada_print_type).  For this
 537    purpose, fields nested in a variant part are taken to be at the same
 538    level as the fields immediately outside the variant part.  */
 539
 540 static void
 541 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 542                     struct ui_file *stream, int show, int level,
 543                     const struct type_print_options *flags)
 544 {
 545   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 546                     ada_variant_discrim_name
 547                     (TYPE_FIELD_TYPE (type, field_num)));
 548   print_variant_clauses (type, field_num, outer_type, stream, show,
 549                          level + 4, flags);
 550   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 551 }
 552
 553 /* Print a description on STREAM of the fields FLD0 through FLD1 in
 554    record or union type TYPE, whose discriminants are in OUTER_TYPE.
 555    LEVEL is the recursion (indentation) level, in case any of the
 556    fields themselves have nested structure, and SHOW is the number of
 557    levels of internal structure to show (see ada_print_type).  Does
 558    not print parent type information of TYPE.  Returns 0 if no fields
 559    printed, -1 for an incomplete type, else > 0.  Prints each field
 560    beginning on a new line, but does not put a new line at end.  */
 561
 562 static int
 563 print_selected_record_field_types (struct type *type, struct type *outer_type,
 564                                    int fld0, int fld1,
 565                                    struct ui_file *stream, int show, int level,
 566                                    const struct type_print_options *flags)
 567 {
 568   int i, flds;
 569
 570   flds = 0;
 571
 572   if (fld0 > fld1 && TYPE_STUB (type))
 573     return -1;
 574
 575   for (i = fld0; i <= fld1; i += 1)
 576     {
 577       QUIT;
 578
 579       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 580         ;
 581       else if (ada_is_wrapper_field (type, i))
 582         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 583                                           stream, show, level, flags);
 584       else if (ada_is_variant_part (type, i))
 585         {
 586           print_variant_part (type, i, outer_type, stream, show, level, flags);
 587           flds = 1;
 588         }
 589       else
 590         {
 591           flds += 1;
 592           fprintf_filtered (stream, "\n%*s", level + 4, "");
 593           ada_print_type (TYPE_FIELD_TYPE (type, i),
 594                           TYPE_FIELD_NAME (type, i),
 595                           stream, show - 1, level + 4, flags);
 596           fprintf_filtered (stream, ";");
 597         }
 598     }
 599
 600   return flds;
 601 }
 602
 603 /* Print a description on STREAM of all fields of record or union type
 604    TYPE, as for print_selected_record_field_types, above.  */
 605
 606 static int
 607 print_record_field_types (struct type *type, struct type *outer_type,
 608                           struct ui_file *stream, int show, int level,
 609                           const struct type_print_options *flags)
 610 {
 611   return print_selected_record_field_types (type, outer_type,
 612                                             0, TYPE_NFIELDS (type) - 1,
 613                                             stream, show, level, flags);
 614 }
 615
 616
 617 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
 618    level, in case the element type itself has nested structure, and SHOW is
 619    the number of levels of internal structure to show (see ada_print_type).  */
 620
 621 static void
 622 print_record_type (struct type *type0, struct ui_file *stream, int show,
 623                    int level, const struct type_print_options *flags)
 624 {
 625   struct type *parent_type;
 626   struct type *type;
 627
 628   type = ada_find_parallel_type (type0, "___XVE");
 629   if (type == NULL)
 630     type = type0;
 631
 632   parent_type = ada_parent_type (type);
 633   if (ada_type_name (parent_type) != NULL)
 634     {
 635       const char *parent_name = decoded_type_name (parent_type);
 636
 637       /* If we fail to decode the parent type name, then use the parent
 638          type name as is.  Not pretty, but should never happen except
 639          when the debugging info is incomplete or incorrect.  This
 640          prevents a crash trying to print a NULL pointer.  */
 641       if (parent_name == NULL)
 642         parent_name = ada_type_name (parent_type);
 643       fprintf_filtered (stream, "new %s with record", parent_name);
 644     }
 645   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 646     fprintf_filtered (stream, "tagged record");
 647   else
 648     fprintf_filtered (stream, "record");
 649
 650   if (show < 0)
 651     fprintf_filtered (stream, " ... end record");
 652   else
 653     {
 654       int flds;
 655
 656       flds = 0;
 657       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 658         flds += print_record_field_types (parent_type, parent_type,
 659                                           stream, show, level, flags);
 660       flds += print_record_field_types (type, type, stream, show, level,
 661                                         flags);
 662
 663       if (flds > 0)
 664         fprintf_filtered (stream, "\n%*send record", level, "");
 665       else if (flds < 0)
 666         fprintf_filtered (stream, _(" <incomplete type> end record"));
 667       else
 668         fprintf_filtered (stream, " null; end record");
 669     }
 670 }
 671
 672 /* Print the unchecked union type TYPE in something resembling Ada
 673    format on STREAM.  LEVEL is the recursion (indentation) level
 674    in case the element type itself has nested structure, and SHOW is the
 675    number of levels of internal structure to show (see ada_print_type).  */
 676 static void
 677 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 678                             int show, int level,
 679                             const struct type_print_options *flags)
 680 {
 681   if (show < 0)
 682     fprintf_filtered (stream, "record (?) is ... end record");
 683   else if (TYPE_NFIELDS (type) == 0)
 684     fprintf_filtered (stream, "record (?) is null; end record");
 685   else
 686     {
 687       int i;
 688
 689       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
 690
 691       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 692         {
 693           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
 694                             level + 12, "");
 695           ada_print_type (TYPE_FIELD_TYPE (type, i),
 696                           TYPE_FIELD_NAME (type, i),
 697                           stream, show - 1, level + 12, flags);
 698           fprintf_filtered (stream, ";");
 699         }
 700
 701       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 702                         level + 4, "", level, "");
 703     }
 704 }
 705
 706
 707
 708 /* Print function or procedure type TYPE on STREAM.  Make it a header
 709    for function or procedure NAME if NAME is not null.  */
 710
 711 static void
 712 print_func_type (struct type *type, struct ui_file *stream, const char *name,
 713                  const struct type_print_options *flags)
 714 {
 715   int i, len = TYPE_NFIELDS (type);
 716
 717   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 718     fprintf_filtered (stream, "procedure");
 719   else
 720     fprintf_filtered (stream, "function");
 721
 722   if (name != NULL && name[0] != '\0')
 723     fprintf_filtered (stream, " %s", name);
 724
 725   if (len > 0)
 726     {
 727       fprintf_filtered (stream, " (");
 728       for (i = 0; i < len; i += 1)
 729         {
 730           if (i > 0)
 731             {
 732               fputs_filtered ("; ", stream);
 733               wrap_here ("    ");
 734             }
 735           fprintf_filtered (stream, "a%d: ", i + 1);
 736           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0,
 737                           flags);
 738         }
 739       fprintf_filtered (stream, ")");
 740     }
 741
 742   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 743     {
 744       fprintf_filtered (stream, " return ");
 745       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
 746     }
 747 }
 748
 749
 750 /* Print a description of a type TYPE0.
 751    Output goes to STREAM (via stdio).
 752    If VARSTRING is a non-empty string, print as an Ada variable/field
 753        declaration.
 754    SHOW+1 is the maximum number of levels of internal type structure
 755       to show (this applies to record types, enumerated types, and
 756       array types).
 757    SHOW is the number of levels of internal type structure to show
 758       when there is a type name for the SHOWth deepest level (0th is
 759       outer level).
 760    When SHOW<0, no inner structure is shown.
 761    LEVEL indicates level of recursion (for nested definitions).  */
 762
 763 void
 764 ada_print_type (struct type *type0, const char *varstring,
 765                 struct ui_file *stream, int show, int level,
 766                 const struct type_print_options *flags)
 767 {
 768   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 769   char *type_name = decoded_type_name (type0);
 770   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 771
 772   if (type == NULL)
 773     {
 774       if (is_var_decl)
 775         fprintf_filtered (stream, "%.*s: ",
 776                           ada_name_prefix_len (varstring), varstring);
 777       fprintf_filtered (stream, "<null type?>");
 778       return;
 779     }
 780
 781   if (show > 0)
 782     type = ada_check_typedef (type);
 783
 784   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 785     fprintf_filtered (stream, "%.*s: ",
 786                       ada_name_prefix_len (varstring), varstring);
 787
 788   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 789     {
 790       fprintf_filtered (stream, "%.*s",
 791                         ada_name_prefix_len (type_name), type_name);
 792       return;
 793     }
 794
 795   if (ada_is_aligner_type (type))
 796     ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
 797   else if (ada_is_constrained_packed_array_type (type)
 798            && TYPE_CODE (type) != TYPE_CODE_PTR)
 799     print_array_type (type, stream, show, level, flags);
 800   else
 801     switch (TYPE_CODE (type))
 802       {
 803       default:
 804         fprintf_filtered (stream, "<");
 805         c_print_type (type, "", stream, show, level, flags);
 806         fprintf_filtered (stream, ">");
 807         break;
 808       case TYPE_CODE_PTR:
 809       case TYPE_CODE_TYPEDEF:
 810         fprintf_filtered (stream, "access ");
 811         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 812                         flags);
 813         break;
 814       case TYPE_CODE_REF:
 815         fprintf_filtered (stream, "<ref> ");
 816         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 817                         flags);
 818         break;
 819       case TYPE_CODE_ARRAY:
 820         print_array_type (type, stream, show, level, flags);
 821         break;
 822       case TYPE_CODE_BOOL:
 823         fprintf_filtered (stream, "(false, true)");
 824         break;
 825       case TYPE_CODE_INT:
 826         if (ada_is_fixed_point_type (type))
 827           print_fixed_point_type (type, stream);
 828         else
 829           {
 830             const char *name = ada_type_name (type);
 831
 832             if (!ada_is_range_type_name (name))
 833               fprintf_filtered (stream, _("<%d-byte integer>"),
 834                                 TYPE_LENGTH (type));
 835             else
 836               {
 837                 fprintf_filtered (stream, "range ");
 838                 print_range_type (type, stream);
 839               }
 840           }
 841         break;
 842       case TYPE_CODE_RANGE:
 843         if (ada_is_fixed_point_type (type))
 844           print_fixed_point_type (type, stream);
 845         else if (ada_is_modular_type (type))
 846           fprintf_filtered (stream, "mod %s",
 847                             int_string (ada_modulus (type), 10, 0, 0, 1));
 848         else
 849           {
 850             fprintf_filtered (stream, "range ");
 851             print_range (type, stream);
 852           }
 853         break;
 854       case TYPE_CODE_FLT:
 855         fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
 856         break;
 857       case TYPE_CODE_ENUM:
 858         if (show < 0)
 859           fprintf_filtered (stream, "(...)");
 860         else
 861           print_enum_type (type, stream);
 862         break;
 863       case TYPE_CODE_STRUCT:
 864         if (ada_is_array_descriptor_type (type))
 865           print_array_type (type, stream, show, level, flags);
 866         else if (ada_is_bogus_array_descriptor (type))
 867           fprintf_filtered (stream,
 868                             _("array (?) of ? (<mal-formed descriptor>)"));
 869         else
 870           print_record_type (type, stream, show, level, flags);
 871         break;
 872       case TYPE_CODE_UNION:
 873         print_unchecked_union_type (type, stream, show, level, flags);
 874         break;
 875       case TYPE_CODE_FUNC:
 876         print_func_type (type, stream, varstring, flags);
 877         break;
 878       }
 879 }
 880
 881 /* Implement the la_print_typedef language method for Ada.  */
 882
 883 void
 884 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 885                    struct ui_file *stream)
 886 {
 887   type = ada_check_typedef (type);
 888   ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
 889   fprintf_filtered (stream, "\n");
 890 }