1 /* Fortran language support definitions for GDB, the GNU debugger. 2 3 Copyright (C) 1992-2023 Free Software Foundation, Inc. 4 5 Contributed by Motorola. Adapted from the C definitions 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 #ifndef F_LANG_H 24 #define F_LANG_H 25 26 #include "valprint.h" 27 28 struct type_print_options; 29 struct parser_state; 30 31 /* Class representing the Fortran language. */ 32 33 class f_language : public language_defn 34 { 35 public: 36 f_language () 37 : language_defn (language_fortran) 38 { /* Nothing. */ } 39 40 /* See language.h. */ 41 42 const char *name () const override 43 { return "fortran"; } 44 45 /* See language.h. */ 46 47 const char *natural_name () const override 48 { return "Fortran"; } 49 50 /* See language.h. */ 51 52 const std::vector<const char *> &filename_extensions () const override 53 { 54 static const std::vector<const char *> extensions = { 55 ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP", 56 ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08" 57 }; 58 return extensions; 59 } 60 61 /* See language.h. */ 62 void print_array_index (struct type *index_type, 63 LONGEST index, 64 struct ui_file *stream, 65 const value_print_options *options) const override; 66 67 /* See language.h. */ 68 void language_arch_info (struct gdbarch *gdbarch, 69 struct language_arch_info *lai) const override; 70 71 /* See language.h. */ 72 unsigned int search_name_hash (const char *name) const override; 73 74 /* See language.h. */ 75 76 gdb::unique_xmalloc_ptr<char> demangle_symbol (const char *mangled, 77 int options) const override 78 { 79 /* We could support demangling here to provide module namespaces 80 also for inferiors with only minimal symbol table (ELF symbols). 81 Just the mangling standard is not standardized across compilers 82 and there is no DW_AT_producer available for inferiors with only 83 the ELF symbols to check the mangling kind. */ 84 return nullptr; 85 } 86 87 /* See language.h. */ 88 89 void print_type (struct type *type, const char *varstring, 90 struct ui_file *stream, int show, int level, 91 const struct type_print_options *flags) const override; 92 93 /* See language.h. This just returns default set of word break 94 characters but with the modules separator `::' removed. */ 95 96 const char *word_break_characters (void) const override 97 { 98 static char *retval; 99 100 if (!retval) 101 { 102 char *s; 103 104 retval = xstrdup (language_defn::word_break_characters ()); 105 s = strchr (retval, ':'); 106 if (s) 107 { 108 char *last_char = &s[strlen (s) - 1]; 109 110 *s = *last_char; 111 *last_char = 0; 112 } 113 } 114 return retval; 115 } 116 117 118 /* See language.h. */ 119 120 void collect_symbol_completion_matches (completion_tracker &tracker, 121 complete_symbol_mode mode, 122 symbol_name_match_type name_match_type, 123 const char *text, const char *word, 124 enum type_code code) const override 125 { 126 /* Consider the modules separator :: as a valid symbol name character 127 class. */ 128 default_collect_symbol_completion_matches_break_on (tracker, mode, 129 name_match_type, 130 text, word, ":", 131 code); 132 } 133 134 /* See language.h. */ 135 136 void value_print_inner 137 (struct value *val, struct ui_file *stream, int recurse, 138 const struct value_print_options *options) const override; 139 140 /* See language.h. */ 141 142 struct block_symbol lookup_symbol_nonlocal 143 (const char *name, const struct block *block, 144 const domain_enum domain) const override; 145 146 /* See language.h. */ 147 148 int parser (struct parser_state *ps) const override; 149 150 /* See language.h. */ 151 152 void emitchar (int ch, struct type *chtype, 153 struct ui_file *stream, int quoter) const override 154 { 155 const char *encoding = get_encoding (chtype); 156 generic_emit_char (ch, chtype, stream, quoter, encoding); 157 } 158 159 /* See language.h. */ 160 161 void printchar (int ch, struct type *chtype, 162 struct ui_file *stream) const override 163 { 164 gdb_puts ("'", stream); 165 emitchar (ch, chtype, stream, '\''); 166 gdb_puts ("'", stream); 167 } 168 169 /* See language.h. */ 170 171 void printstr (struct ui_file *stream, struct type *elttype, 172 const gdb_byte *string, unsigned int length, 173 const char *encoding, int force_ellipses, 174 const struct value_print_options *options) const override 175 { 176 const char *type_encoding = get_encoding (elttype); 177 178 if (elttype->length () == 4) 179 gdb_puts ("4_", stream); 180 181 if (!encoding || !*encoding) 182 encoding = type_encoding; 183 184 generic_printstr (stream, elttype, string, length, encoding, 185 force_ellipses, '\'', 0, options); 186 } 187 188 /* See language.h. */ 189 190 void print_typedef (struct type *type, struct symbol *new_symbol, 191 struct ui_file *stream) const override; 192 193 /* See language.h. */ 194 195 bool is_string_type_p (struct type *type) const override 196 { 197 type = check_typedef (type); 198 return (type->code () == TYPE_CODE_STRING 199 || (type->code () == TYPE_CODE_ARRAY 200 && type->target_type ()->code () == TYPE_CODE_CHAR)); 201 } 202 203 /* See language.h. */ 204 205 const char *struct_too_deep_ellipsis () const override 206 { return "(...)"; } 207 208 /* See language.h. */ 209 210 bool c_style_arrays_p () const override 211 { return false; } 212 213 /* See language.h. */ 214 215 bool range_checking_on_by_default () const override 216 { return true; } 217 218 /* See language.h. */ 219 220 enum case_sensitivity case_sensitivity () const override 221 { return case_sensitive_off; } 222 223 /* See language.h. */ 224 225 enum array_ordering array_ordering () const override 226 { return array_column_major; } 227 228 protected: 229 230 /* See language.h. */ 231 232 symbol_name_matcher_ftype *get_symbol_name_matcher_inner 233 (const lookup_name_info &lookup_name) const override; 234 235 private: 236 /* Return the encoding that should be used for the character type 237 TYPE. */ 238 239 static const char *get_encoding (struct type *type); 240 241 /* Print any asterisks or open-parentheses needed before the variable 242 name (to describe its type). 243 244 On outermost call, pass 0 for PASSED_A_PTR. 245 On outermost call, SHOW > 0 means should ignore 246 any typename for TYPE and show its details. 247 SHOW is always zero on recursive calls. */ 248 249 void f_type_print_varspec_prefix (struct type *type, 250 struct ui_file * stream, 251 int show, int passed_a_ptr) const; 252 253 /* Print any array sizes, function arguments or close parentheses needed 254 after the variable name (to describe its type). Args work like 255 c_type_print_varspec_prefix. 256 257 PRINT_RANK_ONLY is true when TYPE is an array which should be printed 258 without the upper and lower bounds being specified, this will occur 259 when the array is not allocated or not associated and so there are no 260 known upper or lower bounds. */ 261 262 void f_type_print_varspec_suffix (struct type *type, 263 struct ui_file *stream, 264 int show, int passed_a_ptr, 265 int demangled_args, 266 int arrayprint_recurse_level, 267 bool print_rank_only) const; 268 269 /* If TYPE is an extended type, then print out derivation information. 270 271 A typical output could look like this: 272 "Type, extends(point) :: waypoint" 273 " Type point :: point" 274 " real(kind=4) :: angle" 275 "End Type waypoint". */ 276 277 void f_type_print_derivation_info (struct type *type, 278 struct ui_file *stream) const; 279 280 /* Print the name of the type (or the ultimate pointer target, function 281 value or array element), or the description of a structure or union. 282 283 SHOW nonzero means don't print this type as just its name; 284 show its real definition even if it has a name. 285 SHOW zero means print just typename or struct tag if there is one 286 SHOW negative means abbreviate structure elements. 287 SHOW is decremented for printing of structure elements. 288 289 LEVEL is the depth to indent by. We increase it for some recursive 290 calls. */ 291 292 void f_type_print_base (struct type *type, struct ui_file *stream, int show, 293 int level) const; 294 }; 295 296 /* Language-specific data structures */ 297 298 /* A common block. */ 299 300 struct common_block 301 { 302 /* The number of entries in the block. */ 303 size_t n_entries; 304 305 /* The contents of the block, allocated using the struct hack. All 306 pointers in the array are non-NULL. */ 307 struct symbol *contents[1]; 308 }; 309 310 extern LONGEST f77_get_upperbound (struct type *); 311 312 extern LONGEST f77_get_lowerbound (struct type *); 313 314 extern int calc_f77_array_dims (struct type *); 315 316 /* Fortran (F77) types */ 317 318 struct builtin_f_type 319 { 320 struct type *builtin_character = nullptr; 321 struct type *builtin_integer_s1 = nullptr; 322 struct type *builtin_integer_s2 = nullptr; 323 struct type *builtin_integer = nullptr; 324 struct type *builtin_integer_s8 = nullptr; 325 struct type *builtin_logical_s1 = nullptr; 326 struct type *builtin_logical_s2 = nullptr; 327 struct type *builtin_logical = nullptr; 328 struct type *builtin_logical_s8 = nullptr; 329 struct type *builtin_real = nullptr; 330 struct type *builtin_real_s8 = nullptr; 331 struct type *builtin_real_s16 = nullptr; 332 struct type *builtin_complex = nullptr; 333 struct type *builtin_complex_s8 = nullptr; 334 struct type *builtin_complex_s16 = nullptr; 335 struct type *builtin_void = nullptr; 336 }; 337 338 /* Return the Fortran type table for the specified architecture. */ 339 extern const struct builtin_f_type *builtin_f_type (struct gdbarch *gdbarch); 340 341 /* Ensures that function argument TYPE is appropriate to inform the debugger 342 that ARG should be passed as a pointer. Returns the potentially updated 343 argument type. 344 345 If ARG is of type pointer then the type of ARG is returned, otherwise 346 TYPE is returned untouched. 347 348 This function exists to augment the types of Fortran function call 349 parameters to be pointers to the reported value, when the corresponding ARG 350 has also been wrapped in a pointer (by fortran_argument_convert). This 351 informs the debugger that these arguments should be passed as a pointer 352 rather than as the pointed to type. */ 353 354 extern struct type *fortran_preserve_arg_pointer (struct value *arg, 355 struct type *type); 356 357 /* Fortran arrays can have a negative stride. When this happens it is 358 often the case that the base address for an object is not the lowest 359 address occupied by that object. For example, an array slice (10:1:-1) 360 will be encoded with lower bound 1, upper bound 10, a stride of 361 -ELEMENT_SIZE, and have a base address pointer that points at the 362 element with the highest address in memory. 363 364 This really doesn't play well with our current model of value contents, 365 but could easily require a significant update in order to be supported 366 "correctly". 367 368 For now, we manually force the base address to be the lowest addressed 369 element here. Yes, this will break some things, but it fixes other 370 things. The hope is that it fixes more than it breaks. */ 371 372 extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack 373 (struct type *type, CORE_ADDR address); 374 375 #endif /* F_LANG_H */ 376