gdb/p-typeprint.c

   1 /* Support for printing Pascal types for GDB, the GNU debugger.
   2    Copyright (C) 2000, 2001, 2002, 2006, 2007, 2008
   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 /* If TYPE is a derived type, then print out derivation information.
  91    Print only the actual base classes of this type, not the base classes
  92    of the base classes.  I.E.  for the derivation hierarchy:
  93
  94    class A { int a; };
  95    class B : public A {int b; };
  96    class C : public B {int c; };
  97
  98    Print the type of class C as:
  99
 100    class C : public B {
 101    int c;
 102    }
 103
 104    Not as the following (like gdb used to), which is not legal C++ syntax for
 105    derived types and may be confused with the multiple inheritance form:
 106
 107    class C : public B : public A {
 108    int c;
 109    }
 110
 111    In general, gdb should try to print the types as closely as possible to
 112    the form that they appear in the source code. */
 113
 114 static void
 115 pascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
 116 {
 117   char *name;
 118   int i;
 119
 120   for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
 121     {
 122       fputs_filtered (i == 0 ? ": " : ", ", stream);
 123       fprintf_filtered (stream, "%s%s ",
 124                         BASETYPE_VIA_PUBLIC (type, i) ? "public" : "private",
 125                         BASETYPE_VIA_VIRTUAL (type, i) ? " virtual" : "");
 126       name = type_name_no_tag (TYPE_BASECLASS (type, i));
 127       fprintf_filtered (stream, "%s", name ? name : "(null)");
 128     }
 129   if (i > 0)
 130     {
 131       fputs_filtered (" ", stream);
 132     }
 133 }
 134
 135 /* Print the Pascal method arguments ARGS to the file STREAM.  */
 136
 137 void
 138 pascal_type_print_method_args (char *physname, char *methodname,
 139                                struct ui_file *stream)
 140 {
 141   int is_constructor = (strncmp (physname, "__ct__", 6) == 0);
 142   int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
 143
 144   if (is_constructor || is_destructor)
 145     {
 146       physname += 6;
 147     }
 148
 149   fputs_filtered (methodname, stream);
 150
 151   if (physname && (*physname != 0))
 152     {
 153       int i = 0;
 154       int len = 0;
 155       char storec;
 156       char *argname;
 157       fputs_filtered (" (", stream);
 158       /* we must demangle this */
 159       while (isdigit (physname[0]))
 160         {
 161           while (isdigit (physname[len]))
 162             {
 163               len++;
 164             }
 165           i = strtol (physname, &argname, 0);
 166           physname += len;
 167           storec = physname[i];
 168           physname[i] = 0;
 169           fputs_filtered (physname, stream);
 170           physname[i] = storec;
 171           physname += i;
 172           if (physname[0] != 0)
 173             {
 174               fputs_filtered (", ", stream);
 175             }
 176         }
 177       fputs_filtered (")", stream);
 178     }
 179 }
 180
 181 /* Print any asterisks or open-parentheses needed before the
 182    variable name (to describe its type).
 183
 184    On outermost call, pass 0 for PASSED_A_PTR.
 185    On outermost call, SHOW > 0 means should ignore
 186    any typename for TYPE and show its details.
 187    SHOW is always zero on recursive calls.  */
 188
 189 void
 190 pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
 191                                   int show, int passed_a_ptr)
 192 {
 193   char *name;
 194   if (type == 0)
 195     return;
 196
 197   if (TYPE_NAME (type) && show <= 0)
 198     return;
 199
 200   QUIT;
 201
 202   switch (TYPE_CODE (type))
 203     {
 204     case TYPE_CODE_PTR:
 205       fprintf_filtered (stream, "^");
 206       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 207       break;                    /* pointer should be handled normally in pascal */
 208
 209     case TYPE_CODE_METHOD:
 210       if (passed_a_ptr)
 211         fprintf_filtered (stream, "(");
 212       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 213         {
 214           fprintf_filtered (stream, "function  ");
 215         }
 216       else
 217         {
 218           fprintf_filtered (stream, "procedure ");
 219         }
 220
 221       if (passed_a_ptr)
 222         {
 223           fprintf_filtered (stream, " ");
 224           pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
 225           fprintf_filtered (stream, "::");
 226         }
 227       break;
 228
 229     case TYPE_CODE_REF:
 230       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 231       fprintf_filtered (stream, "&");
 232       break;
 233
 234     case TYPE_CODE_FUNC:
 235       if (passed_a_ptr)
 236         fprintf_filtered (stream, "(");
 237
 238       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 239         {
 240           fprintf_filtered (stream, "function  ");
 241         }
 242       else
 243         {
 244           fprintf_filtered (stream, "procedure ");
 245         }
 246
 247       break;
 248
 249     case TYPE_CODE_ARRAY:
 250       if (passed_a_ptr)
 251         fprintf_filtered (stream, "(");
 252       fprintf_filtered (stream, "array ");
 253       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
 254         && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED)
 255         fprintf_filtered (stream, "[%d..%d] ",
 256                           TYPE_ARRAY_LOWER_BOUND_VALUE (type),
 257                           TYPE_ARRAY_UPPER_BOUND_VALUE (type)
 258           );
 259       fprintf_filtered (stream, "of ");
 260       break;
 261
 262     case TYPE_CODE_UNDEF:
 263     case TYPE_CODE_STRUCT:
 264     case TYPE_CODE_UNION:
 265     case TYPE_CODE_ENUM:
 266     case TYPE_CODE_INT:
 267     case TYPE_CODE_FLT:
 268     case TYPE_CODE_VOID:
 269     case TYPE_CODE_ERROR:
 270     case TYPE_CODE_CHAR:
 271     case TYPE_CODE_BOOL:
 272     case TYPE_CODE_SET:
 273     case TYPE_CODE_RANGE:
 274     case TYPE_CODE_STRING:
 275     case TYPE_CODE_BITSTRING:
 276     case TYPE_CODE_COMPLEX:
 277     case TYPE_CODE_TYPEDEF:
 278     case TYPE_CODE_TEMPLATE:
 279       /* These types need no prefix.  They are listed here so that
 280          gcc -Wall will reveal any types that haven't been handled.  */
 281       break;
 282     default:
 283       error (_("type not handled in pascal_type_print_varspec_prefix()"));
 284       break;
 285     }
 286 }
 287
 288 static void
 289 pascal_print_func_args (struct type *type, struct ui_file *stream)
 290 {
 291   int i, len = TYPE_NFIELDS (type);
 292   if (len)
 293     {
 294       fprintf_filtered (stream, "(");
 295     }
 296   for (i = 0; i < len; i++)
 297     {
 298       if (i > 0)
 299         {
 300           fputs_filtered (", ", stream);
 301           wrap_here ("    ");
 302         }
 303       /*  can we find if it is a var parameter ??
 304          if ( TYPE_FIELD(type, i) == )
 305          {
 306          fprintf_filtered (stream, "var ");
 307          } */
 308       pascal_print_type (TYPE_FIELD_TYPE (type, i), ""  /* TYPE_FIELD_NAME seems invalid ! */
 309                          ,stream, -1, 0);
 310     }
 311   if (len)
 312     {
 313       fprintf_filtered (stream, ")");
 314     }
 315 }
 316
 317 /* Print any array sizes, function arguments or close parentheses
 318    needed after the variable name (to describe its type).
 319    Args work like pascal_type_print_varspec_prefix.  */
 320
 321 static void
 322 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
 323                                   int show, int passed_a_ptr,
 324                                   int demangled_args)
 325 {
 326   if (type == 0)
 327     return;
 328
 329   if (TYPE_NAME (type) && show <= 0)
 330     return;
 331
 332   QUIT;
 333
 334   switch (TYPE_CODE (type))
 335     {
 336     case TYPE_CODE_ARRAY:
 337       if (passed_a_ptr)
 338         fprintf_filtered (stream, ")");
 339       break;
 340
 341     case TYPE_CODE_METHOD:
 342       if (passed_a_ptr)
 343         fprintf_filtered (stream, ")");
 344       pascal_type_print_method_args ("",
 345                                      "",
 346                                      stream);
 347       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 348         {
 349           fprintf_filtered (stream, " : ");
 350           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 351           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 352           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 353                                             passed_a_ptr, 0);
 354         }
 355       break;
 356
 357     case TYPE_CODE_PTR:
 358     case TYPE_CODE_REF:
 359       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
 360       break;
 361
 362     case TYPE_CODE_FUNC:
 363       if (passed_a_ptr)
 364         fprintf_filtered (stream, ")");
 365       if (!demangled_args)
 366         pascal_print_func_args (type, 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_UNDEF:
 378     case TYPE_CODE_STRUCT:
 379     case TYPE_CODE_UNION:
 380     case TYPE_CODE_ENUM:
 381     case TYPE_CODE_INT:
 382     case TYPE_CODE_FLT:
 383     case TYPE_CODE_VOID:
 384     case TYPE_CODE_ERROR:
 385     case TYPE_CODE_CHAR:
 386     case TYPE_CODE_BOOL:
 387     case TYPE_CODE_SET:
 388     case TYPE_CODE_RANGE:
 389     case TYPE_CODE_STRING:
 390     case TYPE_CODE_BITSTRING:
 391     case TYPE_CODE_COMPLEX:
 392     case TYPE_CODE_TYPEDEF:
 393     case TYPE_CODE_TEMPLATE:
 394       /* These types do not need a suffix.  They are listed so that
 395          gcc -Wall will report types that may not have been considered.  */
 396       break;
 397     default:
 398       error (_("type not handled in pascal_type_print_varspec_suffix()"));
 399       break;
 400     }
 401 }
 402
 403 /* Print the name of the type (or the ultimate pointer target,
 404    function value or array element), or the description of a
 405    structure or union.
 406
 407    SHOW positive means print details about the type (e.g. enum values),
 408    and print structure elements passing SHOW - 1 for show.
 409    SHOW negative means just print the type name or struct tag if there is one.
 410    If there is no name, print something sensible but concise like
 411    "struct {...}".
 412    SHOW zero means just print the type name or struct tag if there is one.
 413    If there is no name, print something sensible but not as concise like
 414    "struct {int x; int y;}".
 415
 416    LEVEL is the number of spaces to indent by.
 417    We increase it for some recursive calls.  */
 418
 419 void
 420 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
 421                         int level)
 422 {
 423   int i;
 424   int len;
 425   int lastval;
 426   enum
 427     {
 428       s_none, s_public, s_private, s_protected
 429     }
 430   section_type;
 431   QUIT;
 432
 433   wrap_here ("    ");
 434   if (type == NULL)
 435     {
 436       fputs_filtered ("<type unknown>", stream);
 437       return;
 438     }
 439
 440   /* void pointer */
 441   if ((TYPE_CODE (type) == TYPE_CODE_PTR) && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
 442     {
 443       fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
 444                       stream);
 445       return;
 446     }
 447   /* When SHOW is zero or less, and there is a valid type name, then always
 448      just print the type name directly from the type.  */
 449
 450   if (show <= 0
 451       && TYPE_NAME (type) != NULL)
 452     {
 453       fputs_filtered (TYPE_NAME (type), stream);
 454       return;
 455     }
 456
 457   CHECK_TYPEDEF (type);
 458
 459   switch (TYPE_CODE (type))
 460     {
 461     case TYPE_CODE_TYPEDEF:
 462     case TYPE_CODE_PTR:
 463     case TYPE_CODE_REF:
 464       /* case TYPE_CODE_FUNC:
 465          case TYPE_CODE_METHOD: */
 466       pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 467       break;
 468
 469     case TYPE_CODE_ARRAY:
 470       /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 471          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 472          pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
 473       pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0);
 474       break;
 475
 476     case TYPE_CODE_FUNC:
 477     case TYPE_CODE_METHOD:
 478       /*
 479          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 480          only after args !! */
 481       break;
 482     case TYPE_CODE_STRUCT:
 483       if (TYPE_TAG_NAME (type) != NULL)
 484         {
 485           fputs_filtered (TYPE_TAG_NAME (type), stream);
 486           fputs_filtered (" = ", stream);
 487         }
 488       if (HAVE_CPLUS_STRUCT (type))
 489         {
 490           fprintf_filtered (stream, "class ");
 491         }
 492       else
 493         {
 494           fprintf_filtered (stream, "record ");
 495         }
 496       goto struct_union;
 497
 498     case TYPE_CODE_UNION:
 499       if (TYPE_TAG_NAME (type) != NULL)
 500         {
 501           fputs_filtered (TYPE_TAG_NAME (type), stream);
 502           fputs_filtered (" = ", stream);
 503         }
 504       fprintf_filtered (stream, "case <?> of ");
 505
 506     struct_union:
 507       wrap_here ("    ");
 508       if (show < 0)
 509         {
 510           /* If we just printed a tag name, no need to print anything else.  */
 511           if (TYPE_TAG_NAME (type) == NULL)
 512             fprintf_filtered (stream, "{...}");
 513         }
 514       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 515         {
 516           pascal_type_print_derivation_info (stream, type);
 517
 518           fprintf_filtered (stream, "\n");
 519           if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
 520             {
 521               if (TYPE_STUB (type))
 522                 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
 523               else
 524                 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
 525             }
 526
 527           /* Start off with no specific section type, so we can print
 528              one for the first field we find, and use that section type
 529              thereafter until we find another type. */
 530
 531           section_type = s_none;
 532
 533           /* If there is a base class for this type,
 534              do not print the field that it occupies.  */
 535
 536           len = TYPE_NFIELDS (type);
 537           for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 538             {
 539               QUIT;
 540               /* Don't print out virtual function table.  */
 541               if ((strncmp (TYPE_FIELD_NAME (type, i), "_vptr", 5) == 0)
 542                   && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
 543                 continue;
 544
 545               /* If this is a pascal object or class we can print the
 546                  various section labels. */
 547
 548               if (HAVE_CPLUS_STRUCT (type))
 549                 {
 550                   if (TYPE_FIELD_PROTECTED (type, i))
 551                     {
 552                       if (section_type != s_protected)
 553                         {
 554                           section_type = s_protected;
 555                           fprintfi_filtered (level + 2, stream,
 556                                              "protected\n");
 557                         }
 558                     }
 559                   else if (TYPE_FIELD_PRIVATE (type, i))
 560                     {
 561                       if (section_type != s_private)
 562                         {
 563                           section_type = s_private;
 564                           fprintfi_filtered (level + 2, stream, "private\n");
 565                         }
 566                     }
 567                   else
 568                     {
 569                       if (section_type != s_public)
 570                         {
 571                           section_type = s_public;
 572                           fprintfi_filtered (level + 2, stream, "public\n");
 573                         }
 574                     }
 575                 }
 576
 577               print_spaces_filtered (level + 4, stream);
 578               if (TYPE_FIELD_STATIC (type, i))
 579                 {
 580                   fprintf_filtered (stream, "static ");
 581                 }
 582               pascal_print_type (TYPE_FIELD_TYPE (type, i),
 583                                  TYPE_FIELD_NAME (type, i),
 584                                  stream, show - 1, level + 4);
 585               if (!TYPE_FIELD_STATIC (type, i)
 586                   && TYPE_FIELD_PACKED (type, i))
 587                 {
 588                   /* It is a bitfield.  This code does not attempt
 589                      to look at the bitpos and reconstruct filler,
 590                      unnamed fields.  This would lead to misleading
 591                      results if the compiler does not put out fields
 592                      for such things (I don't know what it does).  */
 593                   fprintf_filtered (stream, " : %d",
 594                                     TYPE_FIELD_BITSIZE (type, i));
 595                 }
 596               fprintf_filtered (stream, ";\n");
 597             }
 598
 599           /* If there are both fields and methods, put a space between. */
 600           len = TYPE_NFN_FIELDS (type);
 601           if (len && section_type != s_none)
 602             fprintf_filtered (stream, "\n");
 603
 604           /* Pbject pascal: print out the methods */
 605
 606           for (i = 0; i < len; i++)
 607             {
 608               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 609               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 610               char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 611               char *name = type_name_no_tag (type);
 612               /* this is GNU C++ specific
 613                  how can we know constructor/destructor?
 614                  It might work for GNU pascal */
 615               for (j = 0; j < len2; j++)
 616                 {
 617                   char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 618
 619                   int is_constructor = (strncmp (physname, "__ct__", 6) == 0);
 620                   int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
 621
 622                   QUIT;
 623                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 624                     {
 625                       if (section_type != s_protected)
 626                         {
 627                           section_type = s_protected;
 628                           fprintfi_filtered (level + 2, stream,
 629                                              "protected\n");
 630                         }
 631                     }
 632                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 633                     {
 634                       if (section_type != s_private)
 635                         {
 636                           section_type = s_private;
 637                           fprintfi_filtered (level + 2, stream, "private\n");
 638                         }
 639                     }
 640                   else
 641                     {
 642                       if (section_type != s_public)
 643                         {
 644                           section_type = s_public;
 645                           fprintfi_filtered (level + 2, stream, "public\n");
 646                         }
 647                     }
 648
 649                   print_spaces_filtered (level + 4, stream);
 650                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 651                     fprintf_filtered (stream, "static ");
 652                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
 653                     {
 654                       /* Keep GDB from crashing here.  */
 655                       fprintf_filtered (stream, "<undefined type> %s;\n",
 656                                         TYPE_FN_FIELD_PHYSNAME (f, j));
 657                       break;
 658                     }
 659
 660                   if (is_constructor)
 661                     {
 662                       fprintf_filtered (stream, "constructor ");
 663                     }
 664                   else if (is_destructor)
 665                     {
 666                       fprintf_filtered (stream, "destructor  ");
 667                     }
 668                   else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 669                            && TYPE_CODE (TYPE_TARGET_TYPE (
 670                                 TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 671                     {
 672                       fprintf_filtered (stream, "function  ");
 673                     }
 674                   else
 675                     {
 676                       fprintf_filtered (stream, "procedure ");
 677                     }
 678                   /* this does not work, no idea why !! */
 679
 680                   pascal_type_print_method_args (physname,
 681                                                  method_name,
 682                                                  stream);
 683
 684                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 685                       && TYPE_CODE (TYPE_TARGET_TYPE (
 686                            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 }