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