gdb/p-typeprint.c

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