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