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