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