gdb/m2-valprint.c

   1 /* Support for printing Modula 2 values for GDB, the GNU debugger.
   2
   3    Copyright (C) 1986-2024 Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 #include "symtab.h"
  21 #include "gdbtypes.h"
  22 #include "expression.h"
  23 #include "value.h"
  24 #include "valprint.h"
  25 #include "language.h"
  26 #include "typeprint.h"
  27 #include "c-lang.h"
  28 #include "m2-lang.h"
  29 #include "target.h"
  30 #include "cli/cli-style.h"
  31
  32 static int print_unpacked_pointer (struct type *type,
  33                                    CORE_ADDR address, CORE_ADDR addr,
  34                                    const struct value_print_options *options,
  35                                    struct ui_file *stream);
  36 static void
  37 m2_print_array_contents (struct value *val,
  38                          struct ui_file *stream, int recurse,
  39                          const struct value_print_options *options,
  40                          int len);
  41
  42
  43 /* get_long_set_bounds - assigns the bounds of the long set to low and
  44                          high.  */
  45
  46 int
  47 get_long_set_bounds (struct type *type, LONGEST *low, LONGEST *high)
  48 {
  49   int len, i;
  50
  51   if (type->code () == TYPE_CODE_STRUCT)
  52     {
  53       len = type->num_fields ();
  54       i = TYPE_N_BASECLASSES (type);
  55       if (len == 0)
  56         return 0;
  57       *low = type->field (i).type ()->bounds ()->low.const_val ();
  58       *high = type->field (len - 1).type ()->bounds ()->high.const_val ();
  59       return 1;
  60     }
  61   error (_("expecting long_set"));
  62   return 0;
  63 }
  64
  65 static void
  66 m2_print_long_set (struct type *type, const gdb_byte *valaddr,
  67                    int embedded_offset, CORE_ADDR address,
  68                    struct ui_file *stream)
  69 {
  70   int empty_set        = 1;
  71   int element_seen     = 0;
  72   LONGEST previous_low = 0;
  73   LONGEST previous_high= 0;
  74   LONGEST i, low_bound, high_bound;
  75   LONGEST field_low, field_high;
  76   struct type *range;
  77   int len, field;
  78   struct type *target;
  79   int bitval;
  80
  81   type = check_typedef (type);
  82
  83   gdb_printf (stream, "{");
  84   len = type->num_fields ();
  85   if (get_long_set_bounds (type, &low_bound, &high_bound))
  86     {
  87       field = TYPE_N_BASECLASSES (type);
  88       range = type->field (field).type ()->index_type ();
  89     }
  90   else
  91     {
  92       fprintf_styled (stream, metadata_style.style (),
  93                       " %s }", _("<unknown bounds of set>"));
  94       return;
  95     }
  96
  97   target = range->target_type ();
  98
  99   if (get_discrete_bounds (range, &field_low, &field_high))
 100     {
 101       for (i = low_bound; i <= high_bound; i++)
 102         {
 103           bitval = value_bit_index (type->field (field).type (),
 104                                     (type->field (field).loc_bitpos () / 8) +
 105                                     valaddr + embedded_offset, i);
 106           if (bitval < 0)
 107             error (_("bit test is out of range"));
 108           else if (bitval > 0)
 109             {
 110               previous_high = i;
 111               if (! element_seen)
 112                 {
 113                   if (! empty_set)
 114                     gdb_printf (stream, ", ");
 115                   print_type_scalar (target, i, stream);
 116                   empty_set    = 0;
 117                   element_seen = 1;
 118                   previous_low = i;
 119                 }
 120             }
 121           else
 122             {
 123               /* bit is not set */
 124               if (element_seen)
 125                 {
 126                   if (previous_low+1 < previous_high)
 127                     gdb_printf (stream, "..");
 128                   if (previous_low+1 < previous_high)
 129                     print_type_scalar (target, previous_high, stream);
 130                   element_seen = 0;
 131                 }
 132             }
 133           if (i == field_high)
 134             {
 135               field++;
 136               if (field == len)
 137                 break;
 138               range = type->field (field).type ()->index_type ();
 139               if (!get_discrete_bounds (range, &field_low, &field_high))
 140                 break;
 141               target = range->target_type ();
 142             }
 143         }
 144       if (element_seen)
 145         {
 146           if (previous_low+1 < previous_high)
 147             {
 148               gdb_printf (stream, "..");
 149               print_type_scalar (target, previous_high, stream);
 150             }
 151           element_seen = 0;
 152         }
 153       gdb_printf (stream, "}");
 154     }
 155 }
 156
 157 static void
 158 m2_print_unbounded_array (struct value *value,
 159                           struct ui_file *stream, int recurse,
 160                           const struct value_print_options *options)
 161 {
 162   CORE_ADDR addr;
 163   LONGEST len;
 164   struct value *val;
 165
 166   struct type *type = check_typedef (value->type ());
 167   const gdb_byte *valaddr = value->contents_for_printing ().data ();
 168
 169   addr = unpack_pointer (type->field (0).type (),
 170                          (type->field (0).loc_bitpos () / 8) +
 171                          valaddr);
 172
 173   val = value_at_lazy (type->field (0).type ()->target_type (),
 174                        addr);
 175   len = unpack_field_as_long (type, valaddr, 1);
 176
 177   gdb_printf (stream, "{");
 178   m2_print_array_contents (val, stream, recurse, options, len);
 179   gdb_printf (stream, ", HIGH = %d}", (int) len);
 180 }
 181
 182 static int
 183 print_unpacked_pointer (struct type *type,
 184                         CORE_ADDR address, CORE_ADDR addr,
 185                         const struct value_print_options *options,
 186                         struct ui_file *stream)
 187 {
 188   struct gdbarch *gdbarch = type->arch ();
 189   struct type *elttype = check_typedef (type->target_type ());
 190   int want_space = 0;
 191
 192   if (elttype->code () == TYPE_CODE_FUNC)
 193     {
 194       /* Try to print what function it points to.  */
 195       print_function_pointer_address (options, gdbarch, addr, stream);
 196       /* Return value is irrelevant except for string pointers.  */
 197       return 0;
 198     }
 199
 200   if (options->addressprint && options->format != 's')
 201     {
 202       gdb_puts (paddress (gdbarch, address), stream);
 203       want_space = 1;
 204     }
 205
 206   /* For a pointer to char or unsigned char, also print the string
 207      pointed to, unless pointer is null.  */
 208
 209   if (elttype->length () == 1
 210       && elttype->code () == TYPE_CODE_INT
 211       && (options->format == 0 || options->format == 's')
 212       && addr != 0)
 213     {
 214       if (want_space)
 215         gdb_puts (" ", stream);
 216       return val_print_string (type->target_type (), NULL, addr, -1,
 217                                stream, options);
 218     }
 219
 220   return 0;
 221 }
 222
 223 static void
 224 print_variable_at_address (struct type *type,
 225                            const gdb_byte *valaddr,
 226                            struct ui_file *stream,
 227                            int recurse,
 228                            const struct value_print_options *options)
 229 {
 230   struct gdbarch *gdbarch = type->arch ();
 231   CORE_ADDR addr = unpack_pointer (type, valaddr);
 232   struct type *elttype = check_typedef (type->target_type ());
 233
 234   gdb_printf (stream, "[");
 235   gdb_puts (paddress (gdbarch, addr), stream);
 236   gdb_printf (stream, "] : ");
 237
 238   if (elttype->code () != TYPE_CODE_UNDEF)
 239     {
 240       struct value *deref_val =
 241         value_at (type->target_type (), unpack_pointer (type, valaddr));
 242
 243       common_val_print (deref_val, stream, recurse, options, current_language);
 244     }
 245   else
 246     gdb_puts ("???", stream);
 247 }
 248
 249
 250 /* m2_print_array_contents - prints out the contents of an
 251                              array up to a max_print values.
 252                              It prints arrays of char as a string
 253                              and all other data types as comma
 254                              separated values.  */
 255
 256 static void
 257 m2_print_array_contents (struct value *val,
 258                          struct ui_file *stream, int recurse,
 259                          const struct value_print_options *options,
 260                          int len)
 261 {
 262   struct type *type = check_typedef (val->type ());
 263
 264   if (type->length () > 0)
 265     {
 266       /* For an array of chars, print with string syntax.  */
 267       if (type->length () == 1 &&
 268           ((type->code () == TYPE_CODE_INT)
 269            || ((current_language->la_language == language_m2)
 270                && (type->code () == TYPE_CODE_CHAR)))
 271           && (options->format == 0 || options->format == 's'))
 272         val_print_string (type, NULL, val->address (), len+1, stream,
 273                           options);
 274       else
 275         {
 276           gdb_printf (stream, "{");
 277           value_print_array_elements (val, stream, recurse, options, 0);
 278           gdb_printf (stream, "}");
 279         }
 280     }
 281 }
 282
 283 /* Decorations for Modula 2.  */
 284
 285 static const struct generic_val_print_decorations m2_decorations =
 286 {
 287   "",
 288   " + ",
 289   " * I",
 290   "TRUE",
 291   "FALSE",
 292   "void",
 293   "{",
 294   "}"
 295 };
 296
 297 /* See m2-lang.h.  */
 298
 299 void
 300 m2_language::value_print_inner (struct value *val, struct ui_file *stream,
 301                                 int recurse,
 302                                 const struct value_print_options *options) const
 303 {
 304   unsigned len;
 305   struct type *elttype;
 306   CORE_ADDR addr;
 307   const gdb_byte *valaddr = val->contents_for_printing ().data ();
 308   const CORE_ADDR address = val->address ();
 309
 310   struct type *type = check_typedef (val->type ());
 311   switch (type->code ())
 312     {
 313     case TYPE_CODE_ARRAY:
 314       if (type->length () > 0 && type->target_type ()->length () > 0)
 315         {
 316           elttype = check_typedef (type->target_type ());
 317           len = type->length () / elttype->length ();
 318           /* For an array of chars, print with string syntax.  */
 319           if (elttype->length () == 1 &&
 320               ((elttype->code () == TYPE_CODE_INT)
 321                || ((current_language->la_language == language_m2)
 322                    && (elttype->code () == TYPE_CODE_CHAR)))
 323               && (options->format == 0 || options->format == 's'))
 324             {
 325               /* If requested, look for the first null char and only print
 326                  elements up to it.  */
 327               if (options->stop_print_at_null)
 328                 {
 329                   unsigned int print_max_chars = get_print_max_chars (options);
 330                   unsigned int temp_len;
 331
 332                   /* Look for a NULL char.  */
 333                   for (temp_len = 0;
 334                        (valaddr[temp_len]
 335                         && temp_len < len
 336                         && temp_len < print_max_chars);
 337                        temp_len++);
 338                   len = temp_len;
 339                 }
 340
 341               printstr (stream, type->target_type (), valaddr, len,
 342                         NULL, 0, options);
 343             }
 344           else
 345             {
 346               gdb_printf (stream, "{");
 347               value_print_array_elements (val, stream, recurse,
 348                                           options, 0);
 349               gdb_printf (stream, "}");
 350             }
 351           break;
 352         }
 353       /* Array of unspecified length: treat like pointer to first elt.  */
 354       print_unpacked_pointer (type, address, address, options, stream);
 355       break;
 356
 357     case TYPE_CODE_PTR:
 358       if (TYPE_CONST (type))
 359         print_variable_at_address (type, valaddr, stream, recurse, options);
 360       else if (options->format && options->format != 's')
 361         value_print_scalar_formatted (val, options, 0, stream);
 362       else
 363         {
 364           addr = unpack_pointer (type, valaddr);
 365           print_unpacked_pointer (type, addr, address, options, stream);
 366         }
 367       break;
 368
 369     case TYPE_CODE_UNION:
 370       if (recurse && !options->unionprint)
 371         {
 372           gdb_printf (stream, "{...}");
 373           break;
 374         }
 375       [[fallthrough]];
 376     case TYPE_CODE_STRUCT:
 377       if (m2_is_long_set (type))
 378         m2_print_long_set (type, valaddr, 0, address, stream);
 379       else if (m2_is_unbounded_array (type))
 380         m2_print_unbounded_array (val, stream, recurse, options);
 381       else
 382         cp_print_value_fields (val, stream, recurse, options, NULL, 0);
 383       break;
 384
 385     case TYPE_CODE_SET:
 386       elttype = type->index_type ();
 387       elttype = check_typedef (elttype);
 388       if (elttype->is_stub ())
 389         {
 390           fprintf_styled (stream, metadata_style.style (),
 391                           _("<incomplete type>"));
 392           break;
 393         }
 394       else
 395         {
 396           struct type *range = elttype;
 397           LONGEST low_bound, high_bound;
 398           int i;
 399           int need_comma = 0;
 400
 401           gdb_puts ("{", stream);
 402
 403           i = get_discrete_bounds (range, &low_bound, &high_bound) ? 0 : -1;
 404         maybe_bad_bstring:
 405           if (i < 0)
 406             {
 407               fputs_styled (_("<error value>"), metadata_style.style (),
 408                             stream);
 409               goto done;
 410             }
 411
 412           for (i = low_bound; i <= high_bound; i++)
 413             {
 414               int element = value_bit_index (type, valaddr, i);
 415
 416               if (element < 0)
 417                 {
 418                   i = element;
 419                   goto maybe_bad_bstring;
 420                 }
 421               if (element)
 422                 {
 423                   if (need_comma)
 424                     gdb_puts (", ", stream);
 425                   print_type_scalar (range, i, stream);
 426                   need_comma = 1;
 427
 428                   if (i + 1 <= high_bound
 429                       && value_bit_index (type, valaddr, ++i))
 430                     {
 431                       int j = i;
 432
 433                       gdb_puts ("..", stream);
 434                       while (i + 1 <= high_bound
 435                              && value_bit_index (type, valaddr, ++i))
 436                         j = i;
 437                       print_type_scalar (range, j, stream);
 438                     }
 439                 }
 440             }
 441         done:
 442           gdb_puts ("}", stream);
 443         }
 444       break;
 445
 446     case TYPE_CODE_RANGE:
 447       if (type->length () == type->target_type ()->length ())
 448         {
 449           struct value *v = value_cast (type->target_type (), val);
 450           value_print_inner (v, stream, recurse, options);
 451           break;
 452         }
 453       [[fallthrough]];
 454
 455     case TYPE_CODE_REF:
 456     case TYPE_CODE_ENUM:
 457     case TYPE_CODE_FUNC:
 458     case TYPE_CODE_INT:
 459     case TYPE_CODE_FLT:
 460     case TYPE_CODE_METHOD:
 461     case TYPE_CODE_VOID:
 462     case TYPE_CODE_ERROR:
 463     case TYPE_CODE_UNDEF:
 464     case TYPE_CODE_BOOL:
 465     case TYPE_CODE_CHAR:
 466     default:
 467       generic_value_print (val, stream, recurse, options, &m2_decorations);
 468       break;
 469     }
 470 }