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