Add missing format for built-in floating-point types
[external/binutils.git] / gdb / m2-lang.c
1 /* Modula 2 language support routines for GDB, the GNU debugger.
2
3    Copyright (C) 1992-2016 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:
270   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
271 }
272 \f
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, OP_NULL, PREC_BUILTIN_FUNCTION, 0}
308 };
309 \f
310 /* The built-in types of Modula-2.  */
311
312 enum m2_primitive_types {
313   m2_primitive_type_char,
314   m2_primitive_type_int,
315   m2_primitive_type_card,
316   m2_primitive_type_real,
317   m2_primitive_type_bool,
318   nr_m2_primitive_types
319 };
320
321 static void
322 m2_language_arch_info (struct gdbarch *gdbarch,
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;
328   lai->primitive_type_vector
329     = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
330                               struct type *);
331
332   lai->primitive_type_vector [m2_primitive_type_char]
333     = builtin->builtin_char;
334   lai->primitive_type_vector [m2_primitive_type_int]
335     = builtin->builtin_int;
336   lai->primitive_type_vector [m2_primitive_type_card]
337     = builtin->builtin_card;
338   lai->primitive_type_vector [m2_primitive_type_real]
339     = builtin->builtin_real;
340   lai->primitive_type_vector [m2_primitive_type_bool]
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 {
349   print_subexp_standard,
350   operator_length_standard,
351   operator_check_standard,
352   op_name_standard,
353   dump_subexp_body_standard,
354   evaluate_subexp_modula2
355 };
356
357 const struct language_defn m2_language_defn =
358 {
359   "modula-2",
360   "Modula-2",
361   language_m2,
362   range_check_on,
363   case_sensitive_on,
364   array_row_major,
365   macro_expansion_no,
366   NULL,
367   &exp_descriptor_modula2,
368   m2_parse,                     /* parser */
369   m2_yyerror,                   /* parser error function */
370   null_post_parser,
371   m2_printchar,                 /* Print character constant */
372   m2_printstr,                  /* function to print string constant */
373   m2_emit_char,                 /* Function to print a single character */
374   m2_print_type,                /* Print a type using appropriate syntax */
375   m2_print_typedef,             /* Print a typedef using appropriate syntax */
376   m2_val_print,                 /* Print a value using appropriate syntax */
377   c_value_print,                /* Print a top-level value */
378   default_read_var_value,       /* la_read_var_value */
379   NULL,                         /* Language specific skip_trampoline */
380   NULL,                         /* name_of_this */
381   basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
382   basic_lookup_transparent_type,/* lookup_transparent_type */
383   NULL,                         /* Language specific symbol demangler */
384   NULL,
385   NULL,                         /* Language specific
386                                    class_name_from_physname */
387   m2_op_print_tab,              /* expression operators for printing */
388   0,                            /* arrays are first-class (not c-style) */
389   0,                            /* String lower bound */
390   default_word_break_characters,
391   default_make_symbol_completion_list,
392   m2_language_arch_info,
393   default_print_array_index,
394   default_pass_by_reference,
395   default_get_string,
396   NULL,                         /* la_get_symbol_name_cmp */
397   iterate_over_symbols,
398   &default_varobj_ops,
399   NULL,
400   NULL,
401   LANG_MAGIC
402 };
403
404 static void *
405 build_m2_types (struct gdbarch *gdbarch)
406 {
407   struct builtin_m2_type *builtin_m2_type
408     = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
409
410   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
411   builtin_m2_type->builtin_int
412     = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
413   builtin_m2_type->builtin_card
414     = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
415   builtin_m2_type->builtin_real
416     = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL",
417                        gdbarch_float_format (gdbarch));
418   builtin_m2_type->builtin_char
419     = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
420   builtin_m2_type->builtin_bool
421     = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
422
423   return builtin_m2_type;
424 }
425
426 static struct gdbarch_data *m2_type_data;
427
428 const struct builtin_m2_type *
429 builtin_m2_type (struct gdbarch *gdbarch)
430 {
431   return (const struct builtin_m2_type *) gdbarch_data (gdbarch, m2_type_data);
432 }
433
434
435 /* Initialization for Modula-2 */
436
437 void
438 _initialize_m2_language (void)
439 {
440   m2_type_data = gdbarch_data_register_post_init (build_m2_types);
441
442   add_language (&m2_language_defn);
443 }