gdb/p-typeprint.c

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