1 /* Fortran language support routines for GDB, the GNU debugger.
3 Copyright (C) 1993-2013 Free Software Foundation, Inc.
5 Contributed by Motorola. Adapted from the C parser by Farooq Butt
6 (fmbutt@engage.sps.mot.com).
8 This file is part of GDB.
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.
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.
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/>. */
24 #include "gdb_string.h"
27 #include "expression.h"
28 #include "parser-defs.h"
34 #include "cp-support.h"
41 extern void _initialize_f_language (void);
43 static void f_printchar (int c, struct type *type, struct ui_file * stream);
44 static void f_emit_char (int c, struct type *type,
45 struct ui_file * stream, int quoter);
47 /* Return the encoding that should be used for the character type
51 f_get_encoding (struct type *type)
55 switch (TYPE_LENGTH (type))
58 encoding = target_charset (get_type_arch (type));
61 if (gdbarch_byte_order (get_type_arch (type)) == BFD_ENDIAN_BIG)
62 encoding = "UTF-32BE";
64 encoding = "UTF-32LE";
68 error (_("unrecognized character type"));
74 /* Print the character C on STREAM as part of the contents of a literal
75 string whose delimiter is QUOTER. Note that that format for printing
76 characters and strings is language specific.
77 FIXME: This is a copy of the same function from c-exp.y. It should
78 be replaced with a true F77 version. */
81 f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
83 const char *encoding = f_get_encoding (type);
85 generic_emit_char (c, type, stream, quoter, encoding);
88 /* Implementation of la_printchar. */
91 f_printchar (int c, struct type *type, struct ui_file *stream)
93 fputs_filtered ("'", stream);
94 LA_EMIT_CHAR (c, type, 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 F77 version. */
106 f_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)
110 const char *type_encoding = f_get_encoding (type);
112 if (TYPE_LENGTH (type) == 4)
113 fputs_filtered ("4_", stream);
115 if (!encoding || !*encoding)
116 encoding = type_encoding;
118 generic_printstr (stream, type, string, length, encoding,
119 force_ellipses, '\'', 0, options);
123 /* Table of operators and their precedences for printing expressions. */
125 static const struct op_print f_op_print_tab[] =
127 {"+", BINOP_ADD, PREC_ADD, 0},
128 {"+", UNOP_PLUS, PREC_PREFIX, 0},
129 {"-", BINOP_SUB, PREC_ADD, 0},
130 {"-", UNOP_NEG, PREC_PREFIX, 0},
131 {"*", BINOP_MUL, PREC_MUL, 0},
132 {"/", BINOP_DIV, PREC_MUL, 0},
133 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
134 {"MOD", BINOP_REM, PREC_MUL, 0},
135 {"=", BINOP_ASSIGN, PREC_ASSIGN, 1},
136 {".OR.", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
137 {".AND.", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
138 {".NOT.", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
139 {".EQ.", BINOP_EQUAL, PREC_EQUAL, 0},
140 {".NE.", BINOP_NOTEQUAL, PREC_EQUAL, 0},
141 {".LE.", BINOP_LEQ, PREC_ORDER, 0},
142 {".GE.", BINOP_GEQ, PREC_ORDER, 0},
143 {".GT.", BINOP_GTR, PREC_ORDER, 0},
144 {".LT.", BINOP_LESS, PREC_ORDER, 0},
145 {"**", UNOP_IND, PREC_PREFIX, 0},
146 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
150 enum f_primitive_types {
151 f_primitive_type_character,
152 f_primitive_type_logical,
153 f_primitive_type_logical_s1,
154 f_primitive_type_logical_s2,
155 f_primitive_type_logical_s8,
156 f_primitive_type_integer,
157 f_primitive_type_integer_s2,
158 f_primitive_type_real,
159 f_primitive_type_real_s8,
160 f_primitive_type_real_s16,
161 f_primitive_type_complex_s8,
162 f_primitive_type_complex_s16,
163 f_primitive_type_void,
168 f_language_arch_info (struct gdbarch *gdbarch,
169 struct language_arch_info *lai)
171 const struct builtin_f_type *builtin = builtin_f_type (gdbarch);
173 lai->string_char_type = builtin->builtin_character;
174 lai->primitive_type_vector
175 = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_f_primitive_types + 1,
178 lai->primitive_type_vector [f_primitive_type_character]
179 = builtin->builtin_character;
180 lai->primitive_type_vector [f_primitive_type_logical]
181 = builtin->builtin_logical;
182 lai->primitive_type_vector [f_primitive_type_logical_s1]
183 = builtin->builtin_logical_s1;
184 lai->primitive_type_vector [f_primitive_type_logical_s2]
185 = builtin->builtin_logical_s2;
186 lai->primitive_type_vector [f_primitive_type_logical_s8]
187 = builtin->builtin_logical_s8;
188 lai->primitive_type_vector [f_primitive_type_real]
189 = builtin->builtin_real;
190 lai->primitive_type_vector [f_primitive_type_real_s8]
191 = builtin->builtin_real_s8;
192 lai->primitive_type_vector [f_primitive_type_real_s16]
193 = builtin->builtin_real_s16;
194 lai->primitive_type_vector [f_primitive_type_complex_s8]
195 = builtin->builtin_complex_s8;
196 lai->primitive_type_vector [f_primitive_type_complex_s16]
197 = builtin->builtin_complex_s16;
198 lai->primitive_type_vector [f_primitive_type_void]
199 = builtin->builtin_void;
201 lai->bool_type_symbol = "logical";
202 lai->bool_type_default = builtin->builtin_logical_s2;
205 /* Remove the modules separator :: from the default break list. */
208 f_word_break_characters (void)
216 retval = xstrdup (default_word_break_characters ());
217 s = strchr (retval, ':');
220 char *last_char = &s[strlen (s) - 1];
229 /* Consider the modules separator :: as a valid symbol name character
232 static VEC (char_ptr) *
233 f_make_symbol_completion_list (const char *text, const char *word,
236 return default_make_symbol_completion_list_break_on (text, word, ":", code);
239 const struct language_defn f_language_defn =
247 &exp_descriptor_standard,
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 */
269 f_word_break_characters,
270 f_make_symbol_completion_list,
271 f_language_arch_info,
272 default_print_array_index,
273 default_pass_by_reference,
275 NULL, /* la_get_symbol_name_cmp */
276 iterate_over_symbols,
282 build_fortran_types (struct gdbarch *gdbarch)
284 struct builtin_f_type *builtin_f_type
285 = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
287 builtin_f_type->builtin_void
288 = arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
290 builtin_f_type->builtin_character
291 = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
293 builtin_f_type->builtin_logical_s1
294 = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
296 builtin_f_type->builtin_integer_s2
297 = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
300 builtin_f_type->builtin_logical_s2
301 = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
304 builtin_f_type->builtin_logical_s8
305 = arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
308 builtin_f_type->builtin_integer
309 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
312 builtin_f_type->builtin_logical
313 = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
316 builtin_f_type->builtin_real
317 = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
319 builtin_f_type->builtin_real_s8
320 = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
322 builtin_f_type->builtin_real_s16
323 = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
326 builtin_f_type->builtin_complex_s8
327 = arch_complex_type (gdbarch, "complex*8",
328 builtin_f_type->builtin_real);
329 builtin_f_type->builtin_complex_s16
330 = arch_complex_type (gdbarch, "complex*16",
331 builtin_f_type->builtin_real_s8);
332 builtin_f_type->builtin_complex_s32
333 = arch_complex_type (gdbarch, "complex*32",
334 builtin_f_type->builtin_real_s16);
336 return builtin_f_type;
339 static struct gdbarch_data *f_type_data;
341 const struct builtin_f_type *
342 builtin_f_type (struct gdbarch *gdbarch)
344 return gdbarch_data (gdbarch, f_type_data);
348 _initialize_f_language (void)
350 f_type_data = gdbarch_data_register_post_init (build_fortran_types);
352 add_language (&f_language_defn);