gdb/p-typeprint.c

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