GDB (xrefs)
/tmp/gdb-7.10/gdb/m2-lang.c
Go to the documentation of this file.
1 /* Modula 2 language support routines for GDB, the GNU debugger.
2 
3  Copyright (C) 1992-2015 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 "varobj.h"
27 #include "m2-lang.h"
28 #include "c-lang.h"
29 #include "valprint.h"
30 
31 extern void _initialize_m2_language (void);
32 static void m2_printchar (int, struct type *, struct ui_file *);
33 static void m2_emit_char (int, struct type *, struct ui_file *, int);
34 
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. */
40 
41 static void
42 m2_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
43 {
44 
45  c &= 0xFF; /* Avoid sign bit follies. */
46 
47  if (PRINT_LITERAL_FORM (c))
48  {
49  if (c == '\\' || c == quoter)
50  {
51  fputs_filtered ("\\", stream);
52  }
53  fprintf_filtered (stream, "%c", c);
54  }
55  else
56  {
57  switch (c)
58  {
59  case '\n':
60  fputs_filtered ("\\n", stream);
61  break;
62  case '\b':
63  fputs_filtered ("\\b", stream);
64  break;
65  case '\t':
66  fputs_filtered ("\\t", stream);
67  break;
68  case '\f':
69  fputs_filtered ("\\f", stream);
70  break;
71  case '\r':
72  fputs_filtered ("\\r", stream);
73  break;
74  case '\033':
75  fputs_filtered ("\\e", stream);
76  break;
77  case '\007':
78  fputs_filtered ("\\a", stream);
79  break;
80  default:
81  fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
82  break;
83  }
84  }
85 }
86 
87 /* FIXME: This is a copy of the same function from c-exp.y. It should
88  be replaced with a true Modula version. */
89 
90 static void
91 m2_printchar (int c, struct type *type, struct ui_file *stream)
92 {
93  fputs_filtered ("'", stream);
94  LA_EMIT_CHAR (c, type, stream, '\'');
95  fputs_filtered ("'", stream);
96 }
97 
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. */
104 
105 static void
106 m2_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
107  unsigned int length, const char *encoding, int force_ellipses,
108  const struct value_print_options *options)
109 {
110  unsigned int i;
111  unsigned int things_printed = 0;
112  int in_quotes = 0;
113  int need_comma = 0;
114 
115  if (length == 0)
116  {
117  fputs_filtered ("\"\"", gdb_stdout);
118  return;
119  }
120 
121  for (i = 0; i < length && things_printed < options->print_max; ++i)
122  {
123  /* Position of the character we are examining
124  to see whether it is repeated. */
125  unsigned int rep1;
126  /* Number of repetitions we have detected so far. */
127  unsigned int reps;
128 
129  QUIT;
130 
131  if (need_comma)
132  {
133  fputs_filtered (", ", stream);
134  need_comma = 0;
135  }
136 
137  rep1 = i + 1;
138  reps = 1;
139  while (rep1 < length && string[rep1] == string[i])
140  {
141  ++rep1;
142  ++reps;
143  }
144 
145  if (reps > options->repeat_count_threshold)
146  {
147  if (in_quotes)
148  {
149  fputs_filtered ("\", ", stream);
150  in_quotes = 0;
151  }
152  m2_printchar (string[i], type, stream);
153  fprintf_filtered (stream, " <repeats %u times>", reps);
154  i = rep1 - 1;
155  things_printed += options->repeat_count_threshold;
156  need_comma = 1;
157  }
158  else
159  {
160  if (!in_quotes)
161  {
162  fputs_filtered ("\"", stream);
163  in_quotes = 1;
164  }
165  LA_EMIT_CHAR (string[i], type, stream, '"');
166  ++things_printed;
167  }
168  }
169 
170  /* Terminate the quotes if necessary. */
171  if (in_quotes)
172  fputs_filtered ("\"", stream);
173 
174  if (force_ellipses || i < length)
175  fputs_filtered ("...", stream);
176 }
177 
178 static struct value *
179 evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
180  int *pos, enum noside noside)
181 {
182  enum exp_opcode op = exp->elts[*pos].opcode;
183  struct value *arg1;
184  struct value *arg2;
185  struct type *type;
186 
187  switch (op)
188  {
189  case UNOP_HIGH:
190  (*pos)++;
191  arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
192 
193  if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
194  return arg1;
195  else
196  {
197  arg1 = coerce_ref (arg1);
198  type = check_typedef (value_type (arg1));
199 
200  if (m2_is_unbounded_array (type))
201  {
202  struct value *temp = arg1;
203 
204  type = TYPE_FIELD_TYPE (type, 1);
205  /* i18n: Do not translate the "_m2_high" part! */
206  arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
207  _("unbounded structure "
208  "missing _m2_high field"));
209 
210  if (value_type (arg1) != type)
211  arg1 = value_cast (type, arg1);
212  }
213  }
214  return arg1;
215 
216  case BINOP_SUBSCRIPT:
217  (*pos)++;
218  arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
219  arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
220  if (noside == EVAL_SKIP)
221  goto nosideret;
222  /* If the user attempts to subscript something that is not an
223  array or pointer type (like a plain int variable for example),
224  then report this as an error. */
225 
226  arg1 = coerce_ref (arg1);
227  type = check_typedef (value_type (arg1));
228 
229  if (m2_is_unbounded_array (type))
230  {
231  struct value *temp = arg1;
232  type = TYPE_FIELD_TYPE (type, 0);
233  if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR))
234  {
235  warning (_("internal error: unbounded "
236  "array structure is unknown"));
237  return evaluate_subexp_standard (expect_type, exp, pos, noside);
238  }
239  /* i18n: Do not translate the "_m2_contents" part! */
240  arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
241  _("unbounded structure "
242  "missing _m2_contents field"));
243 
244  if (value_type (arg1) != type)
245  arg1 = value_cast (type, arg1);
246 
247  check_typedef (value_type (arg1));
248  return value_ind (value_ptradd (arg1, value_as_long (arg2)));
249  }
250  else
251  if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
252  {
253  if (TYPE_NAME (type))
254  error (_("cannot subscript something of type `%s'"),
255  TYPE_NAME (type));
256  else
257  error (_("cannot subscript requested type"));
258  }
259 
260  if (noside == EVAL_AVOID_SIDE_EFFECTS)
261  return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
262  else
263  return value_subscript (arg1, value_as_long (arg2));
264 
265  default:
266  return evaluate_subexp_standard (expect_type, exp, pos, noside);
267  }
268 
269  nosideret:
271 }
272 
273 
274 /* Table of operators and their precedences for printing expressions. */
275 
276 static const struct op_print m2_op_print_tab[] =
277 {
278  {"+", BINOP_ADD, PREC_ADD, 0},
279  {"+", UNOP_PLUS, PREC_PREFIX, 0},
280  {"-", BINOP_SUB, PREC_ADD, 0},
281  {"-", UNOP_NEG, PREC_PREFIX, 0},
282  {"*", BINOP_MUL, PREC_MUL, 0},
283  {"/", BINOP_DIV, PREC_MUL, 0},
284  {"DIV", BINOP_INTDIV, PREC_MUL, 0},
285  {"MOD", BINOP_REM, PREC_MUL, 0},
286  {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
287  {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
288  {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
289  {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
290  {"=", BINOP_EQUAL, PREC_EQUAL, 0},
291  {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
292  {"<=", BINOP_LEQ, PREC_ORDER, 0},
293  {">=", BINOP_GEQ, PREC_ORDER, 0},
294  {">", BINOP_GTR, PREC_ORDER, 0},
295  {"<", BINOP_LESS, PREC_ORDER, 0},
296  {"^", UNOP_IND, PREC_PREFIX, 0},
297  {"@", BINOP_REPEAT, PREC_REPEAT, 0},
298  {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
299  {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
300  {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
301  {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
302  {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
303  {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
304  {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
305  {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
306  {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
307  {NULL, 0, 0, 0}
308 };
309 
310 /* The built-in types of Modula-2. */
311 
319 };
320 
321 static void
323  struct language_arch_info *lai)
324 {
325  const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
326 
327  lai->string_char_type = builtin->builtin_char;
330  struct type *);
331 
333  = builtin->builtin_char;
335  = builtin->builtin_int;
337  = builtin->builtin_card;
339  = builtin->builtin_real;
341  = builtin->builtin_bool;
342 
343  lai->bool_type_symbol = "BOOLEAN";
344  lai->bool_type_default = builtin->builtin_bool;
345 }
346 
347 const struct exp_descriptor exp_descriptor_modula2 =
348 {
355 };
356 
357 const struct language_defn m2_language_defn =
358 {
359  "modula-2",
360  "Modula-2",
361  language_m2,
367  m2_parse, /* parser */
368  m2_error, /* parser error function */
370  m2_printchar, /* Print character constant */
371  m2_printstr, /* function to print string constant */
372  m2_emit_char, /* Function to print a single character */
373  m2_print_type, /* Print a type using appropriate syntax */
374  m2_print_typedef, /* Print a typedef using appropriate syntax */
375  m2_val_print, /* Print a value using appropriate syntax */
376  c_value_print, /* Print a top-level value */
377  default_read_var_value, /* la_read_var_value */
378  NULL, /* Language specific skip_trampoline */
379  NULL, /* name_of_this */
380  basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
381  basic_lookup_transparent_type,/* lookup_transparent_type */
382  NULL, /* Language specific symbol demangler */
383  NULL, /* Language specific
384  class_name_from_physname */
385  m2_op_print_tab, /* expression operators for printing */
386  0, /* arrays are first-class (not c-style) */
387  0, /* String lower bound */
389  default_make_symbol_completion_list,
394  NULL, /* la_get_symbol_name_cmp */
397  NULL,
398  NULL,
399  LANG_MAGIC
400 };
401 
402 static void *
404 {
406  = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
407 
408  /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
409  builtin_m2_type->builtin_int
410  = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
411  builtin_m2_type->builtin_card
412  = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
413  builtin_m2_type->builtin_real
414  = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL", NULL);
415  builtin_m2_type->builtin_char
416  = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
417  builtin_m2_type->builtin_bool
418  = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
419 
420  return builtin_m2_type;
421 }
422 
423 static struct gdbarch_data *m2_type_data;
424 
425 const struct builtin_m2_type *
427 {
428  return gdbarch_data (gdbarch, m2_type_data);
429 }
430 
431 
432 /* Initialization for Modula-2 */
433 
434 void
436 {
438 
439  add_language (&m2_language_defn);
440 }
int m2_parse(struct parser_state *par_state)
Definition: m2-exp.c:2893
struct value * value_zero(struct type *type, enum lval_type lv)
Definition: valops.c:842
union exp_element elts[1]
Definition: expression.h:85
unsigned int repeat_count_threshold
Definition: valprint.h:57
static const struct op_print m2_op_print_tab[]
Definition: m2-lang.c:276
void m2_print_type(struct type *, const char *, struct ui_file *, int, int, const struct type_print_options *)
Definition: m2-typeprint.c:72
void m2_print_typedef(struct type *, struct symbol *, struct ui_file *)
Definition: m2-typeprint.c:160
enum exp_opcode opcode
Definition: expression.h:65
struct value * value_subscript(struct value *array, LONGEST index)
Definition: valarith.c:146
const struct builtin_m2_type * builtin_m2_type(struct gdbarch *gdbarch)
Definition: m2-lang.c:426
noside
Definition: expression.h:122
m2_primitive_types
Definition: m2-lang.c:312
void _initialize_m2_language(void)
Definition: m2-lang.c:435
struct type * arch_boolean_type(struct gdbarch *gdbarch, int bit, int unsigned_p, char *name)
Definition: gdbtypes.c:4588
#define GDBARCH_OBSTACK_CALLOC(GDBARCH, NR, TYPE)
Definition: gdbarch.h:1614
LONGEST value_as_long(struct value *val)
Definition: value.c:2654
int gdbarch_int_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1490
void warning(const char *fmt,...)
Definition: errors.c:26
static void * build_m2_types(struct gdbarch *gdbarch)
Definition: m2-lang.c:403
struct value * evaluate_subexp_with_coercion(struct expression *exp, int *pos, enum noside noside)
Definition: eval.c:2958
#define TYPE_NAME(thistype)
Definition: gdbtypes.h:1227
struct type * arch_float_type(struct gdbarch *gdbarch, int bit, char *name, const struct floatformat **floatformats)
Definition: gdbtypes.c:4606
static void m2_printstr(struct ui_file *stream, struct type *type, const gdb_byte *string, unsigned int length, const char *encoding, int force_ellipses, const struct value_print_options *options)
Definition: m2-lang.c:106
void * gdbarch_data(struct gdbarch *gdbarch, struct gdbarch_data *data)
Definition: gdbarch.c:4845
struct ui_file * gdb_stdout
Definition: main.c:71
struct type * builtin_char
Definition: m2-lang.h:49
struct value * default_read_var_value(struct symbol *var, struct frame_info *frame)
Definition: findvar.c:416
struct value * coerce_ref(struct value *arg)
Definition: value.c:3688
static void m2_emit_char(int, struct type *, struct ui_file *, int)
Definition: m2-lang.c:42
struct value * value_ind(struct value *arg1)
Definition: valops.c:1533
#define _(String)
Definition: gdb_locale.h:40
struct type * string_char_type
Definition: language.h:120
#define TYPE_FIELD_TYPE(thistype, n)
Definition: gdbtypes.h:1368
#define VALUE_LVAL(val)
Definition: value.h:411
void add_language(const struct language_defn *lang)
Definition: language.c:518
#define GDBARCH_OBSTACK_ZALLOC(GDBARCH, TYPE)
Definition: gdbarch.h:1615
struct type * arch_character_type(struct gdbarch *gdbarch, int bit, int unsigned_p, char *name)
Definition: gdbtypes.c:4571
struct value * value_ptradd(struct value *arg1, LONGEST arg2)
Definition: valarith.c:84
static struct gdbarch_data * m2_type_data
Definition: m2-lang.c:423
char * default_word_break_characters(void)
Definition: language.c:669
struct value * value_struct_elt(struct value **argp, struct value **args, const char *name, int *static_memfuncp, const char *err)
Definition: valops.c:2128
#define LA_EMIT_CHAR(ch, type, stream, quoter)
Definition: language.h:499
struct type * check_typedef(struct type *type)
Definition: gdbtypes.c:2217
struct type * bool_type_default
Definition: language.h:125
void null_post_parser(struct expression **exp, int void_context_p)
Definition: parse.c:1358
#define PRINT_LITERAL_FORM(c)
Definition: language.h:517
struct type * builtin_int
Definition: m2-lang.h:50
void fprintf_filtered(struct ui_file *stream, const char *format,...)
Definition: utils.c:2351
static void m2_language_arch_info(struct gdbarch *gdbarch, struct language_arch_info *lai)
Definition: m2-lang.c:322
void fputs_filtered(const char *linebuffer, struct ui_file *stream)
Definition: utils.c:2145
const char * bool_type_symbol
Definition: language.h:123
int default_pass_by_reference(struct type *type)
Definition: language.c:659
struct type * basic_lookup_transparent_type(const char *name)
Definition: symtab.c:2851
struct type * builtin_card
Definition: m2-lang.h:51
#define TARGET_CHAR_BIT
Definition: host-defs.h:29
Definition: gdbtypes.h:749
static const char * type
Definition: language.c:103
int dump_subexp_body_standard(struct expression *exp, struct ui_file *stream, int elt)
Definition: expprint.c:762
struct value * value_from_longest(struct type *type, LONGEST num)
Definition: value.c:3464
void iterate_over_symbols(const struct block *block, const char *name, const domain_enum domain, symbol_found_callback_ftype *callback, void *data)
Definition: symtab.c:2912
struct value * value_cast(struct type *type, struct value *arg2)
Definition: valops.c:351
void default_print_array_index(struct value *index_value, struct ui_file *stream, const struct value_print_options *options)
Definition: language.c:677
struct type * arch_integer_type(struct gdbarch *gdbarch, int bit, int unsigned_p, char *name)
Definition: gdbtypes.c:4552
char * op_name_standard(enum exp_opcode opcode)
Definition: expprint.c:662
int m2_is_unbounded_array(struct type *type)
Definition: m2-typeprint.c:489
static char encoding[]
Definition: remote-mips.c:2988
const struct exp_descriptor exp_descriptor_modula2
Definition: m2-lang.c:347
Definition: value.c:172
bfd_byte gdb_byte
Definition: common-types.h:38
static void m2_printchar(int, struct type *, struct ui_file *)
Definition: m2-lang.c:91
static struct value * evaluate_subexp_modula2(struct type *expect_type, struct expression *exp, int *pos, enum noside noside)
Definition: m2-lang.c:179
#define TYPE_TARGET_TYPE(thistype)
Definition: gdbtypes.h:1229
void print_subexp_standard(struct expression *exp, int *pos, struct ui_file *stream, enum precedence prec)
Definition: expprint.c:58
void default_get_string(struct value *value, gdb_byte **buffer, int *length, struct type **char_type, const char **charset)
Definition: language.c:686
#define TYPE_CODE(thistype)
Definition: gdbtypes.h:1240
#define default_varobj_ops
Definition: varobj.h:233
void m2_val_print(struct type *, const gdb_byte *, int, CORE_ADDR, struct ui_file *, int, const struct value *, const struct value_print_options *)
Definition: m2-valprint.c:311
int operator_check_standard(struct expression *exp, int pos, int(*objfile_func)(struct objfile *objfile, void *data), void *data)
Definition: parse.c:1782
void m2_error(char *)
int gdbarch_float_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1591
exp_opcode
Definition: expression.h:43
struct value * evaluate_subexp_standard(struct type *expect_type, struct expression *exp, int *pos, enum noside noside)
Definition: eval.c:699
void operator_length_standard(const struct expression *expr, int endpos, int *oplenp, int *argsp)
Definition: parse.c:859
struct gdbarch * gdbarch
Definition: expression.h:83
struct symbol * basic_lookup_symbol_nonlocal(const struct language_defn *langdef, const char *name, const struct block *block, const domain_enum domain)
Definition: symtab.c:2481
struct type * value_type(const struct value *value)
Definition: value.c:1021
unsigned int print_max
Definition: valprint.h:53
#define LANG_MAGIC
Definition: language.h:402
#define QUIT
Definition: defs.h:160
struct type ** primitive_type_vector
Definition: language.h:113
void c_value_print(struct value *, struct ui_file *, const struct value_print_options *)
Definition: c-valprint.c:459
struct type * builtin_bool
Definition: m2-lang.h:53
void error(const char *fmt,...)
Definition: errors.c:38
struct gdbarch_data * gdbarch_data_register_post_init(gdbarch_data_post_init_ftype *post_init)
Definition: gdbarch.c:4812
struct type * builtin_real
Definition: m2-lang.h:52
struct type * builtin_int
Definition: gdbtypes.h:1483