rename frame_register_read into deprecated_frame_register_read.
[deliverable/binutils-gdb.git] / gdb / f-lang.c
CommitLineData
c906108c 1/* Fortran language support routines for GDB, the GNU debugger.
ce27fb25 2
0b302171
JB
3 Copyright (C) 1993-1996, 1998-2005, 2007-2012 Free Software
4 Foundation, Inc.
ce27fb25 5
c906108c
SS
6 Contributed by Motorola. Adapted from the C parser by Farooq Butt
7 (fmbutt@engage.sps.mot.com).
8
c5aa993b 9 This file is part of GDB.
c906108c 10
c5aa993b
JM
11 This program is free software; you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
a9762ec7 13 the Free Software Foundation; either version 3 of the License, or
c5aa993b 14 (at your option) any later version.
c906108c 15
c5aa993b
JM
16 This program is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
c906108c 20
c5aa993b 21 You should have received a copy of the GNU General Public License
a9762ec7 22 along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c
SS
23
24#include "defs.h"
25#include "gdb_string.h"
26#include "symtab.h"
27#include "gdbtypes.h"
28#include "expression.h"
29#include "parser-defs.h"
30#include "language.h"
31#include "f-lang.h"
745b8ca0 32#include "valprint.h"
5f9a71c3 33#include "value.h"
f55ee35c 34#include "cp-support.h"
3b2b8fea 35#include "charset.h"
8e069a98 36#include "c-lang.h"
c906108c 37
c906108c 38
c906108c
SS
39/* Local functions */
40
a14ed312 41extern void _initialize_f_language (void);
c906108c 42
6c7a06a3
TT
43static void f_printchar (int c, struct type *type, struct ui_file * stream);
44static void f_emit_char (int c, struct type *type,
45 struct ui_file * stream, int quoter);
c906108c 46
3b2b8fea
TT
47/* Return the encoding that should be used for the character type
48 TYPE. */
49
50static const char *
51f_get_encoding (struct type *type)
52{
53 const char *encoding;
54
55 switch (TYPE_LENGTH (type))
56 {
57 case 1:
58 encoding = target_charset (get_type_arch (type));
59 break;
60 case 4:
61 if (gdbarch_byte_order (get_type_arch (type)) == BFD_ENDIAN_BIG)
62 encoding = "UTF-32BE";
63 else
64 encoding = "UTF-32LE";
65 break;
66
67 default:
68 error (_("unrecognized character type"));
69 }
70
71 return encoding;
72}
73
c906108c
SS
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. */
79
80static void
6c7a06a3 81f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
c906108c 82{
3b2b8fea 83 const char *encoding = f_get_encoding (type);
c5aa993b 84
3b2b8fea 85 generic_emit_char (c, type, stream, quoter, encoding);
c906108c
SS
86}
87
3b2b8fea 88/* Implementation of la_printchar. */
c906108c
SS
89
90static void
6c7a06a3 91f_printchar (int c, struct type *type, struct ui_file *stream)
c906108c
SS
92{
93 fputs_filtered ("'", stream);
6c7a06a3 94 LA_EMIT_CHAR (c, type, stream, '\'');
c906108c
SS
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
0963b4bd 103 be replaced with a true F77 version. */
c906108c
SS
104
105static void
6c7a06a3 106f_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
be759fcf 107 unsigned int length, const char *encoding, int force_ellipses,
79a45b7d 108 const struct value_print_options *options)
c906108c 109{
3b2b8fea 110 const char *type_encoding = f_get_encoding (type);
c5aa993b 111
3b2b8fea
TT
112 if (TYPE_LENGTH (type) == 4)
113 fputs_filtered ("4_", stream);
c5aa993b 114
3b2b8fea
TT
115 if (!encoding || !*encoding)
116 encoding = type_encoding;
c5aa993b 117
3b2b8fea
TT
118 generic_printstr (stream, type, string, length, encoding,
119 force_ellipses, '\'', 0, options);
c906108c 120}
c906108c 121\f
c5aa993b 122
c906108c
SS
123/* Table of operators and their precedences for printing expressions. */
124
c5aa993b
JM
125static const struct op_print f_op_print_tab[] =
126{
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},
147 {NULL, 0, 0, 0}
c906108c
SS
148};
149\f
cad351d1
UW
150enum 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,
ce4b0682 155 f_primitive_type_logical_s8,
cad351d1
UW
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,
164 nr_f_primitive_types
c906108c
SS
165};
166
cad351d1
UW
167static void
168f_language_arch_info (struct gdbarch *gdbarch,
169 struct language_arch_info *lai)
170{
54ef06c7
UW
171 const struct builtin_f_type *builtin = builtin_f_type (gdbarch);
172
173 lai->string_char_type = builtin->builtin_character;
cad351d1
UW
174 lai->primitive_type_vector
175 = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_f_primitive_types + 1,
176 struct type *);
177
178 lai->primitive_type_vector [f_primitive_type_character]
54ef06c7 179 = builtin->builtin_character;
cad351d1 180 lai->primitive_type_vector [f_primitive_type_logical]
54ef06c7 181 = builtin->builtin_logical;
cad351d1 182 lai->primitive_type_vector [f_primitive_type_logical_s1]
54ef06c7 183 = builtin->builtin_logical_s1;
cad351d1 184 lai->primitive_type_vector [f_primitive_type_logical_s2]
54ef06c7 185 = builtin->builtin_logical_s2;
ce4b0682
SDJ
186 lai->primitive_type_vector [f_primitive_type_logical_s8]
187 = builtin->builtin_logical_s8;
cad351d1 188 lai->primitive_type_vector [f_primitive_type_real]
54ef06c7 189 = builtin->builtin_real;
cad351d1 190 lai->primitive_type_vector [f_primitive_type_real_s8]
54ef06c7 191 = builtin->builtin_real_s8;
cad351d1 192 lai->primitive_type_vector [f_primitive_type_real_s16]
54ef06c7 193 = builtin->builtin_real_s16;
cad351d1 194 lai->primitive_type_vector [f_primitive_type_complex_s8]
54ef06c7 195 = builtin->builtin_complex_s8;
cad351d1 196 lai->primitive_type_vector [f_primitive_type_complex_s16]
54ef06c7 197 = builtin->builtin_complex_s16;
cad351d1 198 lai->primitive_type_vector [f_primitive_type_void]
54ef06c7 199 = builtin->builtin_void;
fbb06eb1
UW
200
201 lai->bool_type_symbol = "logical";
202 lai->bool_type_default = builtin->builtin_logical_s2;
cad351d1
UW
203}
204
f55ee35c
JK
205/* Remove the modules separator :: from the default break list. */
206
207static char *
208f_word_break_characters (void)
209{
210 static char *retval;
211
212 if (!retval)
213 {
214 char *s;
215
216 retval = xstrdup (default_word_break_characters ());
217 s = strchr (retval, ':');
218 if (s)
219 {
220 char *last_char = &s[strlen (s) - 1];
221
222 *s = *last_char;
223 *last_char = 0;
224 }
225 }
226 return retval;
227}
228
3e43a32a
MS
229/* Consider the modules separator :: as a valid symbol name character
230 class. */
f55ee35c 231
49c4e619 232static VEC (char_ptr) *
f55ee35c
JK
233f_make_symbol_completion_list (char *text, char *word)
234{
235 return default_make_symbol_completion_list_break_on (text, word, ":");
236}
237
c5aa993b
JM
238const struct language_defn f_language_defn =
239{
c906108c
SS
240 "fortran",
241 language_fortran,
c906108c 242 range_check_on,
63872f9d 243 case_sensitive_off,
7ca2d3a3 244 array_column_major,
9a044a89 245 macro_expansion_no,
5f9769d1 246 &exp_descriptor_standard,
c906108c
SS
247 f_parse, /* parser */
248 f_error, /* parser error function */
e85c3284 249 null_post_parser,
c906108c
SS
250 f_printchar, /* Print character constant */
251 f_printstr, /* function to print string constant */
252 f_emit_char, /* Function to print a single character */
c5aa993b 253 f_print_type, /* Print a type using appropriate syntax */
5c6ce71d 254 default_print_typedef, /* Print a typedef using appropriate syntax */
c906108c 255 f_val_print, /* Print a value using appropriate syntax */
c5aa993b 256 c_value_print, /* FIXME */
a5ee536b 257 default_read_var_value, /* la_read_var_value */
f636b87d 258 NULL, /* Language specific skip_trampoline */
2b2d9e11 259 NULL, /* name_of_this */
f55ee35c 260 cp_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e 261 basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd 262 NULL, /* Language specific symbol demangler */
3e43a32a
MS
263 NULL, /* Language specific
264 class_name_from_physname */
c906108c
SS
265 f_op_print_tab, /* expression operators for printing */
266 0, /* arrays are first-class (not c-style) */
267 1, /* String lower bound */
f55ee35c
JK
268 f_word_break_characters,
269 f_make_symbol_completion_list,
cad351d1 270 f_language_arch_info,
e79af960 271 default_print_array_index,
41f1b697 272 default_pass_by_reference,
ae6a3a4c 273 default_get_string,
1a119f36 274 NULL, /* la_get_symbol_name_cmp */
f8eba3c6 275 iterate_over_symbols,
c906108c 276 LANG_MAGIC
c5aa993b 277};
c906108c 278
54ef06c7
UW
279static void *
280build_fortran_types (struct gdbarch *gdbarch)
c906108c 281{
54ef06c7
UW
282 struct builtin_f_type *builtin_f_type
283 = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
284
e9bb382b
UW
285 builtin_f_type->builtin_void
286 = arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
287
288 builtin_f_type->builtin_character
289 = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
290
291 builtin_f_type->builtin_logical_s1
292 = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
293
294 builtin_f_type->builtin_integer_s2
295 = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
296 "integer*2");
297
298 builtin_f_type->builtin_logical_s2
299 = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
300 "logical*2");
301
ce4b0682
SDJ
302 builtin_f_type->builtin_logical_s8
303 = arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
304 "logical*8");
305
e9bb382b
UW
306 builtin_f_type->builtin_integer
307 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
308 "integer");
309
310 builtin_f_type->builtin_logical
311 = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
312 "logical*4");
313
314 builtin_f_type->builtin_real
315 = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
316 "real", NULL);
317 builtin_f_type->builtin_real_s8
318 = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
319 "real*8", NULL);
320 builtin_f_type->builtin_real_s16
321 = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
322 "real*16", NULL);
323
324 builtin_f_type->builtin_complex_s8
325 = arch_complex_type (gdbarch, "complex*8",
326 builtin_f_type->builtin_real);
327 builtin_f_type->builtin_complex_s16
328 = arch_complex_type (gdbarch, "complex*16",
329 builtin_f_type->builtin_real_s8);
330 builtin_f_type->builtin_complex_s32
331 = arch_complex_type (gdbarch, "complex*32",
332 builtin_f_type->builtin_real_s16);
54ef06c7
UW
333
334 return builtin_f_type;
335}
336
337static struct gdbarch_data *f_type_data;
338
339const struct builtin_f_type *
340builtin_f_type (struct gdbarch *gdbarch)
341{
342 return gdbarch_data (gdbarch, f_type_data);
4e845cd3
MS
343}
344
345void
346_initialize_f_language (void)
347{
54ef06c7 348 f_type_data = gdbarch_data_register_post_init (build_fortran_types);
c906108c 349
c906108c
SS
350 add_language (&f_language_defn);
351}
This page took 0.878059 seconds and 4 git commands to generate.