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