gdb/p-typeprint.c

   1 /* Support for printing Pascal types for GDB, the GNU debugger.
   2    Copyright (C) 2000-2023 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 "gdbsupport/gdb_obstack.h"
  23 #include "bfd.h"
  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 #include "gdb-demangle.h"
  34 #include <ctype.h>
  35 #include "cli/cli-style.h"
  36
  37 /* See language.h.  */
  38
  39 void
  40 pascal_language::print_type (struct type *type, const char *varstring,
  41                              struct ui_file *stream, int show, int level,
  42                              const struct type_print_options *flags) const
  43 {
  44   enum type_code code;
  45   int demangled_args;
  46
  47   code = type->code ();
  48
  49   if (show > 0)
  50     type = check_typedef (type);
  51
  52   if ((code == TYPE_CODE_FUNC
  53        || code == TYPE_CODE_METHOD))
  54     {
  55       type_print_varspec_prefix (type, stream, show, 0, flags);
  56     }
  57   /* first the name */
  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                   if (TYPE_FIELD_PROTECTED (type, i))
 490                     {
 491                       if (section_type != s_protected)
 492                         {
 493                           section_type = s_protected;
 494                           gdb_printf (stream, "%*sprotected\n",
 495                                       level + 2, "");
 496                         }
 497                     }
 498                   else if (TYPE_FIELD_PRIVATE (type, i))
 499                     {
 500                       if (section_type != s_private)
 501                         {
 502                           section_type = s_private;
 503                           gdb_printf (stream, "%*sprivate\n",
 504                                       level + 2, "");
 505                         }
 506                     }
 507                   else
 508                     {
 509                       if (section_type != s_public)
 510                         {
 511                           section_type = s_public;
 512                           gdb_printf (stream, "%*spublic\n",
 513                                       level + 2, "");
 514                         }
 515                     }
 516                 }
 517
 518               print_spaces (level + 4, stream);
 519               if (type->field (i).is_static ())
 520                 gdb_printf (stream, "static ");
 521               print_type (type->field (i).type (),
 522                                  type->field (i).name (),
 523                                  stream, show - 1, level + 4, flags);
 524               if (!type->field (i).is_static ()
 525                   && type->field (i).is_packed ())
 526                 {
 527                   /* It is a bitfield.  This code does not attempt
 528                      to look at the bitpos and reconstruct filler,
 529                      unnamed fields.  This would lead to misleading
 530                      results if the compiler does not put out fields
 531                      for such things (I don't know what it does).  */
 532                   gdb_printf (stream, " : %d", type->field (i).bitsize ());
 533                 }
 534               gdb_printf (stream, ";\n");
 535             }
 536
 537           /* If there are both fields and methods, put a space between.  */
 538           len = TYPE_NFN_FIELDS (type);
 539           if (len && section_type != s_none)
 540             gdb_printf (stream, "\n");
 541
 542           /* Object pascal: print out the methods.  */
 543
 544           for (i = 0; i < len; i++)
 545             {
 546               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 547               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 548               const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 549
 550               /* this is GNU C++ specific
 551                  how can we know constructor/destructor?
 552                  It might work for GNU pascal.  */
 553               for (j = 0; j < len2; j++)
 554                 {
 555                   const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 556
 557                   int is_constructor = (startswith (physname, "__ct__"));
 558                   int is_destructor = (startswith (physname, "__dt__"));
 559
 560                   QUIT;
 561                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 562                     {
 563                       if (section_type != s_protected)
 564                         {
 565                           section_type = s_protected;
 566                           gdb_printf (stream, "%*sprotected\n",
 567                                       level + 2, "");
 568                         }
 569                     }
 570                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 571                     {
 572                       if (section_type != s_private)
 573                         {
 574                           section_type = s_private;
 575                           gdb_printf (stream, "%*sprivate\n",
 576                                       level + 2, "");
 577                         }
 578                     }
 579                   else
 580                     {
 581                       if (section_type != s_public)
 582                         {
 583                           section_type = s_public;
 584                           gdb_printf (stream, "%*spublic\n",
 585                                       level + 2, "");
 586                         }
 587                     }
 588
 589                   print_spaces (level + 4, stream);
 590                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 591                     gdb_printf (stream, "static ");
 592                   if (TYPE_FN_FIELD_TYPE (f, j)->target_type () == 0)
 593                     {
 594                       /* Keep GDB from crashing here.  */
 595                       gdb_printf (stream, "<undefined type> %s;\n",
 596                                   TYPE_FN_FIELD_PHYSNAME (f, j));
 597                       break;
 598                     }
 599
 600                   if (is_constructor)
 601                     {
 602                       gdb_printf (stream, "constructor ");
 603                     }
 604                   else if (is_destructor)
 605                     {
 606                       gdb_printf (stream, "destructor  ");
 607                     }
 608                   else if (TYPE_FN_FIELD_TYPE (f, j)->target_type () != 0
 609                            && (TYPE_FN_FIELD_TYPE(f, j)->target_type ()->code ()
 610                                != TYPE_CODE_VOID))
 611                     {
 612                       gdb_printf (stream, "function  ");
 613                     }
 614                   else
 615                     {
 616                       gdb_printf (stream, "procedure ");
 617                     }
 618                   /* This does not work, no idea why !!  */
 619
 620                   type_print_method_args (physname, method_name, stream);
 621
 622                   if (TYPE_FN_FIELD_TYPE (f, j)->target_type () != 0
 623                       && (TYPE_FN_FIELD_TYPE(f, j)->target_type ()->code ()
 624                           != TYPE_CODE_VOID))
 625                     {
 626                       gdb_puts (" : ", stream);
 627                       type_print (TYPE_FN_FIELD_TYPE (f, j)->target_type (),
 628                                   "", stream, -1);
 629                     }
 630                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
 631                     gdb_printf (stream, "; virtual");
 632
 633                   gdb_printf (stream, ";\n");
 634                 }
 635             }
 636           gdb_printf (stream, "%*send", level, "");
 637         }
 638       break;
 639
 640     case TYPE_CODE_ENUM:
 641       if (type->name () != NULL)
 642         {
 643           gdb_puts (type->name (), stream);
 644           if (show > 0)
 645             gdb_puts (" ", stream);
 646         }
 647       /* enum is just defined by
 648          type enume_name = (enum_member1,enum_member2,...)  */
 649       gdb_printf (stream, " = ");
 650       stream->wrap_here (4);
 651       if (show < 0)
 652         {
 653           /* If we just printed a tag name, no need to print anything else.  */
 654           if (type->name () == NULL)
 655             gdb_printf (stream, "(...)");
 656         }
 657       else if (show > 0 || type->name () == NULL)
 658         {
 659           gdb_printf (stream, "(");
 660           len = type->num_fields ();
 661           lastval = 0;
 662           for (i = 0; i < len; i++)
 663             {
 664               QUIT;
 665               if (i)
 666                 gdb_printf (stream, ", ");
 667               stream->wrap_here (4);
 668               gdb_puts (type->field (i).name (), stream);
 669               if (lastval != type->field (i).loc_enumval ())
 670                 {
 671                   gdb_printf (stream,
 672                               " := %s",
 673                               plongest (type->field (i).loc_enumval ()));
 674                   lastval = type->field (i).loc_enumval ();
 675                 }
 676               lastval++;
 677             }
 678           gdb_printf (stream, ")");
 679         }
 680       break;
 681
 682     case TYPE_CODE_VOID:
 683       gdb_printf (stream, "void");
 684       break;
 685
 686     case TYPE_CODE_UNDEF:
 687       gdb_printf (stream, "record <unknown>");
 688       break;
 689
 690     case TYPE_CODE_ERROR:
 691       gdb_printf (stream, "%s", TYPE_ERROR_NAME (type));
 692       break;
 693
 694       /* this probably does not work for enums.  */
 695     case TYPE_CODE_RANGE:
 696       {
 697         struct type *target = type->target_type ();
 698
 699         print_type_scalar (target, type->bounds ()->low.const_val (), stream);
 700         gdb_puts ("..", stream);
 701         print_type_scalar (target, type->bounds ()->high.const_val (), stream);
 702       }
 703       break;
 704
 705     case TYPE_CODE_SET:
 706       gdb_puts ("set of ", stream);
 707       print_type (type->index_type (), "", stream,
 708                          show - 1, level, flags);
 709       break;
 710
 711     case TYPE_CODE_STRING:
 712       gdb_puts ("String", stream);
 713       break;
 714
 715     default:
 716       /* Handle types not explicitly handled by the other cases,
 717          such as fundamental types.  For these, just print whatever
 718          the type name is, as recorded in the type itself.  If there
 719          is no type name, then complain.  */
 720       if (type->name () != NULL)
 721         {
 722           gdb_puts (type->name (), stream);
 723         }
 724       else
 725         {
 726           /* At least for dump_symtab, it is important that this not be
 727              an error ().  */
 728           fprintf_styled (stream, metadata_style.style (),
 729                           "<invalid unnamed pascal type code %d>",
 730                           type->code ());
 731         }
 732       break;
 733     }
 734 }