Automatic date update in version.in
[binutils-gdb.git] / gdb / m2-valprint.c
blobb58e43f81b87980bc9b4c182a97c9a92474c6345
1 /* Support for printing Modula 2 values for GDB, the GNU debugger.
3 Copyright (C) 1986-2022 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
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"
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);
44 /* get_long_set_bounds - assigns the bounds of the long set to low and
45 high. */
47 int
48 get_long_set_bounds (struct type *type, LONGEST *low, LONGEST *high)
50 int len, i;
52 if (type->code () == TYPE_CODE_STRUCT)
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;
62 error (_("expecting long_set"));
63 return 0;
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)
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;
82 type = check_typedef (type);
84 gdb_printf (stream, "{");
85 len = type->num_fields ();
86 if (get_long_set_bounds (type, &low_bound, &high_bound))
88 field = TYPE_N_BASECLASSES (type);
89 range = type->field (field).type ()->index_type ();
91 else
93 fprintf_styled (stream, metadata_style.style (),
94 " %s }", _("<unknown bounds of set>"));
95 return;
98 target = range->target_type ();
100 if (get_discrete_bounds (range, &field_low, &field_high))
102 for (i = low_bound; i <= high_bound; i++)
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)
111 previous_high = i;
112 if (! element_seen)
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;
122 else
124 /* bit is not set */
125 if (element_seen)
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;
134 if (i == field_high)
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 ();
145 if (element_seen)
147 if (previous_low+1 < previous_high)
149 gdb_printf (stream, "..");
150 print_type_scalar (target, previous_high, stream);
152 element_seen = 0;
154 gdb_printf (stream, "}");
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)
163 CORE_ADDR addr;
164 LONGEST len;
165 struct value *val;
167 struct type *type = check_typedef (value_type (value));
168 const gdb_byte *valaddr = value_contents_for_printing (value).data ();
170 addr = unpack_pointer (type->field (0).type (),
171 (type->field (0).loc_bitpos () / 8) +
172 valaddr);
174 val = value_at_lazy (type->field (0).type ()->target_type (),
175 addr);
176 len = unpack_field_as_long (type, valaddr, 1);
178 gdb_printf (stream, "{");
179 m2_print_array_contents (val, stream, recurse, options, len);
180 gdb_printf (stream, ", HIGH = %d}", (int) len);
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)
189 struct gdbarch *gdbarch = type->arch ();
190 struct type *elttype = check_typedef (type->target_type ());
191 int want_space = 0;
193 if (elttype->code () == TYPE_CODE_FUNC)
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;
201 if (options->addressprint && options->format != 's')
203 gdb_puts (paddress (gdbarch, address), stream);
204 want_space = 1;
207 /* For a pointer to char or unsigned char, also print the string
208 pointed to, unless pointer is null. */
210 if (elttype->length () == 1
211 && elttype->code () == TYPE_CODE_INT
212 && (options->format == 0 || options->format == 's')
213 && addr != 0)
215 if (want_space)
216 gdb_puts (" ", stream);
217 return val_print_string (type->target_type (), NULL, addr, -1,
218 stream, options);
221 return 0;
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)
231 struct gdbarch *gdbarch = type->arch ();
232 CORE_ADDR addr = unpack_pointer (type, valaddr);
233 struct type *elttype = check_typedef (type->target_type ());
235 gdb_printf (stream, "[");
236 gdb_puts (paddress (gdbarch, addr), stream);
237 gdb_printf (stream, "] : ");
239 if (elttype->code () != TYPE_CODE_UNDEF)
241 struct value *deref_val =
242 value_at (type->target_type (), unpack_pointer (type, valaddr));
244 common_val_print (deref_val, stream, recurse, options, current_language);
246 else
247 gdb_puts ("???", stream);
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. */
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)
263 struct type *type = check_typedef (value_type (val));
265 if (type->length () > 0)
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
277 gdb_printf (stream, "{");
278 value_print_array_elements (val, stream, recurse, options, 0);
279 gdb_printf (stream, "}");
284 /* Decorations for Modula 2. */
286 static const struct generic_val_print_decorations m2_decorations =
289 " + ",
290 " * I",
291 "TRUE",
292 "FALSE",
293 "void",
294 "{",
298 /* See m2-lang.h. */
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
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);
311 struct type *type = check_typedef (value_type (val));
312 switch (type->code ())
314 case TYPE_CODE_ARRAY:
315 if (type->length () > 0 && type->target_type ()->length () > 0)
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'))
326 /* If requested, look for the first null char and only print
327 elements up to it. */
328 if (options->stop_print_at_null)
330 unsigned int temp_len;
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;
340 printstr (stream, type->target_type (), valaddr, len,
341 NULL, 0, options);
343 else
345 gdb_printf (stream, "{");
346 value_print_array_elements (val, stream, recurse,
347 options, 0);
348 gdb_printf (stream, "}");
350 break;
352 /* Array of unspecified length: treat like pointer to first elt. */
353 print_unpacked_pointer (type, address, address, options, stream);
354 break;
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
363 addr = unpack_pointer (type, valaddr);
364 print_unpacked_pointer (type, addr, address, options, stream);
366 break;
368 case TYPE_CODE_UNION:
369 if (recurse && !options->unionprint)
371 gdb_printf (stream, "{...}");
372 break;
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;
384 case TYPE_CODE_SET:
385 elttype = type->index_type ();
386 elttype = check_typedef (elttype);
387 if (elttype->is_stub ())
389 fprintf_styled (stream, metadata_style.style (),
390 _("<incomplete type>"));
391 break;
393 else
395 struct type *range = elttype;
396 LONGEST low_bound, high_bound;
397 int i;
398 int need_comma = 0;
400 gdb_puts ("{", stream);
402 i = get_discrete_bounds (range, &low_bound, &high_bound) ? 0 : -1;
403 maybe_bad_bstring:
404 if (i < 0)
406 fputs_styled (_("<error value>"), metadata_style.style (),
407 stream);
408 goto done;
411 for (i = low_bound; i <= high_bound; i++)
413 int element = value_bit_index (type, valaddr, i);
415 if (element < 0)
417 i = element;
418 goto maybe_bad_bstring;
420 if (element)
422 if (need_comma)
423 gdb_puts (", ", stream);
424 print_type_scalar (range, i, stream);
425 need_comma = 1;
427 if (i + 1 <= high_bound
428 && value_bit_index (type, valaddr, ++i))
430 int j = i;
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);
440 done:
441 gdb_puts ("}", stream);
443 break;
445 case TYPE_CODE_RANGE:
446 if (type->length () == type->target_type ()->length ())
448 struct value *v = value_cast (type->target_type (), val);
449 value_print_inner (v, stream, recurse, options);
450 break;
452 /* FALLTHROUGH */
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;