GDB (xrefs)
/tmp/gdb-7.10/gdb/f-lang.c
Go to the documentation of this file.
1 /* Fortran language support routines for GDB, the GNU debugger.
2 
3  Copyright (C) 1993-2015 Free Software Foundation, Inc.
4 
5  Contributed by Motorola. Adapted from the C parser by Farooq Butt
6  (fmbutt@engage.sps.mot.com).
7 
8  This file is part of GDB.
9 
10  This program is free software; you can redistribute it and/or modify
11  it under the terms of the GNU General Public License as published by
12  the Free Software Foundation; either version 3 of the License, or
13  (at your option) any later version.
14 
15  This program is distributed in the hope that it will be useful,
16  but WITHOUT ANY WARRANTY; without even the implied warranty of
17  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18  GNU General Public License for more details.
19 
20  You should have received a copy of the GNU General Public License
21  along with this program. If not, see <http://www.gnu.org/licenses/>. */
22 
23 #include "defs.h"
24 #include "symtab.h"
25 #include "gdbtypes.h"
26 #include "expression.h"
27 #include "parser-defs.h"
28 #include "language.h"
29 #include "varobj.h"
30 #include "f-lang.h"
31 #include "valprint.h"
32 #include "value.h"
33 #include "cp-support.h"
34 #include "charset.h"
35 #include "c-lang.h"
36 
37 
38 /* Local functions */
39 
40 extern void _initialize_f_language (void);
41 
42 static void f_printchar (int c, struct type *type, struct ui_file * stream);
43 static void f_emit_char (int c, struct type *type,
44  struct ui_file * stream, int quoter);
45 
46 /* Return the encoding that should be used for the character type
47  TYPE. */
48 
49 static const char *
51 {
52  const char *encoding;
53 
54  switch (TYPE_LENGTH (type))
55  {
56  case 1:
57  encoding = target_charset (get_type_arch (type));
58  break;
59  case 4:
60  if (gdbarch_byte_order (get_type_arch (type)) == BFD_ENDIAN_BIG)
61  encoding = "UTF-32BE";
62  else
63  encoding = "UTF-32LE";
64  break;
65 
66  default:
67  error (_("unrecognized character type"));
68  }
69 
70  return encoding;
71 }
72 
73 /* Print the character C on STREAM as part of the contents of a literal
74  string whose delimiter is QUOTER. Note that that format for printing
75  characters and strings is language specific.
76  FIXME: This is a copy of the same function from c-exp.y. It should
77  be replaced with a true F77 version. */
78 
79 static void
80 f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
81 {
82  const char *encoding = f_get_encoding (type);
83 
84  generic_emit_char (c, type, stream, quoter, encoding);
85 }
86 
87 /* Implementation of la_printchar. */
88 
89 static void
90 f_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 F77 version. */
103 
104 static void
105 f_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  const char *type_encoding = f_get_encoding (type);
110 
111  if (TYPE_LENGTH (type) == 4)
112  fputs_filtered ("4_", stream);
113 
114  if (!encoding || !*encoding)
115  encoding = type_encoding;
116 
117  generic_printstr (stream, type, string, length, encoding,
118  force_ellipses, '\'', 0, options);
119 }
120 
121 
122 /* Table of operators and their precedences for printing expressions. */
123 
124 static const struct op_print f_op_print_tab[] =
125 {
126  {"+", BINOP_ADD, PREC_ADD, 0},
127  {"+", UNOP_PLUS, PREC_PREFIX, 0},
128  {"-", BINOP_SUB, PREC_ADD, 0},
129  {"-", UNOP_NEG, PREC_PREFIX, 0},
130  {"*", BINOP_MUL, PREC_MUL, 0},
131  {"/", BINOP_DIV, PREC_MUL, 0},
132  {"DIV", BINOP_INTDIV, PREC_MUL, 0},
133  {"MOD", BINOP_REM, PREC_MUL, 0},
134  {"=", BINOP_ASSIGN, PREC_ASSIGN, 1},
135  {".OR.", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
136  {".AND.", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
137  {".NOT.", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
138  {".EQ.", BINOP_EQUAL, PREC_EQUAL, 0},
139  {".NE.", BINOP_NOTEQUAL, PREC_EQUAL, 0},
140  {".LE.", BINOP_LEQ, PREC_ORDER, 0},
141  {".GE.", BINOP_GEQ, PREC_ORDER, 0},
142  {".GT.", BINOP_GTR, PREC_ORDER, 0},
143  {".LT.", BINOP_LESS, PREC_ORDER, 0},
144  {"**", UNOP_IND, PREC_PREFIX, 0},
145  {"@", BINOP_REPEAT, PREC_REPEAT, 0},
146  {NULL, 0, 0, 0}
147 };
148 
164 };
165 
166 static void
168  struct language_arch_info *lai)
169 {
170  const struct builtin_f_type *builtin = builtin_f_type (gdbarch);
171 
172  lai->string_char_type = builtin->builtin_character;
175  struct type *);
176 
178  = builtin->builtin_character;
180  = builtin->builtin_logical;
182  = builtin->builtin_logical_s1;
184  = builtin->builtin_logical_s2;
186  = builtin->builtin_logical_s8;
188  = builtin->builtin_real;
190  = builtin->builtin_real_s8;
192  = builtin->builtin_real_s16;
194  = builtin->builtin_complex_s8;
196  = builtin->builtin_complex_s16;
198  = builtin->builtin_void;
199 
200  lai->bool_type_symbol = "logical";
201  lai->bool_type_default = builtin->builtin_logical_s2;
202 }
203 
204 /* Remove the modules separator :: from the default break list. */
205 
206 static char *
208 {
209  static char *retval;
210 
211  if (!retval)
212  {
213  char *s;
214 
215  retval = xstrdup (default_word_break_characters ());
216  s = strchr (retval, ':');
217  if (s)
218  {
219  char *last_char = &s[strlen (s) - 1];
220 
221  *s = *last_char;
222  *last_char = 0;
223  }
224  }
225  return retval;
226 }
227 
228 /* Consider the modules separator :: as a valid symbol name character
229  class. */
230 
231 static VEC (char_ptr) *
232 f_make_symbol_completion_list (const char *text, const char *word,
233  enum type_code code)
234 {
235  return default_make_symbol_completion_list_break_on (text, word, ":", code);
236 }
237 
238 const struct language_defn f_language_defn =
239 {
240  "fortran",
241  "Fortran",
248  f_parse, /* parser */
249  f_error, /* parser error function */
251  f_printchar, /* Print character constant */
252  f_printstr, /* function to print string constant */
253  f_emit_char, /* Function to print a single character */
254  f_print_type, /* Print a type using appropriate syntax */
255  default_print_typedef, /* Print a typedef using appropriate syntax */
256  f_val_print, /* Print a value using appropriate syntax */
257  c_value_print, /* FIXME */
258  default_read_var_value, /* la_read_var_value */
259  NULL, /* Language specific skip_trampoline */
260  NULL, /* name_of_this */
261  cp_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
262  basic_lookup_transparent_type,/* lookup_transparent_type */
263  NULL, /* Language specific symbol demangler */
264  NULL, /* Language specific
265  class_name_from_physname */
266  f_op_print_tab, /* expression operators for printing */
267  0, /* arrays are first-class (not c-style) */
268  1, /* String lower bound */
270  f_make_symbol_completion_list,
275  NULL, /* la_get_symbol_name_cmp */
278  NULL,
279  NULL,
280  LANG_MAGIC
281 };
282 
283 static void *
285 {
287  = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
288 
289  builtin_f_type->builtin_void
290  = arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
291 
292  builtin_f_type->builtin_character
293  = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
294 
295  builtin_f_type->builtin_logical_s1
296  = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
297 
298  builtin_f_type->builtin_integer_s2
299  = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
300  "integer*2");
301 
302  builtin_f_type->builtin_logical_s2
303  = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
304  "logical*2");
305 
306  builtin_f_type->builtin_logical_s8
307  = arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
308  "logical*8");
309 
310  builtin_f_type->builtin_integer
311  = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
312  "integer");
313 
314  builtin_f_type->builtin_logical
315  = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
316  "logical*4");
317 
318  builtin_f_type->builtin_real
319  = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
320  "real", NULL);
321  builtin_f_type->builtin_real_s8
322  = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
323  "real*8", NULL);
324  builtin_f_type->builtin_real_s16
325  = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
326  "real*16", NULL);
327 
328  builtin_f_type->builtin_complex_s8
329  = arch_complex_type (gdbarch, "complex*8",
330  builtin_f_type->builtin_real);
331  builtin_f_type->builtin_complex_s16
332  = arch_complex_type (gdbarch, "complex*16",
333  builtin_f_type->builtin_real_s8);
334  builtin_f_type->builtin_complex_s32
335  = arch_complex_type (gdbarch, "complex*32",
336  builtin_f_type->builtin_real_s16);
337 
338  return builtin_f_type;
339 }
340 
341 static struct gdbarch_data *f_type_data;
342 
343 const struct builtin_f_type *
345 {
346  return gdbarch_data (gdbarch, f_type_data);
347 }
348 
349 void
351 {
353 
354  add_language (&f_language_defn);
355 }
type_code
Definition: gdbtypes.h:85
const char * target_charset(struct gdbarch *gdbarch)
Definition: charset.c:407
struct type * builtin_real_s8
Definition: f-lang.h:86
int f_parse(struct parser_state *par_state)
Definition: f-exp.c:2971
struct type * builtin_integer_s2
Definition: f-lang.h:80
struct type * builtin_real_s16
Definition: f-lang.h:87
struct type * arch_boolean_type(struct gdbarch *gdbarch, int bit, int unsigned_p, char *name)
Definition: gdbtypes.c:4588
struct type * builtin_logical_s8
Definition: f-lang.h:84
#define GDBARCH_OBSTACK_CALLOC(GDBARCH, NR, TYPE)
Definition: gdbarch.h:1614
struct type * builtin_logical_s2
Definition: f-lang.h:83
int gdbarch_int_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1490
static void f_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: f-lang.c:105
struct type * arch_float_type(struct gdbarch *gdbarch, int bit, char *name, const struct floatformat **floatformats)
Definition: gdbtypes.c:4606
struct type * arch_complex_type(struct gdbarch *gdbarch, char *name, struct type *target_type)
Definition: gdbtypes.c:4628
void * gdbarch_data(struct gdbarch *gdbarch, struct gdbarch_data *data)
Definition: gdbarch.c:4845
struct type * builtin_logical
Definition: f-lang.h:81
struct value * default_read_var_value(struct symbol *var, struct frame_info *frame)
Definition: findvar.c:416
void default_print_typedef(struct type *type, struct symbol *new_symbol, struct ui_file *stream)
Definition: typeprint.c:346
#define _(String)
Definition: gdb_locale.h:40
struct type * string_char_type
Definition: language.h:120
char * char_ptr
Definition: gdb_vecs.h:25
void add_language(const struct language_defn *lang)
Definition: language.c:518
static char * f_word_break_characters(void)
Definition: f-lang.c:207
#define GDBARCH_OBSTACK_ZALLOC(GDBARCH, TYPE)
Definition: gdbarch.h:1615
static void f_language_arch_info(struct gdbarch *gdbarch, struct language_arch_info *lai)
Definition: f-lang.c:167
static void * build_fortran_types(struct gdbarch *gdbarch)
Definition: f-lang.c:284
char * default_word_break_characters(void)
Definition: language.c:669
void f_print_type(struct type *, const char *, struct ui_file *, int, int, const struct type_print_options *)
Definition: f-typeprint.c:50
#define LA_EMIT_CHAR(ch, type, stream, quoter)
Definition: language.h:499
void generic_printstr(struct ui_file *stream, struct type *type, const gdb_byte *string, unsigned int length, const char *encoding, int force_ellipses, int quote_char, int c_style_terminator, const struct value_print_options *options)
Definition: valprint.c:2380
struct type * builtin_complex_s16
Definition: f-lang.h:89
struct type * builtin_complex_s32
Definition: f-lang.h:90
struct type * bool_type_default
Definition: language.h:125
void null_post_parser(struct expression **exp, int void_context_p)
Definition: parse.c:1358
struct type * builtin_character
Definition: f-lang.h:78
struct type * builtin_integer
Definition: f-lang.h:79
void f_error(char *)
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
enum bfd_endian gdbarch_byte_order(struct gdbarch *gdbarch)
Definition: gdbarch.c:1420
struct type * basic_lookup_transparent_type(const char *name)
Definition: symtab.c:2851
#define TARGET_CHAR_BIT
Definition: host-defs.h:29
Definition: gdbtypes.h:749
const char * word
Definition: symtab.h:1448
struct gdbarch * get_type_arch(const struct type *type)
Definition: gdbtypes.c:232
int gdbarch_double_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1624
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
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
static char encoding[]
Definition: remote-mips.c:2988
void _initialize_f_language(void)
Definition: f-lang.c:350
static void f_printchar(int c, struct type *type, struct ui_file *stream)
Definition: f-lang.c:90
bfd_byte gdb_byte
Definition: common-types.h:38
static const struct op_print f_op_print_tab[]
Definition: f-lang.c:124
f_primitive_types
Definition: f-lang.c:149
static void f_emit_char(int c, struct type *type, struct ui_file *stream, int quoter)
Definition: f-lang.c:80
void default_get_string(struct value *value, gdb_byte **buffer, int *length, struct type **char_type, const char **charset)
Definition: language.c:686
#define default_varobj_ops
Definition: varobj.h:233
struct type * builtin_complex_s8
Definition: f-lang.h:88
int gdbarch_long_long_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1524
const struct exp_descriptor exp_descriptor_standard
Definition: parse.c:56
int code
Definition: ser-unix.c:684
void generic_emit_char(int c, struct type *type, struct ui_file *stream, int quoter, const char *encoding)
Definition: valprint.c:2051
int gdbarch_float_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1591
struct symbol * cp_lookup_symbol_nonlocal(const struct language_defn *langdef, const char *name, const struct block *block, const domain_enum domain)
Definition: cp-namespace.c:843
void f_val_print(struct type *, const gdb_byte *, int, CORE_ADDR, struct ui_file *, int, const struct value *, const struct value_print_options *)
Definition: f-valprint.c:255
struct type * builtin_void
Definition: f-lang.h:91
struct type * builtin_real
Definition: f-lang.h:85
#define TYPE_LENGTH(thistype)
Definition: gdbtypes.h:1237
static struct gdbarch_data * f_type_data
Definition: f-lang.c:341
const struct builtin_f_type * builtin_f_type(struct gdbarch *gdbarch)
Definition: f-lang.c:344
struct type * arch_type(struct gdbarch *gdbarch, enum type_code code, int length, char *name)
Definition: gdbtypes.c:4532
static VEC(char_ptr)
Definition: f-lang.c:231
#define LANG_MAGIC
Definition: language.h:402
int gdbarch_long_double_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1657
int gdbarch_short_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1473
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
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_logical_s1
Definition: f-lang.h:82
static const char * f_get_encoding(struct type *type)
Definition: f-lang.c:50