gdb/p-typeprint.c

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