gdb/p-typeprint.c

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