15796c8dcSSimon Schubert /* Fortran language support routines for GDB, the GNU debugger.
25796c8dcSSimon Schubert
3*ef5ccd6cSJohn Marino Copyright (C) 1993-2013 Free Software Foundation, Inc.
45796c8dcSSimon Schubert
55796c8dcSSimon Schubert Contributed by Motorola. Adapted from the C parser by Farooq Butt
65796c8dcSSimon Schubert (fmbutt@engage.sps.mot.com).
75796c8dcSSimon Schubert
85796c8dcSSimon Schubert This file is part of GDB.
95796c8dcSSimon Schubert
105796c8dcSSimon Schubert This program is free software; you can redistribute it and/or modify
115796c8dcSSimon Schubert it under the terms of the GNU General Public License as published by
125796c8dcSSimon Schubert the Free Software Foundation; either version 3 of the License, or
135796c8dcSSimon Schubert (at your option) any later version.
145796c8dcSSimon Schubert
155796c8dcSSimon Schubert This program is distributed in the hope that it will be useful,
165796c8dcSSimon Schubert but WITHOUT ANY WARRANTY; without even the implied warranty of
175796c8dcSSimon Schubert MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
185796c8dcSSimon Schubert GNU General Public License for more details.
195796c8dcSSimon Schubert
205796c8dcSSimon Schubert You should have received a copy of the GNU General Public License
215796c8dcSSimon Schubert along with this program. If not, see <http://www.gnu.org/licenses/>. */
225796c8dcSSimon Schubert
235796c8dcSSimon Schubert #include "defs.h"
245796c8dcSSimon Schubert #include "gdb_string.h"
255796c8dcSSimon Schubert #include "symtab.h"
265796c8dcSSimon Schubert #include "gdbtypes.h"
275796c8dcSSimon Schubert #include "expression.h"
285796c8dcSSimon Schubert #include "parser-defs.h"
295796c8dcSSimon Schubert #include "language.h"
305796c8dcSSimon Schubert #include "f-lang.h"
315796c8dcSSimon Schubert #include "valprint.h"
325796c8dcSSimon Schubert #include "value.h"
33cf7f2e2dSJohn Marino #include "cp-support.h"
34a45ae5f8SJohn Marino #include "charset.h"
35*ef5ccd6cSJohn Marino #include "c-lang.h"
365796c8dcSSimon Schubert
375796c8dcSSimon Schubert
385796c8dcSSimon Schubert /* Local functions */
395796c8dcSSimon Schubert
405796c8dcSSimon Schubert extern void _initialize_f_language (void);
415796c8dcSSimon Schubert
425796c8dcSSimon Schubert static void f_printchar (int c, struct type *type, struct ui_file * stream);
435796c8dcSSimon Schubert static void f_emit_char (int c, struct type *type,
445796c8dcSSimon Schubert struct ui_file * stream, int quoter);
455796c8dcSSimon Schubert
46a45ae5f8SJohn Marino /* Return the encoding that should be used for the character type
47a45ae5f8SJohn Marino TYPE. */
48a45ae5f8SJohn Marino
49a45ae5f8SJohn Marino static const char *
f_get_encoding(struct type * type)50a45ae5f8SJohn Marino f_get_encoding (struct type *type)
51a45ae5f8SJohn Marino {
52a45ae5f8SJohn Marino const char *encoding;
53a45ae5f8SJohn Marino
54a45ae5f8SJohn Marino switch (TYPE_LENGTH (type))
55a45ae5f8SJohn Marino {
56a45ae5f8SJohn Marino case 1:
57a45ae5f8SJohn Marino encoding = target_charset (get_type_arch (type));
58a45ae5f8SJohn Marino break;
59a45ae5f8SJohn Marino case 4:
60a45ae5f8SJohn Marino if (gdbarch_byte_order (get_type_arch (type)) == BFD_ENDIAN_BIG)
61a45ae5f8SJohn Marino encoding = "UTF-32BE";
62a45ae5f8SJohn Marino else
63a45ae5f8SJohn Marino encoding = "UTF-32LE";
64a45ae5f8SJohn Marino break;
65a45ae5f8SJohn Marino
66a45ae5f8SJohn Marino default:
67a45ae5f8SJohn Marino error (_("unrecognized character type"));
68a45ae5f8SJohn Marino }
69a45ae5f8SJohn Marino
70a45ae5f8SJohn Marino return encoding;
71a45ae5f8SJohn Marino }
72a45ae5f8SJohn Marino
735796c8dcSSimon Schubert /* Print the character C on STREAM as part of the contents of a literal
745796c8dcSSimon Schubert string whose delimiter is QUOTER. Note that that format for printing
755796c8dcSSimon Schubert characters and strings is language specific.
765796c8dcSSimon Schubert FIXME: This is a copy of the same function from c-exp.y. It should
775796c8dcSSimon Schubert be replaced with a true F77 version. */
785796c8dcSSimon Schubert
795796c8dcSSimon Schubert static void
f_emit_char(int c,struct type * type,struct ui_file * stream,int quoter)805796c8dcSSimon Schubert f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
815796c8dcSSimon Schubert {
82a45ae5f8SJohn Marino const char *encoding = f_get_encoding (type);
835796c8dcSSimon Schubert
84a45ae5f8SJohn Marino generic_emit_char (c, type, stream, quoter, encoding);
855796c8dcSSimon Schubert }
865796c8dcSSimon Schubert
87a45ae5f8SJohn Marino /* Implementation of la_printchar. */
885796c8dcSSimon Schubert
895796c8dcSSimon Schubert static void
f_printchar(int c,struct type * type,struct ui_file * stream)905796c8dcSSimon Schubert f_printchar (int c, struct type *type, struct ui_file *stream)
915796c8dcSSimon Schubert {
925796c8dcSSimon Schubert fputs_filtered ("'", stream);
935796c8dcSSimon Schubert LA_EMIT_CHAR (c, type, stream, '\'');
945796c8dcSSimon Schubert fputs_filtered ("'", stream);
955796c8dcSSimon Schubert }
965796c8dcSSimon Schubert
975796c8dcSSimon Schubert /* Print the character string STRING, printing at most LENGTH characters.
985796c8dcSSimon Schubert Printing stops early if the number hits print_max; repeat counts
995796c8dcSSimon Schubert are printed as appropriate. Print ellipses at the end if we
1005796c8dcSSimon Schubert had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
1015796c8dcSSimon Schubert FIXME: This is a copy of the same function from c-exp.y. It should
1025796c8dcSSimon Schubert be replaced with a true F77 version. */
1035796c8dcSSimon Schubert
1045796c8dcSSimon Schubert 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)1055796c8dcSSimon Schubert f_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
106cf7f2e2dSJohn Marino unsigned int length, const char *encoding, int force_ellipses,
1075796c8dcSSimon Schubert const struct value_print_options *options)
1085796c8dcSSimon Schubert {
109a45ae5f8SJohn Marino const char *type_encoding = f_get_encoding (type);
1105796c8dcSSimon Schubert
111a45ae5f8SJohn Marino if (TYPE_LENGTH (type) == 4)
112a45ae5f8SJohn Marino fputs_filtered ("4_", stream);
1135796c8dcSSimon Schubert
114a45ae5f8SJohn Marino if (!encoding || !*encoding)
115a45ae5f8SJohn Marino encoding = type_encoding;
1165796c8dcSSimon Schubert
117a45ae5f8SJohn Marino generic_printstr (stream, type, string, length, encoding,
118a45ae5f8SJohn Marino force_ellipses, '\'', 0, options);
1195796c8dcSSimon Schubert }
1205796c8dcSSimon Schubert
1215796c8dcSSimon Schubert
1225796c8dcSSimon Schubert /* Table of operators and their precedences for printing expressions. */
1235796c8dcSSimon Schubert
1245796c8dcSSimon Schubert static const struct op_print f_op_print_tab[] =
1255796c8dcSSimon Schubert {
1265796c8dcSSimon Schubert {"+", BINOP_ADD, PREC_ADD, 0},
1275796c8dcSSimon Schubert {"+", UNOP_PLUS, PREC_PREFIX, 0},
1285796c8dcSSimon Schubert {"-", BINOP_SUB, PREC_ADD, 0},
1295796c8dcSSimon Schubert {"-", UNOP_NEG, PREC_PREFIX, 0},
1305796c8dcSSimon Schubert {"*", BINOP_MUL, PREC_MUL, 0},
1315796c8dcSSimon Schubert {"/", BINOP_DIV, PREC_MUL, 0},
1325796c8dcSSimon Schubert {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1335796c8dcSSimon Schubert {"MOD", BINOP_REM, PREC_MUL, 0},
1345796c8dcSSimon Schubert {"=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1355796c8dcSSimon Schubert {".OR.", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
1365796c8dcSSimon Schubert {".AND.", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
1375796c8dcSSimon Schubert {".NOT.", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
1385796c8dcSSimon Schubert {".EQ.", BINOP_EQUAL, PREC_EQUAL, 0},
1395796c8dcSSimon Schubert {".NE.", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1405796c8dcSSimon Schubert {".LE.", BINOP_LEQ, PREC_ORDER, 0},
1415796c8dcSSimon Schubert {".GE.", BINOP_GEQ, PREC_ORDER, 0},
1425796c8dcSSimon Schubert {".GT.", BINOP_GTR, PREC_ORDER, 0},
1435796c8dcSSimon Schubert {".LT.", BINOP_LESS, PREC_ORDER, 0},
1445796c8dcSSimon Schubert {"**", UNOP_IND, PREC_PREFIX, 0},
1455796c8dcSSimon Schubert {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1465796c8dcSSimon Schubert {NULL, 0, 0, 0}
1475796c8dcSSimon Schubert };
1485796c8dcSSimon Schubert
1495796c8dcSSimon Schubert enum f_primitive_types {
1505796c8dcSSimon Schubert f_primitive_type_character,
1515796c8dcSSimon Schubert f_primitive_type_logical,
1525796c8dcSSimon Schubert f_primitive_type_logical_s1,
1535796c8dcSSimon Schubert f_primitive_type_logical_s2,
154cf7f2e2dSJohn Marino f_primitive_type_logical_s8,
1555796c8dcSSimon Schubert f_primitive_type_integer,
1565796c8dcSSimon Schubert f_primitive_type_integer_s2,
1575796c8dcSSimon Schubert f_primitive_type_real,
1585796c8dcSSimon Schubert f_primitive_type_real_s8,
1595796c8dcSSimon Schubert f_primitive_type_real_s16,
1605796c8dcSSimon Schubert f_primitive_type_complex_s8,
1615796c8dcSSimon Schubert f_primitive_type_complex_s16,
1625796c8dcSSimon Schubert f_primitive_type_void,
1635796c8dcSSimon Schubert nr_f_primitive_types
1645796c8dcSSimon Schubert };
1655796c8dcSSimon Schubert
1665796c8dcSSimon Schubert static void
f_language_arch_info(struct gdbarch * gdbarch,struct language_arch_info * lai)1675796c8dcSSimon Schubert f_language_arch_info (struct gdbarch *gdbarch,
1685796c8dcSSimon Schubert struct language_arch_info *lai)
1695796c8dcSSimon Schubert {
1705796c8dcSSimon Schubert const struct builtin_f_type *builtin = builtin_f_type (gdbarch);
1715796c8dcSSimon Schubert
1725796c8dcSSimon Schubert lai->string_char_type = builtin->builtin_character;
1735796c8dcSSimon Schubert lai->primitive_type_vector
1745796c8dcSSimon Schubert = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_f_primitive_types + 1,
1755796c8dcSSimon Schubert struct type *);
1765796c8dcSSimon Schubert
1775796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_character]
1785796c8dcSSimon Schubert = builtin->builtin_character;
1795796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_logical]
1805796c8dcSSimon Schubert = builtin->builtin_logical;
1815796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_logical_s1]
1825796c8dcSSimon Schubert = builtin->builtin_logical_s1;
1835796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_logical_s2]
1845796c8dcSSimon Schubert = builtin->builtin_logical_s2;
185cf7f2e2dSJohn Marino lai->primitive_type_vector [f_primitive_type_logical_s8]
186cf7f2e2dSJohn Marino = builtin->builtin_logical_s8;
1875796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_real]
1885796c8dcSSimon Schubert = builtin->builtin_real;
1895796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_real_s8]
1905796c8dcSSimon Schubert = builtin->builtin_real_s8;
1915796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_real_s16]
1925796c8dcSSimon Schubert = builtin->builtin_real_s16;
1935796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_complex_s8]
1945796c8dcSSimon Schubert = builtin->builtin_complex_s8;
1955796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_complex_s16]
1965796c8dcSSimon Schubert = builtin->builtin_complex_s16;
1975796c8dcSSimon Schubert lai->primitive_type_vector [f_primitive_type_void]
1985796c8dcSSimon Schubert = builtin->builtin_void;
1995796c8dcSSimon Schubert
2005796c8dcSSimon Schubert lai->bool_type_symbol = "logical";
2015796c8dcSSimon Schubert lai->bool_type_default = builtin->builtin_logical_s2;
2025796c8dcSSimon Schubert }
2035796c8dcSSimon Schubert
204cf7f2e2dSJohn Marino /* Remove the modules separator :: from the default break list. */
205cf7f2e2dSJohn Marino
206cf7f2e2dSJohn Marino static char *
f_word_break_characters(void)207cf7f2e2dSJohn Marino f_word_break_characters (void)
208cf7f2e2dSJohn Marino {
209cf7f2e2dSJohn Marino static char *retval;
210cf7f2e2dSJohn Marino
211cf7f2e2dSJohn Marino if (!retval)
212cf7f2e2dSJohn Marino {
213cf7f2e2dSJohn Marino char *s;
214cf7f2e2dSJohn Marino
215cf7f2e2dSJohn Marino retval = xstrdup (default_word_break_characters ());
216cf7f2e2dSJohn Marino s = strchr (retval, ':');
217cf7f2e2dSJohn Marino if (s)
218cf7f2e2dSJohn Marino {
219cf7f2e2dSJohn Marino char *last_char = &s[strlen (s) - 1];
220cf7f2e2dSJohn Marino
221cf7f2e2dSJohn Marino *s = *last_char;
222cf7f2e2dSJohn Marino *last_char = 0;
223cf7f2e2dSJohn Marino }
224cf7f2e2dSJohn Marino }
225cf7f2e2dSJohn Marino return retval;
226cf7f2e2dSJohn Marino }
227cf7f2e2dSJohn Marino
228c50c785cSJohn Marino /* Consider the modules separator :: as a valid symbol name character
229c50c785cSJohn Marino class. */
230cf7f2e2dSJohn Marino
VEC(char_ptr)231*ef5ccd6cSJohn Marino static VEC (char_ptr) *
232*ef5ccd6cSJohn Marino f_make_symbol_completion_list (char *text, char *word, enum type_code code)
233cf7f2e2dSJohn Marino {
234*ef5ccd6cSJohn Marino return default_make_symbol_completion_list_break_on (text, word, ":", code);
235cf7f2e2dSJohn Marino }
236cf7f2e2dSJohn Marino
2375796c8dcSSimon Schubert const struct language_defn f_language_defn =
2385796c8dcSSimon Schubert {
2395796c8dcSSimon Schubert "fortran",
2405796c8dcSSimon Schubert language_fortran,
2415796c8dcSSimon Schubert range_check_on,
2425796c8dcSSimon Schubert case_sensitive_off,
2435796c8dcSSimon Schubert array_column_major,
2445796c8dcSSimon Schubert macro_expansion_no,
2455796c8dcSSimon Schubert &exp_descriptor_standard,
2465796c8dcSSimon Schubert f_parse, /* parser */
2475796c8dcSSimon Schubert f_error, /* parser error function */
2485796c8dcSSimon Schubert null_post_parser,
2495796c8dcSSimon Schubert f_printchar, /* Print character constant */
2505796c8dcSSimon Schubert f_printstr, /* function to print string constant */
2515796c8dcSSimon Schubert f_emit_char, /* Function to print a single character */
2525796c8dcSSimon Schubert f_print_type, /* Print a type using appropriate syntax */
2535796c8dcSSimon Schubert default_print_typedef, /* Print a typedef using appropriate syntax */
2545796c8dcSSimon Schubert f_val_print, /* Print a value using appropriate syntax */
2555796c8dcSSimon Schubert c_value_print, /* FIXME */
256*ef5ccd6cSJohn Marino default_read_var_value, /* la_read_var_value */
2575796c8dcSSimon Schubert NULL, /* Language specific skip_trampoline */
2585796c8dcSSimon Schubert NULL, /* name_of_this */
259cf7f2e2dSJohn Marino cp_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
2605796c8dcSSimon Schubert basic_lookup_transparent_type,/* lookup_transparent_type */
2615796c8dcSSimon Schubert NULL, /* Language specific symbol demangler */
262c50c785cSJohn Marino NULL, /* Language specific
263c50c785cSJohn Marino class_name_from_physname */
2645796c8dcSSimon Schubert f_op_print_tab, /* expression operators for printing */
2655796c8dcSSimon Schubert 0, /* arrays are first-class (not c-style) */
2665796c8dcSSimon Schubert 1, /* String lower bound */
267cf7f2e2dSJohn Marino f_word_break_characters,
268cf7f2e2dSJohn Marino f_make_symbol_completion_list,
2695796c8dcSSimon Schubert f_language_arch_info,
2705796c8dcSSimon Schubert default_print_array_index,
2715796c8dcSSimon Schubert default_pass_by_reference,
2725796c8dcSSimon Schubert default_get_string,
273*ef5ccd6cSJohn Marino NULL, /* la_get_symbol_name_cmp */
274a45ae5f8SJohn Marino iterate_over_symbols,
2755796c8dcSSimon Schubert LANG_MAGIC
2765796c8dcSSimon Schubert };
2775796c8dcSSimon Schubert
2785796c8dcSSimon Schubert static void *
build_fortran_types(struct gdbarch * gdbarch)2795796c8dcSSimon Schubert build_fortran_types (struct gdbarch *gdbarch)
2805796c8dcSSimon Schubert {
2815796c8dcSSimon Schubert struct builtin_f_type *builtin_f_type
2825796c8dcSSimon Schubert = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
2835796c8dcSSimon Schubert
2845796c8dcSSimon Schubert builtin_f_type->builtin_void
2855796c8dcSSimon Schubert = arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
2865796c8dcSSimon Schubert
2875796c8dcSSimon Schubert builtin_f_type->builtin_character
2885796c8dcSSimon Schubert = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
2895796c8dcSSimon Schubert
2905796c8dcSSimon Schubert builtin_f_type->builtin_logical_s1
2915796c8dcSSimon Schubert = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
2925796c8dcSSimon Schubert
2935796c8dcSSimon Schubert builtin_f_type->builtin_integer_s2
2945796c8dcSSimon Schubert = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
2955796c8dcSSimon Schubert "integer*2");
2965796c8dcSSimon Schubert
2975796c8dcSSimon Schubert builtin_f_type->builtin_logical_s2
2985796c8dcSSimon Schubert = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
2995796c8dcSSimon Schubert "logical*2");
3005796c8dcSSimon Schubert
301cf7f2e2dSJohn Marino builtin_f_type->builtin_logical_s8
302cf7f2e2dSJohn Marino = arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
303cf7f2e2dSJohn Marino "logical*8");
304cf7f2e2dSJohn Marino
3055796c8dcSSimon Schubert builtin_f_type->builtin_integer
3065796c8dcSSimon Schubert = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
3075796c8dcSSimon Schubert "integer");
3085796c8dcSSimon Schubert
3095796c8dcSSimon Schubert builtin_f_type->builtin_logical
3105796c8dcSSimon Schubert = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
3115796c8dcSSimon Schubert "logical*4");
3125796c8dcSSimon Schubert
3135796c8dcSSimon Schubert builtin_f_type->builtin_real
3145796c8dcSSimon Schubert = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
3155796c8dcSSimon Schubert "real", NULL);
3165796c8dcSSimon Schubert builtin_f_type->builtin_real_s8
3175796c8dcSSimon Schubert = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
3185796c8dcSSimon Schubert "real*8", NULL);
3195796c8dcSSimon Schubert builtin_f_type->builtin_real_s16
3205796c8dcSSimon Schubert = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
3215796c8dcSSimon Schubert "real*16", NULL);
3225796c8dcSSimon Schubert
3235796c8dcSSimon Schubert builtin_f_type->builtin_complex_s8
3245796c8dcSSimon Schubert = arch_complex_type (gdbarch, "complex*8",
3255796c8dcSSimon Schubert builtin_f_type->builtin_real);
3265796c8dcSSimon Schubert builtin_f_type->builtin_complex_s16
3275796c8dcSSimon Schubert = arch_complex_type (gdbarch, "complex*16",
3285796c8dcSSimon Schubert builtin_f_type->builtin_real_s8);
3295796c8dcSSimon Schubert builtin_f_type->builtin_complex_s32
3305796c8dcSSimon Schubert = arch_complex_type (gdbarch, "complex*32",
3315796c8dcSSimon Schubert builtin_f_type->builtin_real_s16);
3325796c8dcSSimon Schubert
3335796c8dcSSimon Schubert return builtin_f_type;
3345796c8dcSSimon Schubert }
3355796c8dcSSimon Schubert
3365796c8dcSSimon Schubert static struct gdbarch_data *f_type_data;
3375796c8dcSSimon Schubert
3385796c8dcSSimon Schubert const struct builtin_f_type *
builtin_f_type(struct gdbarch * gdbarch)3395796c8dcSSimon Schubert builtin_f_type (struct gdbarch *gdbarch)
3405796c8dcSSimon Schubert {
3415796c8dcSSimon Schubert return gdbarch_data (gdbarch, f_type_data);
3425796c8dcSSimon Schubert }
3435796c8dcSSimon Schubert
3445796c8dcSSimon Schubert void
_initialize_f_language(void)3455796c8dcSSimon Schubert _initialize_f_language (void)
3465796c8dcSSimon Schubert {
3475796c8dcSSimon Schubert f_type_data = gdbarch_data_register_post_init (build_fortran_types);
3485796c8dcSSimon Schubert
3495796c8dcSSimon Schubert add_language (&f_language_defn);
3505796c8dcSSimon Schubert }
351