/* Fortran language support definitions for GDB, the GNU debugger.
- Copyright 1992, 1993, 1994 Free Software Foundation, Inc.
+
+ Copyright (C) 1992-2021 Free Software Foundation, Inc.
+
Contributed by Motorola. Adapted from the C definitions by Farooq Butt
(fmbutt@engage.sps.mot.com).
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
+ the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
-extern int f_parse PARAMS ((void));
+#ifndef F_LANG_H
+#define F_LANG_H
-extern void f_error PARAMS ((char *)); /* Defined in f-exp.y */
+#include "valprint.h"
-extern void f_print_type PARAMS ((struct type *, char *,
- GDB_FILE *, int, int));
+struct type_print_options;
+struct parser_state;
-extern int f_val_print PARAMS ((struct type *, char *, int,
- CORE_ADDR, GDB_FILE *,
- int, int, int, enum val_prettyprint));
+/* Class representing the Fortran language. */
-/* Language-specific data structures */
+class f_language : public language_defn
+{
+public:
+ f_language ()
+ : language_defn (language_fortran)
+ { /* Nothing. */ }
+
+ /* See language.h. */
+
+ const char *name () const override
+ { return "fortran"; }
+
+ /* See language.h. */
+
+ const char *natural_name () const override
+ { return "Fortran"; }
+
+ /* See language.h. */
+
+ const std::vector<const char *> &filename_extensions () const override
+ {
+ static const std::vector<const char *> extensions = {
+ ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
+ ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08"
+ };
+ return extensions;
+ }
+
+ /* See language.h. */
+ void language_arch_info (struct gdbarch *gdbarch,
+ struct language_arch_info *lai) const override;
+
+ /* See language.h. */
+ unsigned int search_name_hash (const char *name) const override;
+
+ /* See language.h. */
+
+ char *demangle_symbol (const char *mangled, int options) const override
+ {
+ /* We could support demangling here to provide module namespaces
+ also for inferiors with only minimal symbol table (ELF symbols).
+ Just the mangling standard is not standardized across compilers
+ and there is no DW_AT_producer available for inferiors with only
+ the ELF symbols to check the mangling kind. */
+ return nullptr;
+ }
+
+ /* See language.h. */
+
+ void print_type (struct type *type, const char *varstring,
+ struct ui_file *stream, int show, int level,
+ const struct type_print_options *flags) const override;
+
+ /* See language.h. This just returns default set of word break
+ characters but with the modules separator `::' removed. */
+
+ const char *word_break_characters (void) const override
+ {
+ static char *retval;
+
+ if (!retval)
+ {
+ char *s;
+
+ retval = xstrdup (language_defn::word_break_characters ());
+ s = strchr (retval, ':');
+ if (s)
+ {
+ char *last_char = &s[strlen (s) - 1];
+
+ *s = *last_char;
+ *last_char = 0;
+ }
+ }
+ return retval;
+ }
+
+
+ /* See language.h. */
+
+ void collect_symbol_completion_matches (completion_tracker &tracker,
+ complete_symbol_mode mode,
+ symbol_name_match_type name_match_type,
+ const char *text, const char *word,
+ enum type_code code) const override
+ {
+ /* Consider the modules separator :: as a valid symbol name character
+ class. */
+ default_collect_symbol_completion_matches_break_on (tracker, mode,
+ name_match_type,
+ text, word, ":",
+ code);
+ }
+
+ /* See language.h. */
+
+ void value_print_inner
+ (struct value *val, struct ui_file *stream, int recurse,
+ const struct value_print_options *options) const override;
+
+ /* See language.h. */
+
+ struct block_symbol lookup_symbol_nonlocal
+ (const char *name, const struct block *block,
+ const domain_enum domain) const override;
+
+ /* See language.h. */
+
+ int parser (struct parser_state *ps) const override;
+
+ /* See language.h. */
+
+ void emitchar (int ch, struct type *chtype,
+ struct ui_file *stream, int quoter) const override
+ {
+ const char *encoding = get_encoding (chtype);
+ generic_emit_char (ch, chtype, stream, quoter, encoding);
+ }
+
+ /* See language.h. */
+
+ void printchar (int ch, struct type *chtype,
+ struct ui_file *stream) const override
+ {
+ fputs_filtered ("'", stream);
+ emitchar (ch, chtype, stream, '\'');
+ fputs_filtered ("'", stream);
+ }
+
+ /* See language.h. */
-struct common_entry
+ void printstr (struct ui_file *stream, struct type *elttype,
+ const gdb_byte *string, unsigned int length,
+ const char *encoding, int force_ellipses,
+ const struct value_print_options *options) const override
{
- struct symbol *symbol; /* The symbol node corresponding
- to this component */
- struct common_entry *next; /* The next component */
- };
+ const char *type_encoding = get_encoding (elttype);
+
+ if (TYPE_LENGTH (elttype) == 4)
+ fputs_filtered ("4_", stream);
+
+ if (!encoding || !*encoding)
+ encoding = type_encoding;
+
+ generic_printstr (stream, elttype, string, length, encoding,
+ force_ellipses, '\'', 0, options);
+ }
-struct saved_f77_common
+ /* See language.h. */
+
+ void print_typedef (struct type *type, struct symbol *new_symbol,
+ struct ui_file *stream) const override;
+
+ /* See language.h. */
+
+ bool is_string_type_p (struct type *type) const override
{
- char *name; /* Name of COMMON */
- char *owning_function; /* Name of parent function */
- int secnum; /* Section # of .bss */
- CORE_ADDR offset; /* Offset from .bss for
- this block */
- struct common_entry *entries; /* List of block's components */
- struct common_entry *end_of_entries; /* ptr. to end of components */
- struct saved_f77_common *next; /* Next saved COMMON block */
- };
+ type = check_typedef (type);
+ return (type->code () == TYPE_CODE_STRING
+ || (type->code () == TYPE_CODE_ARRAY
+ && TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_CHAR));
+ }
+
+ /* See language.h. */
+
+ const char *struct_too_deep_ellipsis () const override
+ { return "(...)"; }
+
+ /* See language.h. */
+
+ bool c_style_arrays_p () const override
+ { return false; }
+
+ /* See language.h. */
+
+ bool range_checking_on_by_default () const override
+ { return true; }
+
+ /* See language.h. */
+
+ enum case_sensitivity case_sensitivity () const override
+ { return case_sensitive_off; }
+
+ /* See language.h. */
+
+ enum array_ordering array_ordering () const override
+ { return array_column_major; }
+
+protected:
+
+ /* See language.h. */
+
+ symbol_name_matcher_ftype *get_symbol_name_matcher_inner
+ (const lookup_name_info &lookup_name) const override;
+
+private:
+ /* Return the encoding that should be used for the character type
+ TYPE. */
+
+ static const char *get_encoding (struct type *type);
+
+ /* Print any asterisks or open-parentheses needed before the variable
+ name (to describe its type).
+
+ On outermost call, pass 0 for PASSED_A_PTR.
+ On outermost call, SHOW > 0 means should ignore
+ any typename for TYPE and show its details.
+ SHOW is always zero on recursive calls. */
+
+ void f_type_print_varspec_prefix (struct type *type,
+ struct ui_file * stream,
+ int show, int passed_a_ptr) const;
+
+ /* Print any array sizes, function arguments or close parentheses needed
+ after the variable name (to describe its type). Args work like
+ c_type_print_varspec_prefix.
+
+ PRINT_RANK_ONLY is true when TYPE is an array which should be printed
+ without the upper and lower bounds being specified, this will occur
+ when the array is not allocated or not associated and so there are no
+ known upper or lower bounds. */
+
+ void f_type_print_varspec_suffix (struct type *type,
+ struct ui_file *stream,
+ int show, int passed_a_ptr,
+ int demangled_args,
+ int arrayprint_recurse_level,
+ bool print_rank_only) const;
+
+ /* Print the name of the type (or the ultimate pointer target, function
+ value or array element), or the description of a structure or union.
+
+ SHOW nonzero means don't print this type as just its name;
+ show its real definition even if it has a name.
+ SHOW zero means print just typename or struct tag if there is one
+ SHOW negative means abbreviate structure elements.
+ SHOW is decremented for printing of structure elements.
+
+ LEVEL is the depth to indent by. We increase it for some recursive
+ calls. */
+
+ void f_type_print_base (struct type *type, struct ui_file *stream, int show,
+ int level) const;
+};
+
+/* Language-specific data structures */
+
+/* A common block. */
+
+struct common_block
+{
+ /* The number of entries in the block. */
+ size_t n_entries;
+
+ /* The contents of the block, allocated using the struct hack. All
+ pointers in the array are non-NULL. */
+ struct symbol *contents[1];
+};
-typedef struct saved_f77_common SAVED_F77_COMMON, *SAVED_F77_COMMON_PTR;
+extern LONGEST f77_get_upperbound (struct type *);
-typedef struct common_entry COMMON_ENTRY, *COMMON_ENTRY_PTR;
+extern LONGEST f77_get_lowerbound (struct type *);
-extern SAVED_F77_COMMON_PTR head_common_list; /* Ptr to 1st saved COMMON */
-extern SAVED_F77_COMMON_PTR tail_common_list; /* Ptr to last saved COMMON */
-extern SAVED_F77_COMMON_PTR current_common; /* Ptr to current COMMON */
+extern int calc_f77_array_dims (struct type *);
-extern SAVED_F77_COMMON_PTR find_common_for_function PARAMS ((char *, char *));
+/* Fortran (F77) types */
-#define UNINITIALIZED_SECNUM -1
-#define COMMON_NEEDS_PATCHING(blk) ((blk)->secnum == UNINITIALIZED_SECNUM)
+struct builtin_f_type
+{
+ struct type *builtin_character;
+ struct type *builtin_integer;
+ struct type *builtin_integer_s2;
+ struct type *builtin_integer_s8;
+ struct type *builtin_logical;
+ struct type *builtin_logical_s1;
+ struct type *builtin_logical_s2;
+ struct type *builtin_logical_s8;
+ struct type *builtin_real;
+ struct type *builtin_real_s8;
+ struct type *builtin_real_s16;
+ struct type *builtin_complex_s8;
+ struct type *builtin_complex_s16;
+ struct type *builtin_complex_s32;
+ struct type *builtin_void;
+};
-#define BLANK_COMMON_NAME_ORIGINAL "#BLNK_COM" /* XLF assigned */
-#define BLANK_COMMON_NAME_MF77 "__BLNK__" /* MF77 assigned */
-#define BLANK_COMMON_NAME_LOCAL "__BLANK" /* Local GDB */
+/* Return the Fortran type table for the specified architecture. */
+extern const struct builtin_f_type *builtin_f_type (struct gdbarch *gdbarch);
-#define BOUND_FETCH_OK 1
-#define BOUND_FETCH_ERROR -999
+/* Ensures that function argument TYPE is appropriate to inform the debugger
+ that ARG should be passed as a pointer. Returns the potentially updated
+ argument type.
-/* When reasonable array bounds cannot be fetched, such as when
- you ask to 'mt print symbols' and there is no stack frame and
- therefore no way of knowing the bounds of stack-based arrays,
- we have to assign default bounds, these are as good as any... */
+ If ARG is of type pointer then the type of ARG is returned, otherwise
+ TYPE is returned untouched.
-#define DEFAULT_UPPER_BOUND 999999
-#define DEFAULT_LOWER_BOUND -999999
+ This function exists to augment the types of Fortran function call
+ parameters to be pointers to the reported value, when the corresponding ARG
+ has also been wrapped in a pointer (by fortran_argument_convert). This
+ informs the debugger that these arguments should be passed as a pointer
+ rather than as the pointed to type. */
-extern char *real_main_name; /* Name of main function */
-extern int real_main_c_value; /* C_value field of main function */
+extern struct type *fortran_preserve_arg_pointer (struct value *arg,
+ struct type *type);
-extern int f77_get_dynamic_upperbound PARAMS ((struct type *, int *));
+/* Fortran arrays can have a negative stride. When this happens it is
+ often the case that the base address for an object is not the lowest
+ address occupied by that object. For example, an array slice (10:1:-1)
+ will be encoded with lower bound 1, upper bound 10, a stride of
+ -ELEMENT_SIZE, and have a base address pointer that points at the
+ element with the highest address in memory.
-extern int f77_get_dynamic_lowerbound PARAMS ((struct type *, int *));
+ This really doesn't play well with our current model of value contents,
+ but could easily require a significant update in order to be supported
+ "correctly".
-extern void f77_get_dynamic_array_length PARAMS ((struct type *));
+ For now, we manually force the base address to be the lowest addressed
+ element here. Yes, this will break some things, but it fixes other
+ things. The hope is that it fixes more than it breaks. */
-extern int calc_f77_array_dims PARAMS ((struct type *));
+extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
+ (struct type *type, CORE_ADDR address);
-#define DEFAULT_DOTMAIN_NAME_IN_MF77 ".MAIN_"
-#define DEFAULT_MAIN_NAME_IN_MF77 "MAIN_"
-#define DEFAULT_DOTMAIN_NAME_IN_XLF_BUGGY ".main "
-#define DEFAULT_DOTMAIN_NAME_IN_XLF ".main"
+#endif /* F_LANG_H */
projects / deliverable / binutils-gdb.git / blobdiff