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