gdb/ada-typeprint.c

   1 /* Support for printing Ada types for GDB, the GNU debugger.
   2    Copyright 1986, 1988, 1989, 1991, 1997 Free Software Foundation, Inc.
   3
   4 This file is part of GDB.
   5
   6 This program is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2 of the License, or
   9 (at your option) any later version.
  10
  11 This program is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with this program; if not, write to the Free Software
  18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20 #include "defs.h"
  21 #include "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 <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*, struct type*);
  47
  48 static void print_range (struct type*, struct ui_file*);
  49
  50 static void print_range_bound (struct type*, char*, int*, struct ui_file*);
  51
  52 static void
  53 print_dynamic_range_bound (struct type*, const char*, int,
  54                            const char*, struct ui_file*);
  55
  56 static void print_range_type_named (char*, struct ui_file*);
  57
  58 \f
  59
  60 static char* name_buffer;
  61 static int name_buffer_len;
  62
  63 /* The (demangled) Ada name of TYPE. This value persists until the
  64    next call. */
  65
  66 static char*
  67 demangled_type_name (type)
  68      struct type *type;
  69 {
  70   if (ada_type_name (type) == NULL)
  71     return NULL;
  72   else
  73     {
  74       char* raw_name = ada_type_name (type);
  75       char *s, *q;
  76
  77       if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
  78         {
  79           name_buffer_len = 16 + 2 * strlen (raw_name);
  80           name_buffer = xrealloc (name_buffer, name_buffer_len);
  81         }
  82       strcpy (name_buffer, raw_name);
  83
  84       s = (char*) strstr (name_buffer, "___");
  85       if (s != NULL)
  86         *s = '\0';
  87
  88       s = name_buffer + strlen (name_buffer) - 1;
  89       while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
  90         s -= 1;
  91
  92       if (s == name_buffer)
  93         return name_buffer;
  94
  95       if (! islower (s[1]))
  96         return NULL;
  97
  98       for (s = q = name_buffer; *s != '\0'; q += 1)
  99         {
 100           if (s[0] == '_' && s[1] == '_')
 101             {
 102               *q = '.'; s += 2;
 103             }
 104           else
 105             {
 106               *q = *s; s += 1;
 107             }
 108         }
 109       *q = '\0';
 110       return name_buffer;
 111     }
 112 }
 113
 114
 115 /* Print a description of a type in the format of a
 116    typedef for the current language.
 117    NEW is the new name for a type TYPE. */
 118
 119 void
 120 ada_typedef_print (type, new, stream)
 121    struct type *type;
 122    struct symbol *new;
 123    struct ui_file *stream;
 124 {
 125   fprintf_filtered (stream, "type %.*s is ",
 126                     ada_name_prefix_len (SYMBOL_SOURCE_NAME(new)),
 127                     SYMBOL_SOURCE_NAME(new));
 128   type_print (type, "", stream, 1);
 129 }
 130
 131 /* Print range type TYPE on STREAM. */
 132
 133 static void
 134 print_range (type, stream)
 135      struct type* type;
 136      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_ada_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          Note that 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 (type, bounds, n, stream)
 187      struct type* type;
 188      char* bounds;
 189      int* n;
 190      struct ui_file* stream;
 191 {
 192   LONGEST B;
 193   if (ada_scan_number (bounds, *n, &B, n))
 194     {
 195       ada_print_scalar (type, B, stream);
 196       if (bounds[*n] == '_')
 197         *n += 2;
 198     }
 199   else
 200     {
 201       int bound_len;
 202       char* bound = bounds + *n;
 203       char* pend;
 204
 205       pend = strstr (bound, "__");
 206       if (pend == NULL)
 207         *n += bound_len = strlen (bound);
 208       else
 209         {
 210           bound_len = pend - bound;
 211           *n += bound_len + 2;
 212         }
 213       fprintf_filtered (stream, "%.*s", bound_len, bound);
 214     }
 215 }
 216
 217 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
 218    the value (if found) of the bound indicated by SUFFIX ("___L" or
 219    "___U") according to the ___XD conventions. */
 220
 221 static void
 222 print_dynamic_range_bound (type, name, name_len, suffix, stream)
 223      struct type* type;
 224      const char* name;
 225      int name_len;
 226      const char* suffix;
 227      struct ui_file* stream;
 228 {
 229   static char *name_buf = NULL;
 230   static size_t name_buf_len = 0;
 231   LONGEST B;
 232   int OK;
 233
 234   GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
 235   strncpy (name_buf, name, name_len);
 236   strcpy (name_buf + name_len, suffix);
 237
 238   B = get_int_var_value (name_buf, 0, &OK);
 239   if (OK)
 240     ada_print_scalar (type, B, stream);
 241   else
 242     fprintf_filtered (stream, "?");
 243 }
 244
 245 /* Print the range type named NAME. */
 246
 247 static void
 248 print_range_type_named (name, stream)
 249      char* name;
 250      struct ui_file* stream;
 251 {
 252   struct type *raw_type = ada_find_any_type (name);
 253   struct type *base_type;
 254   LONGEST low, high;
 255   char* subtype_info;
 256
 257   if (raw_type == NULL)
 258     base_type = builtin_type_int;
 259   else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
 260     base_type = TYPE_TARGET_TYPE (raw_type);
 261   else
 262     base_type = raw_type;
 263
 264   subtype_info = strstr (name, "___XD");
 265   if (subtype_info == NULL && raw_type == NULL)
 266     fprintf_filtered (stream, "? .. ?");
 267   else if (subtype_info == NULL)
 268     print_range (raw_type, stream);
 269   else
 270     {
 271       int prefix_len = subtype_info - name;
 272       char *bounds_str;
 273       int n;
 274
 275       subtype_info += 5;
 276       bounds_str = strchr (subtype_info, '_');
 277       n = 1;
 278
 279       if (*subtype_info == 'L')
 280         {
 281           print_range_bound (raw_type, bounds_str, &n, stream);
 282           subtype_info += 1;
 283         }
 284       else
 285         print_dynamic_range_bound (raw_type, name, prefix_len, "___L", stream);
 286
 287       fprintf_filtered (stream, " .. ");
 288
 289       if (*subtype_info == 'U')
 290         print_range_bound (raw_type, bounds_str, &n, stream);
 291       else
 292         print_dynamic_range_bound (raw_type, name, prefix_len, "___U", stream);
 293     }
 294 }
 295
 296 /* Print enumerated type TYPE on STREAM. */
 297
 298 static void
 299 print_enum_type (type, stream)
 300      struct type *type;
 301      struct ui_file *stream;
 302 {
 303   int len = TYPE_NFIELDS (type);
 304   int i, lastval;
 305
 306   fprintf_filtered (stream, "(");
 307   wrap_here (" ");
 308
 309   lastval = 0;
 310   for (i = 0; i < len; i++)
 311     {
 312       QUIT;
 313       if (i) fprintf_filtered (stream, ", ");
 314       wrap_here ("    ");
 315       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 316       if (lastval != TYPE_FIELD_BITPOS (type, i))
 317         {
 318           fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
 319           lastval = TYPE_FIELD_BITPOS (type, i);
 320         }
 321       lastval += 1;
 322     }
 323   fprintf_filtered (stream, ")");
 324 }
 325
 326 /* Print representation of Ada fixed-point type TYPE on STREAM. */
 327
 328 static void
 329 print_fixed_point_type (type, stream)
 330      struct type *type;
 331      struct ui_file *stream;
 332 {
 333   DOUBLEST delta = ada_delta (type);
 334   DOUBLEST small = ada_fixed_to_float (type, 1.0);
 335
 336   if (delta < 0.0)
 337     fprintf_filtered (stream, "delta ??");
 338   else
 339     {
 340       fprintf_filtered (stream, "delta %g", (double) delta);
 341       if (delta != small)
 342         fprintf_filtered (stream, " <'small = %g>", (double) small);
 343     }
 344 }
 345
 346 /* Print representation of special VAX floating-point type TYPE on STREAM. */
 347
 348 static void
 349 print_vax_floating_point_type (type, stream)
 350      struct type *type;
 351      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 (type, stream, show, level)
 364      struct type *type;
 365      struct ui_file *stream;
 366      int show;
 367      int level;
 368 {
 369   int bitsize;
 370   int n_indices;
 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 (ada_is_packed_array_type (type))
 381         type = ada_coerce_to_simple_array_type (type);
 382       if (ada_is_simple_array (type))
 383         {
 384           struct type* range_desc_type =
 385             ada_find_parallel_type (type, "___XA");
 386           struct type* arr_type;
 387
 388           bitsize = 0;
 389           if (range_desc_type == NULL)
 390             {
 391               for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
 392                    arr_type = TYPE_TARGET_TYPE (arr_type))
 393                 {
 394                   if (arr_type != type)
 395                     fprintf_filtered (stream, ", ");
 396                   print_range (TYPE_INDEX_TYPE (arr_type), stream);
 397                   if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 398                     bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 399                 }
 400             }
 401           else
 402             {
 403               int k;
 404               n_indices = TYPE_NFIELDS (range_desc_type);
 405               for (k = 0, arr_type = type;
 406                    k < n_indices;
 407                    k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
 408                 {
 409                   if (k > 0)
 410                     fprintf_filtered (stream, ", ");
 411                   print_range_type_named (TYPE_FIELD_NAME (range_desc_type, k),
 412                                           stream);
 413                   if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 414                     bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 415                 }
 416             }
 417         }
 418       else
 419         {
 420           int i, i0;
 421           for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
 422             fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
 423         }
 424     }
 425
 426   fprintf_filtered (stream, ") of ");
 427   wrap_here ("");
 428   ada_print_type (ada_array_element_type (type, n_indices), "", stream,
 429                   show == 0 ? 0 : show-1, level+1);
 430   if (bitsize > 0)
 431     fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
 432 }
 433
 434 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
 435    STREAM, assuming the VAL_TYPE is the type of the values. */
 436
 437 static void
 438 print_choices (type, field_num, stream, val_type)
 439      struct type *type;
 440      int field_num;
 441      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'
 489                 || ! 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 (type, field_num, outer_type, stream, show, level)
 519      struct type *type;
 520      int field_num;
 521      struct type *outer_type;
 522      struct ui_file *stream;
 523      int show;
 524      int level;
 525 {
 526   int i;
 527   struct type *var_type;
 528   struct type *discr_type;
 529
 530   var_type = TYPE_FIELD_TYPE (type, field_num);
 531   discr_type = ada_variant_discrim_type (var_type, outer_type);
 532
 533   if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
 534     {
 535       var_type = TYPE_TARGET_TYPE (var_type);
 536       if (TYPE_FLAGS (var_type) & TYPE_FLAG_STUB)
 537         {
 538           var_type = ada_find_parallel_type (var_type, "___XVU");
 539           if (var_type == NULL)
 540             return;
 541         }
 542     }
 543
 544   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 545     {
 546       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 547       print_choices (var_type, i, stream, discr_type);
 548       fprintf_filtered (stream, " =>");
 549       if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 550                                     outer_type, stream, show, level+4) <= 0)
 551         fprintf_filtered (stream, " null;");
 552     }
 553 }
 554
 555 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 556    discriminants are contained in OUTER_TYPE, print a description of it
 557    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
 558    the fields themselves have nested structure, and SHOW is the number of
 559    levels of internal structure to show (see ada_print_type). For this
 560    purpose, fields nested in a variant part are taken to be at the same
 561    level as the fields immediately outside the variant part. */
 562
 563 static void
 564 print_variant_part (type, field_num, outer_type, stream, show, level)
 565      struct type *type;
 566      int field_num;
 567      struct type *outer_type;
 568      struct ui_file *stream;
 569      int show;
 570      int level;
 571 {
 572   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 573                     ada_variant_discrim_name
 574                       (TYPE_FIELD_TYPE (type, field_num)));
 575   print_variant_clauses (type, field_num, outer_type, stream, show, level + 4);
 576   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 577 }
 578
 579 /* Print a description on STREAM of the fields in record type TYPE, whose
 580    discriminants are in OUTER_TYPE.  LEVEL is the recursion (indentation)
 581    level, in case any of the fields themselves have nested structure,
 582    and SHOW is the number of levels of internal structure to show
 583    (see ada_print_type).  Does not print parent type information of TYPE.
 584    Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
 585    Prints each field beginning on a new line, but does not put a new line at
 586    end. */
 587
 588 static int
 589 print_record_field_types (type, outer_type, stream, show, level)
 590      struct type *type;
 591      struct type *outer_type;
 592      struct ui_file *stream;
 593      int show;
 594      int level;
 595 {
 596   int len, i, flds;
 597
 598   flds = 0;
 599   len = TYPE_NFIELDS (type);
 600
 601   if (len == 0 && (TYPE_FLAGS (type) & TYPE_FLAG_STUB) != 0)
 602     return -1;
 603
 604   for (i = 0; i < len; i += 1)
 605     {
 606       QUIT;
 607
 608       if (ada_is_parent_field (type, i)
 609           || ada_is_ignored_field (type, i))
 610         ;
 611       else if (ada_is_wrapper_field (type, i))
 612         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 613                                           stream, show, level);
 614       else if (ada_is_variant_part (type, i))
 615         {
 616           print_variant_part (type, i, outer_type, stream, show, level);
 617           flds = 1;
 618         }
 619       else
 620         {
 621           flds += 1;
 622           fprintf_filtered (stream, "\n%*s", level + 4, "");
 623           ada_print_type (TYPE_FIELD_TYPE (type, i),
 624                           TYPE_FIELD_NAME (type, i),
 625                           stream, show - 1, level + 4);
 626           fprintf_filtered (stream, ";");
 627         }
 628     }
 629
 630   return flds;
 631 }
 632
 633 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
 634    level, in case the element type itself has nested structure, and SHOW is
 635    the number of levels of internal structure to show (see ada_print_type). */
 636
 637 static void
 638 print_record_type (type0, stream, show, level)
 639      struct type* type0;
 640      struct ui_file* stream;
 641      int show;
 642      int level;
 643 {
 644   struct type* parent_type;
 645   struct type* type;
 646
 647   type = type0;
 648   if (TYPE_FLAGS (type) & TYPE_FLAG_STUB)
 649     {
 650       struct type* type1 = ada_find_parallel_type (type, "___XVE");
 651       if (type1 != NULL)
 652         type = type1;
 653     }
 654
 655   parent_type = ada_parent_type (type);
 656   if (ada_type_name (parent_type) != NULL)
 657     fprintf_filtered (stream, "new %s with ",
 658                       demangled_type_name (parent_type));
 659   else if (parent_type == NULL && ada_is_tagged_type (type))
 660     fprintf_filtered (stream, "tagged ");
 661
 662   fprintf_filtered (stream, "record");
 663
 664   if (show < 0)
 665     fprintf_filtered (stream, " ... end record");
 666   else
 667     {
 668       int flds;
 669
 670       flds = 0;
 671       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 672         flds += print_record_field_types (parent_type, parent_type,
 673                                           stream, show, level);
 674       flds += print_record_field_types (type, type, stream, show, level);
 675
 676       if (flds > 0)
 677         fprintf_filtered (stream, "\n%*send record", level, "");
 678       else if (flds < 0)
 679         fprintf_filtered (stream, " <incomplete type> end record");
 680       else
 681         fprintf_filtered (stream, " null; end record");
 682     }
 683 }
 684
 685 /* Print the unchecked union type TYPE in something resembling Ada
 686    format on STREAM. LEVEL is the recursion (indentation) level
 687    in case the element type itself has nested structure, and SHOW is the
 688    number of levels of internal structure to show (see ada_print_type). */
 689 static void
 690 print_unchecked_union_type (struct type* type, struct ui_file* stream,
 691                             int show, int level)
 692 {
 693   fprintf_filtered (stream, "record (?) is");
 694
 695   if (show < 0)
 696     fprintf_filtered (stream, " ... end record");
 697   else if (TYPE_NFIELDS (type) == 0)
 698     fprintf_filtered (stream, " null; end record");
 699   else
 700     {
 701       int i;
 702
 703       fprintf_filtered (stream, "\n%*scase ? is",
 704                         level+4, "");
 705
 706       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 707         {
 708           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level+8, "",
 709                             level+12, "");
 710           ada_print_type (TYPE_FIELD_TYPE (type, i),
 711                           TYPE_FIELD_NAME (type, i),
 712                           stream, show - 1, level + 12);
 713           fprintf_filtered (stream, ";");
 714         }
 715
 716       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 717                         level+4, "", level, "");
 718     }
 719 }
 720
 721
 722
 723 /* Print function or procedure type TYPE on STREAM.  Make it a header
 724    for function or procedure NAME if NAME is not null. */
 725
 726 static void
 727 print_func_type (type, stream, name)
 728      struct type *type;
 729      struct ui_file *stream;
 730      char* name;
 731 {
 732   int i, len = TYPE_NFIELDS (type);
 733
 734   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 735     fprintf_filtered (stream, "procedure");
 736   else
 737     fprintf_filtered (stream, "function");
 738
 739   if (name != NULL && name[0] != '\0')
 740     fprintf_filtered (stream, " %s", name);
 741
 742   if (len > 0)
 743     {
 744       fprintf_filtered (stream, " (");
 745       for (i = 0; i < len; i += 1)
 746         {
 747           if (i > 0)
 748             {
 749               fputs_filtered ("; ", stream);
 750               wrap_here ("    ");
 751             }
 752           fprintf_filtered (stream, "a%d: ", i+1);
 753           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
 754         }
 755       fprintf_filtered (stream, ")");
 756     }
 757
 758   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 759     {
 760       fprintf_filtered (stream, " return ");
 761       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
 762     }
 763 }
 764
 765
 766 /* Print a description of a type TYPE0.
 767    Output goes to STREAM (via stdio).
 768    If VARSTRING is a non-empty string, print as an Ada variable/field
 769        declaration.
 770    SHOW+1 is the maximum number of levels of internal type structure
 771       to show (this applies to record types, enumerated types, and
 772       array types).
 773    SHOW is the number of levels of internal type structure to show
 774       when there is a type name for the SHOWth deepest level (0th is
 775       outer level).
 776    When SHOW<0, no inner structure is shown.
 777    LEVEL indicates level of recursion (for nested definitions). */
 778
 779 void
 780 ada_print_type (type0, varstring, stream, show, level)
 781      struct type* type0;
 782      char* varstring;
 783      struct ui_file* stream;
 784      int show;
 785      int level;
 786 {
 787   enum type_code code;
 788   int demangled_args;
 789   struct type* type = ada_completed_type (ada_get_base_type (type0));
 790   char* type_name = demangled_type_name (type);
 791   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 792
 793   if (type == NULL)
 794     {
 795       if (is_var_decl)
 796         fprintf_filtered (stream, "%.*s: ",
 797                           ada_name_prefix_len(varstring),
 798                           varstring);
 799       fprintf_filtered (stream, "<null type?>");
 800       return;
 801     }
 802
 803   if (show > 0)
 804       CHECK_TYPEDEF (type);
 805
 806   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 807       fprintf_filtered (stream, "%.*s: ",
 808                         ada_name_prefix_len (varstring), varstring);
 809
 810   if (type_name != NULL && show <= 0)
 811     {
 812       fprintf_filtered (stream, "%.*s",
 813                         ada_name_prefix_len (type_name), type_name);
 814       return;
 815     }
 816
 817   if (ada_is_aligner_type (type))
 818     ada_print_type (ada_aligned_type (type), "", stream, show, level);
 819   else if (ada_is_packed_array_type (type))
 820     print_array_type (type, stream, show, level);
 821   else
 822   switch (TYPE_CODE (type))
 823     {
 824     default:
 825       fprintf_filtered (stream, "<");
 826       c_print_type (type, "", stream, show, level);
 827       fprintf_filtered (stream, ">");
 828       break;
 829     case TYPE_CODE_PTR:
 830       fprintf_filtered (stream, "access ");
 831       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show,
 832                       level);
 833       break;
 834     case TYPE_CODE_REF:
 835       fprintf_filtered (stream, "<ref> ");
 836       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show,
 837                       level);
 838       break;
 839     case TYPE_CODE_ARRAY:
 840       print_array_type (type, stream, show, level);
 841       break;
 842     case TYPE_CODE_INT:
 843       if (ada_is_fixed_point_type (type))
 844         print_fixed_point_type (type, stream);
 845       else if (ada_is_vax_floating_type (type))
 846         print_vax_floating_point_type (type, stream);
 847       else
 848         {
 849           char* name = ada_type_name (type);
 850           if (! ada_is_range_type_name (name))
 851             fprintf_filtered (stream, "<%d-byte integer>", TYPE_LENGTH (type));
 852           else
 853             {
 854               fprintf_filtered (stream, "range ");
 855               print_range_type_named (name, stream);
 856             }
 857         }
 858       break;
 859     case TYPE_CODE_RANGE:
 860       if (ada_is_fixed_point_type (type))
 861         print_fixed_point_type (type, stream);
 862       else if (ada_is_vax_floating_type (type))
 863         print_vax_floating_point_type (type, stream);
 864       else if (ada_is_modular_type (type))
 865         fprintf_filtered (stream, "mod %ld", (long) ada_modulus (type));
 866       else
 867         {
 868           fprintf_filtered (stream, "range ");
 869           print_range (type, stream);
 870         }
 871       break;
 872     case TYPE_CODE_FLT:
 873       fprintf_filtered (stream, "<%d-byte float>", TYPE_LENGTH (type));
 874       break;
 875     case TYPE_CODE_ENUM:
 876       if (show < 0)
 877         fprintf_filtered (stream, "(...)");
 878       else
 879         print_enum_type (type, stream);
 880       break;
 881     case TYPE_CODE_STRUCT:
 882       if (ada_is_array_descriptor (type))
 883         print_array_type (type, stream, show, level);
 884       else if (ada_is_bogus_array_descriptor (type))
 885         fprintf_filtered (stream, "array (?) of ? (<mal-formed descriptor>)");
 886       else
 887         print_record_type (type, stream, show, level);
 888       break;
 889     case TYPE_CODE_UNION:
 890       print_unchecked_union_type (type, stream, show, level);
 891       break;
 892     case TYPE_CODE_FUNC:
 893       print_func_type (type, stream, varstring);
 894       break;
 895     }
 896 }