gdb/p-typeprint.c

   1 /* Support for printing Pascal types for GDB, the GNU debugger.
   2    Copyright (C) 2000, 2001, 2002
   3    Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 2 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program; if not, write to the Free Software
  19    Foundation, Inc., 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_MEMBER:
 212       if (passed_a_ptr)
 213         fprintf_filtered (stream, "(");
 214       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 215       fprintf_filtered (stream, " ");
 216       name = type_name_no_tag (TYPE_DOMAIN_TYPE (type));
 217       if (name)
 218         fputs_filtered (name, stream);
 219       else
 220         pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
 221       fprintf_filtered (stream, "::");
 222       break;
 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) >= 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
 269         && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED)
 270         fprintf_filtered (stream, "[%d..%d] ",
 271                           TYPE_ARRAY_LOWER_BOUND_VALUE (type),
 272                           TYPE_ARRAY_UPPER_BOUND_VALUE (type)
 273           );
 274       fprintf_filtered (stream, "of ");
 275       break;
 276
 277     case TYPE_CODE_UNDEF:
 278     case TYPE_CODE_STRUCT:
 279     case TYPE_CODE_UNION:
 280     case TYPE_CODE_ENUM:
 281     case TYPE_CODE_INT:
 282     case TYPE_CODE_FLT:
 283     case TYPE_CODE_VOID:
 284     case TYPE_CODE_ERROR:
 285     case TYPE_CODE_CHAR:
 286     case TYPE_CODE_BOOL:
 287     case TYPE_CODE_SET:
 288     case TYPE_CODE_RANGE:
 289     case TYPE_CODE_STRING:
 290     case TYPE_CODE_BITSTRING:
 291     case TYPE_CODE_COMPLEX:
 292     case TYPE_CODE_TYPEDEF:
 293     case TYPE_CODE_TEMPLATE:
 294       /* These types need no prefix.  They are listed here so that
 295          gcc -Wall will reveal any types that haven't been handled.  */
 296       break;
 297     default:
 298       error (_("type not handled in pascal_type_print_varspec_prefix()"));
 299       break;
 300     }
 301 }
 302
 303 static void
 304 pascal_print_func_args (struct type *type, struct ui_file *stream)
 305 {
 306   int i, len = TYPE_NFIELDS (type);
 307   if (len)
 308     {
 309       fprintf_filtered (stream, "(");
 310     }
 311   for (i = 0; i < len; i++)
 312     {
 313       if (i > 0)
 314         {
 315           fputs_filtered (", ", stream);
 316           wrap_here ("    ");
 317         }
 318       /*  can we find if it is a var parameter ??
 319          if ( TYPE_FIELD(type, i) == )
 320          {
 321          fprintf_filtered (stream, "var ");
 322          } */
 323       pascal_print_type (TYPE_FIELD_TYPE (type, i), ""  /* TYPE_FIELD_NAME seems invalid ! */
 324                          ,stream, -1, 0);
 325     }
 326   if (len)
 327     {
 328       fprintf_filtered (stream, ")");
 329     }
 330 }
 331
 332 /* Print any array sizes, function arguments or close parentheses
 333    needed after the variable name (to describe its type).
 334    Args work like pascal_type_print_varspec_prefix.  */
 335
 336 static void
 337 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
 338                                   int show, int passed_a_ptr,
 339                                   int demangled_args)
 340 {
 341   if (type == 0)
 342     return;
 343
 344   if (TYPE_NAME (type) && show <= 0)
 345     return;
 346
 347   QUIT;
 348
 349   switch (TYPE_CODE (type))
 350     {
 351     case TYPE_CODE_ARRAY:
 352       if (passed_a_ptr)
 353         fprintf_filtered (stream, ")");
 354       break;
 355
 356     case TYPE_CODE_MEMBER:
 357       if (passed_a_ptr)
 358         fprintf_filtered (stream, ")");
 359       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
 360       break;
 361
 362     case TYPE_CODE_METHOD:
 363       if (passed_a_ptr)
 364         fprintf_filtered (stream, ")");
 365       pascal_type_print_method_args ("",
 366                                      "",
 367                                      stream);
 368       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 369         {
 370           fprintf_filtered (stream, " : ");
 371           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 372           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 373           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 374                                             passed_a_ptr, 0);
 375         }
 376       break;
 377
 378     case TYPE_CODE_PTR:
 379     case TYPE_CODE_REF:
 380       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
 381       break;
 382
 383     case TYPE_CODE_FUNC:
 384       if (passed_a_ptr)
 385         fprintf_filtered (stream, ")");
 386       if (!demangled_args)
 387         pascal_print_func_args (type, stream);
 388       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 389         {
 390           fprintf_filtered (stream, " : ");
 391           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 392           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 393           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 394                                             passed_a_ptr, 0);
 395         }
 396       break;
 397
 398     case TYPE_CODE_UNDEF:
 399     case TYPE_CODE_STRUCT:
 400     case TYPE_CODE_UNION:
 401     case TYPE_CODE_ENUM:
 402     case TYPE_CODE_INT:
 403     case TYPE_CODE_FLT:
 404     case TYPE_CODE_VOID:
 405     case TYPE_CODE_ERROR:
 406     case TYPE_CODE_CHAR:
 407     case TYPE_CODE_BOOL:
 408     case TYPE_CODE_SET:
 409     case TYPE_CODE_RANGE:
 410     case TYPE_CODE_STRING:
 411     case TYPE_CODE_BITSTRING:
 412     case TYPE_CODE_COMPLEX:
 413     case TYPE_CODE_TYPEDEF:
 414     case TYPE_CODE_TEMPLATE:
 415       /* These types do not need a suffix.  They are listed so that
 416          gcc -Wall will report types that may not have been considered.  */
 417       break;
 418     default:
 419       error (_("type not handled in pascal_type_print_varspec_suffix()"));
 420       break;
 421     }
 422 }
 423
 424 /* Print the name of the type (or the ultimate pointer target,
 425    function value or array element), or the description of a
 426    structure or union.
 427
 428    SHOW positive means print details about the type (e.g. enum values),
 429    and print structure elements passing SHOW - 1 for show.
 430    SHOW negative means just print the type name or struct tag if there is one.
 431    If there is no name, print something sensible but concise like
 432    "struct {...}".
 433    SHOW zero means just print the type name or struct tag if there is one.
 434    If there is no name, print something sensible but not as concise like
 435    "struct {int x; int y;}".
 436
 437    LEVEL is the number of spaces to indent by.
 438    We increase it for some recursive calls.  */
 439
 440 void
 441 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
 442                         int level)
 443 {
 444   int i;
 445   int len;
 446   int lastval;
 447   enum
 448     {
 449       s_none, s_public, s_private, s_protected
 450     }
 451   section_type;
 452   QUIT;
 453
 454   wrap_here ("    ");
 455   if (type == NULL)
 456     {
 457       fputs_filtered ("<type unknown>", stream);
 458       return;
 459     }
 460
 461   /* void pointer */
 462   if ((TYPE_CODE (type) == TYPE_CODE_PTR) && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
 463     {
 464       fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
 465                       stream);
 466       return;
 467     }
 468   /* When SHOW is zero or less, and there is a valid type name, then always
 469      just print the type name directly from the type.  */
 470
 471   if (show <= 0
 472       && TYPE_NAME (type) != NULL)
 473     {
 474       fputs_filtered (TYPE_NAME (type), stream);
 475       return;
 476     }
 477
 478   CHECK_TYPEDEF (type);
 479
 480   switch (TYPE_CODE (type))
 481     {
 482     case TYPE_CODE_TYPEDEF:
 483     case TYPE_CODE_PTR:
 484     case TYPE_CODE_MEMBER:
 485     case TYPE_CODE_REF:
 486       /* case TYPE_CODE_FUNC:
 487          case TYPE_CODE_METHOD: */
 488       pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 489       break;
 490
 491     case TYPE_CODE_ARRAY:
 492       /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 493          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 494          pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); */
 495       pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0);
 496       break;
 497
 498     case TYPE_CODE_FUNC:
 499     case TYPE_CODE_METHOD:
 500       /*
 501          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 502          only after args !! */
 503       break;
 504     case TYPE_CODE_STRUCT:
 505       if (TYPE_TAG_NAME (type) != NULL)
 506         {
 507           fputs_filtered (TYPE_TAG_NAME (type), stream);
 508           fputs_filtered (" = ", stream);
 509         }
 510       if (HAVE_CPLUS_STRUCT (type))
 511         {
 512           fprintf_filtered (stream, "class ");
 513         }
 514       else
 515         {
 516           fprintf_filtered (stream, "record ");
 517         }
 518       goto struct_union;
 519
 520     case TYPE_CODE_UNION:
 521       if (TYPE_TAG_NAME (type) != NULL)
 522         {
 523           fputs_filtered (TYPE_TAG_NAME (type), stream);
 524           fputs_filtered (" = ", stream);
 525         }
 526       fprintf_filtered (stream, "case <?> of ");
 527
 528     struct_union:
 529       wrap_here ("    ");
 530       if (show < 0)
 531         {
 532           /* If we just printed a tag name, no need to print anything else.  */
 533           if (TYPE_TAG_NAME (type) == NULL)
 534             fprintf_filtered (stream, "{...}");
 535         }
 536       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 537         {
 538           pascal_type_print_derivation_info (stream, type);
 539
 540           fprintf_filtered (stream, "\n");
 541           if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
 542             {
 543               if (TYPE_STUB (type))
 544                 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
 545               else
 546                 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
 547             }
 548
 549           /* Start off with no specific section type, so we can print
 550              one for the first field we find, and use that section type
 551              thereafter until we find another type. */
 552
 553           section_type = s_none;
 554
 555           /* If there is a base class for this type,
 556              do not print the field that it occupies.  */
 557
 558           len = TYPE_NFIELDS (type);
 559           for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 560             {
 561               QUIT;
 562               /* Don't print out virtual function table.  */
 563               if (DEPRECATED_STREQN (TYPE_FIELD_NAME (type, i), "_vptr", 5)
 564                   && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
 565                 continue;
 566
 567               /* If this is a pascal object or class we can print the
 568                  various section labels. */
 569
 570               if (HAVE_CPLUS_STRUCT (type))
 571                 {
 572                   if (TYPE_FIELD_PROTECTED (type, i))
 573                     {
 574                       if (section_type != s_protected)
 575                         {
 576                           section_type = s_protected;
 577                           fprintfi_filtered (level + 2, stream,
 578                                              "protected\n");
 579                         }
 580                     }
 581                   else if (TYPE_FIELD_PRIVATE (type, i))
 582                     {
 583                       if (section_type != s_private)
 584                         {
 585                           section_type = s_private;
 586                           fprintfi_filtered (level + 2, stream, "private\n");
 587                         }
 588                     }
 589                   else
 590                     {
 591                       if (section_type != s_public)
 592                         {
 593                           section_type = s_public;
 594                           fprintfi_filtered (level + 2, stream, "public\n");
 595                         }
 596                     }
 597                 }
 598
 599               print_spaces_filtered (level + 4, stream);
 600               if (TYPE_FIELD_STATIC (type, i))
 601                 {
 602                   fprintf_filtered (stream, "static ");
 603                 }
 604               pascal_print_type (TYPE_FIELD_TYPE (type, i),
 605                                  TYPE_FIELD_NAME (type, i),
 606                                  stream, show - 1, level + 4);
 607               if (!TYPE_FIELD_STATIC (type, i)
 608                   && TYPE_FIELD_PACKED (type, i))
 609                 {
 610                   /* It is a bitfield.  This code does not attempt
 611                      to look at the bitpos and reconstruct filler,
 612                      unnamed fields.  This would lead to misleading
 613                      results if the compiler does not put out fields
 614                      for such things (I don't know what it does).  */
 615                   fprintf_filtered (stream, " : %d",
 616                                     TYPE_FIELD_BITSIZE (type, i));
 617                 }
 618               fprintf_filtered (stream, ";\n");
 619             }
 620
 621           /* If there are both fields and methods, put a space between. */
 622           len = TYPE_NFN_FIELDS (type);
 623           if (len && section_type != s_none)
 624             fprintf_filtered (stream, "\n");
 625
 626           /* Pbject pascal: print out the methods */
 627
 628           for (i = 0; i < len; i++)
 629             {
 630               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 631               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 632               char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 633               char *name = type_name_no_tag (type);
 634               /* this is GNU C++ specific
 635                  how can we know constructor/destructor?
 636                  It might work for GNU pascal */
 637               for (j = 0; j < len2; j++)
 638                 {
 639                   char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 640
 641                   int is_constructor = DEPRECATED_STREQN (physname, "__ct__", 6);
 642                   int is_destructor = DEPRECATED_STREQN (physname, "__dt__", 6);
 643
 644                   QUIT;
 645                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 646                     {
 647                       if (section_type != s_protected)
 648                         {
 649                           section_type = s_protected;
 650                           fprintfi_filtered (level + 2, stream,
 651                                              "protected\n");
 652                         }
 653                     }
 654                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 655                     {
 656                       if (section_type != s_private)
 657                         {
 658                           section_type = s_private;
 659                           fprintfi_filtered (level + 2, stream, "private\n");
 660                         }
 661                     }
 662                   else
 663                     {
 664                       if (section_type != s_public)
 665                         {
 666                           section_type = s_public;
 667                           fprintfi_filtered (level + 2, stream, "public\n");
 668                         }
 669                     }
 670
 671                   print_spaces_filtered (level + 4, stream);
 672                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 673                     fprintf_filtered (stream, "static ");
 674                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
 675                     {
 676                       /* Keep GDB from crashing here.  */
 677                       fprintf_filtered (stream, "<undefined type> %s;\n",
 678                                         TYPE_FN_FIELD_PHYSNAME (f, j));
 679                       break;
 680                     }
 681
 682                   if (is_constructor)
 683                     {
 684                       fprintf_filtered (stream, "constructor ");
 685                     }
 686                   else if (is_destructor)
 687                     {
 688                       fprintf_filtered (stream, "destructor  ");
 689                     }
 690                   else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 &&
 691                            TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 692                     {
 693                       fprintf_filtered (stream, "function  ");
 694                     }
 695                   else
 696                     {
 697                       fprintf_filtered (stream, "procedure ");
 698                     }
 699                   /* this does not work, no idea why !! */
 700
 701                   pascal_type_print_method_args (physname,
 702                                                  method_name,
 703                                                  stream);
 704
 705                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0 &&
 706                       TYPE_CODE (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 707                     {
 708                       fputs_filtered (" : ", stream);
 709                       type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
 710                                   "", stream, -1);
 711                     }
 712                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
 713                     fprintf_filtered (stream, "; virtual");
 714
 715                   fprintf_filtered (stream, ";\n");
 716                 }
 717             }
 718           fprintfi_filtered (level, stream, "end");
 719         }
 720       break;
 721
 722     case TYPE_CODE_ENUM:
 723       if (TYPE_TAG_NAME (type) != NULL)
 724         {
 725           fputs_filtered (TYPE_TAG_NAME (type), stream);
 726           if (show > 0)
 727             fputs_filtered (" ", stream);
 728         }
 729       /* enum is just defined by
 730          type enume_name = (enum_member1,enum_member2,...) */
 731       fprintf_filtered (stream, " = ");
 732       wrap_here ("    ");
 733       if (show < 0)
 734         {
 735           /* If we just printed a tag name, no need to print anything else.  */
 736           if (TYPE_TAG_NAME (type) == NULL)
 737             fprintf_filtered (stream, "(...)");
 738         }
 739       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 740         {
 741           fprintf_filtered (stream, "(");
 742           len = TYPE_NFIELDS (type);
 743           lastval = 0;
 744           for (i = 0; i < len; i++)
 745             {
 746               QUIT;
 747               if (i)
 748                 fprintf_filtered (stream, ", ");
 749               wrap_here ("    ");
 750               fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 751               if (lastval != TYPE_FIELD_BITPOS (type, i))
 752                 {
 753                   fprintf_filtered (stream, " := %d", TYPE_FIELD_BITPOS (type, i));
 754                   lastval = TYPE_FIELD_BITPOS (type, i);
 755                 }
 756               lastval++;
 757             }
 758           fprintf_filtered (stream, ")");
 759         }
 760       break;
 761
 762     case TYPE_CODE_VOID:
 763       fprintf_filtered (stream, "void");
 764       break;
 765
 766     case TYPE_CODE_UNDEF:
 767       fprintf_filtered (stream, "record <unknown>");
 768       break;
 769
 770     case TYPE_CODE_ERROR:
 771       fprintf_filtered (stream, "<unknown type>");
 772       break;
 773
 774       /* this probably does not work for enums */
 775     case TYPE_CODE_RANGE:
 776       {
 777         struct type *target = TYPE_TARGET_TYPE (type);
 778         if (target == NULL)
 779           target = builtin_type_long;
 780         print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
 781         fputs_filtered ("..", stream);
 782         print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
 783       }
 784       break;
 785
 786     case TYPE_CODE_SET:
 787       fputs_filtered ("set of ", stream);
 788       pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
 789                          show - 1, level);
 790       break;
 791
 792     case TYPE_CODE_BITSTRING:
 793       fputs_filtered ("BitString", stream);
 794       break;
 795
 796     case TYPE_CODE_STRING:
 797       fputs_filtered ("String", stream);
 798       break;
 799
 800     default:
 801       /* Handle types not explicitly handled by the other cases,
 802          such as fundamental types.  For these, just print whatever
 803          the type name is, as recorded in the type itself.  If there
 804          is no type name, then complain. */
 805       if (TYPE_NAME (type) != NULL)
 806         {
 807           fputs_filtered (TYPE_NAME (type), stream);
 808         }
 809       else
 810         {
 811           /* At least for dump_symtab, it is important that this not be
 812              an error ().  */
 813           fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
 814                             TYPE_CODE (type));
 815         }
 816       break;
 817     }
 818 }