gdb/p-typeprint.c

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