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[j], stream);
 187
 188           physname += i;
 189           if (physname[0] != 0)
 190             {
 191               fputs_filtered (", ", stream);
 192             }
 193         }
 194       fputs_filtered (")", stream);
 195     }
 196 }
 197
 198 /* Print any asterisks or open-parentheses needed before the
 199    variable name (to describe its type).
 200
 201    On outermost call, pass 0 for PASSED_A_PTR.
 202    On outermost call, SHOW > 0 means should ignore
 203    any typename for TYPE and show its details.
 204    SHOW is always zero on recursive calls.  */
 205
 206 void
 207 pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
 208                                   int show, int passed_a_ptr)
 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       break;                    /* Pointer should be handled normally
 224                                    in pascal.  */
 225
 226     case TYPE_CODE_METHOD:
 227       if (passed_a_ptr)
 228         fprintf_filtered (stream, "(");
 229       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 230         {
 231           fprintf_filtered (stream, "function  ");
 232         }
 233       else
 234         {
 235           fprintf_filtered (stream, "procedure ");
 236         }
 237
 238       if (passed_a_ptr)
 239         {
 240           fprintf_filtered (stream, " ");
 241           pascal_type_print_base (TYPE_DOMAIN_TYPE (type),
 242                                   stream, 0, passed_a_ptr);
 243           fprintf_filtered (stream, "::");
 244         }
 245       break;
 246
 247     case TYPE_CODE_REF:
 248       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 249       fprintf_filtered (stream, "&");
 250       break;
 251
 252     case TYPE_CODE_FUNC:
 253       if (passed_a_ptr)
 254         fprintf_filtered (stream, "(");
 255
 256       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 257         {
 258           fprintf_filtered (stream, "function  ");
 259         }
 260       else
 261         {
 262           fprintf_filtered (stream, "procedure ");
 263         }
 264
 265       break;
 266
 267     case TYPE_CODE_ARRAY:
 268       if (passed_a_ptr)
 269         fprintf_filtered (stream, "(");
 270       fprintf_filtered (stream, "array ");
 271       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
 272         && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 273         fprintf_filtered (stream, "[%s..%s] ",
 274                           plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type)),
 275                           plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type)));
 276       fprintf_filtered (stream, "of ");
 277       break;
 278
 279     case TYPE_CODE_UNDEF:
 280     case TYPE_CODE_STRUCT:
 281     case TYPE_CODE_UNION:
 282     case TYPE_CODE_ENUM:
 283     case TYPE_CODE_INT:
 284     case TYPE_CODE_FLT:
 285     case TYPE_CODE_VOID:
 286     case TYPE_CODE_ERROR:
 287     case TYPE_CODE_CHAR:
 288     case TYPE_CODE_BOOL:
 289     case TYPE_CODE_SET:
 290     case TYPE_CODE_RANGE:
 291     case TYPE_CODE_STRING:
 292     case TYPE_CODE_COMPLEX:
 293     case TYPE_CODE_TYPEDEF:
 294       /* These types need no prefix.  They are listed here so that
 295          gcc -Wall will reveal any types that haven't been handled.  */
 296       break;
 297     default:
 298       error (_("type not handled in pascal_type_print_varspec_prefix()"));
 299       break;
 300     }
 301 }
 302
 303 static void
 304 pascal_print_func_args (struct type *type, struct ui_file *stream)
 305 {
 306   int i, len = TYPE_NFIELDS (type);
 307
 308   if (len)
 309     {
 310       fprintf_filtered (stream, "(");
 311     }
 312   for (i = 0; i < len; i++)
 313     {
 314       if (i > 0)
 315         {
 316           fputs_filtered (", ", stream);
 317           wrap_here ("    ");
 318         }
 319       /*  Can we find if it is a var parameter ??
 320          if ( TYPE_FIELD(type, i) == )
 321          {
 322          fprintf_filtered (stream, "var ");
 323          } */
 324       pascal_print_type (TYPE_FIELD_TYPE (type, i), ""  /* TYPE_FIELD_NAME
 325                                                            seems invalid!  */
 326                          ,stream, -1, 0);
 327     }
 328   if (len)
 329     {
 330       fprintf_filtered (stream, ")");
 331     }
 332 }
 333
 334 /* Print any array sizes, function arguments or close parentheses
 335    needed after the variable name (to describe its type).
 336    Args work like pascal_type_print_varspec_prefix.  */
 337
 338 static void
 339 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
 340                                   int show, int passed_a_ptr,
 341                                   int demangled_args)
 342 {
 343   if (type == 0)
 344     return;
 345
 346   if (TYPE_NAME (type) && show <= 0)
 347     return;
 348
 349   QUIT;
 350
 351   switch (TYPE_CODE (type))
 352     {
 353     case TYPE_CODE_ARRAY:
 354       if (passed_a_ptr)
 355         fprintf_filtered (stream, ")");
 356       break;
 357
 358     case TYPE_CODE_METHOD:
 359       if (passed_a_ptr)
 360         fprintf_filtered (stream, ")");
 361       pascal_type_print_method_args ("",
 362                                      "",
 363                                      stream);
 364       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 365         {
 366           fprintf_filtered (stream, " : ");
 367           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 368                                             stream, 0, 0);
 369           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 370           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 371                                             passed_a_ptr, 0);
 372         }
 373       break;
 374
 375     case TYPE_CODE_PTR:
 376     case TYPE_CODE_REF:
 377       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 378                                         stream, 0, 1, 0);
 379       break;
 380
 381     case TYPE_CODE_FUNC:
 382       if (passed_a_ptr)
 383         fprintf_filtered (stream, ")");
 384       if (!demangled_args)
 385         pascal_print_func_args (type, stream);
 386       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 387         {
 388           fprintf_filtered (stream, " : ");
 389           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 390                                             stream, 0, 0);
 391           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 392           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 393                                             passed_a_ptr, 0);
 394         }
 395       break;
 396
 397     case TYPE_CODE_UNDEF:
 398     case TYPE_CODE_STRUCT:
 399     case TYPE_CODE_UNION:
 400     case TYPE_CODE_ENUM:
 401     case TYPE_CODE_INT:
 402     case TYPE_CODE_FLT:
 403     case TYPE_CODE_VOID:
 404     case TYPE_CODE_ERROR:
 405     case TYPE_CODE_CHAR:
 406     case TYPE_CODE_BOOL:
 407     case TYPE_CODE_SET:
 408     case TYPE_CODE_RANGE:
 409     case TYPE_CODE_STRING:
 410     case TYPE_CODE_COMPLEX:
 411     case TYPE_CODE_TYPEDEF:
 412       /* These types do not need a suffix.  They are listed so that
 413          gcc -Wall will report types that may not have been considered.  */
 414       break;
 415     default:
 416       error (_("type not handled in pascal_type_print_varspec_suffix()"));
 417       break;
 418     }
 419 }
 420
 421 /* Print the name of the type (or the ultimate pointer target,
 422    function value or array element), or the description of a
 423    structure or union.
 424
 425    SHOW positive means print details about the type (e.g. enum values),
 426    and print structure elements passing SHOW - 1 for show.
 427    SHOW negative means just print the type name or struct tag if there is one.
 428    If there is no name, print something sensible but concise like
 429    "struct {...}".
 430    SHOW zero means just print the type name or struct tag if there is one.
 431    If there is no name, print something sensible but not as concise like
 432    "struct {int x; int y;}".
 433
 434    LEVEL is the number of spaces to indent by.
 435    We increase it for some recursive calls.  */
 436
 437 void
 438 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
 439                         int level)
 440 {
 441   int i;
 442   int len;
 443   int lastval;
 444   enum
 445     {
 446       s_none, s_public, s_private, s_protected
 447     }
 448   section_type;
 449
 450   QUIT;
 451   wrap_here ("    ");
 452   if (type == NULL)
 453     {
 454       fputs_filtered ("<type unknown>", stream);
 455       return;
 456     }
 457
 458   /* void pointer */
 459   if ((TYPE_CODE (type) == TYPE_CODE_PTR)
 460       && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
 461     {
 462       fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
 463                       stream);
 464       return;
 465     }
 466   /* When SHOW is zero or less, and there is a valid type name, then always
 467      just print the type name directly from the type.  */
 468
 469   if (show <= 0
 470       && TYPE_NAME (type) != NULL)
 471     {
 472       fputs_filtered (TYPE_NAME (type), stream);
 473       return;
 474     }
 475
 476   CHECK_TYPEDEF (type);
 477
 478   switch (TYPE_CODE (type))
 479     {
 480     case TYPE_CODE_TYPEDEF:
 481     case TYPE_CODE_PTR:
 482     case TYPE_CODE_REF:
 483       /* case TYPE_CODE_FUNC:
 484          case TYPE_CODE_METHOD: */
 485       pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 486       break;
 487
 488     case TYPE_CODE_ARRAY:
 489       /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 490                                            stream, 0, 0);
 491          pascal_type_print_base (TYPE_TARGET_TYPE (type),
 492                                  stream, show, level);
 493          pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 494                                            stream, 0, 0, 0); */
 495       pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0);
 496       break;
 497
 498     case TYPE_CODE_FUNC:
 499     case TYPE_CODE_METHOD:
 500       /*
 501          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 502          only after args !!  */
 503       break;
 504     case TYPE_CODE_STRUCT:
 505       if (TYPE_TAG_NAME (type) != NULL)
 506         {
 507           fputs_filtered (TYPE_TAG_NAME (type), stream);
 508           fputs_filtered (" = ", stream);
 509         }
 510       if (HAVE_CPLUS_STRUCT (type))
 511         {
 512           fprintf_filtered (stream, "class ");
 513         }
 514       else
 515         {
 516           fprintf_filtered (stream, "record ");
 517         }
 518       goto struct_union;
 519
 520     case TYPE_CODE_UNION:
 521       if (TYPE_TAG_NAME (type) != NULL)
 522         {
 523           fputs_filtered (TYPE_TAG_NAME (type), stream);
 524           fputs_filtered (" = ", stream);
 525         }
 526       fprintf_filtered (stream, "case <?> of ");
 527
 528     struct_union:
 529       wrap_here ("    ");
 530       if (show < 0)
 531         {
 532           /* If we just printed a tag name, no need to print anything else.  */
 533           if (TYPE_TAG_NAME (type) == NULL)
 534             fprintf_filtered (stream, "{...}");
 535         }
 536       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 537         {
 538           pascal_type_print_derivation_info (stream, type);
 539
 540           fprintf_filtered (stream, "\n");
 541           if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
 542             {
 543               if (TYPE_STUB (type))
 544                 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
 545               else
 546                 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
 547             }
 548
 549           /* Start off with no specific section type, so we can print
 550              one for the first field we find, and use that section type
 551              thereafter until we find another type.  */
 552
 553           section_type = s_none;
 554
 555           /* If there is a base class for this type,
 556              do not print the field that it occupies.  */
 557
 558           len = TYPE_NFIELDS (type);
 559           for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 560             {
 561               QUIT;
 562               /* Don't print out virtual function table.  */
 563               if ((strncmp (TYPE_FIELD_NAME (type, i), "_vptr", 5) == 0)
 564                   && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
 565                 continue;
 566
 567               /* If this is a pascal object or class we can print the
 568                  various section labels.  */
 569
 570               if (HAVE_CPLUS_STRUCT (type))
 571                 {
 572                   if (TYPE_FIELD_PROTECTED (type, i))
 573                     {
 574                       if (section_type != s_protected)
 575                         {
 576                           section_type = s_protected;
 577                           fprintfi_filtered (level + 2, stream,
 578                                              "protected\n");
 579                         }
 580                     }
 581                   else if (TYPE_FIELD_PRIVATE (type, i))
 582                     {
 583                       if (section_type != s_private)
 584                         {
 585                           section_type = s_private;
 586                           fprintfi_filtered (level + 2, stream, "private\n");
 587                         }
 588                     }
 589                   else
 590                     {
 591                       if (section_type != s_public)
 592                         {
 593                           section_type = s_public;
 594                           fprintfi_filtered (level + 2, stream, "public\n");
 595                         }
 596                     }
 597                 }
 598
 599               print_spaces_filtered (level + 4, stream);
 600               if (field_is_static (&TYPE_FIELD (type, i)))
 601                 fprintf_filtered (stream, "static ");
 602               pascal_print_type (TYPE_FIELD_TYPE (type, i),
 603                                  TYPE_FIELD_NAME (type, i),
 604                                  stream, show - 1, level + 4);
 605               if (!field_is_static (&TYPE_FIELD (type, i))
 606                   && TYPE_FIELD_PACKED (type, i))
 607                 {
 608                   /* It is a bitfield.  This code does not attempt
 609                      to look at the bitpos and reconstruct filler,
 610                      unnamed fields.  This would lead to misleading
 611                      results if the compiler does not put out fields
 612                      for such things (I don't know what it does).  */
 613                   fprintf_filtered (stream, " : %d",
 614                                     TYPE_FIELD_BITSIZE (type, i));
 615                 }
 616               fprintf_filtered (stream, ";\n");
 617             }
 618
 619           /* If there are both fields and methods, put a space between.  */
 620           len = TYPE_NFN_FIELDS (type);
 621           if (len && section_type != s_none)
 622             fprintf_filtered (stream, "\n");
 623
 624           /* Object pascal: print out the methods.  */
 625
 626           for (i = 0; i < len; i++)
 627             {
 628               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 629               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 630               const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 631
 632               /* this is GNU C++ specific
 633                  how can we know constructor/destructor?
 634                  It might work for GNU pascal.  */
 635               for (j = 0; j < len2; j++)
 636                 {
 637                   const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 638
 639                   int is_constructor = (strncmp (physname, "__ct__", 6) == 0);
 640                   int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
 641
 642                   QUIT;
 643                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 644                     {
 645                       if (section_type != s_protected)
 646                         {
 647                           section_type = s_protected;
 648                           fprintfi_filtered (level + 2, stream,
 649                                              "protected\n");
 650                         }
 651                     }
 652                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 653                     {
 654                       if (section_type != s_private)
 655                         {
 656                           section_type = s_private;
 657                           fprintfi_filtered (level + 2, stream, "private\n");
 658                         }
 659                     }
 660                   else
 661                     {
 662                       if (section_type != s_public)
 663                         {
 664                           section_type = s_public;
 665                           fprintfi_filtered (level + 2, stream, "public\n");
 666                         }
 667                     }
 668
 669                   print_spaces_filtered (level + 4, stream);
 670                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 671                     fprintf_filtered (stream, "static ");
 672                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
 673                     {
 674                       /* Keep GDB from crashing here.  */
 675                       fprintf_filtered (stream, "<undefined type> %s;\n",
 676                                         TYPE_FN_FIELD_PHYSNAME (f, j));
 677                       break;
 678                     }
 679
 680                   if (is_constructor)
 681                     {
 682                       fprintf_filtered (stream, "constructor ");
 683                     }
 684                   else if (is_destructor)
 685                     {
 686                       fprintf_filtered (stream, "destructor  ");
 687                     }
 688                   else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 689                            && TYPE_CODE (TYPE_TARGET_TYPE (
 690                                 TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 691                     {
 692                       fprintf_filtered (stream, "function  ");
 693                     }
 694                   else
 695                     {
 696                       fprintf_filtered (stream, "procedure ");
 697                     }
 698                   /* This does not work, no idea why !!  */
 699
 700                   pascal_type_print_method_args (physname,
 701                                                  method_name,
 702                                                  stream);
 703
 704                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 705                       && TYPE_CODE (TYPE_TARGET_TYPE (
 706                            TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 707                     {
 708                       fputs_filtered (" : ", stream);
 709                       type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
 710                                   "", stream, -1);
 711                     }
 712                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
 713                     fprintf_filtered (stream, "; virtual");
 714
 715                   fprintf_filtered (stream, ";\n");
 716                 }
 717             }
 718           fprintfi_filtered (level, stream, "end");
 719         }
 720       break;
 721
 722     case TYPE_CODE_ENUM:
 723       if (TYPE_TAG_NAME (type) != NULL)
 724         {
 725           fputs_filtered (TYPE_TAG_NAME (type), stream);
 726           if (show > 0)
 727             fputs_filtered (" ", stream);
 728         }
 729       /* enum is just defined by
 730          type enume_name = (enum_member1,enum_member2,...)  */
 731       fprintf_filtered (stream, " = ");
 732       wrap_here ("    ");
 733       if (show < 0)
 734         {
 735           /* If we just printed a tag name, no need to print anything else.  */
 736           if (TYPE_TAG_NAME (type) == NULL)
 737             fprintf_filtered (stream, "(...)");
 738         }
 739       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 740         {
 741           fprintf_filtered (stream, "(");
 742           len = TYPE_NFIELDS (type);
 743           lastval = 0;
 744           for (i = 0; i < len; i++)
 745             {
 746               QUIT;
 747               if (i)
 748                 fprintf_filtered (stream, ", ");
 749               wrap_here ("    ");
 750               fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 751               if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 752                 {
 753                   fprintf_filtered (stream,
 754                                     " := %s",
 755                                     plongest (TYPE_FIELD_ENUMVAL (type, i)));
 756                   lastval = TYPE_FIELD_ENUMVAL (type, i);
 757                 }
 758               lastval++;
 759             }
 760           fprintf_filtered (stream, ")");
 761         }
 762       break;
 763
 764     case TYPE_CODE_VOID:
 765       fprintf_filtered (stream, "void");
 766       break;
 767
 768     case TYPE_CODE_UNDEF:
 769       fprintf_filtered (stream, "record <unknown>");
 770       break;
 771
 772     case TYPE_CODE_ERROR:
 773       fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
 774       break;
 775
 776       /* this probably does not work for enums.  */
 777     case TYPE_CODE_RANGE:
 778       {
 779         struct type *target = TYPE_TARGET_TYPE (type);
 780
 781         print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
 782         fputs_filtered ("..", stream);
 783         print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
 784       }
 785       break;
 786
 787     case TYPE_CODE_SET:
 788       fputs_filtered ("set of ", stream);
 789       pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
 790                          show - 1, level);
 791       break;
 792
 793     case TYPE_CODE_STRING:
 794       fputs_filtered ("String", stream);
 795       break;
 796
 797     default:
 798       /* Handle types not explicitly handled by the other cases,
 799          such as fundamental types.  For these, just print whatever
 800          the type name is, as recorded in the type itself.  If there
 801          is no type name, then complain.  */
 802       if (TYPE_NAME (type) != NULL)
 803         {
 804           fputs_filtered (TYPE_NAME (type), stream);
 805         }
 806       else
 807         {
 808           /* At least for dump_symtab, it is important that this not be
 809              an error ().  */
 810           fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
 811                             TYPE_CODE (type));
 812         }
 813       break;
 814     }
 815 }