Commit | Line | Data |
---|---|---|
c906108c | 1 | /* Modula 2 language support routines for GDB, the GNU debugger. |
ce27fb25 | 2 | |
b811d2c2 | 3 | Copyright (C) 1992-2020 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" |
c906108c | 31 | |
6c7a06a3 | 32 | static void m2_printchar (int, struct type *, struct ui_file *); |
c906108c SS |
33 | |
34 | /* FIXME: This is a copy of the same function from c-exp.y. It should | |
844781a1 | 35 | be replaced with a true Modula version. */ |
c906108c SS |
36 | |
37 | static void | |
6c7a06a3 | 38 | m2_printchar (int c, struct type *type, struct ui_file *stream) |
c906108c SS |
39 | { |
40 | fputs_filtered ("'", stream); | |
6c7a06a3 | 41 | LA_EMIT_CHAR (c, type, stream, '\''); |
c906108c SS |
42 | fputs_filtered ("'", stream); |
43 | } | |
44 | ||
4be290b2 AB |
45 | /* Return true if TYPE is a string. */ |
46 | ||
47 | static bool | |
48 | m2_is_string_type_p (struct type *type) | |
49 | { | |
50 | type = check_typedef (type); | |
78134374 | 51 | if (type->code () == TYPE_CODE_ARRAY |
4be290b2 AB |
52 | && TYPE_LENGTH (type) > 0 |
53 | && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0) | |
54 | { | |
55 | struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type)); | |
56 | ||
57 | if (TYPE_LENGTH (elttype) == 1 | |
78134374 SM |
58 | && (elttype->code () == TYPE_CODE_INT |
59 | || elttype->code () == TYPE_CODE_CHAR)) | |
4be290b2 AB |
60 | return true; |
61 | } | |
62 | ||
63 | return false; | |
64 | } | |
65 | ||
844781a1 GM |
66 | static struct value * |
67 | evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp, | |
68 | int *pos, enum noside noside) | |
69 | { | |
70 | enum exp_opcode op = exp->elts[*pos].opcode; | |
71 | struct value *arg1; | |
72 | struct value *arg2; | |
73 | struct type *type; | |
b8d56208 | 74 | |
844781a1 GM |
75 | switch (op) |
76 | { | |
77 | case UNOP_HIGH: | |
78 | (*pos)++; | |
79 | arg1 = evaluate_subexp_with_coercion (exp, pos, noside); | |
80 | ||
81 | if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS) | |
82 | return arg1; | |
83 | else | |
84 | { | |
85 | arg1 = coerce_ref (arg1); | |
86 | type = check_typedef (value_type (arg1)); | |
87 | ||
88 | if (m2_is_unbounded_array (type)) | |
89 | { | |
90 | struct value *temp = arg1; | |
b8d56208 | 91 | |
940da03e | 92 | type = type->field (1).type (); |
844781a1 GM |
93 | /* i18n: Do not translate the "_m2_high" part! */ |
94 | arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL, | |
95 | _("unbounded structure " | |
96 | "missing _m2_high field")); | |
97 | ||
98 | if (value_type (arg1) != type) | |
99 | arg1 = value_cast (type, arg1); | |
100 | } | |
101 | } | |
102 | return arg1; | |
103 | ||
104 | case BINOP_SUBSCRIPT: | |
105 | (*pos)++; | |
106 | arg1 = evaluate_subexp_with_coercion (exp, pos, noside); | |
107 | arg2 = evaluate_subexp_with_coercion (exp, pos, noside); | |
108 | if (noside == EVAL_SKIP) | |
109 | goto nosideret; | |
110 | /* If the user attempts to subscript something that is not an | |
111 | array or pointer type (like a plain int variable for example), | |
112 | then report this as an error. */ | |
113 | ||
114 | arg1 = coerce_ref (arg1); | |
115 | type = check_typedef (value_type (arg1)); | |
116 | ||
117 | if (m2_is_unbounded_array (type)) | |
118 | { | |
119 | struct value *temp = arg1; | |
940da03e | 120 | type = type->field (0).type (); |
78134374 | 121 | if (type == NULL || (type->code () != TYPE_CODE_PTR)) |
b8d56208 | 122 | { |
025bb325 MS |
123 | warning (_("internal error: unbounded " |
124 | "array structure is unknown")); | |
b8d56208 MS |
125 | return evaluate_subexp_standard (expect_type, exp, pos, noside); |
126 | } | |
844781a1 GM |
127 | /* i18n: Do not translate the "_m2_contents" part! */ |
128 | arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL, | |
129 | _("unbounded structure " | |
130 | "missing _m2_contents field")); | |
131 | ||
132 | if (value_type (arg1) != type) | |
133 | arg1 = value_cast (type, arg1); | |
134 | ||
976aa66e | 135 | check_typedef (value_type (arg1)); |
2497b498 | 136 | return value_ind (value_ptradd (arg1, value_as_long (arg2))); |
844781a1 GM |
137 | } |
138 | else | |
78134374 | 139 | if (type->code () != TYPE_CODE_ARRAY) |
844781a1 | 140 | { |
7d93a1e0 | 141 | if (type->name ()) |
844781a1 | 142 | error (_("cannot subscript something of type `%s'"), |
7d93a1e0 | 143 | type->name ()); |
844781a1 GM |
144 | else |
145 | error (_("cannot subscript requested type")); | |
146 | } | |
147 | ||
148 | if (noside == EVAL_AVOID_SIDE_EFFECTS) | |
149 | return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1)); | |
150 | else | |
2497b498 | 151 | return value_subscript (arg1, value_as_long (arg2)); |
844781a1 GM |
152 | |
153 | default: | |
154 | return evaluate_subexp_standard (expect_type, exp, pos, noside); | |
155 | } | |
156 | ||
157 | nosideret: | |
22601c15 | 158 | return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1); |
844781a1 | 159 | } |
c906108c | 160 | \f |
c5aa993b | 161 | |
c906108c SS |
162 | /* Table of operators and their precedences for printing expressions. */ |
163 | ||
c5aa993b JM |
164 | static const struct op_print m2_op_print_tab[] = |
165 | { | |
166 | {"+", BINOP_ADD, PREC_ADD, 0}, | |
167 | {"+", UNOP_PLUS, PREC_PREFIX, 0}, | |
168 | {"-", BINOP_SUB, PREC_ADD, 0}, | |
169 | {"-", UNOP_NEG, PREC_PREFIX, 0}, | |
170 | {"*", BINOP_MUL, PREC_MUL, 0}, | |
171 | {"/", BINOP_DIV, PREC_MUL, 0}, | |
172 | {"DIV", BINOP_INTDIV, PREC_MUL, 0}, | |
173 | {"MOD", BINOP_REM, PREC_MUL, 0}, | |
174 | {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, | |
175 | {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0}, | |
176 | {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0}, | |
177 | {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, | |
178 | {"=", BINOP_EQUAL, PREC_EQUAL, 0}, | |
179 | {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0}, | |
180 | {"<=", BINOP_LEQ, PREC_ORDER, 0}, | |
181 | {">=", BINOP_GEQ, PREC_ORDER, 0}, | |
182 | {">", BINOP_GTR, PREC_ORDER, 0}, | |
183 | {"<", BINOP_LESS, PREC_ORDER, 0}, | |
184 | {"^", UNOP_IND, PREC_PREFIX, 0}, | |
185 | {"@", BINOP_REPEAT, PREC_REPEAT, 0}, | |
186 | {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0}, | |
187 | {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0}, | |
188 | {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0}, | |
189 | {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0}, | |
190 | {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0}, | |
191 | {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0}, | |
192 | {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0}, | |
193 | {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0}, | |
194 | {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0}, | |
f486487f | 195 | {NULL, OP_NULL, PREC_BUILTIN_FUNCTION, 0} |
c906108c SS |
196 | }; |
197 | \f | |
198 | /* The built-in types of Modula-2. */ | |
199 | ||
cad351d1 UW |
200 | enum m2_primitive_types { |
201 | m2_primitive_type_char, | |
202 | m2_primitive_type_int, | |
203 | m2_primitive_type_card, | |
204 | m2_primitive_type_real, | |
205 | m2_primitive_type_bool, | |
206 | nr_m2_primitive_types | |
c906108c SS |
207 | }; |
208 | ||
844781a1 GM |
209 | const struct exp_descriptor exp_descriptor_modula2 = |
210 | { | |
211 | print_subexp_standard, | |
212 | operator_length_standard, | |
c0201579 | 213 | operator_check_standard, |
844781a1 GM |
214 | op_name_standard, |
215 | dump_subexp_body_standard, | |
216 | evaluate_subexp_modula2 | |
217 | }; | |
218 | ||
0874fd07 AB |
219 | /* Constant data describing the M2 language. */ |
220 | ||
221 | extern const struct language_data m2_language_data = | |
c5aa993b | 222 | { |
c906108c | 223 | "modula-2", |
6abde28f | 224 | "Modula-2", |
c906108c | 225 | language_m2, |
c906108c | 226 | range_check_on, |
63872f9d | 227 | case_sensitive_on, |
7ca2d3a3 | 228 | array_row_major, |
9a044a89 | 229 | macro_expansion_no, |
56618e20 | 230 | NULL, |
844781a1 | 231 | &exp_descriptor_modula2, |
5c6ce71d | 232 | m2_print_typedef, /* Print a typedef using appropriate syntax */ |
2b2d9e11 | 233 | NULL, /* name_of_this */ |
59cc4834 | 234 | false, /* la_store_sym_names_in_linkage_form_p */ |
c906108c SS |
235 | m2_op_print_tab, /* expression operators for printing */ |
236 | 0, /* arrays are first-class (not c-style) */ | |
237 | 0, /* String lower bound */ | |
a53b64ea | 238 | &default_varobj_ops, |
4be290b2 | 239 | m2_is_string_type_p, |
721b08c6 | 240 | "{...}" /* la_struct_too_deep_ellipsis */ |
c906108c SS |
241 | }; |
242 | ||
0874fd07 AB |
243 | /* Class representing the M2 language. */ |
244 | ||
245 | class m2_language : public language_defn | |
246 | { | |
247 | public: | |
248 | m2_language () | |
249 | : language_defn (language_m2, m2_language_data) | |
250 | { /* Nothing. */ } | |
1fb314aa AB |
251 | |
252 | /* See language.h. */ | |
253 | void language_arch_info (struct gdbarch *gdbarch, | |
254 | struct language_arch_info *lai) const override | |
255 | { | |
256 | const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch); | |
257 | ||
258 | lai->string_char_type = builtin->builtin_char; | |
259 | lai->primitive_type_vector | |
260 | = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1, | |
261 | struct type *); | |
262 | ||
263 | lai->primitive_type_vector [m2_primitive_type_char] | |
264 | = builtin->builtin_char; | |
265 | lai->primitive_type_vector [m2_primitive_type_int] | |
266 | = builtin->builtin_int; | |
267 | lai->primitive_type_vector [m2_primitive_type_card] | |
268 | = builtin->builtin_card; | |
269 | lai->primitive_type_vector [m2_primitive_type_real] | |
270 | = builtin->builtin_real; | |
271 | lai->primitive_type_vector [m2_primitive_type_bool] | |
272 | = builtin->builtin_bool; | |
273 | ||
274 | lai->bool_type_symbol = "BOOLEAN"; | |
275 | lai->bool_type_default = builtin->builtin_bool; | |
276 | } | |
fbfb0a46 AB |
277 | |
278 | /* See language.h. */ | |
279 | ||
280 | void print_type (struct type *type, const char *varstring, | |
281 | struct ui_file *stream, int show, int level, | |
282 | const struct type_print_options *flags) const override | |
283 | { | |
284 | m2_print_type (type, varstring, stream, show, level, flags); | |
285 | } | |
ebe2334e AB |
286 | |
287 | /* See language.h. */ | |
288 | ||
289 | void value_print_inner | |
290 | (struct value *val, struct ui_file *stream, int recurse, | |
291 | const struct value_print_options *options) const override | |
292 | { | |
293 | return m2_value_print_inner (val, stream, recurse, options); | |
294 | } | |
87afa652 AB |
295 | |
296 | /* See language.h. */ | |
297 | ||
298 | int parser (struct parser_state *ps) const override | |
299 | { | |
300 | return m2_parse (ps); | |
301 | } | |
ec8cec5b AB |
302 | |
303 | /* See language.h. */ | |
304 | ||
305 | void emitchar (int ch, struct type *chtype, | |
306 | struct ui_file *stream, int quoter) const override | |
307 | { | |
308 | ch &= 0xFF; /* Avoid sign bit follies. */ | |
309 | ||
310 | if (PRINT_LITERAL_FORM (ch)) | |
311 | { | |
312 | if (ch == '\\' || ch == quoter) | |
313 | fputs_filtered ("\\", stream); | |
314 | fprintf_filtered (stream, "%c", ch); | |
315 | } | |
316 | else | |
317 | { | |
318 | switch (ch) | |
319 | { | |
320 | case '\n': | |
321 | fputs_filtered ("\\n", stream); | |
322 | break; | |
323 | case '\b': | |
324 | fputs_filtered ("\\b", stream); | |
325 | break; | |
326 | case '\t': | |
327 | fputs_filtered ("\\t", stream); | |
328 | break; | |
329 | case '\f': | |
330 | fputs_filtered ("\\f", stream); | |
331 | break; | |
332 | case '\r': | |
333 | fputs_filtered ("\\r", stream); | |
334 | break; | |
335 | case '\033': | |
336 | fputs_filtered ("\\e", stream); | |
337 | break; | |
338 | case '\007': | |
339 | fputs_filtered ("\\a", stream); | |
340 | break; | |
341 | default: | |
342 | fprintf_filtered (stream, "\\%.3o", (unsigned int) ch); | |
343 | break; | |
344 | } | |
345 | } | |
346 | } | |
52b50f2c AB |
347 | |
348 | /* See language.h. */ | |
349 | ||
350 | void printchar (int ch, struct type *chtype, | |
351 | struct ui_file *stream) const override | |
352 | { | |
353 | m2_printchar (ch, chtype, stream); | |
354 | } | |
d711ee67 AB |
355 | |
356 | /* See language.h. */ | |
357 | ||
358 | void printstr (struct ui_file *stream, struct type *elttype, | |
359 | const gdb_byte *string, unsigned int length, | |
360 | const char *encoding, int force_ellipses, | |
361 | const struct value_print_options *options) const override | |
362 | { | |
363 | unsigned int i; | |
364 | unsigned int things_printed = 0; | |
365 | int in_quotes = 0; | |
366 | int need_comma = 0; | |
367 | ||
368 | if (length == 0) | |
369 | { | |
370 | fputs_filtered ("\"\"", gdb_stdout); | |
371 | return; | |
372 | } | |
373 | ||
374 | for (i = 0; i < length && things_printed < options->print_max; ++i) | |
375 | { | |
376 | /* Position of the character we are examining | |
377 | to see whether it is repeated. */ | |
378 | unsigned int rep1; | |
379 | /* Number of repetitions we have detected so far. */ | |
380 | unsigned int reps; | |
381 | ||
382 | QUIT; | |
383 | ||
384 | if (need_comma) | |
385 | { | |
386 | fputs_filtered (", ", stream); | |
387 | need_comma = 0; | |
388 | } | |
389 | ||
390 | rep1 = i + 1; | |
391 | reps = 1; | |
392 | while (rep1 < length && string[rep1] == string[i]) | |
393 | { | |
394 | ++rep1; | |
395 | ++reps; | |
396 | } | |
397 | ||
398 | if (reps > options->repeat_count_threshold) | |
399 | { | |
400 | if (in_quotes) | |
401 | { | |
402 | fputs_filtered ("\", ", stream); | |
403 | in_quotes = 0; | |
404 | } | |
405 | m2_printchar (string[i], elttype, stream); | |
406 | fprintf_filtered (stream, " <repeats %u times>", reps); | |
407 | i = rep1 - 1; | |
408 | things_printed += options->repeat_count_threshold; | |
409 | need_comma = 1; | |
410 | } | |
411 | else | |
412 | { | |
413 | if (!in_quotes) | |
414 | { | |
415 | fputs_filtered ("\"", stream); | |
416 | in_quotes = 1; | |
417 | } | |
418 | LA_EMIT_CHAR (string[i], elttype, stream, '"'); | |
419 | ++things_printed; | |
420 | } | |
421 | } | |
422 | ||
423 | /* Terminate the quotes if necessary. */ | |
424 | if (in_quotes) | |
425 | fputs_filtered ("\"", stream); | |
426 | ||
427 | if (force_ellipses || i < length) | |
428 | fputs_filtered ("...", stream); | |
429 | } | |
0874fd07 AB |
430 | }; |
431 | ||
432 | /* Single instance of the M2 language. */ | |
433 | ||
434 | static m2_language m2_language_defn; | |
435 | ||
5760b90a UW |
436 | static void * |
437 | build_m2_types (struct gdbarch *gdbarch) | |
c906108c | 438 | { |
5760b90a UW |
439 | struct builtin_m2_type *builtin_m2_type |
440 | = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type); | |
441 | ||
c906108c | 442 | /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */ |
e9bb382b UW |
443 | builtin_m2_type->builtin_int |
444 | = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER"); | |
445 | builtin_m2_type->builtin_card | |
446 | = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL"); | |
447 | builtin_m2_type->builtin_real | |
49f190bc UW |
448 | = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL", |
449 | gdbarch_float_format (gdbarch)); | |
e9bb382b UW |
450 | builtin_m2_type->builtin_char |
451 | = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR"); | |
452 | builtin_m2_type->builtin_bool | |
453 | = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN"); | |
c906108c | 454 | |
5760b90a UW |
455 | return builtin_m2_type; |
456 | } | |
457 | ||
458 | static struct gdbarch_data *m2_type_data; | |
459 | ||
460 | const struct builtin_m2_type * | |
461 | builtin_m2_type (struct gdbarch *gdbarch) | |
462 | { | |
9a3c8263 | 463 | return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data); |
5760b90a UW |
464 | } |
465 | ||
466 | ||
467 | /* Initialization for Modula-2 */ | |
468 | ||
6c265988 | 469 | void _initialize_m2_language (); |
5760b90a | 470 | void |
6c265988 | 471 | _initialize_m2_language () |
5760b90a UW |
472 | { |
473 | m2_type_data = gdbarch_data_register_post_init (build_m2_types); | |
c906108c | 474 | } |