1 /* Modula 2 language support routines for GDB, the GNU debugger.
3 Copyright (C) 1992-2024 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/>. */
22 #include "expression.h"
23 #include "parser-defs.h"
32 /* A helper function for UNOP_HIGH. */
35 eval_op_m2_high (struct type
*expect_type
, struct expression
*exp
,
39 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
43 arg1
= coerce_ref (arg1
);
44 struct type
*type
= check_typedef (arg1
->type ());
46 if (m2_is_unbounded_array (type
))
48 struct value
*temp
= arg1
;
50 type
= type
->field (1).type ();
51 /* i18n: Do not translate the "_m2_high" part! */
52 arg1
= value_struct_elt (&temp
, {}, "_m2_high", NULL
,
53 _("unbounded structure "
54 "missing _m2_high field"));
56 if (arg1
->type () != type
)
57 arg1
= value_cast (type
, arg1
);
63 /* A helper function for BINOP_SUBSCRIPT. */
66 eval_op_m2_subscript (struct type
*expect_type
, struct expression
*exp
,
68 struct value
*arg1
, struct value
*arg2
)
70 /* If the user attempts to subscript something that is not an
71 array or pointer type (like a plain int variable for example),
72 then report this as an error. */
74 arg1
= coerce_ref (arg1
);
75 struct type
*type
= check_typedef (arg1
->type ());
77 if (m2_is_unbounded_array (type
))
79 struct value
*temp
= arg1
;
80 type
= type
->field (0).type ();
81 if (type
== NULL
|| (type
->code () != TYPE_CODE_PTR
))
82 error (_("internal error: unbounded "
83 "array structure is unknown"));
84 /* i18n: Do not translate the "_m2_contents" part! */
85 arg1
= value_struct_elt (&temp
, {}, "_m2_contents", NULL
,
86 _("unbounded structure "
87 "missing _m2_contents field"));
89 if (arg1
->type () != type
)
90 arg1
= value_cast (type
, arg1
);
92 check_typedef (arg1
->type ());
93 return value_ind (value_ptradd (arg1
, value_as_long (arg2
)));
96 if (type
->code () != TYPE_CODE_ARRAY
)
99 error (_("cannot subscript something of type `%s'"),
102 error (_("cannot subscript requested type"));
105 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
106 return value::zero (type
->target_type (), arg1
->lval ());
108 return value_subscript (arg1
, value_as_long (arg2
));
113 /* Single instance of the M2 language. */
115 static m2_language m2_language_defn
;
117 /* See language.h. */
120 m2_language::language_arch_info (struct gdbarch
*gdbarch
,
121 struct language_arch_info
*lai
) const
123 const struct builtin_m2_type
*builtin
= builtin_m2_type (gdbarch
);
125 /* Helper function to allow shorter lines below. */
126 auto add
= [&] (struct type
* t
)
128 lai
->add_primitive_type (t
);
131 add (builtin
->builtin_char
);
132 add (builtin
->builtin_int
);
133 add (builtin
->builtin_card
);
134 add (builtin
->builtin_real
);
135 add (builtin
->builtin_bool
);
137 lai
->set_string_char_type (builtin
->builtin_char
);
138 lai
->set_bool_type (builtin
->builtin_bool
, "BOOLEAN");
141 /* See language.h. */
144 m2_language::printchar (int c
, struct type
*type
,
145 struct ui_file
*stream
) const
147 gdb_puts ("'", stream
);
148 emitchar (c
, type
, stream
, '\'');
149 gdb_puts ("'", stream
);
152 /* See language.h. */
155 m2_language::printstr (struct ui_file
*stream
, struct type
*elttype
,
156 const gdb_byte
*string
, unsigned int length
,
157 const char *encoding
, int force_ellipses
,
158 const struct value_print_options
*options
) const
161 unsigned int things_printed
= 0;
171 unsigned int print_max_chars
= get_print_max_chars (options
);
172 for (i
= 0; i
< length
&& things_printed
< print_max_chars
; ++i
)
174 /* Position of the character we are examining
175 to see whether it is repeated. */
177 /* Number of repetitions we have detected so far. */
184 gdb_puts (", ", stream
);
190 while (rep1
< length
&& string
[rep1
] == string
[i
])
196 if (reps
> options
->repeat_count_threshold
)
200 gdb_puts ("\", ", stream
);
203 printchar (string
[i
], elttype
, stream
);
204 gdb_printf (stream
, " <repeats %u times>", reps
);
206 things_printed
+= options
->repeat_count_threshold
;
213 gdb_puts ("\"", stream
);
216 emitchar (string
[i
], elttype
, stream
, '"');
221 /* Terminate the quotes if necessary. */
223 gdb_puts ("\"", stream
);
225 if (force_ellipses
|| i
< length
)
226 gdb_puts ("...", stream
);
229 /* See language.h. */
232 m2_language::emitchar (int ch
, struct type
*chtype
,
233 struct ui_file
*stream
, int quoter
) const
235 ch
&= 0xFF; /* Avoid sign bit follies. */
237 if (PRINT_LITERAL_FORM (ch
))
239 if (ch
== '\\' || ch
== quoter
)
240 gdb_puts ("\\", stream
);
241 gdb_printf (stream
, "%c", ch
);
248 gdb_puts ("\\n", stream
);
251 gdb_puts ("\\b", stream
);
254 gdb_puts ("\\t", stream
);
257 gdb_puts ("\\f", stream
);
260 gdb_puts ("\\r", stream
);
263 gdb_puts ("\\e", stream
);
266 gdb_puts ("\\a", stream
);
269 gdb_printf (stream
, "\\%.3o", (unsigned int) ch
);
275 /* Called during architecture gdbarch initialisation to create language
278 static struct builtin_m2_type
*
279 build_m2_types (struct gdbarch
*gdbarch
)
281 struct builtin_m2_type
*builtin_m2_type
= new struct builtin_m2_type
;
283 type_allocator
alloc (gdbarch
);
285 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
286 builtin_m2_type
->builtin_int
287 = init_integer_type (alloc
, gdbarch_int_bit (gdbarch
), 0, "INTEGER");
288 builtin_m2_type
->builtin_card
289 = init_integer_type (alloc
, gdbarch_int_bit (gdbarch
), 1, "CARDINAL");
290 builtin_m2_type
->builtin_real
291 = init_float_type (alloc
, gdbarch_float_bit (gdbarch
), "REAL",
292 gdbarch_float_format (gdbarch
));
293 builtin_m2_type
->builtin_char
294 = init_character_type (alloc
, TARGET_CHAR_BIT
, 1, "CHAR");
295 builtin_m2_type
->builtin_bool
296 = init_boolean_type (alloc
, gdbarch_int_bit (gdbarch
), 1, "BOOLEAN");
298 return builtin_m2_type
;
301 static const registry
<gdbarch
>::key
<struct builtin_m2_type
> m2_type_data
;
303 const struct builtin_m2_type
*
304 builtin_m2_type (struct gdbarch
*gdbarch
)
306 struct builtin_m2_type
*result
= m2_type_data
.get (gdbarch
);
307 if (result
== nullptr)
309 result
= build_m2_types (gdbarch
);
310 m2_type_data
.set (gdbarch
, result
);