gdb/p-typeprint.c

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