contrib/gdb-6.2.1/gdb/p-typeprint.c

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