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