1 /* Support for printing Modula 2 types for GDB, the GNU debugger.
2 Copyright (C) 1986-2020 Free Software Foundation, Inc.
4 This file is part of GDB.
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.
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.
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/>. */
20 #include "gdb_obstack.h"
21 #include "bfd.h" /* Binary File Description */
24 #include "expression.h"
32 #include "typeprint.h"
34 #include "cli/cli-style.h"
36 static void m2_print_bounds (struct type
*type
,
37 struct ui_file
*stream
, int show
, int level
,
40 static void m2_typedef (struct type
*, struct ui_file
*, int, int,
41 const struct type_print_options
*);
42 static void m2_array (struct type
*, struct ui_file
*, int, int,
43 const struct type_print_options
*);
44 static void m2_pointer (struct type
*, struct ui_file
*, int, int,
45 const struct type_print_options
*);
46 static void m2_ref (struct type
*, struct ui_file
*, int, int,
47 const struct type_print_options
*);
48 static void m2_procedure (struct type
*, struct ui_file
*, int, int,
49 const struct type_print_options
*);
50 static void m2_union (struct type
*, struct ui_file
*);
51 static void m2_enum (struct type
*, struct ui_file
*, int, int);
52 static void m2_range (struct type
*, struct ui_file
*, int, int,
53 const struct type_print_options
*);
54 static void m2_type_name (struct type
*type
, struct ui_file
*stream
);
55 static void m2_short_set (struct type
*type
, struct ui_file
*stream
,
57 static int m2_long_set (struct type
*type
, struct ui_file
*stream
,
58 int show
, int level
, const struct type_print_options
*flags
);
59 static int m2_unbounded_array (struct type
*type
, struct ui_file
*stream
,
61 const struct type_print_options
*flags
);
62 static void m2_record_fields (struct type
*type
, struct ui_file
*stream
,
63 int show
, int level
, const struct type_print_options
*flags
);
64 static void m2_unknown (const char *s
, struct type
*type
,
65 struct ui_file
*stream
, int show
, int level
);
67 int m2_is_long_set (struct type
*type
);
68 int m2_is_long_set_of_type (struct type
*type
, struct type
**of_type
);
69 int m2_is_unbounded_array (struct type
*type
);
73 m2_print_type (struct type
*type
, const char *varstring
,
74 struct ui_file
*stream
,
76 const struct type_print_options
*flags
)
78 type
= check_typedef (type
);
85 fputs_styled (_("<type unknown>"), metadata_style
.style (), stream
);
89 switch (type
->code ())
92 m2_short_set(type
, stream
, show
, level
);
95 case TYPE_CODE_STRUCT
:
96 if (m2_long_set (type
, stream
, show
, level
, flags
)
97 || m2_unbounded_array (type
, stream
, show
, level
, flags
))
99 m2_record_fields (type
, stream
, show
, level
, flags
);
102 case TYPE_CODE_TYPEDEF
:
103 m2_typedef (type
, stream
, show
, level
, flags
);
106 case TYPE_CODE_ARRAY
:
107 m2_array (type
, stream
, show
, level
, flags
);
111 m2_pointer (type
, stream
, show
, level
, flags
);
115 m2_ref (type
, stream
, show
, level
, flags
);
118 case TYPE_CODE_METHOD
:
119 m2_unknown (_("method"), type
, stream
, show
, level
);
123 m2_procedure (type
, stream
, show
, level
, flags
);
126 case TYPE_CODE_UNION
:
127 m2_union (type
, stream
);
131 m2_enum (type
, stream
, show
, level
);
137 case TYPE_CODE_UNDEF
:
138 /* i18n: Do not translate the "struct" part! */
139 m2_unknown (_("undef"), type
, stream
, show
, level
);
142 case TYPE_CODE_ERROR
:
143 m2_unknown (_("error"), type
, stream
, show
, level
);
146 case TYPE_CODE_RANGE
:
147 m2_range (type
, stream
, show
, level
, flags
);
151 m2_type_name (type
, stream
);
156 /* Print a typedef using M2 syntax. TYPE is the underlying type.
157 NEW_SYMBOL is the symbol naming the type. STREAM is the stream on
161 m2_print_typedef (struct type
*type
, struct symbol
*new_symbol
,
162 struct ui_file
*stream
)
164 type
= check_typedef (type
);
165 fprintf_filtered (stream
, "TYPE ");
166 if (!SYMBOL_TYPE (new_symbol
)->name ()
167 || strcmp ((SYMBOL_TYPE (new_symbol
))->name (),
168 new_symbol
->linkage_name ()) != 0)
169 fprintf_filtered (stream
, "%s = ", new_symbol
->print_name ());
171 fprintf_filtered (stream
, "<builtin> = ");
172 type_print (type
, "", stream
, 0);
173 fprintf_filtered (stream
, ";");
176 /* m2_type_name - if a, type, has a name then print it. */
179 m2_type_name (struct type
*type
, struct ui_file
*stream
)
181 if (type
->name () != NULL
)
182 fputs_filtered (type
->name (), stream
);
185 /* m2_range - displays a Modula-2 subrange type. */
188 m2_range (struct type
*type
, struct ui_file
*stream
, int show
,
189 int level
, const struct type_print_options
*flags
)
191 if (type
->bounds ()->high
.const_val () == type
->bounds ()->low
.const_val ())
193 /* FIXME: TYPE_TARGET_TYPE used to be TYPE_DOMAIN_TYPE but that was
194 wrong. Not sure if TYPE_TARGET_TYPE is correct though. */
195 m2_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
,
200 struct type
*target
= TYPE_TARGET_TYPE (type
);
202 fprintf_filtered (stream
, "[");
203 print_type_scalar (target
, type
->bounds ()->low
.const_val (), stream
);
204 fprintf_filtered (stream
, "..");
205 print_type_scalar (target
, type
->bounds ()->high
.const_val (), stream
);
206 fprintf_filtered (stream
, "]");
211 m2_typedef (struct type
*type
, struct ui_file
*stream
, int show
,
212 int level
, const struct type_print_options
*flags
)
214 if (type
->name () != NULL
)
216 fputs_filtered (type
->name (), stream
);
217 fputs_filtered (" = ", stream
);
219 m2_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
, flags
);
222 /* m2_array - prints out a Modula-2 ARRAY ... OF type. */
224 static void m2_array (struct type
*type
, struct ui_file
*stream
,
225 int show
, int level
, const struct type_print_options
*flags
)
227 fprintf_filtered (stream
, "ARRAY [");
228 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0
229 && type
->bounds ()->high
.kind () != PROP_UNDEFINED
)
231 if (type
->index_type () != 0)
233 m2_print_bounds (type
->index_type (), stream
, show
, -1, 0);
234 fprintf_filtered (stream
, "..");
235 m2_print_bounds (type
->index_type (), stream
, show
, -1, 1);
238 fputs_filtered (pulongest ((TYPE_LENGTH (type
)
239 / TYPE_LENGTH (TYPE_TARGET_TYPE (type
)))),
242 fprintf_filtered (stream
, "] OF ");
243 m2_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
, flags
);
247 m2_pointer (struct type
*type
, struct ui_file
*stream
, int show
,
248 int level
, const struct type_print_options
*flags
)
250 if (TYPE_CONST (type
))
251 fprintf_filtered (stream
, "[...] : ");
253 fprintf_filtered (stream
, "POINTER TO ");
255 m2_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
, flags
);
259 m2_ref (struct type
*type
, struct ui_file
*stream
, int show
,
260 int level
, const struct type_print_options
*flags
)
262 fprintf_filtered (stream
, "VAR");
263 m2_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
, flags
);
267 m2_unknown (const char *s
, struct type
*type
, struct ui_file
*stream
,
270 fprintf_filtered (stream
, "%s %s", s
, _("is unknown"));
273 static void m2_union (struct type
*type
, struct ui_file
*stream
)
275 fprintf_filtered (stream
, "union");
279 m2_procedure (struct type
*type
, struct ui_file
*stream
,
280 int show
, int level
, const struct type_print_options
*flags
)
282 fprintf_filtered (stream
, "PROCEDURE ");
283 m2_type_name (type
, stream
);
284 if (TYPE_TARGET_TYPE (type
) == NULL
285 || TYPE_TARGET_TYPE (type
)->code () != TYPE_CODE_VOID
)
287 int i
, len
= type
->num_fields ();
289 fprintf_filtered (stream
, " (");
290 for (i
= 0; i
< len
; i
++)
294 fputs_filtered (", ", stream
);
297 m2_print_type (type
->field (i
).type (), "", stream
, -1, 0, flags
);
299 fprintf_filtered (stream
, ") : ");
300 if (TYPE_TARGET_TYPE (type
) != NULL
)
301 m2_print_type (TYPE_TARGET_TYPE (type
), "", stream
, 0, 0, flags
);
303 type_print_unknown_return_type (stream
);
308 m2_print_bounds (struct type
*type
,
309 struct ui_file
*stream
, int show
, int level
,
312 struct type
*target
= TYPE_TARGET_TYPE (type
);
314 if (type
->num_fields () == 0)
318 print_type_scalar (target
, type
->bounds ()->high
.const_val (), stream
);
320 print_type_scalar (target
, type
->bounds ()->low
.const_val (), stream
);
324 m2_short_set (struct type
*type
, struct ui_file
*stream
, int show
, int level
)
326 fprintf_filtered(stream
, "SET [");
327 m2_print_bounds (type
->index_type (), stream
,
330 fprintf_filtered(stream
, "..");
331 m2_print_bounds (type
->index_type (), stream
,
333 fprintf_filtered(stream
, "]");
337 m2_is_long_set (struct type
*type
)
339 LONGEST previous_high
= 0; /* Unnecessary initialization
340 keeps gcc -Wall happy. */
344 if (type
->code () == TYPE_CODE_STRUCT
)
347 /* check if all fields of the RECORD are consecutive sets. */
349 len
= type
->num_fields ();
350 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
352 if (type
->field (i
).type () == NULL
)
354 if (type
->field (i
).type ()->code () != TYPE_CODE_SET
)
356 if (TYPE_FIELD_NAME (type
, i
) != NULL
357 && (strcmp (TYPE_FIELD_NAME (type
, i
), "") != 0))
359 range
= type
->field (i
).type ()->index_type ();
360 if ((i
> TYPE_N_BASECLASSES (type
))
361 && previous_high
+ 1 != range
->bounds ()->low
.const_val ())
363 previous_high
= range
->bounds ()->high
.const_val ();
370 /* m2_get_discrete_bounds - a wrapper for get_discrete_bounds which
371 understands that CHARs might be signed.
372 This should be integrated into gdbtypes.c
373 inside get_discrete_bounds. */
376 m2_get_discrete_bounds (struct type
*type
, LONGEST
*lowp
, LONGEST
*highp
)
378 type
= check_typedef (type
);
379 switch (type
->code ())
382 if (TYPE_LENGTH (type
) < sizeof (LONGEST
))
384 if (!type
->is_unsigned ())
386 *lowp
= -(1 << (TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1));
393 return get_discrete_bounds (type
, lowp
, highp
);
397 /* m2_is_long_set_of_type - returns TRUE if the long set was declared as
398 SET OF <oftype> of_type is assigned to the
402 m2_is_long_set_of_type (struct type
*type
, struct type
**of_type
)
410 if (type
->code () == TYPE_CODE_STRUCT
)
412 len
= type
->num_fields ();
413 i
= TYPE_N_BASECLASSES (type
);
416 range
= type
->field (i
).type ()->index_type ();
417 target
= TYPE_TARGET_TYPE (range
);
419 l1
= type
->field (i
).type ()->bounds ()->low
.const_val ();
420 h1
= type
->field (len
- 1).type ()->bounds ()->high
.const_val ();
422 if (m2_get_discrete_bounds (target
, &l2
, &h2
) >= 0)
423 return (l1
== l2
&& h1
== h2
);
424 error (_("long_set failed to find discrete bounds for its subtype"));
427 error (_("expecting long_set"));
432 m2_long_set (struct type
*type
, struct ui_file
*stream
, int show
, int level
,
433 const struct type_print_options
*flags
)
435 struct type
*of_type
;
437 int len
= type
->num_fields ();
441 if (m2_is_long_set (type
))
443 if (type
->name () != NULL
)
445 fputs_filtered (type
->name (), stream
);
448 fputs_filtered (" = ", stream
);
451 if (get_long_set_bounds (type
, &low
, &high
))
453 fprintf_filtered(stream
, "SET OF ");
454 i
= TYPE_N_BASECLASSES (type
);
455 if (m2_is_long_set_of_type (type
, &of_type
))
456 m2_print_type (of_type
, "", stream
, show
- 1, level
, flags
);
459 fprintf_filtered(stream
, "[");
460 m2_print_bounds (type
->field (i
).type ()->index_type (),
461 stream
, show
- 1, level
, 0);
463 fprintf_filtered(stream
, "..");
465 m2_print_bounds (type
->field (len
- 1).type ()->index_type (),
466 stream
, show
- 1, level
, 1);
467 fprintf_filtered(stream
, "]");
471 /* i18n: Do not translate the "SET OF" part! */
472 fprintf_filtered(stream
, _("SET OF <unknown>"));
479 /* m2_is_unbounded_array - returns TRUE if, type, should be regarded
480 as a Modula-2 unbounded ARRAY type. */
483 m2_is_unbounded_array (struct type
*type
)
485 if (type
->code () == TYPE_CODE_STRUCT
)
488 * check if we have a structure with exactly two fields named
489 * _m2_contents and _m2_high. It also checks to see if the
490 * type of _m2_contents is a pointer. The TYPE_TARGET_TYPE
491 * of the pointer determines the unbounded ARRAY OF type.
493 if (type
->num_fields () != 2)
495 if (strcmp (TYPE_FIELD_NAME (type
, 0), "_m2_contents") != 0)
497 if (strcmp (TYPE_FIELD_NAME (type
, 1), "_m2_high") != 0)
499 if (type
->field (0).type ()->code () != TYPE_CODE_PTR
)
506 /* m2_unbounded_array - if the struct type matches a Modula-2 unbounded
507 parameter type then display the type as an
508 ARRAY OF type. Returns TRUE if an unbounded
509 array type was detected. */
512 m2_unbounded_array (struct type
*type
, struct ui_file
*stream
, int show
,
513 int level
, const struct type_print_options
*flags
)
515 if (m2_is_unbounded_array (type
))
519 fputs_filtered ("ARRAY OF ", stream
);
520 m2_print_type (TYPE_TARGET_TYPE (type
->field (0).type ()),
521 "", stream
, 0, level
, flags
);
529 m2_record_fields (struct type
*type
, struct ui_file
*stream
, int show
,
530 int level
, const struct type_print_options
*flags
)
532 /* Print the tag if it exists. */
533 if (type
->name () != NULL
)
535 if (!startswith (type
->name (), "$$"))
537 fputs_filtered (type
->name (), stream
);
539 fprintf_filtered (stream
, " = ");
545 if (type
->code () == TYPE_CODE_STRUCT
)
546 fprintf_filtered (stream
, "RECORD ... END ");
547 else if (type
->code () == TYPE_CODE_UNION
)
548 fprintf_filtered (stream
, "CASE ... END ");
553 int len
= type
->num_fields ();
555 if (type
->code () == TYPE_CODE_STRUCT
)
556 fprintf_filtered (stream
, "RECORD\n");
557 else if (type
->code () == TYPE_CODE_UNION
)
558 /* i18n: Do not translate "CASE" and "OF". */
559 fprintf_filtered (stream
, _("CASE <variant> OF\n"));
561 for (i
= TYPE_N_BASECLASSES (type
); i
< len
; i
++)
565 print_spaces_filtered (level
+ 4, stream
);
566 fputs_styled (TYPE_FIELD_NAME (type
, i
),
567 variable_name_style
.style (), stream
);
568 fputs_filtered (" : ", stream
);
569 m2_print_type (type
->field (i
).type (),
571 stream
, 0, level
+ 4, flags
);
572 if (TYPE_FIELD_PACKED (type
, i
))
574 /* It is a bitfield. This code does not attempt
575 to look at the bitpos and reconstruct filler,
576 unnamed fields. This would lead to misleading
577 results if the compiler does not put out fields
578 for such things (I don't know what it does). */
579 fprintf_filtered (stream
, " : %d",
580 TYPE_FIELD_BITSIZE (type
, i
));
582 fprintf_filtered (stream
, ";\n");
585 fprintfi_filtered (level
, stream
, "END ");
590 m2_enum (struct type
*type
, struct ui_file
*stream
, int show
, int level
)
597 /* If we just printed a tag name, no need to print anything else. */
598 if (type
->name () == NULL
)
599 fprintf_filtered (stream
, "(...)");
601 else if (show
> 0 || type
->name () == NULL
)
603 fprintf_filtered (stream
, "(");
604 len
= type
->num_fields ();
606 for (i
= 0; i
< len
; i
++)
610 fprintf_filtered (stream
, ", ");
612 fputs_styled (TYPE_FIELD_NAME (type
, i
),
613 variable_name_style
.style (), stream
);
614 if (lastval
!= TYPE_FIELD_ENUMVAL (type
, i
))
616 fprintf_filtered (stream
, " = %s",
617 plongest (TYPE_FIELD_ENUMVAL (type
, i
)));
618 lastval
= TYPE_FIELD_ENUMVAL (type
, i
);
622 fprintf_filtered (stream
, ")");