oops - typo correction.
[deliverable/binutils-gdb.git] / gdb / m2-lang.c
1 /* Modula 2 language support routines for GDB, the GNU debugger.
2
3 Copyright (C) 1992-2013 Free Software Foundation, Inc.
4
5 This file is part of GDB.
6
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.
11
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.
16
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/>. */
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"
26 #include "m2-lang.h"
27 #include "c-lang.h"
28 #include "valprint.h"
29
30 extern void _initialize_m2_language (void);
31 static void m2_printchar (int, struct type *, struct ui_file *);
32 static void m2_emit_char (int, struct type *, struct ui_file *, int);
33
34 /* Print the character C on STREAM as part of the contents of a literal
35 string whose delimiter is QUOTER. Note that that format for printing
36 characters and strings is language specific.
37 FIXME: This is a copy of the same function from c-exp.y. It should
38 be replaced with a true Modula version. */
39
40 static void
41 m2_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
42 {
43
44 c &= 0xFF; /* Avoid sign bit follies. */
45
46 if (PRINT_LITERAL_FORM (c))
47 {
48 if (c == '\\' || c == quoter)
49 {
50 fputs_filtered ("\\", stream);
51 }
52 fprintf_filtered (stream, "%c", c);
53 }
54 else
55 {
56 switch (c)
57 {
58 case '\n':
59 fputs_filtered ("\\n", stream);
60 break;
61 case '\b':
62 fputs_filtered ("\\b", stream);
63 break;
64 case '\t':
65 fputs_filtered ("\\t", stream);
66 break;
67 case '\f':
68 fputs_filtered ("\\f", stream);
69 break;
70 case '\r':
71 fputs_filtered ("\\r", stream);
72 break;
73 case '\033':
74 fputs_filtered ("\\e", stream);
75 break;
76 case '\007':
77 fputs_filtered ("\\a", stream);
78 break;
79 default:
80 fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
81 break;
82 }
83 }
84 }
85
86 /* FIXME: This is a copy of the same function from c-exp.y. It should
87 be replaced with a true Modula version. */
88
89 static void
90 m2_printchar (int c, struct type *type, struct ui_file *stream)
91 {
92 fputs_filtered ("'", stream);
93 LA_EMIT_CHAR (c, type, stream, '\'');
94 fputs_filtered ("'", stream);
95 }
96
97 /* Print the character string STRING, printing at most LENGTH characters.
98 Printing stops early if the number hits print_max; repeat counts
99 are printed as appropriate. Print ellipses at the end if we
100 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
101 FIXME: This is a copy of the same function from c-exp.y. It should
102 be replaced with a true Modula version. */
103
104 static void
105 m2_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
106 unsigned int length, const char *encoding, int force_ellipses,
107 const struct value_print_options *options)
108 {
109 unsigned int i;
110 unsigned int things_printed = 0;
111 int in_quotes = 0;
112 int need_comma = 0;
113
114 if (length == 0)
115 {
116 fputs_filtered ("\"\"", gdb_stdout);
117 return;
118 }
119
120 for (i = 0; i < length && things_printed < options->print_max; ++i)
121 {
122 /* Position of the character we are examining
123 to see whether it is repeated. */
124 unsigned int rep1;
125 /* Number of repetitions we have detected so far. */
126 unsigned int reps;
127
128 QUIT;
129
130 if (need_comma)
131 {
132 fputs_filtered (", ", stream);
133 need_comma = 0;
134 }
135
136 rep1 = i + 1;
137 reps = 1;
138 while (rep1 < length && string[rep1] == string[i])
139 {
140 ++rep1;
141 ++reps;
142 }
143
144 if (reps > options->repeat_count_threshold)
145 {
146 if (in_quotes)
147 {
148 if (options->inspect_it)
149 fputs_filtered ("\\\", ", stream);
150 else
151 fputs_filtered ("\", ", stream);
152 in_quotes = 0;
153 }
154 m2_printchar (string[i], type, stream);
155 fprintf_filtered (stream, " <repeats %u times>", reps);
156 i = rep1 - 1;
157 things_printed += options->repeat_count_threshold;
158 need_comma = 1;
159 }
160 else
161 {
162 if (!in_quotes)
163 {
164 if (options->inspect_it)
165 fputs_filtered ("\\\"", stream);
166 else
167 fputs_filtered ("\"", stream);
168 in_quotes = 1;
169 }
170 LA_EMIT_CHAR (string[i], type, stream, '"');
171 ++things_printed;
172 }
173 }
174
175 /* Terminate the quotes if necessary. */
176 if (in_quotes)
177 {
178 if (options->inspect_it)
179 fputs_filtered ("\\\"", stream);
180 else
181 fputs_filtered ("\"", stream);
182 }
183
184 if (force_ellipses || i < length)
185 fputs_filtered ("...", stream);
186 }
187
188 static struct value *
189 evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
190 int *pos, enum noside noside)
191 {
192 enum exp_opcode op = exp->elts[*pos].opcode;
193 struct value *arg1;
194 struct value *arg2;
195 struct type *type;
196
197 switch (op)
198 {
199 case UNOP_HIGH:
200 (*pos)++;
201 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
202
203 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
204 return arg1;
205 else
206 {
207 arg1 = coerce_ref (arg1);
208 type = check_typedef (value_type (arg1));
209
210 if (m2_is_unbounded_array (type))
211 {
212 struct value *temp = arg1;
213
214 type = TYPE_FIELD_TYPE (type, 1);
215 /* i18n: Do not translate the "_m2_high" part! */
216 arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
217 _("unbounded structure "
218 "missing _m2_high field"));
219
220 if (value_type (arg1) != type)
221 arg1 = value_cast (type, arg1);
222 }
223 }
224 return arg1;
225
226 case BINOP_SUBSCRIPT:
227 (*pos)++;
228 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
229 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
230 if (noside == EVAL_SKIP)
231 goto nosideret;
232 /* If the user attempts to subscript something that is not an
233 array or pointer type (like a plain int variable for example),
234 then report this as an error. */
235
236 arg1 = coerce_ref (arg1);
237 type = check_typedef (value_type (arg1));
238
239 if (m2_is_unbounded_array (type))
240 {
241 struct value *temp = arg1;
242 type = TYPE_FIELD_TYPE (type, 0);
243 if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR))
244 {
245 warning (_("internal error: unbounded "
246 "array structure is unknown"));
247 return evaluate_subexp_standard (expect_type, exp, pos, noside);
248 }
249 /* i18n: Do not translate the "_m2_contents" part! */
250 arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
251 _("unbounded structure "
252 "missing _m2_contents field"));
253
254 if (value_type (arg1) != type)
255 arg1 = value_cast (type, arg1);
256
257 check_typedef (value_type (arg1));
258 return value_ind (value_ptradd (arg1, value_as_long (arg2)));
259 }
260 else
261 if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
262 {
263 if (TYPE_NAME (type))
264 error (_("cannot subscript something of type `%s'"),
265 TYPE_NAME (type));
266 else
267 error (_("cannot subscript requested type"));
268 }
269
270 if (noside == EVAL_AVOID_SIDE_EFFECTS)
271 return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
272 else
273 return value_subscript (arg1, value_as_long (arg2));
274
275 default:
276 return evaluate_subexp_standard (expect_type, exp, pos, noside);
277 }
278
279 nosideret:
280 return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
281 }
282 \f
283
284 /* Table of operators and their precedences for printing expressions. */
285
286 static const struct op_print m2_op_print_tab[] =
287 {
288 {"+", BINOP_ADD, PREC_ADD, 0},
289 {"+", UNOP_PLUS, PREC_PREFIX, 0},
290 {"-", BINOP_SUB, PREC_ADD, 0},
291 {"-", UNOP_NEG, PREC_PREFIX, 0},
292 {"*", BINOP_MUL, PREC_MUL, 0},
293 {"/", BINOP_DIV, PREC_MUL, 0},
294 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
295 {"MOD", BINOP_REM, PREC_MUL, 0},
296 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
297 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
298 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
299 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
300 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
301 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
302 {"<=", BINOP_LEQ, PREC_ORDER, 0},
303 {">=", BINOP_GEQ, PREC_ORDER, 0},
304 {">", BINOP_GTR, PREC_ORDER, 0},
305 {"<", BINOP_LESS, PREC_ORDER, 0},
306 {"^", UNOP_IND, PREC_PREFIX, 0},
307 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
308 {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
309 {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
310 {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
311 {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
312 {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
313 {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
314 {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
315 {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
316 {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
317 {NULL, 0, 0, 0}
318 };
319 \f
320 /* The built-in types of Modula-2. */
321
322 enum m2_primitive_types {
323 m2_primitive_type_char,
324 m2_primitive_type_int,
325 m2_primitive_type_card,
326 m2_primitive_type_real,
327 m2_primitive_type_bool,
328 nr_m2_primitive_types
329 };
330
331 static void
332 m2_language_arch_info (struct gdbarch *gdbarch,
333 struct language_arch_info *lai)
334 {
335 const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
336
337 lai->string_char_type = builtin->builtin_char;
338 lai->primitive_type_vector
339 = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
340 struct type *);
341
342 lai->primitive_type_vector [m2_primitive_type_char]
343 = builtin->builtin_char;
344 lai->primitive_type_vector [m2_primitive_type_int]
345 = builtin->builtin_int;
346 lai->primitive_type_vector [m2_primitive_type_card]
347 = builtin->builtin_card;
348 lai->primitive_type_vector [m2_primitive_type_real]
349 = builtin->builtin_real;
350 lai->primitive_type_vector [m2_primitive_type_bool]
351 = builtin->builtin_bool;
352
353 lai->bool_type_symbol = "BOOLEAN";
354 lai->bool_type_default = builtin->builtin_bool;
355 }
356
357 const struct exp_descriptor exp_descriptor_modula2 =
358 {
359 print_subexp_standard,
360 operator_length_standard,
361 operator_check_standard,
362 op_name_standard,
363 dump_subexp_body_standard,
364 evaluate_subexp_modula2
365 };
366
367 const struct language_defn m2_language_defn =
368 {
369 "modula-2",
370 language_m2,
371 range_check_on,
372 case_sensitive_on,
373 array_row_major,
374 macro_expansion_no,
375 &exp_descriptor_modula2,
376 m2_parse, /* parser */
377 m2_error, /* parser error function */
378 null_post_parser,
379 m2_printchar, /* Print character constant */
380 m2_printstr, /* function to print string constant */
381 m2_emit_char, /* Function to print a single character */
382 m2_print_type, /* Print a type using appropriate syntax */
383 m2_print_typedef, /* Print a typedef using appropriate syntax */
384 m2_val_print, /* Print a value using appropriate syntax */
385 c_value_print, /* Print a top-level value */
386 default_read_var_value, /* la_read_var_value */
387 NULL, /* Language specific skip_trampoline */
388 NULL, /* name_of_this */
389 basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
390 basic_lookup_transparent_type,/* lookup_transparent_type */
391 NULL, /* Language specific symbol demangler */
392 NULL, /* Language specific
393 class_name_from_physname */
394 m2_op_print_tab, /* expression operators for printing */
395 0, /* arrays are first-class (not c-style) */
396 0, /* String lower bound */
397 default_word_break_characters,
398 default_make_symbol_completion_list,
399 m2_language_arch_info,
400 default_print_array_index,
401 default_pass_by_reference,
402 default_get_string,
403 NULL, /* la_get_symbol_name_cmp */
404 iterate_over_symbols,
405 LANG_MAGIC
406 };
407
408 static void *
409 build_m2_types (struct gdbarch *gdbarch)
410 {
411 struct builtin_m2_type *builtin_m2_type
412 = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
413
414 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
415 builtin_m2_type->builtin_int
416 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
417 builtin_m2_type->builtin_card
418 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
419 builtin_m2_type->builtin_real
420 = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL", NULL);
421 builtin_m2_type->builtin_char
422 = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
423 builtin_m2_type->builtin_bool
424 = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
425
426 return builtin_m2_type;
427 }
428
429 static struct gdbarch_data *m2_type_data;
430
431 const struct builtin_m2_type *
432 builtin_m2_type (struct gdbarch *gdbarch)
433 {
434 return gdbarch_data (gdbarch, m2_type_data);
435 }
436
437
438 /* Initialization for Modula-2 */
439
440 void
441 _initialize_m2_language (void)
442 {
443 m2_type_data = gdbarch_data_register_post_init (build_m2_types);
444
445 add_language (&m2_language_defn);
446 }
This page took 0.039564 seconds and 5 git commands to generate.