1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
|
/* Fortran language support definitions for GDB, the GNU debugger.
Copyright (C) 1992-2024 Free Software Foundation, Inc.
Contributed by Motorola. Adapted from the C definitions by Farooq Butt
(fmbutt@engage.sps.mot.com).
This file is part of GDB.
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 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
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, see <http://www.gnu.org/licenses/>. */
#ifndef F_LANG_H
#define F_LANG_H
#include "language.h"
#include "valprint.h"
struct type_print_options;
struct parser_state;
/* Class representing the Fortran language. */
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 print_array_index (struct type *index_type,
LONGEST index,
struct ui_file *stream,
const value_print_options *options) const override;
/* 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. */
gdb::unique_xmalloc_ptr<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
{
gdb_puts ("'", stream);
emitchar (ch, chtype, stream, '\'');
gdb_puts ("'", stream);
}
/* See language.h. */
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
{
const char *type_encoding = get_encoding (elttype);
if (elttype->length () == 4)
gdb_puts ("4_", stream);
if (!encoding || !*encoding)
encoding = type_encoding;
generic_printstr (stream, elttype, string, length, encoding,
force_ellipses, '\'', 0, options);
}
/* 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
{
type = check_typedef (type);
return (type->code () == TYPE_CODE_STRING
|| (type->code () == TYPE_CODE_ARRAY
&& type->target_type ()->code () == TYPE_CODE_CHAR));
}
/* See language.h. */
struct value *value_string (struct gdbarch *gdbarch,
const char *ptr, ssize_t len) const override;
/* 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;
/* If TYPE is an extended type, then print out derivation information.
A typical output could look like this:
"Type, extends(point) :: waypoint"
" Type point :: point"
" real(kind=4) :: angle"
"End Type waypoint". */
void f_type_print_derivation_info (struct type *type,
struct ui_file *stream) 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];
};
extern LONGEST f77_get_upperbound (struct type *);
extern LONGEST f77_get_lowerbound (struct type *);
extern int calc_f77_array_dims (struct type *);
/* Fortran (F77) types */
struct builtin_f_type
{
struct type *builtin_character = nullptr;
struct type *builtin_integer_s1 = nullptr;
struct type *builtin_integer_s2 = nullptr;
struct type *builtin_integer = nullptr;
struct type *builtin_integer_s8 = nullptr;
struct type *builtin_logical_s1 = nullptr;
struct type *builtin_logical_s2 = nullptr;
struct type *builtin_logical = nullptr;
struct type *builtin_logical_s8 = nullptr;
struct type *builtin_real = nullptr;
struct type *builtin_real_s8 = nullptr;
struct type *builtin_real_s16 = nullptr;
struct type *builtin_complex = nullptr;
struct type *builtin_complex_s8 = nullptr;
struct type *builtin_complex_s16 = nullptr;
struct type *builtin_void = nullptr;
};
/* Return the Fortran type table for the specified architecture. */
extern const struct builtin_f_type *builtin_f_type (struct gdbarch *gdbarch);
/* 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.
If ARG is of type pointer then the type of ARG is returned, otherwise
TYPE is returned untouched.
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 struct type *fortran_preserve_arg_pointer (struct value *arg,
struct type *type);
/* 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.
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".
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 CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
(struct type *type, CORE_ADDR address);
#endif /* F_LANG_H */
|