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