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/>. */
23 #include "expression.h"
27 #include "typeprint.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
);
38 m2_print_array_contents (struct value
*val
,
39 struct ui_file
*stream
, int recurse
,
40 const struct value_print_options
*options
,
44 /* get_long_set_bounds - assigns the bounds of the long set to low and
48 get_long_set_bounds (struct type
*type
, LONGEST
*low
, LONGEST
*high
)
52 if (type
->code () == TYPE_CODE_STRUCT
)
54 len
= type
->num_fields ();
55 i
= TYPE_N_BASECLASSES (type
);
58 *low
= type
->field (i
).type ()->bounds ()->low
.const_val ();
59 *high
= type
->field (len
- 1).type ()->bounds ()->high
.const_val ();
62 error (_("expecting long_set"));
67 m2_print_long_set (struct type
*type
, const gdb_byte
*valaddr
,
68 int embedded_offset
, CORE_ADDR address
,
69 struct ui_file
*stream
)
73 LONGEST previous_low
= 0;
74 LONGEST previous_high
= 0;
75 LONGEST i
, low_bound
, high_bound
;
76 LONGEST field_low
, field_high
;
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 ();
93 fprintf_styled (stream
, metadata_style
.style (),
94 " %s }", _("<unknown bounds of set>"));
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
);
108 error (_("bit test is out of range"));
115 gdb_printf (stream
, ", ");
116 print_type_scalar (target
, i
, stream
);
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
);
139 range
= type
->field (field
).type ()->index_type ();
140 if (!get_discrete_bounds (range
, &field_low
, &field_high
))
142 target
= range
->target_type ();
147 if (previous_low
+1 < previous_high
)
149 gdb_printf (stream
, "..");
150 print_type_scalar (target
, previous_high
, stream
);
154 gdb_printf (stream
, "}");
159 m2_print_unbounded_array (struct value
*value
,
160 struct ui_file
*stream
, int recurse
,
161 const struct value_print_options
*options
)
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) +
174 val
= value_at_lazy (type
->field (0).type ()->target_type (),
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
);
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 ());
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. */
201 if (options
->addressprint
&& options
->format
!= 's')
203 gdb_puts (paddress (gdbarch
, address
), stream
);
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')
216 gdb_puts (" ", stream
);
217 return val_print_string (type
->target_type (), NULL
, addr
, -1,
225 print_variable_at_address (struct type
*type
,
226 const gdb_byte
*valaddr
,
227 struct ui_file
*stream
,
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
);
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
258 m2_print_array_contents (struct value
*val
,
259 struct ui_file
*stream
, int recurse
,
260 const struct value_print_options
*options
,
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
,
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
=
301 m2_language::value_print_inner (struct value
*val
, struct ui_file
*stream
,
303 const struct value_print_options
*options
) const
306 struct type
*elttype
;
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. */
335 && temp_len
< len
&& temp_len
< options
->print_max
);
340 printstr (stream
, type
->target_type (), valaddr
, len
,
345 gdb_printf (stream
, "{");
346 value_print_array_elements (val
, stream
, recurse
,
348 gdb_printf (stream
, "}");
352 /* Array of unspecified length: treat like pointer to first elt. */
353 print_unpacked_pointer (type
, address
, address
, options
, stream
);
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
);
363 addr
= unpack_pointer (type
, valaddr
);
364 print_unpacked_pointer (type
, addr
, address
, options
, stream
);
368 case TYPE_CODE_UNION
:
369 if (recurse
&& !options
->unionprint
)
371 gdb_printf (stream
, "{...}");
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
);
381 cp_print_value_fields (val
, stream
, recurse
, options
, NULL
, 0);
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>"));
395 struct type
*range
= elttype
;
396 LONGEST low_bound
, high_bound
;
400 gdb_puts ("{", stream
);
402 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
) ? 0 : -1;
406 fputs_styled (_("<error value>"), metadata_style
.style (),
411 for (i
= low_bound
; i
<= high_bound
; i
++)
413 int element
= value_bit_index (type
, valaddr
, i
);
418 goto maybe_bad_bstring
;
423 gdb_puts (", ", stream
);
424 print_type_scalar (range
, i
, stream
);
427 if (i
+ 1 <= high_bound
428 && value_bit_index (type
, valaddr
, ++i
))
432 gdb_puts ("..", stream
);
433 while (i
+ 1 <= high_bound
434 && value_bit_index (type
, valaddr
, ++i
))
436 print_type_scalar (range
, j
, stream
);
441 gdb_puts ("}", stream
);
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
);
459 case TYPE_CODE_METHOD
:
461 case TYPE_CODE_ERROR
:
462 case TYPE_CODE_UNDEF
:
466 generic_value_print (val
, stream
, recurse
, options
, &m2_decorations
);