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