gdb/m2-typeprint.c

   1 /* Support for printing Modula 2 types for GDB, the GNU debugger.
   2    Copyright (C) 1986-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 #include "language.h"
  20 #include "gdbsupport/gdb_obstack.h"
  21 #include "bfd.h"
  22 #include "symtab.h"
  23 #include "gdbtypes.h"
  24 #include "expression.h"
  25 #include "value.h"
  26 #include "gdbcore.h"
  27 #include "m2-lang.h"
  28 #include "target.h"
  29 #include "language.h"
  30 #include "demangle.h"
  31 #include "c-lang.h"
  32 #include "typeprint.h"
  33 #include "cp-abi.h"
  34 #include "cli/cli-style.h"
  35
  36 static void m2_print_bounds (struct type *type,
  37                              struct ui_file *stream, int show, int level,
  38                              int print_high);
  39
  40 static void m2_typedef (struct type *, struct ui_file *, int, int,
  41                         const struct type_print_options *);
  42 static void m2_array (struct type *, struct ui_file *, int, int,
  43                       const struct type_print_options *);
  44 static void m2_pointer (struct type *, struct ui_file *, int, int,
  45                         const struct type_print_options *);
  46 static void m2_ref (struct type *, struct ui_file *, int, int,
  47                     const struct type_print_options *);
  48 static void m2_procedure (struct type *, struct ui_file *, int, int,
  49                           const struct type_print_options *);
  50 static void m2_union (struct type *, struct ui_file *);
  51 static void m2_enum (struct type *, struct ui_file *, int, int);
  52 static void m2_range (struct type *, struct ui_file *, int, int,
  53                       const struct type_print_options *);
  54 static void m2_type_name (struct type *type, struct ui_file *stream);
  55 static void m2_short_set (struct type *type, struct ui_file *stream,
  56                           int show, int level);
  57 static int m2_long_set (struct type *type, struct ui_file *stream,
  58                         int show, int level, const struct type_print_options *flags);
  59 static int m2_unbounded_array (struct type *type, struct ui_file *stream,
  60                                int show, int level,
  61                                const struct type_print_options *flags);
  62 static void m2_record_fields (struct type *type, struct ui_file *stream,
  63                               int show, int level, const struct type_print_options *flags);
  64 static void m2_unknown (const char *s, struct type *type,
  65                         struct ui_file *stream, int show, int level);
  66
  67 int m2_is_long_set (struct type *type);
  68 int m2_is_long_set_of_type (struct type *type, struct type **of_type);
  69 int m2_is_unbounded_array (struct type *type);
  70
  71
  72 void
  73 m2_print_type (struct type *type, const char *varstring,
  74                struct ui_file *stream,
  75                int show, int level,
  76                const struct type_print_options *flags)
  77 {
  78   type = check_typedef (type);
  79
  80   QUIT;
  81
  82   stream->wrap_here (4);
  83   if (type == NULL)
  84     {
  85       fputs_styled (_("<type unknown>"), metadata_style.style (), stream);
  86       return;
  87     }
  88
  89   switch (type->code ())
  90     {
  91     case TYPE_CODE_SET:
  92       m2_short_set(type, stream, show, level);
  93       break;
  94
  95     case TYPE_CODE_STRUCT:
  96       if (m2_long_set (type, stream, show, level, flags)
  97           || m2_unbounded_array (type, stream, show, level, flags))
  98         break;
  99       m2_record_fields (type, stream, show, level, flags);
 100       break;
 101
 102     case TYPE_CODE_TYPEDEF:
 103       m2_typedef (type, stream, show, level, flags);
 104       break;
 105
 106     case TYPE_CODE_ARRAY:
 107       m2_array (type, stream, show, level, flags);
 108       break;
 109
 110     case TYPE_CODE_PTR:
 111       m2_pointer (type, stream, show, level, flags);
 112       break;
 113
 114     case TYPE_CODE_REF:
 115       m2_ref (type, stream, show, level, flags);
 116       break;
 117
 118     case TYPE_CODE_METHOD:
 119       m2_unknown (_("method"), type, stream, show, level);
 120       break;
 121
 122     case TYPE_CODE_FUNC:
 123       m2_procedure (type, stream, show, level, flags);
 124       break;
 125
 126     case TYPE_CODE_UNION:
 127       m2_union (type, stream);
 128       break;
 129
 130     case TYPE_CODE_ENUM:
 131       m2_enum (type, stream, show, level);
 132       break;
 133
 134     case TYPE_CODE_VOID:
 135       break;
 136
 137     case TYPE_CODE_UNDEF:
 138       /* i18n: Do not translate the "struct" part!  */
 139       m2_unknown (_("undef"), type, stream, show, level);
 140       break;
 141
 142     case TYPE_CODE_ERROR:
 143       m2_unknown (_("error"), type, stream, show, level);
 144       break;
 145
 146     case TYPE_CODE_RANGE:
 147       m2_range (type, stream, show, level, flags);
 148       break;
 149
 150     default:
 151       m2_type_name (type, stream);
 152       break;
 153     }
 154 }
 155
 156 /* Print a typedef using M2 syntax.  TYPE is the underlying type.
 157    NEW_SYMBOL is the symbol naming the type.  STREAM is the stream on
 158    which to print.  */
 159
 160 void
 161 m2_language::print_typedef (struct type *type, struct symbol *new_symbol,
 162                             struct ui_file *stream) const
 163 {
 164   type = check_typedef (type);
 165   gdb_printf (stream, "TYPE ");
 166   if (!new_symbol->type ()->name ()
 167       || strcmp ((new_symbol->type ())->name (),
 168                  new_symbol->linkage_name ()) != 0)
 169     gdb_printf (stream, "%s = ", new_symbol->print_name ());
 170   else
 171     gdb_printf (stream, "<builtin> = ");
 172   type_print (type, "", stream, 0);
 173   gdb_printf (stream, ";");
 174 }
 175
 176 /* m2_type_name - if a, type, has a name then print it.  */
 177
 178 void
 179 m2_type_name (struct type *type, struct ui_file *stream)
 180 {
 181   if (type->name () != NULL)
 182     gdb_puts (type->name (), stream);
 183 }
 184
 185 /* m2_range - displays a Modula-2 subrange type.  */
 186
 187 void
 188 m2_range (struct type *type, struct ui_file *stream, int show,
 189           int level, const struct type_print_options *flags)
 190 {
 191   if (type->bounds ()->high.const_val () == type->bounds ()->low.const_val ())
 192     {
 193       /* FIXME: type::target_type used to be TYPE_DOMAIN_TYPE but that was
 194          wrong.  Not sure if type::target_type is correct though.  */
 195       m2_print_type (type->target_type (), "", stream, show, level,
 196                      flags);
 197     }
 198   else
 199     {
 200       struct type *target = type->target_type ();
 201
 202       gdb_printf (stream, "[");
 203       print_type_scalar (target, type->bounds ()->low.const_val (), stream);
 204       gdb_printf (stream, "..");
 205       print_type_scalar (target, type->bounds ()->high.const_val (), stream);
 206       gdb_printf (stream, "]");
 207     }
 208 }
 209
 210 static void
 211 m2_typedef (struct type *type, struct ui_file *stream, int show,
 212             int level, const struct type_print_options *flags)
 213 {
 214   if (type->name () != NULL)
 215     {
 216       gdb_puts (type->name (), stream);
 217       gdb_puts (" = ", stream);
 218     }
 219   m2_print_type (type->target_type (), "", stream, show, level, flags);
 220 }
 221
 222 /* m2_array - prints out a Modula-2 ARRAY ... OF type.  */
 223
 224 static void m2_array (struct type *type, struct ui_file *stream,
 225                       int show, int level, const struct type_print_options *flags)
 226 {
 227   gdb_printf (stream, "ARRAY [");
 228   if (type->target_type ()->length () > 0
 229       && type->bounds ()->high.is_constant ())
 230     {
 231       if (type->index_type () != 0)
 232         {
 233           m2_print_bounds (type->index_type (), stream, show, -1, 0);
 234           gdb_printf (stream, "..");
 235           m2_print_bounds (type->index_type (), stream, show, -1, 1);
 236         }
 237       else
 238         gdb_puts (pulongest ((type->length ()
 239                              / type->target_type ()->length ())),
 240                   stream);
 241     }
 242   gdb_printf (stream, "] OF ");
 243   m2_print_type (type->target_type (), "", stream, show, level, flags);
 244 }
 245
 246 static void
 247 m2_pointer (struct type *type, struct ui_file *stream, int show,
 248             int level, const struct type_print_options *flags)
 249 {
 250   if (TYPE_CONST (type))
 251     gdb_printf (stream, "[...] : ");
 252   else
 253     gdb_printf (stream, "POINTER TO ");
 254
 255   m2_print_type (type->target_type (), "", stream, show, level, flags);
 256 }
 257
 258 static void
 259 m2_ref (struct type *type, struct ui_file *stream, int show,
 260         int level, const struct type_print_options *flags)
 261 {
 262   gdb_printf (stream, "VAR");
 263   m2_print_type (type->target_type (), "", stream, show, level, flags);
 264 }
 265
 266 static void
 267 m2_unknown (const char *s, struct type *type, struct ui_file *stream,
 268             int show, int level)
 269 {
 270   gdb_printf (stream, "%s %s", s, _("is unknown"));
 271 }
 272
 273 static void m2_union (struct type *type, struct ui_file *stream)
 274 {
 275   gdb_printf (stream, "union");
 276 }
 277
 278 static void
 279 m2_procedure (struct type *type, struct ui_file *stream,
 280               int show, int level, const struct type_print_options *flags)
 281 {
 282   gdb_printf (stream, "PROCEDURE ");
 283   m2_type_name (type, stream);
 284   if (type->target_type () == NULL
 285       || type->target_type ()->code () != TYPE_CODE_VOID)
 286     {
 287       int i, len = type->num_fields ();
 288
 289       gdb_printf (stream, " (");
 290       for (i = 0; i < len; i++)
 291         {
 292           if (i > 0)
 293             {
 294               gdb_puts (", ", stream);
 295               stream->wrap_here (4);
 296             }
 297           m2_print_type (type->field (i).type (), "", stream, -1, 0, flags);
 298         }
 299       gdb_printf (stream, ") : ");
 300       if (type->target_type () != NULL)
 301         m2_print_type (type->target_type (), "", stream, 0, 0, flags);
 302       else
 303         type_print_unknown_return_type (stream);
 304     }
 305 }
 306
 307 static void
 308 m2_print_bounds (struct type *type,
 309                  struct ui_file *stream, int show, int level,
 310                  int print_high)
 311 {
 312   struct type *target = type->target_type ();
 313
 314   if (type->num_fields () == 0)
 315     return;
 316
 317   if (print_high)
 318     print_type_scalar (target, type->bounds ()->high.const_val (), stream);
 319   else
 320     print_type_scalar (target, type->bounds ()->low.const_val (), stream);
 321 }
 322
 323 static void
 324 m2_short_set (struct type *type, struct ui_file *stream, int show, int level)
 325 {
 326   gdb_printf(stream, "SET [");
 327   m2_print_bounds (type->index_type (), stream,
 328                    show - 1, level, 0);
 329
 330   gdb_printf(stream, "..");
 331   m2_print_bounds (type->index_type (), stream,
 332                    show - 1, level, 1);
 333   gdb_printf(stream, "]");
 334 }
 335
 336 int
 337 m2_is_long_set (struct type *type)
 338 {
 339   LONGEST previous_high = 0;  /* Unnecessary initialization
 340                                  keeps gcc -Wall happy.  */
 341   int len, i;
 342   struct type *range;
 343
 344   if (type->code () == TYPE_CODE_STRUCT)
 345     {
 346
 347       /* check if all fields of the RECORD are consecutive sets.  */
 348
 349       len = type->num_fields ();
 350       for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 351         {
 352           if (type->field (i).type () == NULL)
 353             return 0;
 354           if (type->field (i).type ()->code () != TYPE_CODE_SET)
 355             return 0;
 356           if (type->field (i).name () != NULL
 357               && (strcmp (type->field (i).name (), "") != 0))
 358             return 0;
 359           range = type->field (i).type ()->index_type ();
 360           if ((i > TYPE_N_BASECLASSES (type))
 361               && previous_high + 1 != range->bounds ()->low.const_val ())
 362             return 0;
 363           previous_high = range->bounds ()->high.const_val ();
 364         }
 365       return len>0;
 366     }
 367   return 0;
 368 }
 369
 370 /* m2_get_discrete_bounds - a wrapper for get_discrete_bounds which
 371                             understands that CHARs might be signed.
 372                             This should be integrated into gdbtypes.c
 373                             inside get_discrete_bounds.  */
 374
 375 static bool
 376 m2_get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *highp)
 377 {
 378   type = check_typedef (type);
 379   switch (type->code ())
 380     {
 381     case TYPE_CODE_CHAR:
 382       if (type->length () < sizeof (LONGEST))
 383         {
 384           if (!type->is_unsigned ())
 385             {
 386               *lowp = -(1 << (type->length () * TARGET_CHAR_BIT - 1));
 387               *highp = -*lowp - 1;
 388               return 0;
 389             }
 390         }
 391       [[fallthrough]];
 392     default:
 393       return get_discrete_bounds (type, lowp, highp);
 394     }
 395 }
 396
 397 /* m2_is_long_set_of_type - returns TRUE if the long set was declared as
 398                             SET OF <oftype> of_type is assigned to the
 399                             subtype.  */
 400
 401 int
 402 m2_is_long_set_of_type (struct type *type, struct type **of_type)
 403 {
 404   int len, i;
 405   struct type *range;
 406   struct type *target;
 407   LONGEST l1, l2;
 408   LONGEST h1, h2;
 409
 410   if (type->code () == TYPE_CODE_STRUCT)
 411     {
 412       len = type->num_fields ();
 413       i = TYPE_N_BASECLASSES (type);
 414       if (len == 0)
 415         return 0;
 416       range = type->field (i).type ()->index_type ();
 417       target = range->target_type ();
 418
 419       l1 = type->field (i).type ()->bounds ()->low.const_val ();
 420       h1 = type->field (len - 1).type ()->bounds ()->high.const_val ();
 421       *of_type = target;
 422       if (m2_get_discrete_bounds (target, &l2, &h2))
 423         return (l1 == l2 && h1 == h2);
 424       error (_("long_set failed to find discrete bounds for its subtype"));
 425       return 0;
 426     }
 427   error (_("expecting long_set"));
 428   return 0;
 429 }
 430
 431 static int
 432 m2_long_set (struct type *type, struct ui_file *stream, int show, int level,
 433              const struct type_print_options *flags)
 434 {
 435   struct type *of_type;
 436   int i;
 437   int len = type->num_fields ();
 438   LONGEST low;
 439   LONGEST high;
 440
 441   if (m2_is_long_set (type))
 442     {
 443       if (type->name () != NULL)
 444         {
 445           gdb_puts (type->name (), stream);
 446           if (show == 0)
 447             return 1;
 448           gdb_puts (" = ", stream);
 449         }
 450
 451       if (get_long_set_bounds (type, &low, &high))
 452         {
 453           gdb_printf(stream, "SET OF ");
 454           i = TYPE_N_BASECLASSES (type);
 455           if (m2_is_long_set_of_type (type, &of_type))
 456             m2_print_type (of_type, "", stream, show - 1, level, flags);
 457           else
 458             {
 459               gdb_printf(stream, "[");
 460               m2_print_bounds (type->field (i).type ()->index_type (),
 461                                stream, show - 1, level, 0);
 462
 463               gdb_printf(stream, "..");
 464
 465               m2_print_bounds (type->field (len - 1).type ()->index_type (),
 466                                stream, show - 1, level, 1);
 467               gdb_printf(stream, "]");
 468             }
 469         }
 470       else
 471         /* i18n: Do not translate the "SET OF" part!  */
 472         gdb_printf(stream, _("SET OF <unknown>"));
 473
 474       return 1;
 475     }
 476   return 0;
 477 }
 478
 479 /* m2_is_unbounded_array - returns TRUE if, type, should be regarded
 480                            as a Modula-2 unbounded ARRAY type.  */
 481
 482 int
 483 m2_is_unbounded_array (struct type *type)
 484 {
 485   if (type->code () == TYPE_CODE_STRUCT)
 486     {
 487       /*
 488        *  check if we have a structure with exactly two fields named
 489        *  _m2_contents and _m2_high.  It also checks to see if the
 490        *  type of _m2_contents is a pointer.  The type::target_type
 491        *  of the pointer determines the unbounded ARRAY OF type.
 492        */
 493       if (type->num_fields () != 2)
 494         return 0;
 495       if (strcmp (type->field (0).name (), "_m2_contents") != 0)
 496         return 0;
 497       if (strcmp (type->field (1).name (), "_m2_high") != 0)
 498         return 0;
 499       if (type->field (0).type ()->code () != TYPE_CODE_PTR)
 500         return 0;
 501       return 1;
 502     }
 503   return 0;
 504 }
 505
 506 /* m2_unbounded_array - if the struct type matches a Modula-2 unbounded
 507                         parameter type then display the type as an
 508                         ARRAY OF type.  Returns TRUE if an unbounded
 509                         array type was detected.  */
 510
 511 static int
 512 m2_unbounded_array (struct type *type, struct ui_file *stream, int show,
 513                     int level, const struct type_print_options *flags)
 514 {
 515   if (m2_is_unbounded_array (type))
 516     {
 517       if (show > 0)
 518         {
 519           gdb_puts ("ARRAY OF ", stream);
 520           m2_print_type (type->field (0).type ()->target_type (),
 521                          "", stream, 0, level, flags);
 522         }
 523       return 1;
 524     }
 525   return 0;
 526 }
 527
 528 void
 529 m2_record_fields (struct type *type, struct ui_file *stream, int show,
 530                   int level, const struct type_print_options *flags)
 531 {
 532   /* Print the tag if it exists.  */
 533   if (type->name () != NULL)
 534     {
 535       if (!startswith (type->name (), "$$"))
 536         {
 537           gdb_puts (type->name (), stream);
 538           if (show > 0)
 539             gdb_printf (stream, " = ");
 540         }
 541     }
 542   stream->wrap_here (4);
 543   if (show < 0)
 544     {
 545       if (type->code () == TYPE_CODE_STRUCT)
 546         gdb_printf (stream, "RECORD ... END ");
 547       else if (type->code () == TYPE_CODE_UNION)
 548         gdb_printf (stream, "CASE ... END ");
 549     }
 550   else if (show > 0)
 551     {
 552       int i;
 553       int len = type->num_fields ();
 554
 555       if (type->code () == TYPE_CODE_STRUCT)
 556         gdb_printf (stream, "RECORD\n");
 557       else if (type->code () == TYPE_CODE_UNION)
 558         /* i18n: Do not translate "CASE" and "OF".  */
 559         gdb_printf (stream, _("CASE <variant> OF\n"));
 560
 561       for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 562         {
 563           QUIT;
 564
 565           print_spaces (level + 4, stream);
 566           fputs_styled (type->field (i).name (),
 567                         variable_name_style.style (), stream);
 568           gdb_puts (" : ", stream);
 569           m2_print_type (type->field (i).type (),
 570                          "",
 571                          stream, 0, level + 4, flags);
 572           if (type->field (i).is_packed ())
 573             {
 574               /* It is a bitfield.  This code does not attempt
 575                  to look at the bitpos and reconstruct filler,
 576                  unnamed fields.  This would lead to misleading
 577                  results if the compiler does not put out fields
 578                  for such things (I don't know what it does).  */
 579               gdb_printf (stream, " : %d", type->field (i).bitsize ());
 580             }
 581           gdb_printf (stream, ";\n");
 582         }
 583
 584       gdb_printf (stream, "%*sEND ", level, "");
 585     }
 586 }
 587
 588 void
 589 m2_enum (struct type *type, struct ui_file *stream, int show, int level)
 590 {
 591   LONGEST lastval;
 592   int i, len;
 593
 594   if (show < 0)
 595     {
 596       /* If we just printed a tag name, no need to print anything else.  */
 597       if (type->name () == NULL)
 598         gdb_printf (stream, "(...)");
 599     }
 600   else if (show > 0 || type->name () == NULL)
 601     {
 602       gdb_printf (stream, "(");
 603       len = type->num_fields ();
 604       lastval = 0;
 605       for (i = 0; i < len; i++)
 606         {
 607           QUIT;
 608           if (i > 0)
 609             gdb_printf (stream, ", ");
 610           stream->wrap_here (4);
 611           fputs_styled (type->field (i).name (),
 612                         variable_name_style.style (), stream);
 613           if (lastval != type->field (i).loc_enumval ())
 614             {
 615               gdb_printf (stream, " = %s",
 616                           plongest (type->field (i).loc_enumval ()));
 617               lastval = type->field (i).loc_enumval ();
 618             }
 619           lastval++;
 620         }
 621       gdb_printf (stream, ")");
 622     }
 623 }