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