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, char *varstring, struct ui_file *stream,
  50                    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   char *name;
 209   if (type == 0)
 210     return;
 211
 212   if (TYPE_NAME (type) && show <= 0)
 213     return;
 214
 215   QUIT;
 216
 217   switch (TYPE_CODE (type))
 218     {
 219     case TYPE_CODE_PTR:
 220       fprintf_filtered (stream, "^");
 221       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 222       break;                    /* pointer should be handled normally in pascal */
 223
 224     case TYPE_CODE_METHOD:
 225       if (passed_a_ptr)
 226         fprintf_filtered (stream, "(");
 227       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 228         {
 229           fprintf_filtered (stream, "function  ");
 230         }
 231       else
 232         {
 233           fprintf_filtered (stream, "procedure ");
 234         }
 235
 236       if (passed_a_ptr)
 237         {
 238           fprintf_filtered (stream, " ");
 239           pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
 240           fprintf_filtered (stream, "::");
 241         }
 242       break;
 243
 244     case TYPE_CODE_REF:
 245       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 246       fprintf_filtered (stream, "&");
 247       break;
 248
 249     case TYPE_CODE_FUNC:
 250       if (passed_a_ptr)
 251         fprintf_filtered (stream, "(");
 252
 253       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 254         {
 255           fprintf_filtered (stream, "function  ");
 256         }
 257       else
 258         {
 259           fprintf_filtered (stream, "procedure ");
 260         }
 261
 262       break;
 263
 264     case TYPE_CODE_ARRAY:
 265       if (passed_a_ptr)
 266         fprintf_filtered (stream, "(");
 267       fprintf_filtered (stream, "array ");
 268       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
 269         && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 270         fprintf_filtered (stream, "[%s..%s] ",
 271                           plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type)),
 272                           plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type)));
 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       /* These types need no prefix.  They are listed here so that
 293          gcc -Wall will reveal any types that haven't been handled.  */
 294       break;
 295     default:
 296       error (_("type not handled in pascal_type_print_varspec_prefix()"));
 297       break;
 298     }
 299 }
 300
 301 static void
 302 pascal_print_func_args (struct type *type, struct ui_file *stream)
 303 {
 304   int i, len = TYPE_NFIELDS (type);
 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   QUIT;
 444
 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               char *name = type_name_no_tag (type);
 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         print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
 769         fputs_filtered ("..", stream);
 770         print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
 771       }
 772       break;
 773
 774     case TYPE_CODE_SET:
 775       fputs_filtered ("set of ", stream);
 776       pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
 777                          show - 1, level);
 778       break;
 779
 780     case TYPE_CODE_BITSTRING:
 781       fputs_filtered ("BitString", stream);
 782       break;
 783
 784     case TYPE_CODE_STRING:
 785       fputs_filtered ("String", stream);
 786       break;
 787
 788     default:
 789       /* Handle types not explicitly handled by the other cases,
 790          such as fundamental types.  For these, just print whatever
 791          the type name is, as recorded in the type itself.  If there
 792          is no type name, then complain. */
 793       if (TYPE_NAME (type) != NULL)
 794         {
 795           fputs_filtered (TYPE_NAME (type), stream);
 796         }
 797       else
 798         {
 799           /* At least for dump_symtab, it is important that this not be
 800              an error ().  */
 801           fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
 802                             TYPE_CODE (type));
 803         }
 804       break;
 805     }
 806 }