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"                /* 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 #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_PACKED (type, i))
 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",
 533                               TYPE_FIELD_BITSIZE (type, i));
 534                 }
 535               gdb_printf (stream, ";\n");
 536             }
 537
 538           /* If there are both fields and methods, put a space between.  */
 539           len = TYPE_NFN_FIELDS (type);
 540           if (len && section_type != s_none)
 541             gdb_printf (stream, "\n");
 542
 543           /* Object pascal: print out the methods.  */
 544
 545           for (i = 0; i < len; i++)
 546             {
 547               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 548               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 549               const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 550
 551               /* this is GNU C++ specific
 552                  how can we know constructor/destructor?
 553                  It might work for GNU pascal.  */
 554               for (j = 0; j < len2; j++)
 555                 {
 556                   const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 557
 558                   int is_constructor = (startswith (physname, "__ct__"));
 559                   int is_destructor = (startswith (physname, "__dt__"));
 560
 561                   QUIT;
 562                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 563                     {
 564                       if (section_type != s_protected)
 565                         {
 566                           section_type = s_protected;
 567                           gdb_printf (stream, "%*sprotected\n",
 568                                       level + 2, "");
 569                         }
 570                     }
 571                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 572                     {
 573                       if (section_type != s_private)
 574                         {
 575                           section_type = s_private;
 576                           gdb_printf (stream, "%*sprivate\n",
 577                                       level + 2, "");
 578                         }
 579                     }
 580                   else
 581                     {
 582                       if (section_type != s_public)
 583                         {
 584                           section_type = s_public;
 585                           gdb_printf (stream, "%*spublic\n",
 586                                       level + 2, "");
 587                         }
 588                     }
 589
 590                   print_spaces (level + 4, stream);
 591                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 592                     gdb_printf (stream, "static ");
 593                   if (TYPE_FN_FIELD_TYPE (f, j)->target_type () == 0)
 594                     {
 595                       /* Keep GDB from crashing here.  */
 596                       gdb_printf (stream, "<undefined type> %s;\n",
 597                                   TYPE_FN_FIELD_PHYSNAME (f, j));
 598                       break;
 599                     }
 600
 601                   if (is_constructor)
 602                     {
 603                       gdb_printf (stream, "constructor ");
 604                     }
 605                   else if (is_destructor)
 606                     {
 607                       gdb_printf (stream, "destructor  ");
 608                     }
 609                   else if (TYPE_FN_FIELD_TYPE (f, j)->target_type () != 0
 610                            && (TYPE_FN_FIELD_TYPE(f, j)->target_type ()->code ()
 611                                != TYPE_CODE_VOID))
 612                     {
 613                       gdb_printf (stream, "function  ");
 614                     }
 615                   else
 616                     {
 617                       gdb_printf (stream, "procedure ");
 618                     }
 619                   /* This does not work, no idea why !!  */
 620
 621                   type_print_method_args (physname, method_name, stream);
 622
 623                   if (TYPE_FN_FIELD_TYPE (f, j)->target_type () != 0
 624                       && (TYPE_FN_FIELD_TYPE(f, j)->target_type ()->code ()
 625                           != TYPE_CODE_VOID))
 626                     {
 627                       gdb_puts (" : ", stream);
 628                       type_print (TYPE_FN_FIELD_TYPE (f, j)->target_type (),
 629                                   "", stream, -1);
 630                     }
 631                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
 632                     gdb_printf (stream, "; virtual");
 633
 634                   gdb_printf (stream, ";\n");
 635                 }
 636             }
 637           gdb_printf (stream, "%*send", level, "");
 638         }
 639       break;
 640
 641     case TYPE_CODE_ENUM:
 642       if (type->name () != NULL)
 643         {
 644           gdb_puts (type->name (), stream);
 645           if (show > 0)
 646             gdb_puts (" ", stream);
 647         }
 648       /* enum is just defined by
 649          type enume_name = (enum_member1,enum_member2,...)  */
 650       gdb_printf (stream, " = ");
 651       stream->wrap_here (4);
 652       if (show < 0)
 653         {
 654           /* If we just printed a tag name, no need to print anything else.  */
 655           if (type->name () == NULL)
 656             gdb_printf (stream, "(...)");
 657         }
 658       else if (show > 0 || type->name () == NULL)
 659         {
 660           gdb_printf (stream, "(");
 661           len = type->num_fields ();
 662           lastval = 0;
 663           for (i = 0; i < len; i++)
 664             {
 665               QUIT;
 666               if (i)
 667                 gdb_printf (stream, ", ");
 668               stream->wrap_here (4);
 669               gdb_puts (type->field (i).name (), stream);
 670               if (lastval != type->field (i).loc_enumval ())
 671                 {
 672                   gdb_printf (stream,
 673                               " := %s",
 674                               plongest (type->field (i).loc_enumval ()));
 675                   lastval = type->field (i).loc_enumval ();
 676                 }
 677               lastval++;
 678             }
 679           gdb_printf (stream, ")");
 680         }
 681       break;
 682
 683     case TYPE_CODE_VOID:
 684       gdb_printf (stream, "void");
 685       break;
 686
 687     case TYPE_CODE_UNDEF:
 688       gdb_printf (stream, "record <unknown>");
 689       break;
 690
 691     case TYPE_CODE_ERROR:
 692       gdb_printf (stream, "%s", TYPE_ERROR_NAME (type));
 693       break;
 694
 695       /* this probably does not work for enums.  */
 696     case TYPE_CODE_RANGE:
 697       {
 698         struct type *target = type->target_type ();
 699
 700         print_type_scalar (target, type->bounds ()->low.const_val (), stream);
 701         gdb_puts ("..", stream);
 702         print_type_scalar (target, type->bounds ()->high.const_val (), stream);
 703       }
 704       break;
 705
 706     case TYPE_CODE_SET:
 707       gdb_puts ("set of ", stream);
 708       print_type (type->index_type (), "", stream,
 709                          show - 1, level, flags);
 710       break;
 711
 712     case TYPE_CODE_STRING:
 713       gdb_puts ("String", stream);
 714       break;
 715
 716     default:
 717       /* Handle types not explicitly handled by the other cases,
 718          such as fundamental types.  For these, just print whatever
 719          the type name is, as recorded in the type itself.  If there
 720          is no type name, then complain.  */
 721       if (type->name () != NULL)
 722         {
 723           gdb_puts (type->name (), stream);
 724         }
 725       else
 726         {
 727           /* At least for dump_symtab, it is important that this not be
 728              an error ().  */
 729           fprintf_styled (stream, metadata_style.style (),
 730                           "<invalid unnamed pascal type code %d>",
 731                           type->code ());
 732         }
 733       break;
 734     }
 735 }