]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/m2-lang.c
gdb: use gdb::optional instead of passing a pointer to gdb::array_view
[thirdparty/binutils-gdb.git] / gdb / m2-lang.c
CommitLineData
c906108c 1/* Modula 2 language support routines for GDB, the GNU debugger.
ce27fb25 2
3666a048 3 Copyright (C) 1992-2021 Free Software Foundation, Inc.
c906108c 4
c5aa993b 5 This file is part of GDB.
c906108c 6
c5aa993b
JM
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
a9762ec7 9 the Free Software Foundation; either version 3 of the License, or
c5aa993b 10 (at your option) any later version.
c906108c 11
c5aa993b
JM
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.
c906108c 16
c5aa993b 17 You should have received a copy of the GNU General Public License
a9762ec7 18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c
SS
19
20#include "defs.h"
21#include "symtab.h"
22#include "gdbtypes.h"
23#include "expression.h"
24#include "parser-defs.h"
25#include "language.h"
a53b64ea 26#include "varobj.h"
c906108c
SS
27#include "m2-lang.h"
28#include "c-lang.h"
745b8ca0 29#include "valprint.h"
0d12e84c 30#include "gdbarch.h"
2bc9b40c 31#include "m2-exp.h"
c906108c 32
41bdced5
TT
33/* A helper function for UNOP_HIGH. */
34
2bc9b40c 35struct value *
41bdced5
TT
36eval_op_m2_high (struct type *expect_type, struct expression *exp,
37 enum noside noside,
38 struct value *arg1)
39{
0b2b0b82 40 if (noside == EVAL_AVOID_SIDE_EFFECTS)
41bdced5
TT
41 return arg1;
42 else
43 {
44 arg1 = coerce_ref (arg1);
45 struct type *type = check_typedef (value_type (arg1));
46
47 if (m2_is_unbounded_array (type))
48 {
49 struct value *temp = arg1;
50
51 type = type->field (1).type ();
52 /* i18n: Do not translate the "_m2_high" part! */
158cc4fe 53 arg1 = value_struct_elt (&temp, {}, "_m2_high", NULL,
41bdced5
TT
54 _("unbounded structure "
55 "missing _m2_high field"));
56
57 if (value_type (arg1) != type)
58 arg1 = value_cast (type, arg1);
59 }
60 }
61 return arg1;
62}
63
a49881f7
TT
64/* A helper function for BINOP_SUBSCRIPT. */
65
2bc9b40c 66struct value *
a49881f7
TT
67eval_op_m2_subscript (struct type *expect_type, struct expression *exp,
68 enum noside noside,
69 struct value *arg1, struct value *arg2)
70{
a49881f7
TT
71 /* If the user attempts to subscript something that is not an
72 array or pointer type (like a plain int variable for example),
73 then report this as an error. */
74
75 arg1 = coerce_ref (arg1);
76 struct type *type = check_typedef (value_type (arg1));
77
78 if (m2_is_unbounded_array (type))
79 {
80 struct value *temp = arg1;
81 type = type->field (0).type ();
82 if (type == NULL || (type->code () != TYPE_CODE_PTR))
83 error (_("internal error: unbounded "
84 "array structure is unknown"));
85 /* i18n: Do not translate the "_m2_contents" part! */
158cc4fe 86 arg1 = value_struct_elt (&temp, {}, "_m2_contents", NULL,
a49881f7
TT
87 _("unbounded structure "
88 "missing _m2_contents field"));
89
90 if (value_type (arg1) != type)
91 arg1 = value_cast (type, arg1);
92
93 check_typedef (value_type (arg1));
94 return value_ind (value_ptradd (arg1, value_as_long (arg2)));
95 }
96 else
97 if (type->code () != TYPE_CODE_ARRAY)
98 {
99 if (type->name ())
100 error (_("cannot subscript something of type `%s'"),
101 type->name ());
102 else
103 error (_("cannot subscript requested type"));
104 }
105
106 if (noside == EVAL_AVOID_SIDE_EFFECTS)
107 return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
108 else
109 return value_subscript (arg1, value_as_long (arg2));
110}
111
c906108c 112\f
c5aa993b 113
790e2a12 114/* Single instance of the M2 language. */
d711ee67 115
790e2a12 116static m2_language m2_language_defn;
4ffc13fb 117
790e2a12 118/* See language.h. */
4ffc13fb 119
790e2a12
AB
120void
121m2_language::language_arch_info (struct gdbarch *gdbarch,
122 struct language_arch_info *lai) const
123{
124 const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
125
7bea47f0
AB
126 /* Helper function to allow shorter lines below. */
127 auto add = [&] (struct type * t)
128 {
129 lai->add_primitive_type (t);
130 };
131
132 add (builtin->builtin_char);
133 add (builtin->builtin_int);
134 add (builtin->builtin_card);
135 add (builtin->builtin_real);
136 add (builtin->builtin_bool);
137
138 lai->set_string_char_type (builtin->builtin_char);
139 lai->set_bool_type (builtin->builtin_bool, "BOOLEAN");
790e2a12 140}
4ffc13fb 141
790e2a12 142/* See languge.h. */
39e7ecca 143
790e2a12
AB
144void
145m2_language::printchar (int c, struct type *type,
146 struct ui_file *stream) const
147{
148 fputs_filtered ("'", stream);
149 emitchar (c, type, stream, '\'');
150 fputs_filtered ("'", stream);
151}
39e7ecca 152
790e2a12 153/* See language.h. */
39e7ecca 154
790e2a12
AB
155void
156m2_language::printstr (struct ui_file *stream, struct type *elttype,
157 const gdb_byte *string, unsigned int length,
158 const char *encoding, int force_ellipses,
159 const struct value_print_options *options) const
160{
161 unsigned int i;
162 unsigned int things_printed = 0;
163 int in_quotes = 0;
164 int need_comma = 0;
67bd3fd5 165
790e2a12
AB
166 if (length == 0)
167 {
168 fputs_filtered ("\"\"", gdb_stdout);
169 return;
170 }
67bd3fd5 171
790e2a12
AB
172 for (i = 0; i < length && things_printed < options->print_max; ++i)
173 {
174 /* Position of the character we are examining
175 to see whether it is repeated. */
176 unsigned int rep1;
177 /* Number of repetitions we have detected so far. */
178 unsigned int reps;
22c12a6c 179
790e2a12 180 QUIT;
22c12a6c 181
790e2a12
AB
182 if (need_comma)
183 {
184 fputs_filtered (", ", stream);
185 need_comma = 0;
186 }
efdf6a73 187
790e2a12
AB
188 rep1 = i + 1;
189 reps = 1;
190 while (rep1 < length && string[rep1] == string[i])
191 {
192 ++rep1;
193 ++reps;
194 }
efdf6a73 195
790e2a12
AB
196 if (reps > options->repeat_count_threshold)
197 {
198 if (in_quotes)
199 {
200 fputs_filtered ("\", ", stream);
201 in_quotes = 0;
202 }
203 printchar (string[i], elttype, stream);
204 fprintf_filtered (stream, " <repeats %u times>", reps);
205 i = rep1 - 1;
206 things_printed += options->repeat_count_threshold;
207 need_comma = 1;
208 }
209 else
210 {
211 if (!in_quotes)
212 {
213 fputs_filtered ("\"", stream);
214 in_quotes = 1;
215 }
216 emitchar (string[i], elttype, stream, '"');
217 ++things_printed;
218 }
219 }
5aba6ebe 220
790e2a12
AB
221 /* Terminate the quotes if necessary. */
222 if (in_quotes)
223 fputs_filtered ("\"", stream);
5aba6ebe 224
790e2a12
AB
225 if (force_ellipses || i < length)
226 fputs_filtered ("...", stream);
227}
b7c6e27d 228
790e2a12 229/* See language.h. */
b7c6e27d 230
790e2a12
AB
231void
232m2_language::emitchar (int ch, struct type *chtype,
233 struct ui_file *stream, int quoter) const
234{
235 ch &= 0xFF; /* Avoid sign bit follies. */
0874fd07 236
790e2a12
AB
237 if (PRINT_LITERAL_FORM (ch))
238 {
239 if (ch == '\\' || ch == quoter)
240 fputs_filtered ("\\", stream);
241 fprintf_filtered (stream, "%c", ch);
242 }
243 else
244 {
245 switch (ch)
246 {
247 case '\n':
248 fputs_filtered ("\\n", stream);
249 break;
250 case '\b':
251 fputs_filtered ("\\b", stream);
252 break;
253 case '\t':
254 fputs_filtered ("\\t", stream);
255 break;
256 case '\f':
257 fputs_filtered ("\\f", stream);
258 break;
259 case '\r':
260 fputs_filtered ("\\r", stream);
261 break;
262 case '\033':
263 fputs_filtered ("\\e", stream);
264 break;
265 case '\007':
266 fputs_filtered ("\\a", stream);
267 break;
268 default:
269 fprintf_filtered (stream, "\\%.3o", (unsigned int) ch);
270 break;
271 }
272 }
273}
0874fd07 274
790e2a12
AB
275/* Called during architecture gdbarch initialisation to create language
276 specific types. */
0874fd07 277
5760b90a
UW
278static void *
279build_m2_types (struct gdbarch *gdbarch)
c906108c 280{
5760b90a
UW
281 struct builtin_m2_type *builtin_m2_type
282 = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
283
c906108c 284 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
e9bb382b
UW
285 builtin_m2_type->builtin_int
286 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
287 builtin_m2_type->builtin_card
288 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
289 builtin_m2_type->builtin_real
49f190bc
UW
290 = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL",
291 gdbarch_float_format (gdbarch));
e9bb382b
UW
292 builtin_m2_type->builtin_char
293 = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
294 builtin_m2_type->builtin_bool
295 = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
c906108c 296
5760b90a
UW
297 return builtin_m2_type;
298}
299
300static struct gdbarch_data *m2_type_data;
301
302const struct builtin_m2_type *
303builtin_m2_type (struct gdbarch *gdbarch)
304{
9a3c8263 305 return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data);
5760b90a
UW
306}
307
308
309/* Initialization for Modula-2 */
310
6c265988 311void _initialize_m2_language ();
5760b90a 312void
6c265988 313_initialize_m2_language ()
5760b90a
UW
314{
315 m2_type_data = gdbarch_data_register_post_init (build_m2_types);
c906108c 316}