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