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