gdb/p-typeprint.c

   1 /* Support for printing Pascal types for GDB, the GNU debugger.
   2    Copyright (C) 2000-2024 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 "event-top.h"
  22 #include "bfd.h"
  23 #include "symtab.h"
  24 #include "gdbtypes.h"
  25 #include "expression.h"
  26 #include "value.h"
  27 #include "gdbcore.h"
  28 #include "target.h"
  29 #include "language.h"
  30 #include "p-lang.h"
  31 #include "typeprint.h"
  32 #include "gdb-demangle.h"
  33 #include <ctype.h>
  34 #include "cli/cli-style.h"
  35
  36 /* See language.h.  */
  37
  38 void
  39 pascal_language::print_type (struct type *type, const char *varstring,
  40                              struct ui_file *stream, int show, int level,
  41                              const struct type_print_options *flags) const
  42 {
  43   enum type_code code;
  44   int demangled_args;
  45
  46   code = type->code ();
  47
  48   if (show > 0)
  49     type = check_typedef (type);
  50
  51   if ((code == TYPE_CODE_FUNC
  52        || code == TYPE_CODE_METHOD))
  53     {
  54       type_print_varspec_prefix (type, stream, show, 0, flags);
  55     }
  56   /* first the name */
  57   if (varstring != nullptr)
  58     gdb_puts (varstring, stream);
  59
  60   if ((varstring != NULL && *varstring != '\0')
  61       && !(code == TYPE_CODE_FUNC
  62            || code == TYPE_CODE_METHOD))
  63     {
  64       gdb_puts (" : ", stream);
  65     }
  66
  67   if (!(code == TYPE_CODE_FUNC
  68         || code == TYPE_CODE_METHOD))
  69     {
  70       type_print_varspec_prefix (type, stream, show, 0, flags);
  71     }
  72
  73   type_print_base (type, stream, show, level, flags);
  74   /* For demangled function names, we have the arglist as part of the name,
  75      so don't print an additional pair of ()'s.  */
  76
  77   demangled_args = varstring ? strchr (varstring, '(') != NULL : 0;
  78   type_print_varspec_suffix (type, stream, show, 0, demangled_args,
  79                                     flags);
  80
  81 }
  82
  83 /* See language.h.  */
  84
  85 void
  86 pascal_language::print_typedef (struct type *type, struct symbol *new_symbol,
  87                                 struct ui_file *stream) const
  88 {
  89   type = check_typedef (type);
  90   gdb_printf (stream, "type ");
  91   gdb_printf (stream, "%s = ", new_symbol->print_name ());
  92   type_print (type, "", stream, 0);
  93   gdb_printf (stream, ";");
  94 }
  95
  96 /* See p-lang.h.  */
  97
  98 void
  99 pascal_language::type_print_derivation_info (struct ui_file *stream,
 100                                              struct type *type) const
 101 {
 102   const char *name;
 103   int i;
 104
 105   for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
 106     {
 107       gdb_puts (i == 0 ? ": " : ", ", stream);
 108       gdb_printf (stream, "%s%s ",
 109                   BASETYPE_VIA_PUBLIC (type, i) ? "public" : "private",
 110                   BASETYPE_VIA_VIRTUAL (type, i) ? " virtual" : "");
 111       name = TYPE_BASECLASS (type, i)->name ();
 112       gdb_printf (stream, "%s", name ? name : "(null)");
 113     }
 114   if (i > 0)
 115     {
 116       gdb_puts (" ", stream);
 117     }
 118 }
 119
 120 /* See p-lang.h.  */
 121
 122 void
 123 pascal_language::type_print_method_args (const char *physname,
 124                                          const char *methodname,
 125                                          struct ui_file *stream) const
 126 {
 127   int is_constructor = (startswith (physname, "__ct__"));
 128   int is_destructor = (startswith (physname, "__dt__"));
 129
 130   if (is_constructor || is_destructor)
 131     {
 132       physname += 6;
 133     }
 134
 135   gdb_puts (methodname, stream);
 136
 137   if (physname && (*physname != 0))
 138     {
 139       gdb_puts (" (", stream);
 140       /* We must demangle this.  */
 141       while (isdigit (physname[0]))
 142         {
 143           int len = 0;
 144           int i, j;
 145           char *argname;
 146
 147           while (isdigit (physname[len]))
 148             {
 149               len++;
 150             }
 151           i = strtol (physname, &argname, 0);
 152           physname += len;
 153
 154           for (j = 0; j < i; ++j)
 155             gdb_putc (physname[j], stream);
 156
 157           physname += i;
 158           if (physname[0] != 0)
 159             {
 160               gdb_puts (", ", stream);
 161             }
 162         }
 163       gdb_puts (")", stream);
 164     }
 165 }
 166
 167 /* See p-lang.h.  */
 168
 169 void
 170 pascal_language::type_print_varspec_prefix (struct type *type,
 171                                             struct ui_file *stream,
 172                                             int show, int passed_a_ptr,
 173                                             const struct type_print_options *flags) const
 174 {
 175   if (type == 0)
 176     return;
 177
 178   if (type->name () && show <= 0)
 179     return;
 180
 181   QUIT;
 182
 183   switch (type->code ())
 184     {
 185     case TYPE_CODE_PTR:
 186       gdb_printf (stream, "^");
 187       type_print_varspec_prefix (type->target_type (), stream, 0, 1,
 188                                         flags);
 189       break;                    /* Pointer should be handled normally
 190                                    in pascal.  */
 191
 192     case TYPE_CODE_METHOD:
 193       if (passed_a_ptr)
 194         gdb_printf (stream, "(");
 195       if (type->target_type () != NULL
 196           && type->target_type ()->code () != TYPE_CODE_VOID)
 197         {
 198           gdb_printf (stream, "function  ");
 199         }
 200       else
 201         {
 202           gdb_printf (stream, "procedure ");
 203         }
 204
 205       if (passed_a_ptr)
 206         {
 207           gdb_printf (stream, " ");
 208           type_print_base (TYPE_SELF_TYPE (type),
 209                                   stream, 0, passed_a_ptr, flags);
 210           gdb_printf (stream, "::");
 211         }
 212       break;
 213
 214     case TYPE_CODE_REF:
 215       type_print_varspec_prefix (type->target_type (), stream, 0, 1,
 216                                  flags);
 217       gdb_printf (stream, "&");
 218       break;
 219
 220     case TYPE_CODE_FUNC:
 221       if (passed_a_ptr)
 222         gdb_printf (stream, "(");
 223
 224       if (type->target_type () != NULL
 225           && type->target_type ()->code () != TYPE_CODE_VOID)
 226         {
 227           gdb_printf (stream, "function  ");
 228         }
 229       else
 230         {
 231           gdb_printf (stream, "procedure ");
 232         }
 233
 234       break;
 235
 236     case TYPE_CODE_ARRAY:
 237       if (passed_a_ptr)
 238         gdb_printf (stream, "(");
 239       gdb_printf (stream, "array ");
 240       if (type->target_type ()->length () > 0
 241           && type->bounds ()->high.is_constant ())
 242         gdb_printf (stream, "[%s..%s] ",
 243                     plongest (type->bounds ()->low.const_val ()),
 244                     plongest (type->bounds ()->high.const_val ()));
 245       gdb_printf (stream, "of ");
 246       break;
 247     }
 248 }
 249
 250 /* See p-lang.h.  */
 251
 252 void
 253 pascal_language::print_func_args (struct type *type, struct ui_file *stream,
 254                                   const struct type_print_options *flags) const
 255 {
 256   int i, len = type->num_fields ();
 257
 258   if (len)
 259     {
 260       gdb_printf (stream, "(");
 261     }
 262   for (i = 0; i < len; i++)
 263     {
 264       if (i > 0)
 265         {
 266           gdb_puts (", ", stream);
 267           stream->wrap_here (4);
 268         }
 269       /*  Can we find if it is a var parameter ??
 270           if ( TYPE_FIELD(type, i) == )
 271           {
 272           gdb_printf (stream, "var ");
 273           } */
 274       print_type (type->field (i).type (), ""   /* TYPE_FIELD_NAME
 275                                                    seems invalid!  */
 276                          ,stream, -1, 0, flags);
 277     }
 278   if (len)
 279     {
 280       gdb_printf (stream, ")");
 281     }
 282 }
 283
 284 /* See p-lang.h.  */
 285
 286 void
 287 pascal_language::type_print_func_varspec_suffix  (struct type *type,
 288                                                   struct ui_file *stream,
 289                                                   int show, int passed_a_ptr,
 290                                                   int demangled_args,
 291                                                   const struct type_print_options *flags) const
 292 {
 293   if (type->target_type () == NULL
 294       || type->target_type ()->code () != TYPE_CODE_VOID)
 295     {
 296       gdb_printf (stream, " : ");
 297       type_print_varspec_prefix (type->target_type (),
 298                                         stream, 0, 0, flags);
 299
 300       if (type->target_type () == NULL)
 301         type_print_unknown_return_type (stream);
 302       else
 303         type_print_base (type->target_type (), stream, show, 0,
 304                                 flags);
 305
 306       type_print_varspec_suffix (type->target_type (), stream, 0,
 307                                  passed_a_ptr, 0, flags);
 308     }
 309 }
 310
 311 /* See p-lang.h.  */
 312
 313 void
 314 pascal_language::type_print_varspec_suffix (struct type *type,
 315                                             struct ui_file *stream,
 316                                             int show, int passed_a_ptr,
 317                                             int demangled_args,
 318                                             const struct type_print_options *flags) const
 319 {
 320   if (type == 0)
 321     return;
 322
 323   if (type->name () && show <= 0)
 324     return;
 325
 326   QUIT;
 327
 328   switch (type->code ())
 329     {
 330     case TYPE_CODE_ARRAY:
 331       if (passed_a_ptr)
 332         gdb_printf (stream, ")");
 333       break;
 334
 335     case TYPE_CODE_METHOD:
 336       if (passed_a_ptr)
 337         gdb_printf (stream, ")");
 338       type_print_method_args ("", "", stream);
 339       type_print_func_varspec_suffix (type, stream, show,
 340                                              passed_a_ptr, 0, flags);
 341       break;
 342
 343     case TYPE_CODE_PTR:
 344     case TYPE_CODE_REF:
 345       type_print_varspec_suffix (type->target_type (),
 346                                  stream, 0, 1, 0, flags);
 347       break;
 348
 349     case TYPE_CODE_FUNC:
 350       if (passed_a_ptr)
 351         gdb_printf (stream, ")");
 352       if (!demangled_args)
 353         print_func_args (type, stream, flags);
 354       type_print_func_varspec_suffix (type, stream, show,
 355                                              passed_a_ptr, 0, flags);
 356       break;
 357     }
 358 }
 359
 360 /* See p-lang.h.  */
 361
 362 void
 363 pascal_language::type_print_base (struct type *type, struct ui_file *stream, int show,
 364                                   int level, const struct type_print_options *flags) const
 365 {
 366   int i;
 367   int len;
 368   LONGEST lastval;
 369   enum
 370     {
 371       s_none, s_public, s_private, s_protected
 372     }
 373   section_type;
 374
 375   QUIT;
 376   stream->wrap_here (4);
 377   if (type == NULL)
 378     {
 379       fputs_styled ("<type unknown>", metadata_style.style (), stream);
 380       return;
 381     }
 382
 383   /* void pointer */
 384   if ((type->code () == TYPE_CODE_PTR)
 385       && (type->target_type ()->code () == TYPE_CODE_VOID))
 386     {
 387       gdb_puts (type->name () ? type->name () : "pointer",
 388                 stream);
 389       return;
 390     }
 391   /* When SHOW is zero or less, and there is a valid type name, then always
 392      just print the type name directly from the type.  */
 393
 394   if (show <= 0
 395       && type->name () != NULL)
 396     {
 397       gdb_puts (type->name (), stream);
 398       return;
 399     }
 400
 401   type = check_typedef (type);
 402
 403   switch (type->code ())
 404     {
 405     case TYPE_CODE_TYPEDEF:
 406     case TYPE_CODE_PTR:
 407     case TYPE_CODE_REF:
 408       type_print_base (type->target_type (), stream, show, level,
 409                        flags);
 410       break;
 411
 412     case TYPE_CODE_ARRAY:
 413       print_type (type->target_type (), NULL, stream, 0, 0, flags);
 414       break;
 415
 416     case TYPE_CODE_FUNC:
 417     case TYPE_CODE_METHOD:
 418       break;
 419     case TYPE_CODE_STRUCT:
 420       if (type->name () != NULL)
 421         {
 422           gdb_puts (type->name (), stream);
 423           gdb_puts (" = ", stream);
 424         }
 425       if (HAVE_CPLUS_STRUCT (type))
 426         {
 427           gdb_printf (stream, "class ");
 428         }
 429       else
 430         {
 431           gdb_printf (stream, "record ");
 432         }
 433       goto struct_union;
 434
 435     case TYPE_CODE_UNION:
 436       if (type->name () != NULL)
 437         {
 438           gdb_puts (type->name (), stream);
 439           gdb_puts (" = ", stream);
 440         }
 441       gdb_printf (stream, "case <?> of ");
 442
 443     struct_union:
 444       stream->wrap_here (4);
 445       if (show < 0)
 446         {
 447           /* If we just printed a tag name, no need to print anything else.  */
 448           if (type->name () == NULL)
 449             gdb_printf (stream, "{...}");
 450         }
 451       else if (show > 0 || type->name () == NULL)
 452         {
 453           type_print_derivation_info (stream, type);
 454
 455           gdb_printf (stream, "\n");
 456           if ((type->num_fields () == 0) && (TYPE_NFN_FIELDS (type) == 0))
 457             {
 458               if (type->is_stub ())
 459                 gdb_printf (stream, "%*s<incomplete type>\n",
 460                             level + 4, "");
 461               else
 462                 gdb_printf (stream, "%*s<no data fields>\n",
 463                             level + 4, "");
 464             }
 465
 466           /* Start off with no specific section type, so we can print
 467              one for the first field we find, and use that section type
 468              thereafter until we find another type.  */
 469
 470           section_type = s_none;
 471
 472           /* If there is a base class for this type,
 473              do not print the field that it occupies.  */
 474
 475           len = type->num_fields ();
 476           for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 477             {
 478               QUIT;
 479               /* Don't print out virtual function table.  */
 480               if ((startswith (type->field (i).name (), "_vptr"))
 481                   && is_cplus_marker ((type->field (i).name ())[5]))
 482                 continue;
 483
 484               /* If this is a pascal object or class we can print the
 485                  various section labels.  */
 486
 487               if (HAVE_CPLUS_STRUCT (type))
 488                 {
 489                   field &fld = type->field (i);
 490
 491                   if (fld.is_protected ())
 492                     {
 493                       if (section_type != s_protected)
 494                         {
 495                           section_type = s_protected;
 496                           gdb_printf (stream, "%*sprotected\n",
 497                                       level + 2, "");
 498                         }
 499                     }
 500                   else if (fld.is_private ())
 501                     {
 502                       if (section_type != s_private)
 503                         {
 504                           section_type = s_private;
 505                           gdb_printf (stream, "%*sprivate\n",
 506                                       level + 2, "");
 507                         }
 508                     }
 509                   else
 510                     {
 511                       if (section_type != s_public)
 512                         {
 513                           section_type = s_public;
 514                           gdb_printf (stream, "%*spublic\n",
 515                                       level + 2, "");
 516                         }
 517                     }
 518                 }
 519
 520               print_spaces (level + 4, stream);
 521               if (type->field (i).is_static ())
 522                 gdb_printf (stream, "static ");
 523               print_type (type->field (i).type (),
 524                                  type->field (i).name (),
 525                                  stream, show - 1, level + 4, flags);
 526               if (!type->field (i).is_static ()
 527                   && type->field (i).is_packed ())
 528                 {
 529                   /* It is a bitfield.  This code does not attempt
 530                      to look at the bitpos and reconstruct filler,
 531                      unnamed fields.  This would lead to misleading
 532                      results if the compiler does not put out fields
 533                      for such things (I don't know what it does).  */
 534                   gdb_printf (stream, " : %d", type->field (i).bitsize ());
 535                 }
 536               gdb_printf (stream, ";\n");
 537             }
 538
 539           /* If there are both fields and methods, put a space between.  */
 540           len = TYPE_NFN_FIELDS (type);
 541           if (len && section_type != s_none)
 542             gdb_printf (stream, "\n");
 543
 544           /* Object pascal: print out the methods.  */
 545
 546           for (i = 0; i < len; i++)
 547             {
 548               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 549               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 550               const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 551
 552               /* this is GNU C++ specific
 553                  how can we know constructor/destructor?
 554                  It might work for GNU pascal.  */
 555               for (j = 0; j < len2; j++)
 556                 {
 557                   const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 558
 559                   int is_constructor = (startswith (physname, "__ct__"));
 560                   int is_destructor = (startswith (physname, "__dt__"));
 561
 562                   QUIT;
 563                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 564                     {
 565                       if (section_type != s_protected)
 566                         {
 567                           section_type = s_protected;
 568                           gdb_printf (stream, "%*sprotected\n",
 569                                       level + 2, "");
 570                         }
 571                     }
 572                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 573                     {
 574                       if (section_type != s_private)
 575                         {
 576                           section_type = s_private;
 577                           gdb_printf (stream, "%*sprivate\n",
 578                                       level + 2, "");
 579                         }
 580                     }
 581                   else
 582                     {
 583                       if (section_type != s_public)
 584                         {
 585                           section_type = s_public;
 586                           gdb_printf (stream, "%*spublic\n",
 587                                       level + 2, "");
 588                         }
 589                     }
 590
 591                   print_spaces (level + 4, stream);
 592                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 593                     gdb_printf (stream, "static ");
 594                   if (TYPE_FN_FIELD_TYPE (f, j)->target_type () == 0)
 595                     {
 596                       /* Keep GDB from crashing here.  */
 597                       gdb_printf (stream, "<undefined type> %s;\n",
 598                                   TYPE_FN_FIELD_PHYSNAME (f, j));
 599                       break;
 600                     }
 601
 602                   if (is_constructor)
 603                     {
 604                       gdb_printf (stream, "constructor ");
 605                     }
 606                   else if (is_destructor)
 607                     {
 608                       gdb_printf (stream, "destructor  ");
 609                     }
 610                   else if (TYPE_FN_FIELD_TYPE (f, j)->target_type () != 0
 611                            && (TYPE_FN_FIELD_TYPE(f, j)->target_type ()->code ()
 612                                != TYPE_CODE_VOID))
 613                     {
 614                       gdb_printf (stream, "function  ");
 615                     }
 616                   else
 617                     {
 618                       gdb_printf (stream, "procedure ");
 619                     }
 620                   /* This does not work, no idea why !!  */
 621
 622                   type_print_method_args (physname, method_name, stream);
 623
 624                   if (TYPE_FN_FIELD_TYPE (f, j)->target_type () != 0
 625                       && (TYPE_FN_FIELD_TYPE(f, j)->target_type ()->code ()
 626                           != TYPE_CODE_VOID))
 627                     {
 628                       gdb_puts (" : ", stream);
 629                       type_print (TYPE_FN_FIELD_TYPE (f, j)->target_type (),
 630                                   "", stream, -1);
 631                     }
 632                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
 633                     gdb_printf (stream, "; virtual");
 634
 635                   gdb_printf (stream, ";\n");
 636                 }
 637             }
 638           gdb_printf (stream, "%*send", level, "");
 639         }
 640       break;
 641
 642     case TYPE_CODE_ENUM:
 643       if (type->name () != NULL)
 644         {
 645           gdb_puts (type->name (), stream);
 646           if (show > 0)
 647             gdb_puts (" ", stream);
 648         }
 649       /* enum is just defined by
 650          type enume_name = (enum_member1,enum_member2,...)  */
 651       gdb_printf (stream, " = ");
 652       stream->wrap_here (4);
 653       if (show < 0)
 654         {
 655           /* If we just printed a tag name, no need to print anything else.  */
 656           if (type->name () == NULL)
 657             gdb_printf (stream, "(...)");
 658         }
 659       else if (show > 0 || type->name () == NULL)
 660         {
 661           gdb_printf (stream, "(");
 662           len = type->num_fields ();
 663           lastval = 0;
 664           for (i = 0; i < len; i++)
 665             {
 666               QUIT;
 667               if (i)
 668                 gdb_printf (stream, ", ");
 669               stream->wrap_here (4);
 670               gdb_puts (type->field (i).name (), stream);
 671               if (lastval != type->field (i).loc_enumval ())
 672                 {
 673                   gdb_printf (stream,
 674                               " := %s",
 675                               plongest (type->field (i).loc_enumval ()));
 676                   lastval = type->field (i).loc_enumval ();
 677                 }
 678               lastval++;
 679             }
 680           gdb_printf (stream, ")");
 681         }
 682       break;
 683
 684     case TYPE_CODE_VOID:
 685       gdb_printf (stream, "void");
 686       break;
 687
 688     case TYPE_CODE_UNDEF:
 689       gdb_printf (stream, "record <unknown>");
 690       break;
 691
 692     case TYPE_CODE_ERROR:
 693       gdb_printf (stream, "%s", TYPE_ERROR_NAME (type));
 694       break;
 695
 696       /* this probably does not work for enums.  */
 697     case TYPE_CODE_RANGE:
 698       {
 699         struct type *target = type->target_type ();
 700
 701         print_type_scalar (target, type->bounds ()->low.const_val (), stream);
 702         gdb_puts ("..", stream);
 703         print_type_scalar (target, type->bounds ()->high.const_val (), stream);
 704       }
 705       break;
 706
 707     case TYPE_CODE_SET:
 708       gdb_puts ("set of ", stream);
 709       print_type (type->index_type (), "", stream,
 710                          show - 1, level, flags);
 711       break;
 712
 713     case TYPE_CODE_STRING:
 714       gdb_puts ("String", stream);
 715       break;
 716
 717     default:
 718       /* Handle types not explicitly handled by the other cases,
 719          such as fundamental types.  For these, just print whatever
 720          the type name is, as recorded in the type itself.  If there
 721          is no type name, then complain.  */
 722       if (type->name () != NULL)
 723         {
 724           gdb_puts (type->name (), stream);
 725         }
 726       else
 727         {
 728           /* At least for dump_symtab, it is important that this not be
 729              an error ().  */
 730           fprintf_styled (stream, metadata_style.style (),
 731                           "<invalid unnamed pascal type code %d>",
 732                           type->code ());
 733         }
 734       break;
 735     }
 736 }