1 /* Modula 2 language support routines for GDB, the GNU debugger.
3 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
4 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
24 #include "expression.h"
25 #include "parser-defs.h"
31 extern void _initialize_m2_language (void);
32 static void m2_printchar (int, struct ui_file
*);
33 static void m2_emit_char (int, struct ui_file
*, int);
35 /* Print the character C on STREAM as part of the contents of a literal
36 string whose delimiter is QUOTER. Note that that format for printing
37 characters and strings is language specific.
38 FIXME: This is a copy of the same function from c-exp.y. It should
39 be replaced with a true Modula version. */
42 m2_emit_char (int c
, struct ui_file
*stream
, int quoter
)
45 c
&= 0xFF; /* Avoid sign bit follies */
47 if (PRINT_LITERAL_FORM (c
))
49 if (c
== '\\' || c
== quoter
)
51 fputs_filtered ("\\", stream
);
53 fprintf_filtered (stream
, "%c", c
);
60 fputs_filtered ("\\n", stream
);
63 fputs_filtered ("\\b", stream
);
66 fputs_filtered ("\\t", stream
);
69 fputs_filtered ("\\f", stream
);
72 fputs_filtered ("\\r", stream
);
75 fputs_filtered ("\\e", stream
);
78 fputs_filtered ("\\a", stream
);
81 fprintf_filtered (stream
, "\\%.3o", (unsigned int) c
);
87 /* FIXME: This is a copy of the same function from c-exp.y. It should
88 be replaced with a true Modula version. */
91 m2_printchar (int c
, struct ui_file
*stream
)
93 fputs_filtered ("'", stream
);
94 LA_EMIT_CHAR (c
, stream
, '\'');
95 fputs_filtered ("'", stream
);
98 /* Print the character string STRING, printing at most LENGTH characters.
99 Printing stops early if the number hits print_max; repeat counts
100 are printed as appropriate. Print ellipses at the end if we
101 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
102 FIXME: This is a copy of the same function from c-exp.y. It should
103 be replaced with a true Modula version. */
106 m2_printstr (struct ui_file
*stream
, const gdb_byte
*string
,
107 unsigned int length
, int width
, int force_ellipses
,
108 const struct value_print_options
*options
)
111 unsigned int things_printed
= 0;
117 fputs_filtered ("\"\"", gdb_stdout
);
121 for (i
= 0; i
< length
&& things_printed
< options
->print_max
; ++i
)
123 /* Position of the character we are examining
124 to see whether it is repeated. */
126 /* Number of repetitions we have detected so far. */
133 fputs_filtered (", ", stream
);
139 while (rep1
< length
&& string
[rep1
] == string
[i
])
145 if (reps
> options
->repeat_count_threshold
)
149 if (options
->inspect_it
)
150 fputs_filtered ("\\\", ", stream
);
152 fputs_filtered ("\", ", stream
);
155 m2_printchar (string
[i
], stream
);
156 fprintf_filtered (stream
, " <repeats %u times>", reps
);
158 things_printed
+= options
->repeat_count_threshold
;
165 if (options
->inspect_it
)
166 fputs_filtered ("\\\"", stream
);
168 fputs_filtered ("\"", stream
);
171 LA_EMIT_CHAR (string
[i
], stream
, '"');
176 /* Terminate the quotes if necessary. */
179 if (options
->inspect_it
)
180 fputs_filtered ("\\\"", stream
);
182 fputs_filtered ("\"", stream
);
185 if (force_ellipses
|| i
< length
)
186 fputs_filtered ("...", stream
);
189 static struct value
*
190 evaluate_subexp_modula2 (struct type
*expect_type
, struct expression
*exp
,
191 int *pos
, enum noside noside
)
193 enum exp_opcode op
= exp
->elts
[*pos
].opcode
;
201 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
203 if (noside
== EVAL_SKIP
|| noside
== EVAL_AVOID_SIDE_EFFECTS
)
207 arg1
= coerce_ref (arg1
);
208 type
= check_typedef (value_type (arg1
));
210 if (m2_is_unbounded_array (type
))
212 struct value
*temp
= arg1
;
213 type
= TYPE_FIELD_TYPE (type
, 1);
214 /* i18n: Do not translate the "_m2_high" part! */
215 arg1
= value_struct_elt (&temp
, NULL
, "_m2_high", NULL
,
216 _("unbounded structure "
217 "missing _m2_high field"));
219 if (value_type (arg1
) != type
)
220 arg1
= value_cast (type
, arg1
);
225 case BINOP_SUBSCRIPT
:
227 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
228 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
229 if (noside
== EVAL_SKIP
)
231 /* If the user attempts to subscript something that is not an
232 array or pointer type (like a plain int variable for example),
233 then report this as an error. */
235 arg1
= coerce_ref (arg1
);
236 type
= check_typedef (value_type (arg1
));
238 if (m2_is_unbounded_array (type
))
240 struct value
*temp
= arg1
;
241 type
= TYPE_FIELD_TYPE (type
, 0);
242 if (type
== NULL
|| (TYPE_CODE (type
) != TYPE_CODE_PTR
)) {
243 warning (_("internal error: unbounded array structure is unknown"));
244 return evaluate_subexp_standard (expect_type
, exp
, pos
, noside
);
246 /* i18n: Do not translate the "_m2_contents" part! */
247 arg1
= value_struct_elt (&temp
, NULL
, "_m2_contents", NULL
,
248 _("unbounded structure "
249 "missing _m2_contents field"));
251 if (value_type (arg1
) != type
)
252 arg1
= value_cast (type
, arg1
);
254 type
= check_typedef (value_type (arg1
));
255 return value_ind (value_ptradd (arg1
, arg2
));
258 if (TYPE_CODE (type
) != TYPE_CODE_ARRAY
)
260 if (TYPE_NAME (type
))
261 error (_("cannot subscript something of type `%s'"),
264 error (_("cannot subscript requested type"));
267 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
268 return value_zero (TYPE_TARGET_TYPE (type
), VALUE_LVAL (arg1
));
270 return value_subscript (arg1
, arg2
);
273 return evaluate_subexp_standard (expect_type
, exp
, pos
, noside
);
277 return value_from_longest (builtin_type_int8
, (LONGEST
) 1);
281 /* Table of operators and their precedences for printing expressions. */
283 static const struct op_print m2_op_print_tab
[] =
285 {"+", BINOP_ADD
, PREC_ADD
, 0},
286 {"+", UNOP_PLUS
, PREC_PREFIX
, 0},
287 {"-", BINOP_SUB
, PREC_ADD
, 0},
288 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
289 {"*", BINOP_MUL
, PREC_MUL
, 0},
290 {"/", BINOP_DIV
, PREC_MUL
, 0},
291 {"DIV", BINOP_INTDIV
, PREC_MUL
, 0},
292 {"MOD", BINOP_REM
, PREC_MUL
, 0},
293 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
294 {"OR", BINOP_LOGICAL_OR
, PREC_LOGICAL_OR
, 0},
295 {"AND", BINOP_LOGICAL_AND
, PREC_LOGICAL_AND
, 0},
296 {"NOT", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
297 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
298 {"<>", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
299 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
300 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
301 {">", BINOP_GTR
, PREC_ORDER
, 0},
302 {"<", BINOP_LESS
, PREC_ORDER
, 0},
303 {"^", UNOP_IND
, PREC_PREFIX
, 0},
304 {"@", BINOP_REPEAT
, PREC_REPEAT
, 0},
305 {"CAP", UNOP_CAP
, PREC_BUILTIN_FUNCTION
, 0},
306 {"CHR", UNOP_CHR
, PREC_BUILTIN_FUNCTION
, 0},
307 {"ORD", UNOP_ORD
, PREC_BUILTIN_FUNCTION
, 0},
308 {"FLOAT", UNOP_FLOAT
, PREC_BUILTIN_FUNCTION
, 0},
309 {"HIGH", UNOP_HIGH
, PREC_BUILTIN_FUNCTION
, 0},
310 {"MAX", UNOP_MAX
, PREC_BUILTIN_FUNCTION
, 0},
311 {"MIN", UNOP_MIN
, PREC_BUILTIN_FUNCTION
, 0},
312 {"ODD", UNOP_ODD
, PREC_BUILTIN_FUNCTION
, 0},
313 {"TRUNC", UNOP_TRUNC
, PREC_BUILTIN_FUNCTION
, 0},
317 /* The built-in types of Modula-2. */
319 enum m2_primitive_types
{
320 m2_primitive_type_char
,
321 m2_primitive_type_int
,
322 m2_primitive_type_card
,
323 m2_primitive_type_real
,
324 m2_primitive_type_bool
,
325 nr_m2_primitive_types
329 m2_language_arch_info (struct gdbarch
*gdbarch
,
330 struct language_arch_info
*lai
)
332 const struct builtin_m2_type
*builtin
= builtin_m2_type (gdbarch
);
334 lai
->string_char_type
= builtin
->builtin_char
;
335 lai
->primitive_type_vector
336 = GDBARCH_OBSTACK_CALLOC (gdbarch
, nr_m2_primitive_types
+ 1,
339 lai
->primitive_type_vector
[m2_primitive_type_char
]
340 = builtin
->builtin_char
;
341 lai
->primitive_type_vector
[m2_primitive_type_int
]
342 = builtin
->builtin_int
;
343 lai
->primitive_type_vector
[m2_primitive_type_card
]
344 = builtin
->builtin_card
;
345 lai
->primitive_type_vector
[m2_primitive_type_real
]
346 = builtin
->builtin_real
;
347 lai
->primitive_type_vector
[m2_primitive_type_bool
]
348 = builtin
->builtin_bool
;
350 lai
->bool_type_symbol
= "BOOLEAN";
351 lai
->bool_type_default
= builtin
->builtin_bool
;
354 const struct exp_descriptor exp_descriptor_modula2
=
356 print_subexp_standard
,
357 operator_length_standard
,
359 dump_subexp_body_standard
,
360 evaluate_subexp_modula2
363 const struct language_defn m2_language_defn
=
372 &exp_descriptor_modula2
,
373 m2_parse
, /* parser */
374 m2_error
, /* parser error function */
376 m2_printchar
, /* Print character constant */
377 m2_printstr
, /* function to print string constant */
378 m2_emit_char
, /* Function to print a single character */
379 m2_print_type
, /* Print a type using appropriate syntax */
380 m2_print_typedef
, /* Print a typedef using appropriate syntax */
381 m2_val_print
, /* Print a value using appropriate syntax */
382 c_value_print
, /* Print a top-level value */
383 NULL
, /* Language specific skip_trampoline */
384 NULL
, /* name_of_this */
385 basic_lookup_symbol_nonlocal
, /* lookup_symbol_nonlocal */
386 basic_lookup_transparent_type
,/* lookup_transparent_type */
387 NULL
, /* Language specific symbol demangler */
388 NULL
, /* Language specific class_name_from_physname */
389 m2_op_print_tab
, /* expression operators for printing */
390 0, /* arrays are first-class (not c-style) */
391 0, /* String lower bound */
392 default_word_break_characters
,
393 default_make_symbol_completion_list
,
394 m2_language_arch_info
,
395 default_print_array_index
,
396 default_pass_by_reference
,
401 build_m2_types (struct gdbarch
*gdbarch
)
403 struct builtin_m2_type
*builtin_m2_type
404 = GDBARCH_OBSTACK_ZALLOC (gdbarch
, struct builtin_m2_type
);
406 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
407 builtin_m2_type
->builtin_int
=
408 init_type (TYPE_CODE_INT
,
409 gdbarch_int_bit (gdbarch
) / TARGET_CHAR_BIT
,
410 0, "INTEGER", (struct objfile
*) NULL
);
411 builtin_m2_type
->builtin_card
=
412 init_type (TYPE_CODE_INT
,
413 gdbarch_int_bit (gdbarch
) / TARGET_CHAR_BIT
,
415 "CARDINAL", (struct objfile
*) NULL
);
416 builtin_m2_type
->builtin_real
=
417 init_type (TYPE_CODE_FLT
,
418 gdbarch_float_bit (gdbarch
) / TARGET_CHAR_BIT
,
420 "REAL", (struct objfile
*) NULL
);
421 builtin_m2_type
->builtin_char
=
422 init_type (TYPE_CODE_CHAR
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
424 "CHAR", (struct objfile
*) NULL
);
425 builtin_m2_type
->builtin_bool
=
426 init_type (TYPE_CODE_BOOL
,
427 gdbarch_int_bit (gdbarch
) / TARGET_CHAR_BIT
,
429 "BOOLEAN", (struct objfile
*) NULL
);
431 return builtin_m2_type
;
434 static struct gdbarch_data
*m2_type_data
;
436 const struct builtin_m2_type
*
437 builtin_m2_type (struct gdbarch
*gdbarch
)
439 return gdbarch_data (gdbarch
, m2_type_data
);
443 /* Initialization for Modula-2 */
446 _initialize_m2_language (void)
448 m2_type_data
= gdbarch_data_register_post_init (build_m2_types
);
450 add_language (&m2_language_defn
);