gdb/p-typeprint.c

   1 /* Support for printing Pascal types for GDB, the GNU debugger.
   2    Copyright (C) 2000-2002, 2006-2012 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 3 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, see <http://www.gnu.org/licenses/>.  */
  18
  19 /* This file is derived from p-typeprint.c */
  20
  21 #include "defs.h"
  22 #include "gdb_obstack.h"
  23 #include "bfd.h"                /* Binary File Description */
  24 #include "symtab.h"
  25 #include "gdbtypes.h"
  26 #include "expression.h"
  27 #include "value.h"
  28 #include "gdbcore.h"
  29 #include "target.h"
  30 #include "language.h"
  31 #include "p-lang.h"
  32 #include "typeprint.h"
  33 #include "gdb-demangle.h"
  34 #include "gdb_string.h"
  35 #include <errno.h>
  36 #include <ctype.h>
  37
  38 static void pascal_type_print_varspec_suffix (struct type *, struct ui_file *,
  39                                               int, int, int);
  40
  41 static void pascal_type_print_derivation_info (struct ui_file *,
  42                                                struct type *);
  43
  44 void pascal_type_print_varspec_prefix (struct type *, struct ui_file *,
  45                                        int, int);
  46 \f
  47
  48 /* LEVEL is the depth to indent lines by.  */
  49
  50 void
  51 pascal_print_type (struct type *type, const char *varstring,
  52                    struct ui_file *stream, int show, int level)
  53 {
  54   enum type_code code;
  55   int demangled_args;
  56
  57   code = TYPE_CODE (type);
  58
  59   if (show > 0)
  60     CHECK_TYPEDEF (type);
  61
  62   if ((code == TYPE_CODE_FUNC
  63        || code == TYPE_CODE_METHOD))
  64     {
  65       pascal_type_print_varspec_prefix (type, stream, show, 0);
  66     }
  67   /* first the name */
  68   fputs_filtered (varstring, stream);
  69
  70   if ((varstring != NULL && *varstring != '\0')
  71       && !(code == TYPE_CODE_FUNC
  72            || code == TYPE_CODE_METHOD))
  73     {
  74       fputs_filtered (" : ", stream);
  75     }
  76
  77   if (!(code == TYPE_CODE_FUNC
  78         || code == TYPE_CODE_METHOD))
  79     {
  80       pascal_type_print_varspec_prefix (type, stream, show, 0);
  81     }
  82
  83   pascal_type_print_base (type, stream, show, level);
  84   /* For demangled function names, we have the arglist as part of the name,
  85      so don't print an additional pair of ()'s.  */
  86
  87   demangled_args = varstring ? strchr (varstring, '(') != NULL : 0;
  88   pascal_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
  89
  90 }
  91
  92 /* Print a typedef using Pascal syntax.  TYPE is the underlying type.
  93    NEW_SYMBOL is the symbol naming the type.  STREAM is the stream on
  94    which to print.  */
  95
  96 void
  97 pascal_print_typedef (struct type *type, struct symbol *new_symbol,
  98                       struct ui_file *stream)
  99 {
 100   CHECK_TYPEDEF (type);
 101   fprintf_filtered (stream, "type ");
 102   fprintf_filtered (stream, "%s = ", SYMBOL_PRINT_NAME (new_symbol));
 103   type_print (type, "", stream, 0);
 104   fprintf_filtered (stream, ";\n");
 105 }
 106
 107 /* If TYPE is a derived type, then print out derivation information.
 108    Print only the actual base classes of this type, not the base classes
 109    of the base classes.  I.e. for the derivation hierarchy:
 110
 111    class A { int a; };
 112    class B : public A {int b; };
 113    class C : public B {int c; };
 114
 115    Print the type of class C as:
 116
 117    class C : public B {
 118    int c;
 119    }
 120
 121    Not as the following (like gdb used to), which is not legal C++ syntax for
 122    derived types and may be confused with the multiple inheritance form:
 123
 124    class C : public B : public A {
 125    int c;
 126    }
 127
 128    In general, gdb should try to print the types as closely as possible to
 129    the form that they appear in the source code.  */
 130
 131 static void
 132 pascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
 133 {
 134   const char *name;
 135   int i;
 136
 137   for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
 138     {
 139       fputs_filtered (i == 0 ? ": " : ", ", stream);
 140       fprintf_filtered (stream, "%s%s ",
 141                         BASETYPE_VIA_PUBLIC (type, i) ? "public" : "private",
 142                         BASETYPE_VIA_VIRTUAL (type, i) ? " virtual" : "");
 143       name = type_name_no_tag (TYPE_BASECLASS (type, i));
 144       fprintf_filtered (stream, "%s", name ? name : "(null)");
 145     }
 146   if (i > 0)
 147     {
 148       fputs_filtered (" ", stream);
 149     }
 150 }
 151
 152 /* Print the Pascal method arguments ARGS to the file STREAM.  */
 153
 154 void
 155 pascal_type_print_method_args (const char *physname, const char *methodname,
 156                                struct ui_file *stream)
 157 {
 158   int is_constructor = (strncmp (physname, "__ct__", 6) == 0);
 159   int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
 160
 161   if (is_constructor || is_destructor)
 162     {
 163       physname += 6;
 164     }
 165
 166   fputs_filtered (methodname, stream);
 167
 168   if (physname && (*physname != 0))
 169     {
 170       fputs_filtered (" (", stream);
 171       /* We must demangle this.  */
 172       while (isdigit (physname[0]))
 173         {
 174           int len = 0;
 175           int i, j;
 176           char *argname;
 177
 178           while (isdigit (physname[len]))
 179             {
 180               len++;
 181             }
 182           i = strtol (physname, &argname, 0);
 183           physname += len;
 184
 185           for (j = 0; j < i; ++j)
 186             fputc_filtered (physname[i], stream);
 187           fputs_filtered (physname, stream);
 188
 189           physname += i;
 190           if (physname[0] != 0)
 191             {
 192               fputs_filtered (", ", stream);
 193             }
 194         }
 195       fputs_filtered (")", stream);
 196     }
 197 }
 198
 199 /* Print any asterisks or open-parentheses needed before the
 200    variable name (to describe its type).
 201
 202    On outermost call, pass 0 for PASSED_A_PTR.
 203    On outermost call, SHOW > 0 means should ignore
 204    any typename for TYPE and show its details.
 205    SHOW is always zero on recursive calls.  */
 206
 207 void
 208 pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
 209                                   int show, int passed_a_ptr)
 210 {
 211   if (type == 0)
 212     return;
 213
 214   if (TYPE_NAME (type) && show <= 0)
 215     return;
 216
 217   QUIT;
 218
 219   switch (TYPE_CODE (type))
 220     {
 221     case TYPE_CODE_PTR:
 222       fprintf_filtered (stream, "^");
 223       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 224       break;                    /* Pointer should be handled normally
 225                                    in pascal.  */
 226
 227     case TYPE_CODE_METHOD:
 228       if (passed_a_ptr)
 229         fprintf_filtered (stream, "(");
 230       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 231         {
 232           fprintf_filtered (stream, "function  ");
 233         }
 234       else
 235         {
 236           fprintf_filtered (stream, "procedure ");
 237         }
 238
 239       if (passed_a_ptr)
 240         {
 241           fprintf_filtered (stream, " ");
 242           pascal_type_print_base (TYPE_DOMAIN_TYPE (type),
 243                                   stream, 0, passed_a_ptr);
 244           fprintf_filtered (stream, "::");
 245         }
 246       break;
 247
 248     case TYPE_CODE_REF:
 249       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 250       fprintf_filtered (stream, "&");
 251       break;
 252
 253     case TYPE_CODE_FUNC:
 254       if (passed_a_ptr)
 255         fprintf_filtered (stream, "(");
 256
 257       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 258         {
 259           fprintf_filtered (stream, "function  ");
 260         }
 261       else
 262         {
 263           fprintf_filtered (stream, "procedure ");
 264         }
 265
 266       break;
 267
 268     case TYPE_CODE_ARRAY:
 269       if (passed_a_ptr)
 270         fprintf_filtered (stream, "(");
 271       fprintf_filtered (stream, "array ");
 272       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
 273         && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 274         fprintf_filtered (stream, "[%s..%s] ",
 275                           plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type)),
 276                           plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type)));
 277       fprintf_filtered (stream, "of ");
 278       break;
 279
 280     case TYPE_CODE_UNDEF:
 281     case TYPE_CODE_STRUCT:
 282     case TYPE_CODE_UNION:
 283     case TYPE_CODE_ENUM:
 284     case TYPE_CODE_INT:
 285     case TYPE_CODE_FLT:
 286     case TYPE_CODE_VOID:
 287     case TYPE_CODE_ERROR:
 288     case TYPE_CODE_CHAR:
 289     case TYPE_CODE_BOOL:
 290     case TYPE_CODE_SET:
 291     case TYPE_CODE_RANGE:
 292     case TYPE_CODE_STRING:
 293     case TYPE_CODE_BITSTRING:
 294     case TYPE_CODE_COMPLEX:
 295     case TYPE_CODE_TYPEDEF:
 296       /* These types need no prefix.  They are listed here so that
 297          gcc -Wall will reveal any types that haven't been handled.  */
 298       break;
 299     default:
 300       error (_("type not handled in pascal_type_print_varspec_prefix()"));
 301       break;
 302     }
 303 }
 304
 305 static void
 306 pascal_print_func_args (struct type *type, struct ui_file *stream)
 307 {
 308   int i, len = TYPE_NFIELDS (type);
 309
 310   if (len)
 311     {
 312       fprintf_filtered (stream, "(");
 313     }
 314   for (i = 0; i < len; i++)
 315     {
 316       if (i > 0)
 317         {
 318           fputs_filtered (", ", stream);
 319           wrap_here ("    ");
 320         }
 321       /*  Can we find if it is a var parameter ??
 322          if ( TYPE_FIELD(type, i) == )
 323          {
 324          fprintf_filtered (stream, "var ");
 325          } */
 326       pascal_print_type (TYPE_FIELD_TYPE (type, i), ""  /* TYPE_FIELD_NAME
 327                                                            seems invalid!  */
 328                          ,stream, -1, 0);
 329     }
 330   if (len)
 331     {
 332       fprintf_filtered (stream, ")");
 333     }
 334 }
 335
 336 /* Print any array sizes, function arguments or close parentheses
 337    needed after the variable name (to describe its type).
 338    Args work like pascal_type_print_varspec_prefix.  */
 339
 340 static void
 341 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
 342                                   int show, int passed_a_ptr,
 343                                   int demangled_args)
 344 {
 345   if (type == 0)
 346     return;
 347
 348   if (TYPE_NAME (type) && show <= 0)
 349     return;
 350
 351   QUIT;
 352
 353   switch (TYPE_CODE (type))
 354     {
 355     case TYPE_CODE_ARRAY:
 356       if (passed_a_ptr)
 357         fprintf_filtered (stream, ")");
 358       break;
 359
 360     case TYPE_CODE_METHOD:
 361       if (passed_a_ptr)
 362         fprintf_filtered (stream, ")");
 363       pascal_type_print_method_args ("",
 364                                      "",
 365                                      stream);
 366       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 367         {
 368           fprintf_filtered (stream, " : ");
 369           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 370                                             stream, 0, 0);
 371           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 372           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 373                                             passed_a_ptr, 0);
 374         }
 375       break;
 376
 377     case TYPE_CODE_PTR:
 378     case TYPE_CODE_REF:
 379       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 380                                         stream, 0, 1, 0);
 381       break;
 382
 383     case TYPE_CODE_FUNC:
 384       if (passed_a_ptr)
 385         fprintf_filtered (stream, ")");
 386       if (!demangled_args)
 387         pascal_print_func_args (type, stream);
 388       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 389         {
 390           fprintf_filtered (stream, " : ");
 391           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 392                                             stream, 0, 0);
 393           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 394           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 395                                             passed_a_ptr, 0);
 396         }
 397       break;
 398
 399     case TYPE_CODE_UNDEF:
 400     case TYPE_CODE_STRUCT:
 401     case TYPE_CODE_UNION:
 402     case TYPE_CODE_ENUM:
 403     case TYPE_CODE_INT:
 404     case TYPE_CODE_FLT:
 405     case TYPE_CODE_VOID:
 406     case TYPE_CODE_ERROR:
 407     case TYPE_CODE_CHAR:
 408     case TYPE_CODE_BOOL:
 409     case TYPE_CODE_SET:
 410     case TYPE_CODE_RANGE:
 411     case TYPE_CODE_STRING:
 412     case TYPE_CODE_BITSTRING:
 413     case TYPE_CODE_COMPLEX:
 414     case TYPE_CODE_TYPEDEF:
 415       /* These types do not need a suffix.  They are listed so that
 416          gcc -Wall will report types that may not have been considered.  */
 417       break;
 418     default:
 419       error (_("type not handled in pascal_type_print_varspec_suffix()"));
 420       break;
 421     }
 422 }
 423
 424 /* Print the name of the type (or the ultimate pointer target,
 425    function value or array element), or the description of a
 426    structure or union.
 427
 428    SHOW positive means print details about the type (e.g. enum values),
 429    and print structure elements passing SHOW - 1 for show.
 430    SHOW negative means just print the type name or struct tag if there is one.
 431    If there is no name, print something sensible but concise like
 432    "struct {...}".
 433    SHOW zero means just print the type name or struct tag if there is one.
 434    If there is no name, print something sensible but not as concise like
 435    "struct {int x; int y;}".
 436
 437    LEVEL is the number of spaces to indent by.
 438    We increase it for some recursive calls.  */
 439
 440 void
 441 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
 442                         int level)
 443 {
 444   int i;
 445   int len;
 446   int lastval;
 447   enum
 448     {
 449       s_none, s_public, s_private, s_protected
 450     }
 451   section_type;
 452
 453   QUIT;
 454   wrap_here ("    ");
 455   if (type == NULL)
 456     {
 457       fputs_filtered ("<type unknown>", stream);
 458       return;
 459     }
 460
 461   /* void pointer */
 462   if ((TYPE_CODE (type) == TYPE_CODE_PTR)
 463       && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
 464     {
 465       fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
 466                       stream);
 467       return;
 468     }
 469   /* When SHOW is zero or less, and there is a valid type name, then always
 470      just print the type name directly from the type.  */
 471
 472   if (show <= 0
 473       && TYPE_NAME (type) != NULL)
 474     {
 475       fputs_filtered (TYPE_NAME (type), stream);
 476       return;
 477     }
 478
 479   CHECK_TYPEDEF (type);
 480
 481   switch (TYPE_CODE (type))
 482     {
 483     case TYPE_CODE_TYPEDEF:
 484     case TYPE_CODE_PTR:
 485     case TYPE_CODE_REF:
 486       /* case TYPE_CODE_FUNC:
 487          case TYPE_CODE_METHOD: */
 488       pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 489       break;
 490
 491     case TYPE_CODE_ARRAY:
 492       /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 493                                            stream, 0, 0);
 494          pascal_type_print_base (TYPE_TARGET_TYPE (type),
 495                                  stream, show, level);
 496          pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 497                                            stream, 0, 0, 0); */
 498       pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0);
 499       break;
 500
 501     case TYPE_CODE_FUNC:
 502     case TYPE_CODE_METHOD:
 503       /*
 504          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 505          only after args !!  */
 506       break;
 507     case TYPE_CODE_STRUCT:
 508       if (TYPE_TAG_NAME (type) != NULL)
 509         {
 510           fputs_filtered (TYPE_TAG_NAME (type), stream);
 511           fputs_filtered (" = ", stream);
 512         }
 513       if (HAVE_CPLUS_STRUCT (type))
 514         {
 515           fprintf_filtered (stream, "class ");
 516         }
 517       else
 518         {
 519           fprintf_filtered (stream, "record ");
 520         }
 521       goto struct_union;
 522
 523     case TYPE_CODE_UNION:
 524       if (TYPE_TAG_NAME (type) != NULL)
 525         {
 526           fputs_filtered (TYPE_TAG_NAME (type), stream);
 527           fputs_filtered (" = ", stream);
 528         }
 529       fprintf_filtered (stream, "case <?> of ");
 530
 531     struct_union:
 532       wrap_here ("    ");
 533       if (show < 0)
 534         {
 535           /* If we just printed a tag name, no need to print anything else.  */
 536           if (TYPE_TAG_NAME (type) == NULL)
 537             fprintf_filtered (stream, "{...}");
 538         }
 539       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 540         {
 541           pascal_type_print_derivation_info (stream, type);
 542
 543           fprintf_filtered (stream, "\n");
 544           if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
 545             {
 546               if (TYPE_STUB (type))
 547                 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
 548               else
 549                 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
 550             }
 551
 552           /* Start off with no specific section type, so we can print
 553              one for the first field we find, and use that section type
 554              thereafter until we find another type.  */
 555
 556           section_type = s_none;
 557
 558           /* If there is a base class for this type,
 559              do not print the field that it occupies.  */
 560
 561           len = TYPE_NFIELDS (type);
 562           for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 563             {
 564               QUIT;
 565               /* Don't print out virtual function table.  */
 566               if ((strncmp (TYPE_FIELD_NAME (type, i), "_vptr", 5) == 0)
 567                   && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
 568                 continue;
 569
 570               /* If this is a pascal object or class we can print the
 571                  various section labels.  */
 572
 573               if (HAVE_CPLUS_STRUCT (type))
 574                 {
 575                   if (TYPE_FIELD_PROTECTED (type, i))
 576                     {
 577                       if (section_type != s_protected)
 578                         {
 579                           section_type = s_protected;
 580                           fprintfi_filtered (level + 2, stream,
 581                                              "protected\n");
 582                         }
 583                     }
 584                   else if (TYPE_FIELD_PRIVATE (type, i))
 585                     {
 586                       if (section_type != s_private)
 587                         {
 588                           section_type = s_private;
 589                           fprintfi_filtered (level + 2, stream, "private\n");
 590                         }
 591                     }
 592                   else
 593                     {
 594                       if (section_type != s_public)
 595                         {
 596                           section_type = s_public;
 597                           fprintfi_filtered (level + 2, stream, "public\n");
 598                         }
 599                     }
 600                 }
 601
 602               print_spaces_filtered (level + 4, stream);
 603               if (field_is_static (&TYPE_FIELD (type, i)))
 604                 fprintf_filtered (stream, "static ");
 605               pascal_print_type (TYPE_FIELD_TYPE (type, i),
 606                                  TYPE_FIELD_NAME (type, i),
 607                                  stream, show - 1, level + 4);
 608               if (!field_is_static (&TYPE_FIELD (type, i))
 609                   && TYPE_FIELD_PACKED (type, i))
 610                 {
 611                   /* It is a bitfield.  This code does not attempt
 612                      to look at the bitpos and reconstruct filler,
 613                      unnamed fields.  This would lead to misleading
 614                      results if the compiler does not put out fields
 615                      for such things (I don't know what it does).  */
 616                   fprintf_filtered (stream, " : %d",
 617                                     TYPE_FIELD_BITSIZE (type, i));
 618                 }
 619               fprintf_filtered (stream, ";\n");
 620             }
 621
 622           /* If there are both fields and methods, put a space between.  */
 623           len = TYPE_NFN_FIELDS (type);
 624           if (len && section_type != s_none)
 625             fprintf_filtered (stream, "\n");
 626
 627           /* Object pascal: print out the methods.  */
 628
 629           for (i = 0; i < len; i++)
 630             {
 631               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 632               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 633               const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 634
 635               /* this is GNU C++ specific
 636                  how can we know constructor/destructor?
 637                  It might work for GNU pascal.  */
 638               for (j = 0; j < len2; j++)
 639                 {
 640                   const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 641
 642                   int is_constructor = (strncmp (physname, "__ct__", 6) == 0);
 643                   int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
 644
 645                   QUIT;
 646                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 647                     {
 648                       if (section_type != s_protected)
 649                         {
 650                           section_type = s_protected;
 651                           fprintfi_filtered (level + 2, stream,
 652                                              "protected\n");
 653                         }
 654                     }
 655                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 656                     {
 657                       if (section_type != s_private)
 658                         {
 659                           section_type = s_private;
 660                           fprintfi_filtered (level + 2, stream, "private\n");
 661                         }
 662                     }
 663                   else
 664                     {
 665                       if (section_type != s_public)
 666                         {
 667                           section_type = s_public;
 668                           fprintfi_filtered (level + 2, stream, "public\n");
 669                         }
 670                     }
 671
 672                   print_spaces_filtered (level + 4, stream);
 673                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 674                     fprintf_filtered (stream, "static ");
 675                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
 676                     {
 677                       /* Keep GDB from crashing here.  */
 678                       fprintf_filtered (stream, "<undefined type> %s;\n",
 679                                         TYPE_FN_FIELD_PHYSNAME (f, j));
 680                       break;
 681                     }
 682
 683                   if (is_constructor)
 684                     {
 685                       fprintf_filtered (stream, "constructor ");
 686                     }
 687                   else if (is_destructor)
 688                     {
 689                       fprintf_filtered (stream, "destructor  ");
 690                     }
 691                   else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 692                            && TYPE_CODE (TYPE_TARGET_TYPE (
 693                                 TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 694                     {
 695                       fprintf_filtered (stream, "function  ");
 696                     }
 697                   else
 698                     {
 699                       fprintf_filtered (stream, "procedure ");
 700                     }
 701                   /* This does not work, no idea why !!  */
 702
 703                   pascal_type_print_method_args (physname,
 704                                                  method_name,
 705                                                  stream);
 706
 707                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 708                       && TYPE_CODE (TYPE_TARGET_TYPE (
 709                            TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 710                     {
 711                       fputs_filtered (" : ", stream);
 712                       type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
 713                                   "", stream, -1);
 714                     }
 715                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
 716                     fprintf_filtered (stream, "; virtual");
 717
 718                   fprintf_filtered (stream, ";\n");
 719                 }
 720             }
 721           fprintfi_filtered (level, stream, "end");
 722         }
 723       break;
 724
 725     case TYPE_CODE_ENUM:
 726       if (TYPE_TAG_NAME (type) != NULL)
 727         {
 728           fputs_filtered (TYPE_TAG_NAME (type), stream);
 729           if (show > 0)
 730             fputs_filtered (" ", stream);
 731         }
 732       /* enum is just defined by
 733          type enume_name = (enum_member1,enum_member2,...)  */
 734       fprintf_filtered (stream, " = ");
 735       wrap_here ("    ");
 736       if (show < 0)
 737         {
 738           /* If we just printed a tag name, no need to print anything else.  */
 739           if (TYPE_TAG_NAME (type) == NULL)
 740             fprintf_filtered (stream, "(...)");
 741         }
 742       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 743         {
 744           fprintf_filtered (stream, "(");
 745           len = TYPE_NFIELDS (type);
 746           lastval = 0;
 747           for (i = 0; i < len; i++)
 748             {
 749               QUIT;
 750               if (i)
 751                 fprintf_filtered (stream, ", ");
 752               wrap_here ("    ");
 753               fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 754               if (lastval != TYPE_FIELD_BITPOS (type, i))
 755                 {
 756                   fprintf_filtered (stream,
 757                                     " := %d", TYPE_FIELD_BITPOS (type, i));
 758                   lastval = TYPE_FIELD_BITPOS (type, i);
 759                 }
 760               lastval++;
 761             }
 762           fprintf_filtered (stream, ")");
 763         }
 764       break;
 765
 766     case TYPE_CODE_VOID:
 767       fprintf_filtered (stream, "void");
 768       break;
 769
 770     case TYPE_CODE_UNDEF:
 771       fprintf_filtered (stream, "record <unknown>");
 772       break;
 773
 774     case TYPE_CODE_ERROR:
 775       fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
 776       break;
 777
 778       /* this probably does not work for enums.  */
 779     case TYPE_CODE_RANGE:
 780       {
 781         struct type *target = TYPE_TARGET_TYPE (type);
 782
 783         print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
 784         fputs_filtered ("..", stream);
 785         print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
 786       }
 787       break;
 788
 789     case TYPE_CODE_SET:
 790       fputs_filtered ("set of ", stream);
 791       pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
 792                          show - 1, level);
 793       break;
 794
 795     case TYPE_CODE_BITSTRING:
 796       fputs_filtered ("BitString", stream);
 797       break;
 798
 799     case TYPE_CODE_STRING:
 800       fputs_filtered ("String", stream);
 801       break;
 802
 803     default:
 804       /* Handle types not explicitly handled by the other cases,
 805          such as fundamental types.  For these, just print whatever
 806          the type name is, as recorded in the type itself.  If there
 807          is no type name, then complain.  */
 808       if (TYPE_NAME (type) != NULL)
 809         {
 810           fputs_filtered (TYPE_NAME (type), stream);
 811         }
 812       else
 813         {
 814           /* At least for dump_symtab, it is important that this not be
 815              an error ().  */
 816           fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
 817                             TYPE_CODE (type));
 818         }
 819       break;
 820     }
 821 }