1 |
285 |
jeremybenn |
/* gfortran header file
|
2 |
|
|
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
|
3 |
|
|
2009, 2010
|
4 |
|
|
Free Software Foundation, Inc.
|
5 |
|
|
Contributed by Andy Vaught
|
6 |
|
|
|
7 |
|
|
This file is part of GCC.
|
8 |
|
|
|
9 |
|
|
GCC is free software; you can redistribute it and/or modify it under
|
10 |
|
|
the terms of the GNU General Public License as published by the Free
|
11 |
|
|
Software Foundation; either version 3, or (at your option) any later
|
12 |
|
|
version.
|
13 |
|
|
|
14 |
|
|
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
15 |
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
16 |
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
17 |
|
|
for more details.
|
18 |
|
|
|
19 |
|
|
You should have received a copy of the GNU General Public License
|
20 |
|
|
along with GCC; see the file COPYING3. If not see
|
21 |
|
|
<http://www.gnu.org/licenses/>. */
|
22 |
|
|
|
23 |
|
|
#ifndef GCC_GFORTRAN_H
|
24 |
|
|
#define GCC_GFORTRAN_H
|
25 |
|
|
|
26 |
|
|
/* It's probably insane to have this large of a header file, but it
|
27 |
|
|
seemed like everything had to be recompiled anyway when a change
|
28 |
|
|
was made to a header file, and there were ordering issues with
|
29 |
|
|
multiple header files. Besides, Microsoft's winnt.h was 250k last
|
30 |
|
|
time I looked, so by comparison this is perfectly reasonable. */
|
31 |
|
|
|
32 |
|
|
/* Declarations common to the front-end and library are put in
|
33 |
|
|
libgfortran/libgfortran_frontend.h */
|
34 |
|
|
#include "libgfortran.h"
|
35 |
|
|
|
36 |
|
|
|
37 |
|
|
#include "system.h"
|
38 |
|
|
#include "intl.h"
|
39 |
|
|
#include "coretypes.h"
|
40 |
|
|
#include "input.h"
|
41 |
|
|
#include "splay-tree.h"
|
42 |
|
|
/* The following ifdefs are recommended by the autoconf documentation
|
43 |
|
|
for any code using alloca. */
|
44 |
|
|
|
45 |
|
|
/* AIX requires this to be the first thing in the file. */
|
46 |
|
|
#ifdef __GNUC__
|
47 |
|
|
#else /* not __GNUC__ */
|
48 |
|
|
#ifdef HAVE_ALLOCA_H
|
49 |
|
|
#include <alloca.h>
|
50 |
|
|
#else /* do not HAVE_ALLOCA_H */
|
51 |
|
|
#ifdef _AIX
|
52 |
|
|
#pragma alloca
|
53 |
|
|
#else
|
54 |
|
|
#ifndef alloca /* predefined by HP cc +Olibcalls */
|
55 |
|
|
char *alloca ();
|
56 |
|
|
#endif /* not predefined */
|
57 |
|
|
#endif /* not _AIX */
|
58 |
|
|
#endif /* do not HAVE_ALLOCA_H */
|
59 |
|
|
#endif /* not __GNUC__ */
|
60 |
|
|
|
61 |
|
|
/* Major control parameters. */
|
62 |
|
|
|
63 |
|
|
#define GFC_MAX_SYMBOL_LEN 63 /* Must be at least 63 for F2003. */
|
64 |
|
|
#define GFC_MAX_BINDING_LABEL_LEN 126 /* (2 * GFC_MAX_SYMBOL_LEN) */
|
65 |
|
|
#define GFC_MAX_LINE 132 /* Characters beyond this are not seen. */
|
66 |
|
|
#define GFC_LETTERS 26 /* Number of letters in the alphabet. */
|
67 |
|
|
|
68 |
|
|
#define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */
|
69 |
|
|
|
70 |
|
|
|
71 |
|
|
#define free(x) Use_gfc_free_instead_of_free()
|
72 |
|
|
#define gfc_is_whitespace(c) ((c==' ') || (c=='\t'))
|
73 |
|
|
|
74 |
|
|
#ifndef NULL
|
75 |
|
|
#define NULL ((void *) 0)
|
76 |
|
|
#endif
|
77 |
|
|
|
78 |
|
|
/* Stringization. */
|
79 |
|
|
#define stringize(x) expand_macro(x)
|
80 |
|
|
#define expand_macro(x) # x
|
81 |
|
|
|
82 |
|
|
/* For the runtime library, a standard prefix is a requirement to
|
83 |
|
|
avoid cluttering the namespace with things nobody asked for. It's
|
84 |
|
|
ugly to look at and a pain to type when you add the prefix by hand,
|
85 |
|
|
so we hide it behind a macro. */
|
86 |
|
|
#define PREFIX(x) "_gfortran_" x
|
87 |
|
|
#define PREFIX_LEN 10
|
88 |
|
|
|
89 |
|
|
#define BLANK_COMMON_NAME "__BLNK__"
|
90 |
|
|
|
91 |
|
|
/* Macro to initialize an mstring structure. */
|
92 |
|
|
#define minit(s, t) { s, NULL, t }
|
93 |
|
|
|
94 |
|
|
/* Structure for storing strings to be matched by gfc_match_string. */
|
95 |
|
|
typedef struct
|
96 |
|
|
{
|
97 |
|
|
const char *string;
|
98 |
|
|
const char *mp;
|
99 |
|
|
int tag;
|
100 |
|
|
}
|
101 |
|
|
mstring;
|
102 |
|
|
|
103 |
|
|
|
104 |
|
|
|
105 |
|
|
/*************************** Enums *****************************/
|
106 |
|
|
|
107 |
|
|
/* Used when matching and resolving data I/O transfer statements. */
|
108 |
|
|
|
109 |
|
|
typedef enum
|
110 |
|
|
{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
|
111 |
|
|
io_kind;
|
112 |
|
|
|
113 |
|
|
/* The author remains confused to this day about the convention of
|
114 |
|
|
returning '0' for 'SUCCESS'... or was it the other way around? The
|
115 |
|
|
following enum makes things much more readable. We also start
|
116 |
|
|
values off at one instead of zero. */
|
117 |
|
|
|
118 |
|
|
typedef enum
|
119 |
|
|
{ SUCCESS = 1, FAILURE }
|
120 |
|
|
gfc_try;
|
121 |
|
|
|
122 |
|
|
/* This is returned by gfc_notification_std to know if, given the flags
|
123 |
|
|
that were given (-std=, -pedantic) we should issue an error, a warning
|
124 |
|
|
or nothing. */
|
125 |
|
|
|
126 |
|
|
typedef enum
|
127 |
|
|
{ SILENT, WARNING, ERROR }
|
128 |
|
|
notification;
|
129 |
|
|
|
130 |
|
|
/* Matchers return one of these three values. The difference between
|
131 |
|
|
MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
|
132 |
|
|
successful, but that something non-syntactic is wrong and an error
|
133 |
|
|
has already been issued. */
|
134 |
|
|
|
135 |
|
|
typedef enum
|
136 |
|
|
{ MATCH_NO = 1, MATCH_YES, MATCH_ERROR }
|
137 |
|
|
match;
|
138 |
|
|
|
139 |
|
|
typedef enum
|
140 |
|
|
{ FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
|
141 |
|
|
gfc_source_form;
|
142 |
|
|
|
143 |
|
|
/* Basic types. BT_VOID is used by ISO C Binding so funcs like c_f_pointer
|
144 |
|
|
can take any arg with the pointer attribute as a param. */
|
145 |
|
|
typedef enum
|
146 |
|
|
{ BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX, BT_LOGICAL, BT_CHARACTER,
|
147 |
|
|
BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID
|
148 |
|
|
}
|
149 |
|
|
bt;
|
150 |
|
|
|
151 |
|
|
/* Expression node types. */
|
152 |
|
|
typedef enum
|
153 |
|
|
{ EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
|
154 |
|
|
EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL, EXPR_PPC
|
155 |
|
|
}
|
156 |
|
|
expr_t;
|
157 |
|
|
|
158 |
|
|
/* Array types. */
|
159 |
|
|
typedef enum
|
160 |
|
|
{ AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
|
161 |
|
|
AS_ASSUMED_SIZE, AS_UNKNOWN
|
162 |
|
|
}
|
163 |
|
|
array_type;
|
164 |
|
|
|
165 |
|
|
typedef enum
|
166 |
|
|
{ AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN }
|
167 |
|
|
ar_type;
|
168 |
|
|
|
169 |
|
|
/* Statement label types. */
|
170 |
|
|
typedef enum
|
171 |
|
|
{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET,
|
172 |
|
|
ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
|
173 |
|
|
}
|
174 |
|
|
gfc_sl_type;
|
175 |
|
|
|
176 |
|
|
/* Intrinsic operators. */
|
177 |
|
|
typedef enum
|
178 |
|
|
{ GFC_INTRINSIC_BEGIN = 0,
|
179 |
|
|
INTRINSIC_NONE = -1, INTRINSIC_UPLUS = GFC_INTRINSIC_BEGIN,
|
180 |
|
|
INTRINSIC_UMINUS, INTRINSIC_PLUS, INTRINSIC_MINUS, INTRINSIC_TIMES,
|
181 |
|
|
INTRINSIC_DIVIDE, INTRINSIC_POWER, INTRINSIC_CONCAT,
|
182 |
|
|
INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV,
|
183 |
|
|
/* ==, /=, >, >=, <, <= */
|
184 |
|
|
INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE,
|
185 |
|
|
INTRINSIC_LT, INTRINSIC_LE,
|
186 |
|
|
/* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style) */
|
187 |
|
|
INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
|
188 |
|
|
INTRINSIC_LT_OS, INTRINSIC_LE_OS,
|
189 |
|
|
INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN,
|
190 |
|
|
INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */
|
191 |
|
|
}
|
192 |
|
|
gfc_intrinsic_op;
|
193 |
|
|
|
194 |
|
|
|
195 |
|
|
/* This macro is the number of intrinsic operators that exist.
|
196 |
|
|
Assumptions are made about the numbering of the interface_op enums. */
|
197 |
|
|
#define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
|
198 |
|
|
|
199 |
|
|
/* Arithmetic results. */
|
200 |
|
|
typedef enum
|
201 |
|
|
{ ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
|
202 |
|
|
ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT
|
203 |
|
|
}
|
204 |
|
|
arith;
|
205 |
|
|
|
206 |
|
|
/* Statements. */
|
207 |
|
|
typedef enum
|
208 |
|
|
{
|
209 |
|
|
ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_BACKSPACE,
|
210 |
|
|
ST_BLOCK, ST_BLOCK_DATA,
|
211 |
|
|
ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE,
|
212 |
|
|
ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF,
|
213 |
|
|
ST_ELSEWHERE, ST_END_BLOCK, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO,
|
214 |
|
|
ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
|
215 |
|
|
ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
|
216 |
|
|
ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
|
217 |
|
|
ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO,
|
218 |
|
|
ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
|
219 |
|
|
ST_INQUIRE, ST_INTERFACE,
|
220 |
|
|
ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
|
221 |
|
|
ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
|
222 |
|
|
ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT,
|
223 |
|
|
ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
|
224 |
|
|
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
|
225 |
|
|
ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
|
226 |
|
|
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
|
227 |
|
|
ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
|
228 |
|
|
ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
|
229 |
|
|
ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE,
|
230 |
|
|
ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
|
231 |
|
|
ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
|
232 |
|
|
ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
|
233 |
|
|
ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
|
234 |
|
|
ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC,
|
235 |
|
|
ST_GET_FCN_CHARACTERISTICS, ST_NONE
|
236 |
|
|
}
|
237 |
|
|
gfc_statement;
|
238 |
|
|
|
239 |
|
|
|
240 |
|
|
/* Types of interfaces that we can have. Assignment interfaces are
|
241 |
|
|
considered to be intrinsic operators. */
|
242 |
|
|
typedef enum
|
243 |
|
|
{
|
244 |
|
|
INTERFACE_NAMELESS = 1, INTERFACE_GENERIC,
|
245 |
|
|
INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT
|
246 |
|
|
}
|
247 |
|
|
interface_type;
|
248 |
|
|
|
249 |
|
|
/* Symbol flavors: these are all mutually exclusive.
|
250 |
|
|
10 elements = 4 bits. */
|
251 |
|
|
typedef enum sym_flavor
|
252 |
|
|
{
|
253 |
|
|
FL_UNKNOWN = 0, FL_PROGRAM, FL_BLOCK_DATA, FL_MODULE, FL_VARIABLE,
|
254 |
|
|
FL_PARAMETER, FL_LABEL, FL_PROCEDURE, FL_DERIVED, FL_NAMELIST,
|
255 |
|
|
FL_VOID
|
256 |
|
|
}
|
257 |
|
|
sym_flavor;
|
258 |
|
|
|
259 |
|
|
/* Procedure types. 7 elements = 3 bits. */
|
260 |
|
|
typedef enum procedure_type
|
261 |
|
|
{ PROC_UNKNOWN, PROC_MODULE, PROC_INTERNAL, PROC_DUMMY,
|
262 |
|
|
PROC_INTRINSIC, PROC_ST_FUNCTION, PROC_EXTERNAL
|
263 |
|
|
}
|
264 |
|
|
procedure_type;
|
265 |
|
|
|
266 |
|
|
/* Intent types. */
|
267 |
|
|
typedef enum sym_intent
|
268 |
|
|
{ INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT
|
269 |
|
|
}
|
270 |
|
|
sym_intent;
|
271 |
|
|
|
272 |
|
|
/* Access types. */
|
273 |
|
|
typedef enum gfc_access
|
274 |
|
|
{ ACCESS_UNKNOWN = 0, ACCESS_PUBLIC, ACCESS_PRIVATE
|
275 |
|
|
}
|
276 |
|
|
gfc_access;
|
277 |
|
|
|
278 |
|
|
/* Flags to keep track of where an interface came from.
|
279 |
|
|
3 elements = 2 bits. */
|
280 |
|
|
typedef enum ifsrc
|
281 |
|
|
{ IFSRC_UNKNOWN = 0, /* Interface unknown, only return type may be known. */
|
282 |
|
|
IFSRC_DECL, /* FUNCTION or SUBROUTINE declaration. */
|
283 |
|
|
IFSRC_IFBODY /* INTERFACE statement or PROCEDURE statement
|
284 |
|
|
with explicit interface. */
|
285 |
|
|
}
|
286 |
|
|
ifsrc;
|
287 |
|
|
|
288 |
|
|
/* Whether a SAVE attribute was set explicitly or implicitly. */
|
289 |
|
|
typedef enum save_state
|
290 |
|
|
{ SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
|
291 |
|
|
}
|
292 |
|
|
save_state;
|
293 |
|
|
|
294 |
|
|
/* Strings for all symbol attributes. We use these for dumping the
|
295 |
|
|
parse tree, in error messages, and also when reading and writing
|
296 |
|
|
modules. In symbol.c. */
|
297 |
|
|
extern const mstring flavors[];
|
298 |
|
|
extern const mstring procedures[];
|
299 |
|
|
extern const mstring intents[];
|
300 |
|
|
extern const mstring access_types[];
|
301 |
|
|
extern const mstring ifsrc_types[];
|
302 |
|
|
extern const mstring save_status[];
|
303 |
|
|
|
304 |
|
|
/* Enumeration of all the generic intrinsic functions. Used by the
|
305 |
|
|
backend for identification of a function. */
|
306 |
|
|
|
307 |
|
|
enum gfc_isym_id
|
308 |
|
|
{
|
309 |
|
|
/* GFC_ISYM_NONE is used for intrinsics which will never be seen by
|
310 |
|
|
the backend (e.g. KIND). */
|
311 |
|
|
GFC_ISYM_NONE = 0,
|
312 |
|
|
GFC_ISYM_ABORT,
|
313 |
|
|
GFC_ISYM_ABS,
|
314 |
|
|
GFC_ISYM_ACCESS,
|
315 |
|
|
GFC_ISYM_ACHAR,
|
316 |
|
|
GFC_ISYM_ACOS,
|
317 |
|
|
GFC_ISYM_ACOSH,
|
318 |
|
|
GFC_ISYM_ADJUSTL,
|
319 |
|
|
GFC_ISYM_ADJUSTR,
|
320 |
|
|
GFC_ISYM_AIMAG,
|
321 |
|
|
GFC_ISYM_AINT,
|
322 |
|
|
GFC_ISYM_ALARM,
|
323 |
|
|
GFC_ISYM_ALL,
|
324 |
|
|
GFC_ISYM_ALLOCATED,
|
325 |
|
|
GFC_ISYM_AND,
|
326 |
|
|
GFC_ISYM_ANINT,
|
327 |
|
|
GFC_ISYM_ANY,
|
328 |
|
|
GFC_ISYM_ASIN,
|
329 |
|
|
GFC_ISYM_ASINH,
|
330 |
|
|
GFC_ISYM_ASSOCIATED,
|
331 |
|
|
GFC_ISYM_ATAN,
|
332 |
|
|
GFC_ISYM_ATAN2,
|
333 |
|
|
GFC_ISYM_ATANH,
|
334 |
|
|
GFC_ISYM_BIT_SIZE,
|
335 |
|
|
GFC_ISYM_BTEST,
|
336 |
|
|
GFC_ISYM_CEILING,
|
337 |
|
|
GFC_ISYM_CHAR,
|
338 |
|
|
GFC_ISYM_CHDIR,
|
339 |
|
|
GFC_ISYM_CHMOD,
|
340 |
|
|
GFC_ISYM_CMPLX,
|
341 |
|
|
GFC_ISYM_COMMAND_ARGUMENT_COUNT,
|
342 |
|
|
GFC_ISYM_COMPLEX,
|
343 |
|
|
GFC_ISYM_CONJG,
|
344 |
|
|
GFC_ISYM_CONVERSION,
|
345 |
|
|
GFC_ISYM_COS,
|
346 |
|
|
GFC_ISYM_COSH,
|
347 |
|
|
GFC_ISYM_COUNT,
|
348 |
|
|
GFC_ISYM_CPU_TIME,
|
349 |
|
|
GFC_ISYM_CSHIFT,
|
350 |
|
|
GFC_ISYM_CTIME,
|
351 |
|
|
GFC_ISYM_DATE_AND_TIME,
|
352 |
|
|
GFC_ISYM_DBLE,
|
353 |
|
|
GFC_ISYM_DIGITS,
|
354 |
|
|
GFC_ISYM_DIM,
|
355 |
|
|
GFC_ISYM_DOT_PRODUCT,
|
356 |
|
|
GFC_ISYM_DPROD,
|
357 |
|
|
GFC_ISYM_DTIME,
|
358 |
|
|
GFC_ISYM_EOSHIFT,
|
359 |
|
|
GFC_ISYM_EPSILON,
|
360 |
|
|
GFC_ISYM_ERF,
|
361 |
|
|
GFC_ISYM_ERFC,
|
362 |
|
|
GFC_ISYM_ERFC_SCALED,
|
363 |
|
|
GFC_ISYM_ETIME,
|
364 |
|
|
GFC_ISYM_EXIT,
|
365 |
|
|
GFC_ISYM_EXP,
|
366 |
|
|
GFC_ISYM_EXPONENT,
|
367 |
|
|
GFC_ISYM_EXTENDS_TYPE_OF,
|
368 |
|
|
GFC_ISYM_FDATE,
|
369 |
|
|
GFC_ISYM_FGET,
|
370 |
|
|
GFC_ISYM_FGETC,
|
371 |
|
|
GFC_ISYM_FLOOR,
|
372 |
|
|
GFC_ISYM_FLUSH,
|
373 |
|
|
GFC_ISYM_FNUM,
|
374 |
|
|
GFC_ISYM_FPUT,
|
375 |
|
|
GFC_ISYM_FPUTC,
|
376 |
|
|
GFC_ISYM_FRACTION,
|
377 |
|
|
GFC_ISYM_FREE,
|
378 |
|
|
GFC_ISYM_FSEEK,
|
379 |
|
|
GFC_ISYM_FSTAT,
|
380 |
|
|
GFC_ISYM_FTELL,
|
381 |
|
|
GFC_ISYM_TGAMMA,
|
382 |
|
|
GFC_ISYM_GERROR,
|
383 |
|
|
GFC_ISYM_GETARG,
|
384 |
|
|
GFC_ISYM_GET_COMMAND,
|
385 |
|
|
GFC_ISYM_GET_COMMAND_ARGUMENT,
|
386 |
|
|
GFC_ISYM_GETCWD,
|
387 |
|
|
GFC_ISYM_GETENV,
|
388 |
|
|
GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
|
389 |
|
|
GFC_ISYM_GETGID,
|
390 |
|
|
GFC_ISYM_GETLOG,
|
391 |
|
|
GFC_ISYM_GETPID,
|
392 |
|
|
GFC_ISYM_GETUID,
|
393 |
|
|
GFC_ISYM_GMTIME,
|
394 |
|
|
GFC_ISYM_HOSTNM,
|
395 |
|
|
GFC_ISYM_HUGE,
|
396 |
|
|
GFC_ISYM_HYPOT,
|
397 |
|
|
GFC_ISYM_IACHAR,
|
398 |
|
|
GFC_ISYM_IAND,
|
399 |
|
|
GFC_ISYM_IARGC,
|
400 |
|
|
GFC_ISYM_IBCLR,
|
401 |
|
|
GFC_ISYM_IBITS,
|
402 |
|
|
GFC_ISYM_IBSET,
|
403 |
|
|
GFC_ISYM_ICHAR,
|
404 |
|
|
GFC_ISYM_IDATE,
|
405 |
|
|
GFC_ISYM_IEOR,
|
406 |
|
|
GFC_ISYM_IERRNO,
|
407 |
|
|
GFC_ISYM_INDEX,
|
408 |
|
|
GFC_ISYM_INT,
|
409 |
|
|
GFC_ISYM_INT2,
|
410 |
|
|
GFC_ISYM_INT8,
|
411 |
|
|
GFC_ISYM_IOR,
|
412 |
|
|
GFC_ISYM_IRAND,
|
413 |
|
|
GFC_ISYM_ISATTY,
|
414 |
|
|
GFC_ISYM_IS_IOSTAT_END,
|
415 |
|
|
GFC_ISYM_IS_IOSTAT_EOR,
|
416 |
|
|
GFC_ISYM_ISNAN,
|
417 |
|
|
GFC_ISYM_ISHFT,
|
418 |
|
|
GFC_ISYM_ISHFTC,
|
419 |
|
|
GFC_ISYM_ITIME,
|
420 |
|
|
GFC_ISYM_J0,
|
421 |
|
|
GFC_ISYM_J1,
|
422 |
|
|
GFC_ISYM_JN,
|
423 |
|
|
GFC_ISYM_KILL,
|
424 |
|
|
GFC_ISYM_KIND,
|
425 |
|
|
GFC_ISYM_LBOUND,
|
426 |
|
|
GFC_ISYM_LEADZ,
|
427 |
|
|
GFC_ISYM_LEN,
|
428 |
|
|
GFC_ISYM_LEN_TRIM,
|
429 |
|
|
GFC_ISYM_LGAMMA,
|
430 |
|
|
GFC_ISYM_LGE,
|
431 |
|
|
GFC_ISYM_LGT,
|
432 |
|
|
GFC_ISYM_LINK,
|
433 |
|
|
GFC_ISYM_LLE,
|
434 |
|
|
GFC_ISYM_LLT,
|
435 |
|
|
GFC_ISYM_LOC,
|
436 |
|
|
GFC_ISYM_LOG,
|
437 |
|
|
GFC_ISYM_LOG10,
|
438 |
|
|
GFC_ISYM_LOGICAL,
|
439 |
|
|
GFC_ISYM_LONG,
|
440 |
|
|
GFC_ISYM_LSHIFT,
|
441 |
|
|
GFC_ISYM_LSTAT,
|
442 |
|
|
GFC_ISYM_LTIME,
|
443 |
|
|
GFC_ISYM_MALLOC,
|
444 |
|
|
GFC_ISYM_MATMUL,
|
445 |
|
|
GFC_ISYM_MAX,
|
446 |
|
|
GFC_ISYM_MAXEXPONENT,
|
447 |
|
|
GFC_ISYM_MAXLOC,
|
448 |
|
|
GFC_ISYM_MAXVAL,
|
449 |
|
|
GFC_ISYM_MCLOCK,
|
450 |
|
|
GFC_ISYM_MCLOCK8,
|
451 |
|
|
GFC_ISYM_MERGE,
|
452 |
|
|
GFC_ISYM_MIN,
|
453 |
|
|
GFC_ISYM_MINEXPONENT,
|
454 |
|
|
GFC_ISYM_MINLOC,
|
455 |
|
|
GFC_ISYM_MINVAL,
|
456 |
|
|
GFC_ISYM_MOD,
|
457 |
|
|
GFC_ISYM_MODULO,
|
458 |
|
|
GFC_ISYM_MOVE_ALLOC,
|
459 |
|
|
GFC_ISYM_MVBITS,
|
460 |
|
|
GFC_ISYM_NEAREST,
|
461 |
|
|
GFC_ISYM_NEW_LINE,
|
462 |
|
|
GFC_ISYM_NINT,
|
463 |
|
|
GFC_ISYM_NOT,
|
464 |
|
|
GFC_ISYM_NULL,
|
465 |
|
|
GFC_ISYM_OR,
|
466 |
|
|
GFC_ISYM_PACK,
|
467 |
|
|
GFC_ISYM_PERROR,
|
468 |
|
|
GFC_ISYM_PRECISION,
|
469 |
|
|
GFC_ISYM_PRESENT,
|
470 |
|
|
GFC_ISYM_PRODUCT,
|
471 |
|
|
GFC_ISYM_RADIX,
|
472 |
|
|
GFC_ISYM_RAND,
|
473 |
|
|
GFC_ISYM_RANDOM_NUMBER,
|
474 |
|
|
GFC_ISYM_RANDOM_SEED,
|
475 |
|
|
GFC_ISYM_RANGE,
|
476 |
|
|
GFC_ISYM_REAL,
|
477 |
|
|
GFC_ISYM_RENAME,
|
478 |
|
|
GFC_ISYM_REPEAT,
|
479 |
|
|
GFC_ISYM_RESHAPE,
|
480 |
|
|
GFC_ISYM_RRSPACING,
|
481 |
|
|
GFC_ISYM_RSHIFT,
|
482 |
|
|
GFC_ISYM_SAME_TYPE_AS,
|
483 |
|
|
GFC_ISYM_SC_KIND,
|
484 |
|
|
GFC_ISYM_SCALE,
|
485 |
|
|
GFC_ISYM_SCAN,
|
486 |
|
|
GFC_ISYM_SECNDS,
|
487 |
|
|
GFC_ISYM_SECOND,
|
488 |
|
|
GFC_ISYM_SET_EXPONENT,
|
489 |
|
|
GFC_ISYM_SHAPE,
|
490 |
|
|
GFC_ISYM_SIGN,
|
491 |
|
|
GFC_ISYM_SIGNAL,
|
492 |
|
|
GFC_ISYM_SI_KIND,
|
493 |
|
|
GFC_ISYM_SIN,
|
494 |
|
|
GFC_ISYM_SINH,
|
495 |
|
|
GFC_ISYM_SIZE,
|
496 |
|
|
GFC_ISYM_SLEEP,
|
497 |
|
|
GFC_ISYM_SIZEOF,
|
498 |
|
|
GFC_ISYM_SPACING,
|
499 |
|
|
GFC_ISYM_SPREAD,
|
500 |
|
|
GFC_ISYM_SQRT,
|
501 |
|
|
GFC_ISYM_SRAND,
|
502 |
|
|
GFC_ISYM_SR_KIND,
|
503 |
|
|
GFC_ISYM_STAT,
|
504 |
|
|
GFC_ISYM_SUM,
|
505 |
|
|
GFC_ISYM_SYMLINK,
|
506 |
|
|
GFC_ISYM_SYMLNK,
|
507 |
|
|
GFC_ISYM_SYSTEM,
|
508 |
|
|
GFC_ISYM_SYSTEM_CLOCK,
|
509 |
|
|
GFC_ISYM_TAN,
|
510 |
|
|
GFC_ISYM_TANH,
|
511 |
|
|
GFC_ISYM_TIME,
|
512 |
|
|
GFC_ISYM_TIME8,
|
513 |
|
|
GFC_ISYM_TINY,
|
514 |
|
|
GFC_ISYM_TRAILZ,
|
515 |
|
|
GFC_ISYM_TRANSFER,
|
516 |
|
|
GFC_ISYM_TRANSPOSE,
|
517 |
|
|
GFC_ISYM_TRIM,
|
518 |
|
|
GFC_ISYM_TTYNAM,
|
519 |
|
|
GFC_ISYM_UBOUND,
|
520 |
|
|
GFC_ISYM_UMASK,
|
521 |
|
|
GFC_ISYM_UNLINK,
|
522 |
|
|
GFC_ISYM_UNPACK,
|
523 |
|
|
GFC_ISYM_VERIFY,
|
524 |
|
|
GFC_ISYM_XOR,
|
525 |
|
|
GFC_ISYM_Y0,
|
526 |
|
|
GFC_ISYM_Y1,
|
527 |
|
|
GFC_ISYM_YN
|
528 |
|
|
};
|
529 |
|
|
typedef enum gfc_isym_id gfc_isym_id;
|
530 |
|
|
|
531 |
|
|
|
532 |
|
|
typedef enum
|
533 |
|
|
{
|
534 |
|
|
GFC_INIT_REAL_OFF = 0,
|
535 |
|
|
GFC_INIT_REAL_ZERO,
|
536 |
|
|
GFC_INIT_REAL_NAN,
|
537 |
|
|
GFC_INIT_REAL_SNAN,
|
538 |
|
|
GFC_INIT_REAL_INF,
|
539 |
|
|
GFC_INIT_REAL_NEG_INF
|
540 |
|
|
}
|
541 |
|
|
init_local_real;
|
542 |
|
|
|
543 |
|
|
typedef enum
|
544 |
|
|
{
|
545 |
|
|
GFC_INIT_LOGICAL_OFF = 0,
|
546 |
|
|
GFC_INIT_LOGICAL_FALSE,
|
547 |
|
|
GFC_INIT_LOGICAL_TRUE
|
548 |
|
|
}
|
549 |
|
|
init_local_logical;
|
550 |
|
|
|
551 |
|
|
typedef enum
|
552 |
|
|
{
|
553 |
|
|
GFC_INIT_CHARACTER_OFF = 0,
|
554 |
|
|
GFC_INIT_CHARACTER_ON
|
555 |
|
|
}
|
556 |
|
|
init_local_character;
|
557 |
|
|
|
558 |
|
|
typedef enum
|
559 |
|
|
{
|
560 |
|
|
GFC_INIT_INTEGER_OFF = 0,
|
561 |
|
|
GFC_INIT_INTEGER_ON
|
562 |
|
|
}
|
563 |
|
|
init_local_integer;
|
564 |
|
|
|
565 |
|
|
/************************* Structures *****************************/
|
566 |
|
|
|
567 |
|
|
/* Used for keeping things in balanced binary trees. */
|
568 |
|
|
#define BBT_HEADER(self) int priority; struct self *left, *right
|
569 |
|
|
|
570 |
|
|
#define NAMED_INTCST(a,b,c,d) a,
|
571 |
|
|
typedef enum
|
572 |
|
|
{
|
573 |
|
|
ISOFORTRANENV_INVALID = -1,
|
574 |
|
|
#include "iso-fortran-env.def"
|
575 |
|
|
ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
|
576 |
|
|
}
|
577 |
|
|
iso_fortran_env_symbol;
|
578 |
|
|
#undef NAMED_INTCST
|
579 |
|
|
|
580 |
|
|
#define NAMED_INTCST(a,b,c,d) a,
|
581 |
|
|
#define NAMED_REALCST(a,b,c) a,
|
582 |
|
|
#define NAMED_CMPXCST(a,b,c) a,
|
583 |
|
|
#define NAMED_LOGCST(a,b,c) a,
|
584 |
|
|
#define NAMED_CHARKNDCST(a,b,c) a,
|
585 |
|
|
#define NAMED_CHARCST(a,b,c) a,
|
586 |
|
|
#define DERIVED_TYPE(a,b,c) a,
|
587 |
|
|
#define PROCEDURE(a,b) a,
|
588 |
|
|
typedef enum
|
589 |
|
|
{
|
590 |
|
|
ISOCBINDING_INVALID = -1,
|
591 |
|
|
#include "iso-c-binding.def"
|
592 |
|
|
ISOCBINDING_LAST,
|
593 |
|
|
ISOCBINDING_NUMBER = ISOCBINDING_LAST
|
594 |
|
|
}
|
595 |
|
|
iso_c_binding_symbol;
|
596 |
|
|
#undef NAMED_INTCST
|
597 |
|
|
#undef NAMED_REALCST
|
598 |
|
|
#undef NAMED_CMPXCST
|
599 |
|
|
#undef NAMED_LOGCST
|
600 |
|
|
#undef NAMED_CHARKNDCST
|
601 |
|
|
#undef NAMED_CHARCST
|
602 |
|
|
#undef DERIVED_TYPE
|
603 |
|
|
#undef PROCEDURE
|
604 |
|
|
|
605 |
|
|
typedef enum
|
606 |
|
|
{
|
607 |
|
|
INTMOD_NONE = 0, INTMOD_ISO_FORTRAN_ENV, INTMOD_ISO_C_BINDING
|
608 |
|
|
}
|
609 |
|
|
intmod_id;
|
610 |
|
|
|
611 |
|
|
typedef struct
|
612 |
|
|
{
|
613 |
|
|
char name[GFC_MAX_SYMBOL_LEN + 1];
|
614 |
|
|
int value; /* Used for both integer and character values. */
|
615 |
|
|
bt f90_type;
|
616 |
|
|
}
|
617 |
|
|
CInteropKind_t;
|
618 |
|
|
|
619 |
|
|
/* Array of structs, where the structs represent the C interop kinds.
|
620 |
|
|
The list will be implemented based on a hash of the kind name since
|
621 |
|
|
these could be accessed multiple times.
|
622 |
|
|
Declared in trans-types.c as a global, since it's in that file
|
623 |
|
|
that the list is initialized. */
|
624 |
|
|
extern CInteropKind_t c_interop_kinds_table[];
|
625 |
|
|
|
626 |
|
|
|
627 |
|
|
/* Structure and list of supported extension attributes. */
|
628 |
|
|
typedef enum
|
629 |
|
|
{
|
630 |
|
|
EXT_ATTR_DLLIMPORT = 0,
|
631 |
|
|
EXT_ATTR_DLLEXPORT,
|
632 |
|
|
EXT_ATTR_STDCALL,
|
633 |
|
|
EXT_ATTR_CDECL,
|
634 |
|
|
EXT_ATTR_FASTCALL,
|
635 |
|
|
EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
|
636 |
|
|
}
|
637 |
|
|
ext_attr_id_t;
|
638 |
|
|
|
639 |
|
|
typedef struct
|
640 |
|
|
{
|
641 |
|
|
const char *name;
|
642 |
|
|
unsigned id;
|
643 |
|
|
const char *middle_end_name;
|
644 |
|
|
}
|
645 |
|
|
ext_attr_t;
|
646 |
|
|
|
647 |
|
|
extern const ext_attr_t ext_attr_list[];
|
648 |
|
|
|
649 |
|
|
/* Symbol attribute structure. */
|
650 |
|
|
typedef struct
|
651 |
|
|
{
|
652 |
|
|
/* Variable attributes. */
|
653 |
|
|
unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
|
654 |
|
|
optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
|
655 |
|
|
dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
|
656 |
|
|
implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1;
|
657 |
|
|
|
658 |
|
|
/* For CLASS containers, the pointer attribute is sometimes set internally
|
659 |
|
|
even though it was not directly specified. In this case, keep the
|
660 |
|
|
"real" (original) value here. */
|
661 |
|
|
unsigned class_pointer:1;
|
662 |
|
|
|
663 |
|
|
ENUM_BITFIELD (save_state) save:2;
|
664 |
|
|
|
665 |
|
|
unsigned data:1, /* Symbol is named in a DATA statement. */
|
666 |
|
|
is_protected:1, /* Symbol has been marked as protected. */
|
667 |
|
|
use_assoc:1, /* Symbol has been use-associated. */
|
668 |
|
|
use_only:1, /* Symbol has been use-associated, with ONLY. */
|
669 |
|
|
use_rename:1, /* Symbol has been use-associated and renamed. */
|
670 |
|
|
imported:1, /* Symbol has been associated by IMPORT. */
|
671 |
|
|
host_assoc:1; /* Symbol has been host associated. */
|
672 |
|
|
|
673 |
|
|
unsigned in_namelist:1, in_common:1, in_equivalence:1;
|
674 |
|
|
unsigned function:1, subroutine:1, procedure:1;
|
675 |
|
|
unsigned generic:1, generic_copy:1;
|
676 |
|
|
unsigned implicit_type:1; /* Type defined via implicit rules. */
|
677 |
|
|
unsigned untyped:1; /* No implicit type could be found. */
|
678 |
|
|
|
679 |
|
|
unsigned is_bind_c:1; /* say if is bound to C. */
|
680 |
|
|
unsigned extension:8; /* extension level of a derived type. */
|
681 |
|
|
unsigned is_class:1; /* is a CLASS container. */
|
682 |
|
|
unsigned class_ok:1; /* is a CLASS object with correct attributes. */
|
683 |
|
|
unsigned vtab:1; /* is a derived type vtab. */
|
684 |
|
|
|
685 |
|
|
/* These flags are both in the typespec and attribute. The attribute
|
686 |
|
|
list is what gets read from/written to a module file. The typespec
|
687 |
|
|
is created from a decl being processed. */
|
688 |
|
|
unsigned is_c_interop:1; /* It's c interoperable. */
|
689 |
|
|
unsigned is_iso_c:1; /* Symbol is from iso_c_binding. */
|
690 |
|
|
|
691 |
|
|
/* Function/subroutine attributes */
|
692 |
|
|
unsigned sequence:1, elemental:1, pure:1, recursive:1;
|
693 |
|
|
unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
|
694 |
|
|
|
695 |
|
|
/* This is set if the subroutine doesn't return. Currently, this
|
696 |
|
|
is only possible for intrinsic subroutines. */
|
697 |
|
|
unsigned noreturn:1;
|
698 |
|
|
|
699 |
|
|
/* Set if this procedure is an alternate entry point. These procedures
|
700 |
|
|
don't have any code associated, and the backend will turn them into
|
701 |
|
|
thunks to the master function. */
|
702 |
|
|
unsigned entry:1;
|
703 |
|
|
|
704 |
|
|
/* Set if this is the master function for a procedure with multiple
|
705 |
|
|
entry points. */
|
706 |
|
|
unsigned entry_master:1;
|
707 |
|
|
|
708 |
|
|
/* Set if this is the master function for a function with multiple
|
709 |
|
|
entry points where characteristics of the entry points differ. */
|
710 |
|
|
unsigned mixed_entry_master:1;
|
711 |
|
|
|
712 |
|
|
/* Set if a function must always be referenced by an explicit interface. */
|
713 |
|
|
unsigned always_explicit:1;
|
714 |
|
|
|
715 |
|
|
/* Set if the symbol has been referenced in an expression. No further
|
716 |
|
|
modification of type or type parameters is permitted. */
|
717 |
|
|
unsigned referenced:1;
|
718 |
|
|
|
719 |
|
|
/* Set if this is the symbol for the main program. */
|
720 |
|
|
unsigned is_main_program:1;
|
721 |
|
|
|
722 |
|
|
/* Mutually exclusive multibit attributes. */
|
723 |
|
|
ENUM_BITFIELD (gfc_access) access:2;
|
724 |
|
|
ENUM_BITFIELD (sym_intent) intent:2;
|
725 |
|
|
ENUM_BITFIELD (sym_flavor) flavor:4;
|
726 |
|
|
ENUM_BITFIELD (ifsrc) if_source:2;
|
727 |
|
|
|
728 |
|
|
ENUM_BITFIELD (procedure_type) proc:3;
|
729 |
|
|
|
730 |
|
|
/* Special attributes for Cray pointers, pointees. */
|
731 |
|
|
unsigned cray_pointer:1, cray_pointee:1;
|
732 |
|
|
|
733 |
|
|
/* The symbol is a derived type with allocatable components, pointer
|
734 |
|
|
components or private components, procedure pointer components,
|
735 |
|
|
possibly nested. zero_comp is true if the derived type has no
|
736 |
|
|
component at all. */
|
737 |
|
|
unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
|
738 |
|
|
private_comp:1, zero_comp:1;
|
739 |
|
|
|
740 |
|
|
/* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
|
741 |
|
|
unsigned ext_attr:EXT_ATTR_NUM;
|
742 |
|
|
|
743 |
|
|
/* The namespace where the attribute has been set. */
|
744 |
|
|
struct gfc_namespace *volatile_ns, *asynchronous_ns;
|
745 |
|
|
}
|
746 |
|
|
symbol_attribute;
|
747 |
|
|
|
748 |
|
|
|
749 |
|
|
/* We need to store source lines as sequences of multibyte source
|
750 |
|
|
characters. We define here a type wide enough to hold any multibyte
|
751 |
|
|
source character, just like libcpp does. A 32-bit type is enough. */
|
752 |
|
|
|
753 |
|
|
#if HOST_BITS_PER_INT >= 32
|
754 |
|
|
typedef unsigned int gfc_char_t;
|
755 |
|
|
#elif HOST_BITS_PER_LONG >= 32
|
756 |
|
|
typedef unsigned long gfc_char_t;
|
757 |
|
|
#elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
|
758 |
|
|
typedef unsigned long long gfc_char_t;
|
759 |
|
|
#else
|
760 |
|
|
# error "Cannot find an integer type with at least 32 bits"
|
761 |
|
|
#endif
|
762 |
|
|
|
763 |
|
|
|
764 |
|
|
/* The following three structures are used to identify a location in
|
765 |
|
|
the sources.
|
766 |
|
|
|
767 |
|
|
gfc_file is used to maintain a tree of the source files and how
|
768 |
|
|
they include each other
|
769 |
|
|
|
770 |
|
|
gfc_linebuf holds a single line of source code and information
|
771 |
|
|
which file it resides in
|
772 |
|
|
|
773 |
|
|
locus point to the sourceline and the character in the source
|
774 |
|
|
line.
|
775 |
|
|
*/
|
776 |
|
|
|
777 |
|
|
typedef struct gfc_file
|
778 |
|
|
{
|
779 |
|
|
struct gfc_file *next, *up;
|
780 |
|
|
int inclusion_line, line;
|
781 |
|
|
char *filename;
|
782 |
|
|
} gfc_file;
|
783 |
|
|
|
784 |
|
|
typedef struct gfc_linebuf
|
785 |
|
|
{
|
786 |
|
|
source_location location;
|
787 |
|
|
struct gfc_file *file;
|
788 |
|
|
struct gfc_linebuf *next;
|
789 |
|
|
|
790 |
|
|
int truncated;
|
791 |
|
|
bool dbg_emitted;
|
792 |
|
|
|
793 |
|
|
gfc_char_t line[1];
|
794 |
|
|
} gfc_linebuf;
|
795 |
|
|
|
796 |
|
|
#define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
|
797 |
|
|
|
798 |
|
|
#define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
|
799 |
|
|
|
800 |
|
|
typedef struct
|
801 |
|
|
{
|
802 |
|
|
gfc_char_t *nextc;
|
803 |
|
|
gfc_linebuf *lb;
|
804 |
|
|
} locus;
|
805 |
|
|
|
806 |
|
|
/* In order for the "gfc" format checking to work correctly, you must
|
807 |
|
|
have declared a typedef locus first. */
|
808 |
|
|
#if GCC_VERSION >= 4001
|
809 |
|
|
#define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
|
810 |
|
|
#else
|
811 |
|
|
#define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
|
812 |
|
|
#endif
|
813 |
|
|
|
814 |
|
|
|
815 |
|
|
/* Suppress error messages or re-enable them. */
|
816 |
|
|
|
817 |
|
|
void gfc_push_suppress_errors (void);
|
818 |
|
|
void gfc_pop_suppress_errors (void);
|
819 |
|
|
|
820 |
|
|
|
821 |
|
|
/* Character length structures hold the expression that gives the
|
822 |
|
|
length of a character variable. We avoid putting these into
|
823 |
|
|
gfc_typespec because doing so prevents us from doing structure
|
824 |
|
|
copies and forces us to deallocate any typespecs we create, as well
|
825 |
|
|
as structures that contain typespecs. They also can have multiple
|
826 |
|
|
character typespecs pointing to them.
|
827 |
|
|
|
828 |
|
|
These structures form a singly linked list within the current
|
829 |
|
|
namespace and are deallocated with the namespace. It is possible to
|
830 |
|
|
end up with gfc_charlen structures that have nothing pointing to them. */
|
831 |
|
|
|
832 |
|
|
typedef struct gfc_charlen
|
833 |
|
|
{
|
834 |
|
|
struct gfc_expr *length;
|
835 |
|
|
struct gfc_charlen *next;
|
836 |
|
|
bool length_from_typespec; /* Length from explicit array ctor typespec? */
|
837 |
|
|
tree backend_decl;
|
838 |
|
|
tree passed_length; /* Length argument explicitelly passed. */
|
839 |
|
|
|
840 |
|
|
int resolved;
|
841 |
|
|
}
|
842 |
|
|
gfc_charlen;
|
843 |
|
|
|
844 |
|
|
#define gfc_get_charlen() XCNEW (gfc_charlen)
|
845 |
|
|
|
846 |
|
|
/* Type specification structure. */
|
847 |
|
|
typedef struct
|
848 |
|
|
{
|
849 |
|
|
bt type;
|
850 |
|
|
int kind;
|
851 |
|
|
|
852 |
|
|
union
|
853 |
|
|
{
|
854 |
|
|
struct gfc_symbol *derived; /* For derived types only. */
|
855 |
|
|
gfc_charlen *cl; /* For character types only. */
|
856 |
|
|
}
|
857 |
|
|
u;
|
858 |
|
|
|
859 |
|
|
struct gfc_symbol *interface; /* For PROCEDURE declarations. */
|
860 |
|
|
int is_c_interop;
|
861 |
|
|
int is_iso_c;
|
862 |
|
|
bt f90_type;
|
863 |
|
|
}
|
864 |
|
|
gfc_typespec;
|
865 |
|
|
|
866 |
|
|
/* Array specification. */
|
867 |
|
|
typedef struct
|
868 |
|
|
{
|
869 |
|
|
int rank; /* A rank of zero means that a variable is a scalar. */
|
870 |
|
|
array_type type;
|
871 |
|
|
struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
|
872 |
|
|
|
873 |
|
|
/* These two fields are used with the Cray Pointer extension. */
|
874 |
|
|
bool cray_pointee; /* True iff this spec belongs to a cray pointee. */
|
875 |
|
|
bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to
|
876 |
|
|
AS_EXPLICIT, but we want to remember that we
|
877 |
|
|
did this. */
|
878 |
|
|
|
879 |
|
|
}
|
880 |
|
|
gfc_array_spec;
|
881 |
|
|
|
882 |
|
|
#define gfc_get_array_spec() XCNEW (gfc_array_spec)
|
883 |
|
|
|
884 |
|
|
|
885 |
|
|
/* Components of derived types. */
|
886 |
|
|
typedef struct gfc_component
|
887 |
|
|
{
|
888 |
|
|
const char *name;
|
889 |
|
|
gfc_typespec ts;
|
890 |
|
|
|
891 |
|
|
symbol_attribute attr;
|
892 |
|
|
gfc_array_spec *as;
|
893 |
|
|
|
894 |
|
|
tree backend_decl;
|
895 |
|
|
locus loc;
|
896 |
|
|
struct gfc_expr *initializer;
|
897 |
|
|
struct gfc_component *next;
|
898 |
|
|
|
899 |
|
|
/* Needed for procedure pointer components. */
|
900 |
|
|
struct gfc_formal_arglist *formal;
|
901 |
|
|
struct gfc_namespace *formal_ns;
|
902 |
|
|
struct gfc_typebound_proc *tb;
|
903 |
|
|
}
|
904 |
|
|
gfc_component;
|
905 |
|
|
|
906 |
|
|
#define gfc_get_component() XCNEW (gfc_component)
|
907 |
|
|
|
908 |
|
|
/* Formal argument lists are lists of symbols. */
|
909 |
|
|
typedef struct gfc_formal_arglist
|
910 |
|
|
{
|
911 |
|
|
/* Symbol representing the argument at this position in the arglist. */
|
912 |
|
|
struct gfc_symbol *sym;
|
913 |
|
|
/* Points to the next formal argument. */
|
914 |
|
|
struct gfc_formal_arglist *next;
|
915 |
|
|
}
|
916 |
|
|
gfc_formal_arglist;
|
917 |
|
|
|
918 |
|
|
#define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
|
919 |
|
|
|
920 |
|
|
|
921 |
|
|
/* The gfc_actual_arglist structure is for actual arguments. */
|
922 |
|
|
typedef struct gfc_actual_arglist
|
923 |
|
|
{
|
924 |
|
|
const char *name;
|
925 |
|
|
/* Alternate return label when the expr member is null. */
|
926 |
|
|
struct gfc_st_label *label;
|
927 |
|
|
|
928 |
|
|
/* This is set to the type of an eventual omitted optional
|
929 |
|
|
argument. This is used to determine if a hidden string length
|
930 |
|
|
argument has to be added to a function call. */
|
931 |
|
|
bt missing_arg_type;
|
932 |
|
|
|
933 |
|
|
struct gfc_expr *expr;
|
934 |
|
|
struct gfc_actual_arglist *next;
|
935 |
|
|
}
|
936 |
|
|
gfc_actual_arglist;
|
937 |
|
|
|
938 |
|
|
#define gfc_get_actual_arglist() XCNEW (gfc_actual_arglist)
|
939 |
|
|
|
940 |
|
|
|
941 |
|
|
/* Because a symbol can belong to multiple namelists, they must be
|
942 |
|
|
linked externally to the symbol itself. */
|
943 |
|
|
typedef struct gfc_namelist
|
944 |
|
|
{
|
945 |
|
|
struct gfc_symbol *sym;
|
946 |
|
|
struct gfc_namelist *next;
|
947 |
|
|
}
|
948 |
|
|
gfc_namelist;
|
949 |
|
|
|
950 |
|
|
#define gfc_get_namelist() XCNEW (gfc_namelist)
|
951 |
|
|
|
952 |
|
|
enum
|
953 |
|
|
{
|
954 |
|
|
OMP_LIST_PRIVATE,
|
955 |
|
|
OMP_LIST_FIRSTPRIVATE,
|
956 |
|
|
OMP_LIST_LASTPRIVATE,
|
957 |
|
|
OMP_LIST_COPYPRIVATE,
|
958 |
|
|
OMP_LIST_SHARED,
|
959 |
|
|
OMP_LIST_COPYIN,
|
960 |
|
|
OMP_LIST_PLUS,
|
961 |
|
|
OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
|
962 |
|
|
OMP_LIST_MULT,
|
963 |
|
|
OMP_LIST_SUB,
|
964 |
|
|
OMP_LIST_AND,
|
965 |
|
|
OMP_LIST_OR,
|
966 |
|
|
OMP_LIST_EQV,
|
967 |
|
|
OMP_LIST_NEQV,
|
968 |
|
|
OMP_LIST_MAX,
|
969 |
|
|
OMP_LIST_MIN,
|
970 |
|
|
OMP_LIST_IAND,
|
971 |
|
|
OMP_LIST_IOR,
|
972 |
|
|
OMP_LIST_IEOR,
|
973 |
|
|
OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR,
|
974 |
|
|
OMP_LIST_NUM
|
975 |
|
|
};
|
976 |
|
|
|
977 |
|
|
/* Because a symbol can belong to multiple namelists, they must be
|
978 |
|
|
linked externally to the symbol itself. */
|
979 |
|
|
|
980 |
|
|
enum gfc_omp_sched_kind
|
981 |
|
|
{
|
982 |
|
|
OMP_SCHED_NONE,
|
983 |
|
|
OMP_SCHED_STATIC,
|
984 |
|
|
OMP_SCHED_DYNAMIC,
|
985 |
|
|
OMP_SCHED_GUIDED,
|
986 |
|
|
OMP_SCHED_RUNTIME,
|
987 |
|
|
OMP_SCHED_AUTO
|
988 |
|
|
};
|
989 |
|
|
|
990 |
|
|
enum gfc_omp_default_sharing
|
991 |
|
|
{
|
992 |
|
|
OMP_DEFAULT_UNKNOWN,
|
993 |
|
|
OMP_DEFAULT_NONE,
|
994 |
|
|
OMP_DEFAULT_PRIVATE,
|
995 |
|
|
OMP_DEFAULT_SHARED,
|
996 |
|
|
OMP_DEFAULT_FIRSTPRIVATE
|
997 |
|
|
};
|
998 |
|
|
|
999 |
|
|
typedef struct gfc_omp_clauses
|
1000 |
|
|
{
|
1001 |
|
|
struct gfc_expr *if_expr;
|
1002 |
|
|
struct gfc_expr *num_threads;
|
1003 |
|
|
gfc_namelist *lists[OMP_LIST_NUM];
|
1004 |
|
|
enum gfc_omp_sched_kind sched_kind;
|
1005 |
|
|
struct gfc_expr *chunk_size;
|
1006 |
|
|
enum gfc_omp_default_sharing default_sharing;
|
1007 |
|
|
int collapse;
|
1008 |
|
|
bool nowait, ordered, untied;
|
1009 |
|
|
}
|
1010 |
|
|
gfc_omp_clauses;
|
1011 |
|
|
|
1012 |
|
|
#define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
|
1013 |
|
|
|
1014 |
|
|
|
1015 |
|
|
/* The gfc_st_label structure is a BBT attached to a namespace that
|
1016 |
|
|
records the usage of statement labels within that space. */
|
1017 |
|
|
|
1018 |
|
|
typedef struct gfc_st_label
|
1019 |
|
|
{
|
1020 |
|
|
BBT_HEADER(gfc_st_label);
|
1021 |
|
|
|
1022 |
|
|
int value;
|
1023 |
|
|
|
1024 |
|
|
gfc_sl_type defined, referenced;
|
1025 |
|
|
|
1026 |
|
|
struct gfc_expr *format;
|
1027 |
|
|
|
1028 |
|
|
tree backend_decl;
|
1029 |
|
|
|
1030 |
|
|
locus where;
|
1031 |
|
|
}
|
1032 |
|
|
gfc_st_label;
|
1033 |
|
|
|
1034 |
|
|
|
1035 |
|
|
/* gfc_interface()-- Interfaces are lists of symbols strung together. */
|
1036 |
|
|
typedef struct gfc_interface
|
1037 |
|
|
{
|
1038 |
|
|
struct gfc_symbol *sym;
|
1039 |
|
|
locus where;
|
1040 |
|
|
struct gfc_interface *next;
|
1041 |
|
|
}
|
1042 |
|
|
gfc_interface;
|
1043 |
|
|
|
1044 |
|
|
#define gfc_get_interface() XCNEW (gfc_interface)
|
1045 |
|
|
|
1046 |
|
|
/* User operator nodes. These are like stripped down symbols. */
|
1047 |
|
|
typedef struct
|
1048 |
|
|
{
|
1049 |
|
|
const char *name;
|
1050 |
|
|
|
1051 |
|
|
gfc_interface *op;
|
1052 |
|
|
struct gfc_namespace *ns;
|
1053 |
|
|
gfc_access access;
|
1054 |
|
|
}
|
1055 |
|
|
gfc_user_op;
|
1056 |
|
|
|
1057 |
|
|
|
1058 |
|
|
/* A list of specific bindings that are associated with a generic spec. */
|
1059 |
|
|
typedef struct gfc_tbp_generic
|
1060 |
|
|
{
|
1061 |
|
|
/* The parser sets specific_st, upon resolution we look for the corresponding
|
1062 |
|
|
gfc_typebound_proc and set specific for further use. */
|
1063 |
|
|
struct gfc_symtree* specific_st;
|
1064 |
|
|
struct gfc_typebound_proc* specific;
|
1065 |
|
|
|
1066 |
|
|
struct gfc_tbp_generic* next;
|
1067 |
|
|
}
|
1068 |
|
|
gfc_tbp_generic;
|
1069 |
|
|
|
1070 |
|
|
#define gfc_get_tbp_generic() XCNEW (gfc_tbp_generic)
|
1071 |
|
|
|
1072 |
|
|
|
1073 |
|
|
/* Data needed for type-bound procedures. */
|
1074 |
|
|
typedef struct gfc_typebound_proc
|
1075 |
|
|
{
|
1076 |
|
|
locus where; /* Where the PROCEDURE/GENERIC definition was. */
|
1077 |
|
|
|
1078 |
|
|
union
|
1079 |
|
|
{
|
1080 |
|
|
struct gfc_symtree* specific; /* The interface if DEFERRED. */
|
1081 |
|
|
gfc_tbp_generic* generic;
|
1082 |
|
|
}
|
1083 |
|
|
u;
|
1084 |
|
|
|
1085 |
|
|
gfc_access access;
|
1086 |
|
|
const char* pass_arg; /* Argument-name for PASS. NULL if not specified. */
|
1087 |
|
|
|
1088 |
|
|
/* The overridden type-bound proc (or GENERIC with this name in the
|
1089 |
|
|
parent-type) or NULL if non. */
|
1090 |
|
|
struct gfc_typebound_proc* overridden;
|
1091 |
|
|
|
1092 |
|
|
/* Once resolved, we use the position of pass_arg in the formal arglist of
|
1093 |
|
|
the binding-target procedure to identify it. The first argument has
|
1094 |
|
|
number 1 here, the second 2, and so on. */
|
1095 |
|
|
unsigned pass_arg_num;
|
1096 |
|
|
|
1097 |
|
|
unsigned nopass:1; /* Whether we have NOPASS (PASS otherwise). */
|
1098 |
|
|
unsigned non_overridable:1;
|
1099 |
|
|
unsigned deferred:1;
|
1100 |
|
|
unsigned is_generic:1;
|
1101 |
|
|
unsigned function:1, subroutine:1;
|
1102 |
|
|
unsigned error:1; /* Ignore it, when an error occurred during resolution. */
|
1103 |
|
|
unsigned ppc:1;
|
1104 |
|
|
}
|
1105 |
|
|
gfc_typebound_proc;
|
1106 |
|
|
|
1107 |
|
|
|
1108 |
|
|
/* Symbol nodes. These are important things. They are what the
|
1109 |
|
|
standard refers to as "entities". The possibly multiple names that
|
1110 |
|
|
refer to the same entity are accomplished by a binary tree of
|
1111 |
|
|
symtree structures that is balanced by the red-black method-- more
|
1112 |
|
|
than one symtree node can point to any given symbol. */
|
1113 |
|
|
|
1114 |
|
|
typedef struct gfc_symbol
|
1115 |
|
|
{
|
1116 |
|
|
const char *name; /* Primary name, before renaming */
|
1117 |
|
|
const char *module; /* Module this symbol came from */
|
1118 |
|
|
locus declared_at;
|
1119 |
|
|
|
1120 |
|
|
gfc_typespec ts;
|
1121 |
|
|
symbol_attribute attr;
|
1122 |
|
|
|
1123 |
|
|
/* The formal member points to the formal argument list if the
|
1124 |
|
|
symbol is a function or subroutine name. If the symbol is a
|
1125 |
|
|
generic name, the generic member points to the list of
|
1126 |
|
|
interfaces. */
|
1127 |
|
|
|
1128 |
|
|
gfc_interface *generic;
|
1129 |
|
|
gfc_access component_access;
|
1130 |
|
|
|
1131 |
|
|
gfc_formal_arglist *formal;
|
1132 |
|
|
struct gfc_namespace *formal_ns;
|
1133 |
|
|
struct gfc_namespace *f2k_derived;
|
1134 |
|
|
|
1135 |
|
|
struct gfc_expr *value; /* Parameter/Initializer value */
|
1136 |
|
|
gfc_array_spec *as;
|
1137 |
|
|
struct gfc_symbol *result; /* function result symbol */
|
1138 |
|
|
gfc_component *components; /* Derived type components */
|
1139 |
|
|
|
1140 |
|
|
/* Defined only for Cray pointees; points to their pointer. */
|
1141 |
|
|
struct gfc_symbol *cp_pointer;
|
1142 |
|
|
|
1143 |
|
|
int entry_id; /* Used in resolve.c for entries. */
|
1144 |
|
|
|
1145 |
|
|
/* CLASS hashed name for declared and dynamic types in the class. */
|
1146 |
|
|
int hash_value;
|
1147 |
|
|
|
1148 |
|
|
struct gfc_symbol *common_next; /* Links for COMMON syms */
|
1149 |
|
|
|
1150 |
|
|
/* This is in fact a gfc_common_head but it is only used for pointer
|
1151 |
|
|
comparisons to check if symbols are in the same common block. */
|
1152 |
|
|
struct gfc_common_head* common_head;
|
1153 |
|
|
|
1154 |
|
|
/* Make sure setup code for dummy arguments is generated in the correct
|
1155 |
|
|
order. */
|
1156 |
|
|
int dummy_order;
|
1157 |
|
|
|
1158 |
|
|
gfc_namelist *namelist, *namelist_tail;
|
1159 |
|
|
|
1160 |
|
|
/* Change management fields. Symbols that might be modified by the
|
1161 |
|
|
current statement have the mark member nonzero and are kept in a
|
1162 |
|
|
singly linked list through the tlink field. Of these symbols,
|
1163 |
|
|
symbols with old_symbol equal to NULL are symbols created within
|
1164 |
|
|
the current statement. Otherwise, old_symbol points to a copy of
|
1165 |
|
|
the old symbol. */
|
1166 |
|
|
|
1167 |
|
|
struct gfc_symbol *old_symbol, *tlink;
|
1168 |
|
|
unsigned mark:1, gfc_new:1;
|
1169 |
|
|
/* Nonzero if all equivalences associated with this symbol have been
|
1170 |
|
|
processed. */
|
1171 |
|
|
unsigned equiv_built:1;
|
1172 |
|
|
/* Set if this variable is used as an index name in a FORALL. */
|
1173 |
|
|
unsigned forall_index:1;
|
1174 |
|
|
int refs;
|
1175 |
|
|
struct gfc_namespace *ns; /* namespace containing this symbol */
|
1176 |
|
|
|
1177 |
|
|
tree backend_decl;
|
1178 |
|
|
|
1179 |
|
|
/* Identity of the intrinsic module the symbol comes from, or
|
1180 |
|
|
INTMOD_NONE if it's not imported from a intrinsic module. */
|
1181 |
|
|
intmod_id from_intmod;
|
1182 |
|
|
/* Identity of the symbol from intrinsic modules, from enums maintained
|
1183 |
|
|
separately by each intrinsic module. Used together with from_intmod,
|
1184 |
|
|
it uniquely identifies a symbol from an intrinsic module. */
|
1185 |
|
|
int intmod_sym_id;
|
1186 |
|
|
|
1187 |
|
|
/* This may be repetitive, since the typespec now has a binding
|
1188 |
|
|
label field. */
|
1189 |
|
|
char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
|
1190 |
|
|
/* Store a reference to the common_block, if this symbol is in one. */
|
1191 |
|
|
struct gfc_common_head *common_block;
|
1192 |
|
|
}
|
1193 |
|
|
gfc_symbol;
|
1194 |
|
|
|
1195 |
|
|
|
1196 |
|
|
/* This structure is used to keep track of symbols in common blocks. */
|
1197 |
|
|
typedef struct gfc_common_head
|
1198 |
|
|
{
|
1199 |
|
|
locus where;
|
1200 |
|
|
char use_assoc, saved, threadprivate;
|
1201 |
|
|
char name[GFC_MAX_SYMBOL_LEN + 1];
|
1202 |
|
|
struct gfc_symbol *head;
|
1203 |
|
|
char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
|
1204 |
|
|
int is_bind_c;
|
1205 |
|
|
}
|
1206 |
|
|
gfc_common_head;
|
1207 |
|
|
|
1208 |
|
|
#define gfc_get_common_head() XCNEW (gfc_common_head)
|
1209 |
|
|
|
1210 |
|
|
|
1211 |
|
|
/* A list of all the alternate entry points for a procedure. */
|
1212 |
|
|
|
1213 |
|
|
typedef struct gfc_entry_list
|
1214 |
|
|
{
|
1215 |
|
|
/* The symbol for this entry point. */
|
1216 |
|
|
gfc_symbol *sym;
|
1217 |
|
|
/* The zero-based id of this entry point. */
|
1218 |
|
|
int id;
|
1219 |
|
|
/* The LABEL_EXPR marking this entry point. */
|
1220 |
|
|
tree label;
|
1221 |
|
|
/* The next item in the list. */
|
1222 |
|
|
struct gfc_entry_list *next;
|
1223 |
|
|
}
|
1224 |
|
|
gfc_entry_list;
|
1225 |
|
|
|
1226 |
|
|
#define gfc_get_entry_list() \
|
1227 |
|
|
(gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))
|
1228 |
|
|
|
1229 |
|
|
/* Lists of rename info for the USE statement. */
|
1230 |
|
|
|
1231 |
|
|
typedef struct gfc_use_rename
|
1232 |
|
|
{
|
1233 |
|
|
char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
|
1234 |
|
|
struct gfc_use_rename *next;
|
1235 |
|
|
int found;
|
1236 |
|
|
gfc_intrinsic_op op;
|
1237 |
|
|
locus where;
|
1238 |
|
|
}
|
1239 |
|
|
gfc_use_rename;
|
1240 |
|
|
|
1241 |
|
|
#define gfc_get_use_rename() XCNEW (gfc_use_rename);
|
1242 |
|
|
|
1243 |
|
|
/* A list of all USE statements in a namespace. */
|
1244 |
|
|
|
1245 |
|
|
typedef struct gfc_use_list
|
1246 |
|
|
{
|
1247 |
|
|
const char *module_name;
|
1248 |
|
|
int only_flag;
|
1249 |
|
|
struct gfc_use_rename *rename;
|
1250 |
|
|
locus where;
|
1251 |
|
|
/* Next USE statement. */
|
1252 |
|
|
struct gfc_use_list *next;
|
1253 |
|
|
}
|
1254 |
|
|
gfc_use_list;
|
1255 |
|
|
|
1256 |
|
|
#define gfc_get_use_list() \
|
1257 |
|
|
(gfc_use_list *) gfc_getmem(sizeof(gfc_use_list))
|
1258 |
|
|
|
1259 |
|
|
/* Within a namespace, symbols are pointed to by symtree nodes that
|
1260 |
|
|
are linked together in a balanced binary tree. There can be
|
1261 |
|
|
several symtrees pointing to the same symbol node via USE
|
1262 |
|
|
statements. */
|
1263 |
|
|
|
1264 |
|
|
typedef struct gfc_symtree
|
1265 |
|
|
{
|
1266 |
|
|
BBT_HEADER (gfc_symtree);
|
1267 |
|
|
const char *name;
|
1268 |
|
|
int ambiguous;
|
1269 |
|
|
union
|
1270 |
|
|
{
|
1271 |
|
|
gfc_symbol *sym; /* Symbol associated with this node */
|
1272 |
|
|
gfc_user_op *uop;
|
1273 |
|
|
gfc_common_head *common;
|
1274 |
|
|
gfc_typebound_proc *tb;
|
1275 |
|
|
}
|
1276 |
|
|
n;
|
1277 |
|
|
}
|
1278 |
|
|
gfc_symtree;
|
1279 |
|
|
|
1280 |
|
|
/* A linked list of derived types in the namespace. */
|
1281 |
|
|
typedef struct gfc_dt_list
|
1282 |
|
|
{
|
1283 |
|
|
struct gfc_symbol *derived;
|
1284 |
|
|
struct gfc_dt_list *next;
|
1285 |
|
|
}
|
1286 |
|
|
gfc_dt_list;
|
1287 |
|
|
|
1288 |
|
|
#define gfc_get_dt_list() XCNEW (gfc_dt_list)
|
1289 |
|
|
|
1290 |
|
|
/* A list of all derived types. */
|
1291 |
|
|
extern gfc_dt_list *gfc_derived_types;
|
1292 |
|
|
|
1293 |
|
|
/* A namespace describes the contents of procedure, module, interface block
|
1294 |
|
|
or BLOCK construct. */
|
1295 |
|
|
/* ??? Anything else use these? */
|
1296 |
|
|
|
1297 |
|
|
typedef struct gfc_namespace
|
1298 |
|
|
{
|
1299 |
|
|
/* Tree containing all the symbols in this namespace. */
|
1300 |
|
|
gfc_symtree *sym_root;
|
1301 |
|
|
/* Tree containing all the user-defined operators in the namespace. */
|
1302 |
|
|
gfc_symtree *uop_root;
|
1303 |
|
|
/* Tree containing all the common blocks. */
|
1304 |
|
|
gfc_symtree *common_root;
|
1305 |
|
|
|
1306 |
|
|
/* Tree containing type-bound procedures. */
|
1307 |
|
|
gfc_symtree *tb_sym_root;
|
1308 |
|
|
/* Type-bound user operators. */
|
1309 |
|
|
gfc_symtree *tb_uop_root;
|
1310 |
|
|
/* For derived-types, store type-bound intrinsic operators here. */
|
1311 |
|
|
gfc_typebound_proc *tb_op[GFC_INTRINSIC_OPS];
|
1312 |
|
|
/* Linked list of finalizer procedures. */
|
1313 |
|
|
struct gfc_finalizer *finalizers;
|
1314 |
|
|
|
1315 |
|
|
/* If set_flag[letter] is set, an implicit type has been set for letter. */
|
1316 |
|
|
int set_flag[GFC_LETTERS];
|
1317 |
|
|
/* Keeps track of the implicit types associated with the letters. */
|
1318 |
|
|
gfc_typespec default_type[GFC_LETTERS];
|
1319 |
|
|
/* Store the positions of IMPLICIT statements. */
|
1320 |
|
|
locus implicit_loc[GFC_LETTERS];
|
1321 |
|
|
|
1322 |
|
|
/* If this is a namespace of a procedure, this points to the procedure. */
|
1323 |
|
|
struct gfc_symbol *proc_name;
|
1324 |
|
|
/* If this is the namespace of a unit which contains executable
|
1325 |
|
|
code, this points to it. */
|
1326 |
|
|
struct gfc_code *code;
|
1327 |
|
|
|
1328 |
|
|
/* Points to the equivalences set up in this namespace. */
|
1329 |
378 |
julius |
struct gfc_equiv *equiv, *old_equiv;
|
1330 |
285 |
jeremybenn |
|
1331 |
|
|
/* Points to the equivalence groups produced by trans_common. */
|
1332 |
|
|
struct gfc_equiv_list *equiv_lists;
|
1333 |
|
|
|
1334 |
|
|
gfc_interface *op[GFC_INTRINSIC_OPS];
|
1335 |
|
|
|
1336 |
|
|
/* Points to the parent namespace, i.e. the namespace of a module or
|
1337 |
|
|
procedure in which the procedure belonging to this namespace is
|
1338 |
|
|
contained. The parent namespace points to this namespace either
|
1339 |
|
|
directly via CONTAINED, or indirectly via the chain built by
|
1340 |
|
|
SIBLING. */
|
1341 |
|
|
struct gfc_namespace *parent;
|
1342 |
|
|
/* CONTAINED points to the first contained namespace. Sibling
|
1343 |
|
|
namespaces are chained via SIBLING. */
|
1344 |
|
|
struct gfc_namespace *contained, *sibling;
|
1345 |
|
|
|
1346 |
|
|
gfc_common_head blank_common;
|
1347 |
|
|
gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];
|
1348 |
|
|
|
1349 |
|
|
gfc_st_label *st_labels;
|
1350 |
|
|
/* This list holds information about all the data initializers in
|
1351 |
|
|
this namespace. */
|
1352 |
|
|
struct gfc_data *data;
|
1353 |
|
|
|
1354 |
|
|
gfc_charlen *cl_list, *old_cl_list;
|
1355 |
|
|
|
1356 |
|
|
gfc_dt_list *derived_types;
|
1357 |
|
|
|
1358 |
|
|
int save_all, seen_save, seen_implicit_none;
|
1359 |
|
|
|
1360 |
|
|
/* Normally we don't need to refcount namespaces. However when we read
|
1361 |
|
|
a module containing a function with multiple entry points, this
|
1362 |
|
|
will appear as several functions with the same formal namespace. */
|
1363 |
|
|
int refs;
|
1364 |
|
|
|
1365 |
|
|
/* A list of all alternate entry points to this procedure (or NULL). */
|
1366 |
|
|
gfc_entry_list *entries;
|
1367 |
|
|
|
1368 |
|
|
/* A list of USE statements in this namespace. */
|
1369 |
|
|
gfc_use_list *use_stmts;
|
1370 |
|
|
|
1371 |
|
|
/* Set to 1 if namespace is a BLOCK DATA program unit. */
|
1372 |
|
|
unsigned is_block_data:1;
|
1373 |
|
|
|
1374 |
|
|
/* Set to 1 if namespace is an interface body with "IMPORT" used. */
|
1375 |
|
|
unsigned has_import_set:1;
|
1376 |
|
|
|
1377 |
|
|
/* Set to 1 if resolved has been called for this namespace.
|
1378 |
|
|
Holds -1 during resolution. */
|
1379 |
|
|
signed resolved:2;
|
1380 |
|
|
|
1381 |
|
|
/* Set to 1 if code has been generated for this namespace. */
|
1382 |
|
|
unsigned translated:1;
|
1383 |
|
|
|
1384 |
|
|
/* Set to 1 if symbols in this namespace should be 'construct entities',
|
1385 |
|
|
i.e. for BLOCK local variables. */
|
1386 |
|
|
unsigned construct_entities:1;
|
1387 |
|
|
}
|
1388 |
|
|
gfc_namespace;
|
1389 |
|
|
|
1390 |
|
|
extern gfc_namespace *gfc_current_ns;
|
1391 |
|
|
extern gfc_namespace *gfc_global_ns_list;
|
1392 |
|
|
|
1393 |
|
|
/* Global symbols are symbols of global scope. Currently we only use
|
1394 |
|
|
this to detect collisions already when parsing.
|
1395 |
|
|
TODO: Extend to verify procedure calls. */
|
1396 |
|
|
|
1397 |
|
|
enum gfc_symbol_type
|
1398 |
|
|
{
|
1399 |
|
|
GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
|
1400 |
|
|
GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA
|
1401 |
|
|
};
|
1402 |
|
|
|
1403 |
|
|
typedef struct gfc_gsymbol
|
1404 |
|
|
{
|
1405 |
|
|
BBT_HEADER(gfc_gsymbol);
|
1406 |
|
|
|
1407 |
|
|
const char *name;
|
1408 |
|
|
const char *sym_name;
|
1409 |
|
|
const char *mod_name;
|
1410 |
|
|
const char *binding_label;
|
1411 |
|
|
enum gfc_symbol_type type;
|
1412 |
|
|
|
1413 |
|
|
int defined, used;
|
1414 |
|
|
locus where;
|
1415 |
|
|
gfc_namespace *ns;
|
1416 |
|
|
}
|
1417 |
|
|
gfc_gsymbol;
|
1418 |
|
|
|
1419 |
|
|
extern gfc_gsymbol *gfc_gsym_root;
|
1420 |
|
|
|
1421 |
|
|
/* Information on interfaces being built. */
|
1422 |
|
|
typedef struct
|
1423 |
|
|
{
|
1424 |
|
|
interface_type type;
|
1425 |
|
|
gfc_symbol *sym;
|
1426 |
|
|
gfc_namespace *ns;
|
1427 |
|
|
gfc_user_op *uop;
|
1428 |
|
|
gfc_intrinsic_op op;
|
1429 |
|
|
}
|
1430 |
|
|
gfc_interface_info;
|
1431 |
|
|
|
1432 |
|
|
extern gfc_interface_info current_interface;
|
1433 |
|
|
|
1434 |
|
|
|
1435 |
|
|
/* Array reference. */
|
1436 |
|
|
|
1437 |
|
|
enum gfc_array_ref_dimen_type
|
1438 |
|
|
{
|
1439 |
|
|
DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_UNKNOWN
|
1440 |
|
|
};
|
1441 |
|
|
|
1442 |
|
|
typedef struct gfc_array_ref
|
1443 |
|
|
{
|
1444 |
|
|
ar_type type;
|
1445 |
|
|
int dimen; /* # of components in the reference */
|
1446 |
|
|
locus where;
|
1447 |
|
|
gfc_array_spec *as;
|
1448 |
|
|
|
1449 |
|
|
locus c_where[GFC_MAX_DIMENSIONS]; /* All expressions can be NULL */
|
1450 |
|
|
struct gfc_expr *start[GFC_MAX_DIMENSIONS], *end[GFC_MAX_DIMENSIONS],
|
1451 |
|
|
*stride[GFC_MAX_DIMENSIONS];
|
1452 |
|
|
|
1453 |
|
|
enum gfc_array_ref_dimen_type dimen_type[GFC_MAX_DIMENSIONS];
|
1454 |
|
|
|
1455 |
|
|
struct gfc_expr *offset;
|
1456 |
|
|
}
|
1457 |
|
|
gfc_array_ref;
|
1458 |
|
|
|
1459 |
|
|
#define gfc_get_array_ref() XCNEW (gfc_array_ref)
|
1460 |
|
|
|
1461 |
|
|
|
1462 |
|
|
/* Component reference nodes. A variable is stored as an expression
|
1463 |
|
|
node that points to the base symbol. After that, a singly linked
|
1464 |
|
|
list of component reference nodes gives the variable's complete
|
1465 |
|
|
resolution. The array_ref component may be present and comes
|
1466 |
|
|
before the component component. */
|
1467 |
|
|
|
1468 |
|
|
typedef enum
|
1469 |
|
|
{ REF_ARRAY, REF_COMPONENT, REF_SUBSTRING }
|
1470 |
|
|
ref_type;
|
1471 |
|
|
|
1472 |
|
|
typedef struct gfc_ref
|
1473 |
|
|
{
|
1474 |
|
|
ref_type type;
|
1475 |
|
|
|
1476 |
|
|
union
|
1477 |
|
|
{
|
1478 |
|
|
struct gfc_array_ref ar;
|
1479 |
|
|
|
1480 |
|
|
struct
|
1481 |
|
|
{
|
1482 |
|
|
gfc_component *component;
|
1483 |
|
|
gfc_symbol *sym;
|
1484 |
|
|
}
|
1485 |
|
|
c;
|
1486 |
|
|
|
1487 |
|
|
struct
|
1488 |
|
|
{
|
1489 |
|
|
struct gfc_expr *start, *end; /* Substring */
|
1490 |
|
|
gfc_charlen *length;
|
1491 |
|
|
}
|
1492 |
|
|
ss;
|
1493 |
|
|
|
1494 |
|
|
}
|
1495 |
|
|
u;
|
1496 |
|
|
|
1497 |
|
|
struct gfc_ref *next;
|
1498 |
|
|
}
|
1499 |
|
|
gfc_ref;
|
1500 |
|
|
|
1501 |
|
|
#define gfc_get_ref() XCNEW (gfc_ref)
|
1502 |
|
|
|
1503 |
|
|
|
1504 |
|
|
/* Structures representing intrinsic symbols and their arguments lists. */
|
1505 |
|
|
typedef struct gfc_intrinsic_arg
|
1506 |
|
|
{
|
1507 |
|
|
char name[GFC_MAX_SYMBOL_LEN + 1];
|
1508 |
|
|
|
1509 |
|
|
gfc_typespec ts;
|
1510 |
|
|
int optional;
|
1511 |
|
|
ENUM_BITFIELD (sym_intent) intent:2;
|
1512 |
|
|
gfc_actual_arglist *actual;
|
1513 |
|
|
|
1514 |
|
|
struct gfc_intrinsic_arg *next;
|
1515 |
|
|
|
1516 |
|
|
}
|
1517 |
|
|
gfc_intrinsic_arg;
|
1518 |
|
|
|
1519 |
|
|
|
1520 |
|
|
/* Specifies the various kinds of check functions used to verify the
|
1521 |
|
|
argument lists of intrinsic functions. fX with X an integer refer
|
1522 |
|
|
to check functions of intrinsics with X arguments. f1m is used for
|
1523 |
|
|
the MAX and MIN intrinsics which can have an arbitrary number of
|
1524 |
|
|
arguments, f3ml is used for the MINLOC and MAXLOC intrinsics as
|
1525 |
|
|
these have special semantics. */
|
1526 |
|
|
|
1527 |
|
|
typedef union
|
1528 |
|
|
{
|
1529 |
|
|
gfc_try (*f0)(void);
|
1530 |
|
|
gfc_try (*f1)(struct gfc_expr *);
|
1531 |
|
|
gfc_try (*f1m)(gfc_actual_arglist *);
|
1532 |
|
|
gfc_try (*f2)(struct gfc_expr *, struct gfc_expr *);
|
1533 |
|
|
gfc_try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
|
1534 |
|
|
gfc_try (*f3ml)(gfc_actual_arglist *);
|
1535 |
|
|
gfc_try (*f3red)(gfc_actual_arglist *);
|
1536 |
|
|
gfc_try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
1537 |
|
|
struct gfc_expr *);
|
1538 |
|
|
gfc_try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
1539 |
|
|
struct gfc_expr *, struct gfc_expr *);
|
1540 |
|
|
}
|
1541 |
|
|
gfc_check_f;
|
1542 |
|
|
|
1543 |
|
|
/* Like gfc_check_f, these specify the type of the simplification
|
1544 |
|
|
function associated with an intrinsic. The fX are just like in
|
1545 |
|
|
gfc_check_f. cc is used for type conversion functions. */
|
1546 |
|
|
|
1547 |
|
|
typedef union
|
1548 |
|
|
{
|
1549 |
|
|
struct gfc_expr *(*f0)(void);
|
1550 |
|
|
struct gfc_expr *(*f1)(struct gfc_expr *);
|
1551 |
|
|
struct gfc_expr *(*f2)(struct gfc_expr *, struct gfc_expr *);
|
1552 |
|
|
struct gfc_expr *(*f3)(struct gfc_expr *, struct gfc_expr *,
|
1553 |
|
|
struct gfc_expr *);
|
1554 |
|
|
struct gfc_expr *(*f4)(struct gfc_expr *, struct gfc_expr *,
|
1555 |
|
|
struct gfc_expr *, struct gfc_expr *);
|
1556 |
|
|
struct gfc_expr *(*f5)(struct gfc_expr *, struct gfc_expr *,
|
1557 |
|
|
struct gfc_expr *, struct gfc_expr *,
|
1558 |
|
|
struct gfc_expr *);
|
1559 |
|
|
struct gfc_expr *(*cc)(struct gfc_expr *, bt, int);
|
1560 |
|
|
}
|
1561 |
|
|
gfc_simplify_f;
|
1562 |
|
|
|
1563 |
|
|
/* Again like gfc_check_f, these specify the type of the resolution
|
1564 |
|
|
function associated with an intrinsic. The fX are just like in
|
1565 |
|
|
gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort(). */
|
1566 |
|
|
|
1567 |
|
|
typedef union
|
1568 |
|
|
{
|
1569 |
|
|
void (*f0)(struct gfc_expr *);
|
1570 |
|
|
void (*f1)(struct gfc_expr *, struct gfc_expr *);
|
1571 |
|
|
void (*f1m)(struct gfc_expr *, struct gfc_actual_arglist *);
|
1572 |
|
|
void (*f2)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
|
1573 |
|
|
void (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
1574 |
|
|
struct gfc_expr *);
|
1575 |
|
|
void (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
1576 |
|
|
struct gfc_expr *, struct gfc_expr *);
|
1577 |
|
|
void (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
|
1578 |
|
|
struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
|
1579 |
|
|
void (*s1)(struct gfc_code *);
|
1580 |
|
|
}
|
1581 |
|
|
gfc_resolve_f;
|
1582 |
|
|
|
1583 |
|
|
|
1584 |
|
|
typedef struct gfc_intrinsic_sym
|
1585 |
|
|
{
|
1586 |
|
|
const char *name, *lib_name;
|
1587 |
|
|
gfc_intrinsic_arg *formal;
|
1588 |
|
|
gfc_typespec ts;
|
1589 |
|
|
unsigned elemental:1, inquiry:1, transformational:1, pure:1,
|
1590 |
|
|
generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1;
|
1591 |
|
|
|
1592 |
|
|
int standard;
|
1593 |
|
|
|
1594 |
|
|
gfc_simplify_f simplify;
|
1595 |
|
|
gfc_check_f check;
|
1596 |
|
|
gfc_resolve_f resolve;
|
1597 |
|
|
struct gfc_intrinsic_sym *specific_head, *next;
|
1598 |
|
|
gfc_isym_id id;
|
1599 |
|
|
|
1600 |
|
|
}
|
1601 |
|
|
gfc_intrinsic_sym;
|
1602 |
|
|
|
1603 |
|
|
|
1604 |
|
|
typedef struct gfc_class_esym_list
|
1605 |
|
|
{
|
1606 |
|
|
gfc_symbol *derived;
|
1607 |
|
|
gfc_symbol *esym;
|
1608 |
|
|
struct gfc_expr *hash_value;
|
1609 |
|
|
struct gfc_class_esym_list *next;
|
1610 |
|
|
}
|
1611 |
|
|
gfc_class_esym_list;
|
1612 |
|
|
|
1613 |
|
|
#define gfc_get_class_esym_list() XCNEW (gfc_class_esym_list)
|
1614 |
|
|
|
1615 |
|
|
/* Expression nodes. The expression node types deserve explanations,
|
1616 |
|
|
since the last couple can be easily misconstrued:
|
1617 |
|
|
|
1618 |
|
|
EXPR_OP Operator node pointing to one or two other nodes
|
1619 |
|
|
EXPR_FUNCTION Function call, symbol points to function's name
|
1620 |
|
|
EXPR_CONSTANT A scalar constant: Logical, String, Real, Int or Complex
|
1621 |
|
|
EXPR_VARIABLE An Lvalue with a root symbol and possible reference list
|
1622 |
|
|
which expresses structure, array and substring refs.
|
1623 |
|
|
EXPR_NULL The NULL pointer value (which also has a basic type).
|
1624 |
|
|
EXPR_SUBSTRING A substring of a constant string
|
1625 |
|
|
EXPR_STRUCTURE A structure constructor
|
1626 |
|
|
EXPR_ARRAY An array constructor.
|
1627 |
|
|
EXPR_COMPCALL Function (or subroutine) call of a procedure pointer
|
1628 |
|
|
component or type-bound procedure. */
|
1629 |
|
|
|
1630 |
|
|
#include <gmp.h>
|
1631 |
|
|
#include <mpfr.h>
|
1632 |
|
|
#include <mpc.h>
|
1633 |
|
|
#define GFC_RND_MODE GMP_RNDN
|
1634 |
|
|
#define GFC_MPC_RND_MODE MPC_RNDNN
|
1635 |
|
|
|
1636 |
|
|
typedef struct gfc_expr
|
1637 |
|
|
{
|
1638 |
|
|
expr_t expr_type;
|
1639 |
|
|
|
1640 |
|
|
gfc_typespec ts; /* These two refer to the overall expression */
|
1641 |
|
|
|
1642 |
|
|
int rank;
|
1643 |
|
|
mpz_t *shape; /* Can be NULL if shape is unknown at compile time */
|
1644 |
|
|
|
1645 |
|
|
/* Nonnull for functions and structure constructors, may also used to hold the
|
1646 |
|
|
base-object for component calls. */
|
1647 |
|
|
gfc_symtree *symtree;
|
1648 |
|
|
|
1649 |
|
|
gfc_ref *ref;
|
1650 |
|
|
|
1651 |
|
|
locus where;
|
1652 |
|
|
|
1653 |
|
|
/* True if the expression is a call to a function that returns an array,
|
1654 |
|
|
and if we have decided not to allocate temporary data for that array.
|
1655 |
|
|
is_boz is true if the integer is regarded as BOZ bitpatten and is_snan
|
1656 |
|
|
denotes a signalling not-a-number. */
|
1657 |
|
|
unsigned int inline_noncopying_intrinsic : 1, is_boz : 1, is_snan : 1;
|
1658 |
|
|
|
1659 |
|
|
/* Sometimes, when an error has been emitted, it is necessary to prevent
|
1660 |
|
|
it from recurring. */
|
1661 |
|
|
unsigned int error : 1;
|
1662 |
|
|
|
1663 |
|
|
/* Mark and expression where a user operator has been substituted by
|
1664 |
|
|
a function call in interface.c(gfc_extend_expr). */
|
1665 |
|
|
unsigned int user_operator : 1;
|
1666 |
|
|
|
1667 |
|
|
/* Used to quickly find a given constructor by its offset. */
|
1668 |
|
|
splay_tree con_by_offset;
|
1669 |
|
|
|
1670 |
|
|
/* If an expression comes from a Hollerith constant or compile-time
|
1671 |
|
|
evaluation of a transfer statement, it may have a prescribed target-
|
1672 |
|
|
memory representation, and these cannot always be backformed from
|
1673 |
|
|
the value. */
|
1674 |
|
|
struct
|
1675 |
|
|
{
|
1676 |
|
|
int length;
|
1677 |
|
|
char *string;
|
1678 |
|
|
}
|
1679 |
|
|
representation;
|
1680 |
|
|
|
1681 |
|
|
union
|
1682 |
|
|
{
|
1683 |
|
|
int logical;
|
1684 |
|
|
|
1685 |
|
|
io_kind iokind;
|
1686 |
|
|
|
1687 |
|
|
mpz_t integer;
|
1688 |
|
|
|
1689 |
|
|
mpfr_t real;
|
1690 |
|
|
|
1691 |
|
|
mpc_t complex;
|
1692 |
|
|
|
1693 |
|
|
struct
|
1694 |
|
|
{
|
1695 |
|
|
gfc_intrinsic_op op;
|
1696 |
|
|
gfc_user_op *uop;
|
1697 |
|
|
struct gfc_expr *op1, *op2;
|
1698 |
|
|
}
|
1699 |
|
|
op;
|
1700 |
|
|
|
1701 |
|
|
struct
|
1702 |
|
|
{
|
1703 |
|
|
gfc_actual_arglist *actual;
|
1704 |
|
|
const char *name; /* Points to the ultimate name of the function */
|
1705 |
|
|
gfc_intrinsic_sym *isym;
|
1706 |
|
|
gfc_symbol *esym;
|
1707 |
|
|
gfc_class_esym_list *class_esym;
|
1708 |
|
|
}
|
1709 |
|
|
function;
|
1710 |
|
|
|
1711 |
|
|
struct
|
1712 |
|
|
{
|
1713 |
|
|
gfc_actual_arglist* actual;
|
1714 |
|
|
const char* name;
|
1715 |
|
|
/* Base-object, whose component was called. NULL means that it should
|
1716 |
|
|
be taken from symtree/ref. */
|
1717 |
|
|
struct gfc_expr* base_object;
|
1718 |
|
|
gfc_typebound_proc* tbp; /* Should overlap with esym. */
|
1719 |
|
|
|
1720 |
|
|
/* For type-bound operators, we want to call PASS procedures but already
|
1721 |
|
|
have the full arglist; mark this, so that it is not extended by the
|
1722 |
|
|
PASS argument. */
|
1723 |
|
|
unsigned ignore_pass:1;
|
1724 |
|
|
|
1725 |
|
|
/* Do assign-calls rather than calls, that is appropriate dependency
|
1726 |
|
|
checking. */
|
1727 |
|
|
unsigned assign:1;
|
1728 |
|
|
}
|
1729 |
|
|
compcall;
|
1730 |
|
|
|
1731 |
|
|
struct
|
1732 |
|
|
{
|
1733 |
|
|
int length;
|
1734 |
|
|
gfc_char_t *string;
|
1735 |
|
|
}
|
1736 |
|
|
character;
|
1737 |
|
|
|
1738 |
|
|
struct gfc_constructor *constructor;
|
1739 |
|
|
}
|
1740 |
|
|
value;
|
1741 |
|
|
|
1742 |
|
|
}
|
1743 |
|
|
gfc_expr;
|
1744 |
|
|
|
1745 |
|
|
|
1746 |
|
|
#define gfc_get_shape(rank) ((mpz_t *) gfc_getmem((rank)*sizeof(mpz_t)))
|
1747 |
|
|
|
1748 |
|
|
/* Structures for information associated with different kinds of
|
1749 |
|
|
numbers. The first set of integer parameters define all there is
|
1750 |
|
|
to know about a particular kind. The rest of the elements are
|
1751 |
|
|
computed from the first elements. */
|
1752 |
|
|
|
1753 |
|
|
typedef struct
|
1754 |
|
|
{
|
1755 |
|
|
/* Values really representable by the target. */
|
1756 |
|
|
mpz_t huge, pedantic_min_int, min_int;
|
1757 |
|
|
|
1758 |
|
|
int kind, radix, digits, bit_size, range;
|
1759 |
|
|
|
1760 |
|
|
/* True if the C type of the given name maps to this precision.
|
1761 |
|
|
Note that more than one bit can be set. */
|
1762 |
|
|
unsigned int c_char : 1;
|
1763 |
|
|
unsigned int c_short : 1;
|
1764 |
|
|
unsigned int c_int : 1;
|
1765 |
|
|
unsigned int c_long : 1;
|
1766 |
|
|
unsigned int c_long_long : 1;
|
1767 |
|
|
}
|
1768 |
|
|
gfc_integer_info;
|
1769 |
|
|
|
1770 |
|
|
extern gfc_integer_info gfc_integer_kinds[];
|
1771 |
|
|
|
1772 |
|
|
|
1773 |
|
|
typedef struct
|
1774 |
|
|
{
|
1775 |
|
|
int kind, bit_size;
|
1776 |
|
|
|
1777 |
|
|
/* True if the C++ type bool, C99 type _Bool, maps to this precision. */
|
1778 |
|
|
unsigned int c_bool : 1;
|
1779 |
|
|
}
|
1780 |
|
|
gfc_logical_info;
|
1781 |
|
|
|
1782 |
|
|
extern gfc_logical_info gfc_logical_kinds[];
|
1783 |
|
|
|
1784 |
|
|
|
1785 |
|
|
typedef struct
|
1786 |
|
|
{
|
1787 |
|
|
mpfr_t epsilon, huge, tiny, subnormal;
|
1788 |
|
|
int kind, radix, digits, min_exponent, max_exponent;
|
1789 |
|
|
int range, precision;
|
1790 |
|
|
|
1791 |
|
|
/* The precision of the type as reported by GET_MODE_PRECISION. */
|
1792 |
|
|
int mode_precision;
|
1793 |
|
|
|
1794 |
|
|
/* True if the C type of the given name maps to this precision.
|
1795 |
|
|
Note that more than one bit can be set. */
|
1796 |
|
|
unsigned int c_float : 1;
|
1797 |
|
|
unsigned int c_double : 1;
|
1798 |
|
|
unsigned int c_long_double : 1;
|
1799 |
|
|
}
|
1800 |
|
|
gfc_real_info;
|
1801 |
|
|
|
1802 |
|
|
extern gfc_real_info gfc_real_kinds[];
|
1803 |
|
|
|
1804 |
|
|
typedef struct
|
1805 |
|
|
{
|
1806 |
|
|
int kind, bit_size;
|
1807 |
|
|
const char *name;
|
1808 |
|
|
}
|
1809 |
|
|
gfc_character_info;
|
1810 |
|
|
|
1811 |
|
|
extern gfc_character_info gfc_character_kinds[];
|
1812 |
|
|
|
1813 |
|
|
|
1814 |
|
|
/* Equivalence structures. Equivalent lvalues are linked along the
|
1815 |
|
|
*eq pointer, equivalence sets are strung along the *next node. */
|
1816 |
|
|
typedef struct gfc_equiv
|
1817 |
|
|
{
|
1818 |
|
|
struct gfc_equiv *next, *eq;
|
1819 |
|
|
gfc_expr *expr;
|
1820 |
|
|
const char *module;
|
1821 |
|
|
int used;
|
1822 |
|
|
}
|
1823 |
|
|
gfc_equiv;
|
1824 |
|
|
|
1825 |
|
|
#define gfc_get_equiv() XCNEW (gfc_equiv)
|
1826 |
|
|
|
1827 |
|
|
/* Holds a single equivalence member after processing. */
|
1828 |
|
|
typedef struct gfc_equiv_info
|
1829 |
|
|
{
|
1830 |
|
|
gfc_symbol *sym;
|
1831 |
|
|
HOST_WIDE_INT offset;
|
1832 |
|
|
HOST_WIDE_INT length;
|
1833 |
|
|
struct gfc_equiv_info *next;
|
1834 |
|
|
} gfc_equiv_info;
|
1835 |
|
|
|
1836 |
|
|
/* Holds equivalence groups, after they have been processed. */
|
1837 |
|
|
typedef struct gfc_equiv_list
|
1838 |
|
|
{
|
1839 |
|
|
gfc_equiv_info *equiv;
|
1840 |
|
|
struct gfc_equiv_list *next;
|
1841 |
|
|
} gfc_equiv_list;
|
1842 |
|
|
|
1843 |
|
|
/* gfc_case stores the selector list of a case statement. The *low
|
1844 |
|
|
and *high pointers can point to the same expression in the case of
|
1845 |
|
|
a single value. If *high is NULL, the selection is from *low
|
1846 |
|
|
upwards, if *low is NULL the selection is *high downwards.
|
1847 |
|
|
|
1848 |
|
|
This structure has separate fields to allow single and double linked
|
1849 |
|
|
lists of CASEs at the same time. The singe linked list along the NEXT
|
1850 |
|
|
field is a list of cases for a single CASE label. The double linked
|
1851 |
|
|
list along the LEFT/RIGHT fields is used to detect overlap and to
|
1852 |
|
|
build a table of the cases for SELECT constructs with a CHARACTER
|
1853 |
|
|
case expression. */
|
1854 |
|
|
|
1855 |
|
|
typedef struct gfc_case
|
1856 |
|
|
{
|
1857 |
|
|
/* Where we saw this case. */
|
1858 |
|
|
locus where;
|
1859 |
|
|
int n;
|
1860 |
|
|
|
1861 |
|
|
/* Case range values. If (low == high), it's a single value. If one of
|
1862 |
|
|
the labels is NULL, it's an unbounded case. If both are NULL, this
|
1863 |
|
|
represents the default case. */
|
1864 |
|
|
gfc_expr *low, *high;
|
1865 |
|
|
|
1866 |
|
|
/* Only used for SELECT TYPE. */
|
1867 |
|
|
gfc_typespec ts;
|
1868 |
|
|
|
1869 |
|
|
/* Next case label in the list of cases for a single CASE label. */
|
1870 |
|
|
struct gfc_case *next;
|
1871 |
|
|
|
1872 |
|
|
/* Used for detecting overlap, and for code generation. */
|
1873 |
|
|
struct gfc_case *left, *right;
|
1874 |
|
|
|
1875 |
|
|
/* True if this case label can never be matched. */
|
1876 |
|
|
int unreachable;
|
1877 |
|
|
}
|
1878 |
|
|
gfc_case;
|
1879 |
|
|
|
1880 |
|
|
#define gfc_get_case() XCNEW (gfc_case)
|
1881 |
|
|
|
1882 |
|
|
|
1883 |
|
|
typedef struct
|
1884 |
|
|
{
|
1885 |
|
|
gfc_expr *var, *start, *end, *step;
|
1886 |
|
|
}
|
1887 |
|
|
gfc_iterator;
|
1888 |
|
|
|
1889 |
|
|
#define gfc_get_iterator() XCNEW (gfc_iterator)
|
1890 |
|
|
|
1891 |
|
|
|
1892 |
|
|
/* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements. */
|
1893 |
|
|
|
1894 |
|
|
typedef struct gfc_alloc
|
1895 |
|
|
{
|
1896 |
|
|
gfc_expr *expr;
|
1897 |
|
|
struct gfc_alloc *next;
|
1898 |
|
|
}
|
1899 |
|
|
gfc_alloc;
|
1900 |
|
|
|
1901 |
|
|
#define gfc_get_alloc() XCNEW (gfc_alloc)
|
1902 |
|
|
|
1903 |
|
|
|
1904 |
|
|
typedef struct
|
1905 |
|
|
{
|
1906 |
|
|
gfc_expr *unit, *file, *status, *access, *form, *recl,
|
1907 |
|
|
*blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
|
1908 |
|
|
*decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit;
|
1909 |
|
|
gfc_st_label *err;
|
1910 |
|
|
}
|
1911 |
|
|
gfc_open;
|
1912 |
|
|
|
1913 |
|
|
|
1914 |
|
|
typedef struct
|
1915 |
|
|
{
|
1916 |
|
|
gfc_expr *unit, *status, *iostat, *iomsg;
|
1917 |
|
|
gfc_st_label *err;
|
1918 |
|
|
}
|
1919 |
|
|
gfc_close;
|
1920 |
|
|
|
1921 |
|
|
|
1922 |
|
|
typedef struct
|
1923 |
|
|
{
|
1924 |
|
|
gfc_expr *unit, *iostat, *iomsg;
|
1925 |
|
|
gfc_st_label *err;
|
1926 |
|
|
}
|
1927 |
|
|
gfc_filepos;
|
1928 |
|
|
|
1929 |
|
|
|
1930 |
|
|
typedef struct
|
1931 |
|
|
{
|
1932 |
|
|
gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
|
1933 |
|
|
*name, *access, *sequential, *direct, *form, *formatted,
|
1934 |
|
|
*unformatted, *recl, *nextrec, *blank, *position, *action, *read,
|
1935 |
|
|
*write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
|
1936 |
|
|
*asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id;
|
1937 |
|
|
|
1938 |
|
|
gfc_st_label *err;
|
1939 |
|
|
|
1940 |
|
|
}
|
1941 |
|
|
gfc_inquire;
|
1942 |
|
|
|
1943 |
|
|
|
1944 |
|
|
typedef struct
|
1945 |
|
|
{
|
1946 |
|
|
gfc_expr *unit, *iostat, *iomsg, *id;
|
1947 |
|
|
gfc_st_label *err, *end, *eor;
|
1948 |
|
|
}
|
1949 |
|
|
gfc_wait;
|
1950 |
|
|
|
1951 |
|
|
|
1952 |
|
|
typedef struct
|
1953 |
|
|
{
|
1954 |
|
|
gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
|
1955 |
|
|
*id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
|
1956 |
|
|
*sign, *extra_comma;
|
1957 |
|
|
|
1958 |
|
|
gfc_symbol *namelist;
|
1959 |
|
|
/* A format_label of `format_asterisk' indicates the "*" format */
|
1960 |
|
|
gfc_st_label *format_label;
|
1961 |
|
|
gfc_st_label *err, *end, *eor;
|
1962 |
|
|
|
1963 |
|
|
locus eor_where, end_where, err_where;
|
1964 |
|
|
}
|
1965 |
|
|
gfc_dt;
|
1966 |
|
|
|
1967 |
|
|
|
1968 |
|
|
typedef struct gfc_forall_iterator
|
1969 |
|
|
{
|
1970 |
|
|
gfc_expr *var, *start, *end, *stride;
|
1971 |
|
|
struct gfc_forall_iterator *next;
|
1972 |
|
|
}
|
1973 |
|
|
gfc_forall_iterator;
|
1974 |
|
|
|
1975 |
|
|
|
1976 |
|
|
/* Executable statements that fill gfc_code structures. */
|
1977 |
|
|
typedef enum
|
1978 |
|
|
{
|
1979 |
|
|
EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN,
|
1980 |
|
|
EXEC_POINTER_ASSIGN,
|
1981 |
|
|
EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN,
|
1982 |
|
|
EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
|
1983 |
|
|
EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_BLOCK,
|
1984 |
|
|
EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC,
|
1985 |
|
|
EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE, EXEC_SELECT_TYPE,
|
1986 |
|
|
EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
|
1987 |
|
|
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
|
1988 |
|
|
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
|
1989 |
|
|
EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
|
1990 |
|
|
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
|
1991 |
|
|
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
|
1992 |
|
|
EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
|
1993 |
|
|
EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
|
1994 |
|
|
EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT
|
1995 |
|
|
}
|
1996 |
|
|
gfc_exec_op;
|
1997 |
|
|
|
1998 |
|
|
typedef struct gfc_code
|
1999 |
|
|
{
|
2000 |
|
|
gfc_exec_op op;
|
2001 |
|
|
|
2002 |
|
|
struct gfc_code *block, *next;
|
2003 |
|
|
locus loc;
|
2004 |
|
|
|
2005 |
|
|
gfc_st_label *here, *label1, *label2, *label3;
|
2006 |
|
|
gfc_symtree *symtree;
|
2007 |
|
|
gfc_expr *expr1, *expr2, *expr3;
|
2008 |
|
|
/* A name isn't sufficient to identify a subroutine, we need the actual
|
2009 |
|
|
symbol for the interface definition.
|
2010 |
|
|
const char *sub_name; */
|
2011 |
|
|
gfc_symbol *resolved_sym;
|
2012 |
|
|
gfc_intrinsic_sym *resolved_isym;
|
2013 |
|
|
|
2014 |
|
|
union
|
2015 |
|
|
{
|
2016 |
|
|
gfc_actual_arglist *actual;
|
2017 |
|
|
gfc_case *case_list;
|
2018 |
|
|
gfc_iterator *iterator;
|
2019 |
|
|
|
2020 |
|
|
struct
|
2021 |
|
|
{
|
2022 |
|
|
gfc_typespec ts;
|
2023 |
|
|
gfc_alloc *list;
|
2024 |
|
|
}
|
2025 |
|
|
alloc;
|
2026 |
|
|
|
2027 |
|
|
gfc_open *open;
|
2028 |
|
|
gfc_close *close;
|
2029 |
|
|
gfc_filepos *filepos;
|
2030 |
|
|
gfc_inquire *inquire;
|
2031 |
|
|
gfc_wait *wait;
|
2032 |
|
|
gfc_dt *dt;
|
2033 |
|
|
gfc_forall_iterator *forall_iterator;
|
2034 |
|
|
struct gfc_code *whichloop;
|
2035 |
|
|
int stop_code;
|
2036 |
|
|
gfc_entry_list *entry;
|
2037 |
|
|
gfc_omp_clauses *omp_clauses;
|
2038 |
|
|
const char *omp_name;
|
2039 |
|
|
gfc_namelist *omp_namelist;
|
2040 |
|
|
bool omp_bool;
|
2041 |
|
|
gfc_namespace *ns;
|
2042 |
|
|
}
|
2043 |
|
|
ext; /* Points to additional structures required by statement */
|
2044 |
|
|
|
2045 |
|
|
/* Backend_decl is used for cycle and break labels in do loops, and
|
2046 |
|
|
probably for other constructs as well, once we translate them. */
|
2047 |
|
|
tree backend_decl;
|
2048 |
|
|
}
|
2049 |
|
|
gfc_code;
|
2050 |
|
|
|
2051 |
|
|
|
2052 |
|
|
/* Storage for DATA statements. */
|
2053 |
|
|
typedef struct gfc_data_variable
|
2054 |
|
|
{
|
2055 |
|
|
gfc_expr *expr;
|
2056 |
|
|
gfc_iterator iter;
|
2057 |
|
|
struct gfc_data_variable *list, *next;
|
2058 |
|
|
}
|
2059 |
|
|
gfc_data_variable;
|
2060 |
|
|
|
2061 |
|
|
|
2062 |
|
|
typedef struct gfc_data_value
|
2063 |
|
|
{
|
2064 |
|
|
mpz_t repeat;
|
2065 |
|
|
gfc_expr *expr;
|
2066 |
|
|
struct gfc_data_value *next;
|
2067 |
|
|
}
|
2068 |
|
|
gfc_data_value;
|
2069 |
|
|
|
2070 |
|
|
|
2071 |
|
|
typedef struct gfc_data
|
2072 |
|
|
{
|
2073 |
|
|
gfc_data_variable *var;
|
2074 |
|
|
gfc_data_value *value;
|
2075 |
|
|
locus where;
|
2076 |
|
|
|
2077 |
|
|
struct gfc_data *next;
|
2078 |
|
|
}
|
2079 |
|
|
gfc_data;
|
2080 |
|
|
|
2081 |
|
|
|
2082 |
|
|
/* Structure for holding compile options */
|
2083 |
|
|
typedef struct
|
2084 |
|
|
{
|
2085 |
|
|
char *module_dir;
|
2086 |
|
|
gfc_source_form source_form;
|
2087 |
|
|
/* Maximum line lengths in fixed- and free-form source, respectively.
|
2088 |
|
|
When fixed_line_length or free_line_length are 0, the whole line is used,
|
2089 |
|
|
regardless of length.
|
2090 |
|
|
|
2091 |
|
|
If the user requests a fixed_line_length <7 then gfc_init_options()
|
2092 |
|
|
emits a fatal error. */
|
2093 |
|
|
int fixed_line_length;
|
2094 |
|
|
int free_line_length;
|
2095 |
|
|
/* Maximum number of continuation lines in fixed- and free-form source,
|
2096 |
|
|
respectively. */
|
2097 |
|
|
int max_continue_fixed;
|
2098 |
|
|
int max_continue_free;
|
2099 |
|
|
int max_identifier_length;
|
2100 |
|
|
int dump_parse_tree;
|
2101 |
|
|
|
2102 |
|
|
int warn_aliasing;
|
2103 |
|
|
int warn_ampersand;
|
2104 |
|
|
int warn_conversion;
|
2105 |
|
|
int warn_implicit_interface;
|
2106 |
|
|
int warn_implicit_procedure;
|
2107 |
|
|
int warn_line_truncation;
|
2108 |
|
|
int warn_surprising;
|
2109 |
|
|
int warn_tabs;
|
2110 |
|
|
int warn_underflow;
|
2111 |
|
|
int warn_intrinsic_shadow;
|
2112 |
|
|
int warn_intrinsics_std;
|
2113 |
|
|
int warn_character_truncation;
|
2114 |
|
|
int warn_array_temp;
|
2115 |
|
|
int warn_align_commons;
|
2116 |
|
|
int max_errors;
|
2117 |
|
|
|
2118 |
|
|
int flag_all_intrinsics;
|
2119 |
|
|
int flag_default_double;
|
2120 |
|
|
int flag_default_integer;
|
2121 |
|
|
int flag_default_real;
|
2122 |
|
|
int flag_dollar_ok;
|
2123 |
|
|
int flag_underscoring;
|
2124 |
|
|
int flag_second_underscore;
|
2125 |
|
|
int flag_implicit_none;
|
2126 |
|
|
int flag_max_stack_var_size;
|
2127 |
|
|
int flag_max_array_constructor;
|
2128 |
|
|
int flag_range_check;
|
2129 |
|
|
int flag_pack_derived;
|
2130 |
|
|
int flag_repack_arrays;
|
2131 |
|
|
int flag_preprocessed;
|
2132 |
|
|
int flag_f2c;
|
2133 |
|
|
int flag_automatic;
|
2134 |
|
|
int flag_backslash;
|
2135 |
|
|
int flag_backtrace;
|
2136 |
|
|
int flag_allow_leading_underscore;
|
2137 |
|
|
int flag_dump_core;
|
2138 |
|
|
int flag_external_blas;
|
2139 |
|
|
int blas_matmul_limit;
|
2140 |
|
|
int flag_cray_pointer;
|
2141 |
|
|
int flag_d_lines;
|
2142 |
|
|
int flag_openmp;
|
2143 |
|
|
int flag_sign_zero;
|
2144 |
|
|
int flag_module_private;
|
2145 |
|
|
int flag_recursive;
|
2146 |
|
|
int flag_init_local_zero;
|
2147 |
|
|
int flag_init_integer;
|
2148 |
|
|
int flag_init_integer_value;
|
2149 |
|
|
int flag_init_real;
|
2150 |
|
|
int flag_init_logical;
|
2151 |
|
|
int flag_init_character;
|
2152 |
|
|
char flag_init_character_value;
|
2153 |
|
|
int flag_align_commons;
|
2154 |
|
|
int flag_whole_file;
|
2155 |
|
|
int flag_protect_parens;
|
2156 |
|
|
|
2157 |
|
|
int fpe;
|
2158 |
|
|
int rtcheck;
|
2159 |
|
|
|
2160 |
|
|
int warn_std;
|
2161 |
|
|
int allow_std;
|
2162 |
|
|
int convert;
|
2163 |
|
|
int record_marker;
|
2164 |
|
|
int max_subrecord_length;
|
2165 |
|
|
}
|
2166 |
|
|
gfc_option_t;
|
2167 |
|
|
|
2168 |
|
|
extern gfc_option_t gfc_option;
|
2169 |
|
|
|
2170 |
|
|
/* Constructor nodes for array and structure constructors. */
|
2171 |
|
|
typedef struct gfc_constructor
|
2172 |
|
|
{
|
2173 |
|
|
gfc_expr *expr;
|
2174 |
|
|
gfc_iterator *iterator;
|
2175 |
|
|
locus where;
|
2176 |
|
|
struct gfc_constructor *next;
|
2177 |
|
|
struct
|
2178 |
|
|
{
|
2179 |
|
|
mpz_t offset; /* Record the offset of array element which appears in
|
2180 |
|
|
data statement like "data a(5)/4/". */
|
2181 |
|
|
gfc_component *component; /* Record the component being initialized. */
|
2182 |
|
|
}
|
2183 |
|
|
n;
|
2184 |
|
|
mpz_t repeat; /* Record the repeat number of initial values in data
|
2185 |
|
|
statement like "data a/5*10/". */
|
2186 |
|
|
}
|
2187 |
|
|
gfc_constructor;
|
2188 |
|
|
|
2189 |
|
|
|
2190 |
|
|
typedef struct iterator_stack
|
2191 |
|
|
{
|
2192 |
|
|
gfc_symtree *variable;
|
2193 |
|
|
mpz_t value;
|
2194 |
|
|
struct iterator_stack *prev;
|
2195 |
|
|
}
|
2196 |
|
|
iterator_stack;
|
2197 |
|
|
extern iterator_stack *iter_stack;
|
2198 |
|
|
|
2199 |
|
|
|
2200 |
|
|
/* Used for (possibly nested) SELECT TYPE statements. */
|
2201 |
|
|
typedef struct gfc_select_type_stack
|
2202 |
|
|
{
|
2203 |
|
|
gfc_symbol *selector; /* Current selector variable. */
|
2204 |
|
|
gfc_symtree *tmp; /* Current temporary variable. */
|
2205 |
|
|
struct gfc_select_type_stack *prev; /* Previous element on stack. */
|
2206 |
|
|
}
|
2207 |
|
|
gfc_select_type_stack;
|
2208 |
|
|
extern gfc_select_type_stack *select_type_stack;
|
2209 |
|
|
#define gfc_get_select_type_stack() XCNEW (gfc_select_type_stack)
|
2210 |
|
|
|
2211 |
|
|
|
2212 |
|
|
/* Node in the linked list used for storing finalizer procedures. */
|
2213 |
|
|
|
2214 |
|
|
typedef struct gfc_finalizer
|
2215 |
|
|
{
|
2216 |
|
|
struct gfc_finalizer* next;
|
2217 |
|
|
locus where; /* Where the FINAL declaration occurred. */
|
2218 |
|
|
|
2219 |
|
|
/* Up to resolution, we want the gfc_symbol, there we lookup the corresponding
|
2220 |
|
|
symtree and later need only that. This way, we can access and call the
|
2221 |
|
|
finalizers from every context as they should be "always accessible". I
|
2222 |
|
|
don't make this a union because we need the information whether proc_sym is
|
2223 |
|
|
still referenced or not for dereferencing it on deleting a gfc_finalizer
|
2224 |
|
|
structure. */
|
2225 |
|
|
gfc_symbol* proc_sym;
|
2226 |
|
|
gfc_symtree* proc_tree;
|
2227 |
|
|
}
|
2228 |
|
|
gfc_finalizer;
|
2229 |
|
|
#define gfc_get_finalizer() XCNEW (gfc_finalizer)
|
2230 |
|
|
|
2231 |
|
|
|
2232 |
|
|
/************************ Function prototypes *************************/
|
2233 |
|
|
|
2234 |
|
|
/* decl.c */
|
2235 |
|
|
bool gfc_in_match_data (void);
|
2236 |
|
|
match gfc_match_char_spec (gfc_typespec *);
|
2237 |
|
|
|
2238 |
|
|
/* scanner.c */
|
2239 |
|
|
void gfc_scanner_done_1 (void);
|
2240 |
|
|
void gfc_scanner_init_1 (void);
|
2241 |
|
|
|
2242 |
|
|
void gfc_add_include_path (const char *, bool, bool);
|
2243 |
|
|
void gfc_add_intrinsic_modules_path (const char *);
|
2244 |
|
|
void gfc_release_include_path (void);
|
2245 |
|
|
FILE *gfc_open_included_file (const char *, bool, bool);
|
2246 |
|
|
FILE *gfc_open_intrinsic_module (const char *);
|
2247 |
|
|
|
2248 |
|
|
int gfc_at_end (void);
|
2249 |
|
|
int gfc_at_eof (void);
|
2250 |
|
|
int gfc_at_bol (void);
|
2251 |
|
|
int gfc_at_eol (void);
|
2252 |
|
|
void gfc_advance_line (void);
|
2253 |
|
|
int gfc_check_include (void);
|
2254 |
|
|
int gfc_define_undef_line (void);
|
2255 |
|
|
|
2256 |
|
|
int gfc_wide_is_printable (gfc_char_t);
|
2257 |
|
|
int gfc_wide_is_digit (gfc_char_t);
|
2258 |
|
|
int gfc_wide_fits_in_byte (gfc_char_t);
|
2259 |
|
|
gfc_char_t gfc_wide_tolower (gfc_char_t);
|
2260 |
|
|
gfc_char_t gfc_wide_toupper (gfc_char_t);
|
2261 |
|
|
size_t gfc_wide_strlen (const gfc_char_t *);
|
2262 |
|
|
int gfc_wide_strncasecmp (const gfc_char_t *, const char *, size_t);
|
2263 |
|
|
gfc_char_t *gfc_wide_memset (gfc_char_t *, gfc_char_t, size_t);
|
2264 |
|
|
char *gfc_widechar_to_char (const gfc_char_t *, int);
|
2265 |
|
|
gfc_char_t *gfc_char_to_widechar (const char *);
|
2266 |
|
|
|
2267 |
|
|
#define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
|
2268 |
|
|
|
2269 |
|
|
void gfc_skip_comments (void);
|
2270 |
|
|
gfc_char_t gfc_next_char_literal (int);
|
2271 |
|
|
gfc_char_t gfc_next_char (void);
|
2272 |
|
|
char gfc_next_ascii_char (void);
|
2273 |
|
|
gfc_char_t gfc_peek_char (void);
|
2274 |
|
|
char gfc_peek_ascii_char (void);
|
2275 |
|
|
void gfc_error_recovery (void);
|
2276 |
|
|
void gfc_gobble_whitespace (void);
|
2277 |
|
|
gfc_try gfc_new_file (void);
|
2278 |
|
|
const char * gfc_read_orig_filename (const char *, const char **);
|
2279 |
|
|
|
2280 |
|
|
extern gfc_source_form gfc_current_form;
|
2281 |
|
|
extern const char *gfc_source_file;
|
2282 |
|
|
extern locus gfc_current_locus;
|
2283 |
|
|
|
2284 |
|
|
void gfc_start_source_files (void);
|
2285 |
|
|
void gfc_end_source_files (void);
|
2286 |
|
|
|
2287 |
|
|
/* misc.c */
|
2288 |
|
|
void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
|
2289 |
|
|
void gfc_free (void *);
|
2290 |
|
|
int gfc_terminal_width (void);
|
2291 |
|
|
void gfc_clear_ts (gfc_typespec *);
|
2292 |
|
|
FILE *gfc_open_file (const char *);
|
2293 |
|
|
const char *gfc_basic_typename (bt);
|
2294 |
|
|
const char *gfc_typename (gfc_typespec *);
|
2295 |
|
|
const char *gfc_op2string (gfc_intrinsic_op);
|
2296 |
|
|
const char *gfc_code2string (const mstring *, int);
|
2297 |
|
|
int gfc_string2code (const mstring *, const char *);
|
2298 |
|
|
const char *gfc_intent_string (sym_intent);
|
2299 |
|
|
|
2300 |
|
|
void gfc_init_1 (void);
|
2301 |
|
|
void gfc_init_2 (void);
|
2302 |
|
|
void gfc_done_1 (void);
|
2303 |
|
|
void gfc_done_2 (void);
|
2304 |
|
|
|
2305 |
|
|
int get_c_kind (const char *, CInteropKind_t *);
|
2306 |
|
|
|
2307 |
|
|
/* options.c */
|
2308 |
|
|
unsigned int gfc_init_options (unsigned int, const char **);
|
2309 |
|
|
int gfc_handle_option (size_t, const char *, int);
|
2310 |
|
|
bool gfc_post_options (const char **);
|
2311 |
|
|
|
2312 |
|
|
/* f95-lang.c */
|
2313 |
|
|
void gfc_maybe_initialize_eh (void);
|
2314 |
|
|
|
2315 |
|
|
/* iresolve.c */
|
2316 |
|
|
const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
|
2317 |
|
|
bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
|
2318 |
|
|
|
2319 |
|
|
/* error.c */
|
2320 |
|
|
|
2321 |
|
|
typedef struct gfc_error_buf
|
2322 |
|
|
{
|
2323 |
|
|
int flag;
|
2324 |
|
|
size_t allocated, index;
|
2325 |
|
|
char *message;
|
2326 |
|
|
} gfc_error_buf;
|
2327 |
|
|
|
2328 |
|
|
void gfc_error_init_1 (void);
|
2329 |
|
|
void gfc_buffer_error (int);
|
2330 |
|
|
|
2331 |
|
|
const char *gfc_print_wide_char (gfc_char_t);
|
2332 |
|
|
|
2333 |
|
|
void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
|
2334 |
|
|
void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
|
2335 |
|
|
void gfc_clear_warning (void);
|
2336 |
|
|
void gfc_warning_check (void);
|
2337 |
|
|
|
2338 |
|
|
void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
|
2339 |
|
|
void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
|
2340 |
|
|
void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
|
2341 |
|
|
void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
|
2342 |
|
|
void gfc_clear_error (void);
|
2343 |
|
|
int gfc_error_check (void);
|
2344 |
|
|
int gfc_error_flag_test (void);
|
2345 |
|
|
|
2346 |
|
|
notification gfc_notification_std (int);
|
2347 |
|
|
gfc_try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
|
2348 |
|
|
|
2349 |
|
|
/* A general purpose syntax error. */
|
2350 |
|
|
#define gfc_syntax_error(ST) \
|
2351 |
|
|
gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
|
2352 |
|
|
|
2353 |
|
|
void gfc_push_error (gfc_error_buf *);
|
2354 |
|
|
void gfc_pop_error (gfc_error_buf *);
|
2355 |
|
|
void gfc_free_error (gfc_error_buf *);
|
2356 |
|
|
|
2357 |
|
|
void gfc_get_errors (int *, int *);
|
2358 |
|
|
void gfc_errors_to_warnings (int);
|
2359 |
|
|
|
2360 |
|
|
/* arith.c */
|
2361 |
|
|
void gfc_arith_init_1 (void);
|
2362 |
|
|
void gfc_arith_done_1 (void);
|
2363 |
|
|
arith gfc_check_integer_range (mpz_t p, int kind);
|
2364 |
|
|
bool gfc_check_character_range (gfc_char_t, int);
|
2365 |
|
|
|
2366 |
|
|
/* trans-types.c */
|
2367 |
|
|
gfc_try gfc_check_any_c_kind (gfc_typespec *);
|
2368 |
|
|
int gfc_validate_kind (bt, int, bool);
|
2369 |
|
|
int gfc_get_int_kind_from_width_isofortranenv (int size);
|
2370 |
|
|
int gfc_get_real_kind_from_width_isofortranenv (int size);
|
2371 |
|
|
tree gfc_get_derived_type (gfc_symbol * derived);
|
2372 |
|
|
extern int gfc_index_integer_kind;
|
2373 |
|
|
extern int gfc_default_integer_kind;
|
2374 |
|
|
extern int gfc_max_integer_kind;
|
2375 |
|
|
extern int gfc_default_real_kind;
|
2376 |
|
|
extern int gfc_default_double_kind;
|
2377 |
|
|
extern int gfc_default_character_kind;
|
2378 |
|
|
extern int gfc_default_logical_kind;
|
2379 |
|
|
extern int gfc_default_complex_kind;
|
2380 |
|
|
extern int gfc_c_int_kind;
|
2381 |
|
|
extern int gfc_intio_kind;
|
2382 |
|
|
extern int gfc_charlen_int_kind;
|
2383 |
|
|
extern int gfc_numeric_storage_size;
|
2384 |
|
|
extern int gfc_character_storage_size;
|
2385 |
|
|
|
2386 |
|
|
/* symbol.c */
|
2387 |
|
|
void gfc_clear_new_implicit (void);
|
2388 |
|
|
gfc_try gfc_add_new_implicit_range (int, int);
|
2389 |
|
|
gfc_try gfc_merge_new_implicit (gfc_typespec *);
|
2390 |
|
|
void gfc_set_implicit_none (void);
|
2391 |
|
|
void gfc_check_function_type (gfc_namespace *);
|
2392 |
|
|
bool gfc_is_intrinsic_typename (const char *);
|
2393 |
|
|
|
2394 |
|
|
gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
|
2395 |
|
|
gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
|
2396 |
|
|
|
2397 |
|
|
void gfc_set_sym_referenced (gfc_symbol *);
|
2398 |
|
|
|
2399 |
|
|
gfc_try gfc_add_attribute (symbol_attribute *, locus *);
|
2400 |
|
|
gfc_try gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
|
2401 |
|
|
gfc_try gfc_add_allocatable (symbol_attribute *, locus *);
|
2402 |
|
|
gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *);
|
2403 |
|
|
gfc_try gfc_add_external (symbol_attribute *, locus *);
|
2404 |
|
|
gfc_try gfc_add_intrinsic (symbol_attribute *, locus *);
|
2405 |
|
|
gfc_try gfc_add_optional (symbol_attribute *, locus *);
|
2406 |
|
|
gfc_try gfc_add_pointer (symbol_attribute *, locus *);
|
2407 |
|
|
gfc_try gfc_add_cray_pointer (symbol_attribute *, locus *);
|
2408 |
|
|
gfc_try gfc_add_cray_pointee (symbol_attribute *, locus *);
|
2409 |
|
|
match gfc_mod_pointee_as (gfc_array_spec *);
|
2410 |
|
|
gfc_try gfc_add_protected (symbol_attribute *, const char *, locus *);
|
2411 |
|
|
gfc_try gfc_add_result (symbol_attribute *, const char *, locus *);
|
2412 |
|
|
gfc_try gfc_add_save (symbol_attribute *, const char *, locus *);
|
2413 |
|
|
gfc_try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
|
2414 |
|
|
gfc_try gfc_add_saved_common (symbol_attribute *, locus *);
|
2415 |
|
|
gfc_try gfc_add_target (symbol_attribute *, locus *);
|
2416 |
|
|
gfc_try gfc_add_dummy (symbol_attribute *, const char *, locus *);
|
2417 |
|
|
gfc_try gfc_add_generic (symbol_attribute *, const char *, locus *);
|
2418 |
|
|
gfc_try gfc_add_common (symbol_attribute *, locus *);
|
2419 |
|
|
gfc_try gfc_add_in_common (symbol_attribute *, const char *, locus *);
|
2420 |
|
|
gfc_try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
|
2421 |
|
|
gfc_try gfc_add_data (symbol_attribute *, const char *, locus *);
|
2422 |
|
|
gfc_try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
|
2423 |
|
|
gfc_try gfc_add_sequence (symbol_attribute *, const char *, locus *);
|
2424 |
|
|
gfc_try gfc_add_elemental (symbol_attribute *, locus *);
|
2425 |
|
|
gfc_try gfc_add_pure (symbol_attribute *, locus *);
|
2426 |
|
|
gfc_try gfc_add_recursive (symbol_attribute *, locus *);
|
2427 |
|
|
gfc_try gfc_add_function (symbol_attribute *, const char *, locus *);
|
2428 |
|
|
gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
|
2429 |
|
|
gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
|
2430 |
|
|
gfc_try gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
|
2431 |
|
|
gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
|
2432 |
|
|
gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);
|
2433 |
|
|
|
2434 |
|
|
gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
|
2435 |
|
|
gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
|
2436 |
|
|
gfc_try gfc_add_extension (symbol_attribute *, locus *);
|
2437 |
|
|
gfc_try gfc_add_value (symbol_attribute *, const char *, locus *);
|
2438 |
|
|
gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
|
2439 |
|
|
gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *);
|
2440 |
|
|
gfc_try gfc_add_procedure (symbol_attribute *, procedure_type,
|
2441 |
|
|
const char *, locus *);
|
2442 |
|
|
gfc_try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
|
2443 |
|
|
gfc_try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
|
2444 |
|
|
gfc_formal_arglist *, locus *);
|
2445 |
|
|
gfc_try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
|
2446 |
|
|
|
2447 |
|
|
void gfc_clear_attr (symbol_attribute *);
|
2448 |
|
|
gfc_try gfc_missing_attr (symbol_attribute *, locus *);
|
2449 |
|
|
gfc_try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
|
2450 |
|
|
|
2451 |
|
|
gfc_try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
|
2452 |
|
|
gfc_symbol *gfc_use_derived (gfc_symbol *);
|
2453 |
|
|
gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
|
2454 |
|
|
gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool);
|
2455 |
|
|
|
2456 |
|
|
gfc_st_label *gfc_get_st_label (int);
|
2457 |
|
|
void gfc_free_st_label (gfc_st_label *);
|
2458 |
|
|
void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
|
2459 |
|
|
gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
|
2460 |
|
|
|
2461 |
|
|
gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
|
2462 |
|
|
|
2463 |
|
|
gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
|
2464 |
|
|
gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
|
2465 |
|
|
gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
|
2466 |
|
|
void gfc_delete_symtree (gfc_symtree **, const char *);
|
2467 |
|
|
gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
|
2468 |
|
|
gfc_user_op *gfc_get_uop (const char *);
|
2469 |
|
|
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
|
2470 |
|
|
void gfc_free_symbol (gfc_symbol *);
|
2471 |
|
|
gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
|
2472 |
|
|
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
|
2473 |
|
|
int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
|
2474 |
|
|
int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
|
2475 |
|
|
gfc_try verify_c_interop (gfc_typespec *);
|
2476 |
|
|
gfc_try verify_c_interop_param (gfc_symbol *);
|
2477 |
|
|
gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
|
2478 |
|
|
gfc_try verify_bind_c_derived_type (gfc_symbol *);
|
2479 |
|
|
gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
|
2480 |
|
|
void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *);
|
2481 |
|
|
gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int);
|
2482 |
|
|
int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
|
2483 |
|
|
int gfc_get_ha_symbol (const char *, gfc_symbol **);
|
2484 |
|
|
int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
|
2485 |
|
|
|
2486 |
|
|
int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
|
2487 |
|
|
|
2488 |
|
|
void gfc_undo_symbols (void);
|
2489 |
|
|
void gfc_commit_symbols (void);
|
2490 |
|
|
void gfc_commit_symbol (gfc_symbol *);
|
2491 |
|
|
gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
|
2492 |
|
|
void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
|
2493 |
|
|
void gfc_free_namespace (gfc_namespace *);
|
2494 |
|
|
|
2495 |
|
|
void gfc_symbol_init_2 (void);
|
2496 |
|
|
void gfc_symbol_done_2 (void);
|
2497 |
|
|
|
2498 |
|
|
void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
|
2499 |
|
|
void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
|
2500 |
|
|
void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
|
2501 |
|
|
void gfc_save_all (gfc_namespace *);
|
2502 |
|
|
|
2503 |
|
|
void gfc_symbol_state (void);
|
2504 |
|
|
void gfc_free_dt_list (void);
|
2505 |
|
|
|
2506 |
|
|
|
2507 |
|
|
gfc_gsymbol *gfc_get_gsymbol (const char *);
|
2508 |
|
|
gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
|
2509 |
|
|
|
2510 |
|
|
gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
|
2511 |
|
|
gfc_array_spec **);
|
2512 |
|
|
gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
|
2513 |
|
|
gfc_typebound_proc* gfc_get_typebound_proc (void);
|
2514 |
|
|
gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
|
2515 |
|
|
gfc_symbol* gfc_get_ultimate_derived_super_type (gfc_symbol*);
|
2516 |
|
|
bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
|
2517 |
|
|
bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
|
2518 |
|
|
gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
|
2519 |
|
|
const char*, bool, locus*);
|
2520 |
|
|
gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
|
2521 |
|
|
const char*, bool, locus*);
|
2522 |
|
|
gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
|
2523 |
|
|
gfc_intrinsic_op, bool,
|
2524 |
|
|
locus*);
|
2525 |
|
|
gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
|
2526 |
|
|
|
2527 |
|
|
void gfc_copy_formal_args (gfc_symbol *, gfc_symbol *);
|
2528 |
|
|
void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
|
2529 |
|
|
void gfc_copy_formal_args_ppc (gfc_component *, gfc_symbol *);
|
2530 |
|
|
|
2531 |
|
|
void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */
|
2532 |
|
|
|
2533 |
|
|
gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
|
2534 |
|
|
|
2535 |
|
|
/* intrinsic.c */
|
2536 |
|
|
extern int gfc_init_expr;
|
2537 |
|
|
|
2538 |
|
|
/* Given a symbol that we have decided is intrinsic, mark it as such
|
2539 |
|
|
by placing it into a special module that is otherwise impossible to
|
2540 |
|
|
read or write. */
|
2541 |
|
|
|
2542 |
|
|
#define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
|
2543 |
|
|
|
2544 |
|
|
void gfc_intrinsic_init_1 (void);
|
2545 |
|
|
void gfc_intrinsic_done_1 (void);
|
2546 |
|
|
|
2547 |
|
|
char gfc_type_letter (bt);
|
2548 |
|
|
gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
|
2549 |
|
|
gfc_try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
|
2550 |
|
|
gfc_try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
|
2551 |
|
|
gfc_try gfc_convert_chartype (gfc_expr *, gfc_typespec *);
|
2552 |
|
|
int gfc_generic_intrinsic (const char *);
|
2553 |
|
|
int gfc_specific_intrinsic (const char *);
|
2554 |
|
|
bool gfc_is_intrinsic (gfc_symbol*, int, locus);
|
2555 |
|
|
int gfc_intrinsic_actual_ok (const char *, const bool);
|
2556 |
|
|
gfc_intrinsic_sym *gfc_find_function (const char *);
|
2557 |
|
|
gfc_intrinsic_sym *gfc_find_subroutine (const char *);
|
2558 |
|
|
|
2559 |
|
|
match gfc_intrinsic_func_interface (gfc_expr *, int);
|
2560 |
|
|
match gfc_intrinsic_sub_interface (gfc_code *, int);
|
2561 |
|
|
|
2562 |
|
|
void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
|
2563 |
|
|
gfc_try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
|
2564 |
|
|
bool, locus);
|
2565 |
|
|
|
2566 |
|
|
/* match.c -- FIXME */
|
2567 |
|
|
void gfc_free_iterator (gfc_iterator *, int);
|
2568 |
|
|
void gfc_free_forall_iterator (gfc_forall_iterator *);
|
2569 |
|
|
void gfc_free_alloc_list (gfc_alloc *);
|
2570 |
|
|
void gfc_free_namelist (gfc_namelist *);
|
2571 |
|
|
void gfc_free_equiv (gfc_equiv *);
|
2572 |
378 |
julius |
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
|
2573 |
285 |
jeremybenn |
void gfc_free_data (gfc_data *);
|
2574 |
|
|
void gfc_free_case_list (gfc_case *);
|
2575 |
|
|
|
2576 |
|
|
/* matchexp.c -- FIXME too? */
|
2577 |
|
|
gfc_expr *gfc_get_parentheses (gfc_expr *);
|
2578 |
|
|
|
2579 |
|
|
/* openmp.c */
|
2580 |
|
|
void gfc_free_omp_clauses (gfc_omp_clauses *);
|
2581 |
|
|
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
|
2582 |
|
|
void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *);
|
2583 |
|
|
void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
|
2584 |
|
|
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
|
2585 |
|
|
|
2586 |
|
|
/* expr.c */
|
2587 |
|
|
void gfc_free_actual_arglist (gfc_actual_arglist *);
|
2588 |
|
|
gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
|
2589 |
|
|
const char *gfc_extract_int (gfc_expr *, int *);
|
2590 |
|
|
bool is_subref_array (gfc_expr *);
|
2591 |
|
|
|
2592 |
|
|
void gfc_add_component_ref (gfc_expr *, const char *);
|
2593 |
|
|
gfc_expr *gfc_build_conversion (gfc_expr *);
|
2594 |
|
|
void gfc_free_ref_list (gfc_ref *);
|
2595 |
|
|
void gfc_type_convert_binary (gfc_expr *, int);
|
2596 |
|
|
int gfc_is_constant_expr (gfc_expr *);
|
2597 |
|
|
gfc_try gfc_simplify_expr (gfc_expr *, int);
|
2598 |
|
|
int gfc_has_vector_index (gfc_expr *);
|
2599 |
|
|
|
2600 |
|
|
gfc_expr *gfc_get_expr (void);
|
2601 |
|
|
void gfc_free_expr (gfc_expr *);
|
2602 |
|
|
void gfc_replace_expr (gfc_expr *, gfc_expr *);
|
2603 |
|
|
gfc_expr *gfc_int_expr (int);
|
2604 |
|
|
gfc_expr *gfc_logical_expr (int, locus *);
|
2605 |
|
|
mpz_t *gfc_copy_shape (mpz_t *, int);
|
2606 |
|
|
mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
|
2607 |
|
|
gfc_expr *gfc_copy_expr (gfc_expr *);
|
2608 |
|
|
gfc_ref* gfc_copy_ref (gfc_ref*);
|
2609 |
|
|
|
2610 |
|
|
gfc_try gfc_specification_expr (gfc_expr *);
|
2611 |
|
|
|
2612 |
|
|
int gfc_numeric_ts (gfc_typespec *);
|
2613 |
|
|
int gfc_kind_max (gfc_expr *, gfc_expr *);
|
2614 |
|
|
|
2615 |
|
|
gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
|
2616 |
|
|
gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int);
|
2617 |
|
|
gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
|
2618 |
|
|
gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
|
2619 |
|
|
|
2620 |
|
|
gfc_expr *gfc_default_initializer (gfc_typespec *);
|
2621 |
|
|
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
|
2622 |
|
|
|
2623 |
|
|
gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
|
2624 |
|
|
|
2625 |
|
|
bool gfc_traverse_expr (gfc_expr *, gfc_symbol *,
|
2626 |
|
|
bool (*)(gfc_expr *, gfc_symbol *, int*),
|
2627 |
|
|
int);
|
2628 |
|
|
void gfc_expr_set_symbols_referenced (gfc_expr *);
|
2629 |
|
|
gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
|
2630 |
|
|
void gfc_expr_replace_symbols (gfc_expr *, gfc_symbol *);
|
2631 |
|
|
void gfc_expr_replace_comp (gfc_expr *, gfc_component *);
|
2632 |
|
|
|
2633 |
|
|
bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
|
2634 |
|
|
|
2635 |
|
|
/* st.c */
|
2636 |
|
|
extern gfc_code new_st;
|
2637 |
|
|
|
2638 |
|
|
void gfc_clear_new_st (void);
|
2639 |
|
|
gfc_code *gfc_get_code (void);
|
2640 |
|
|
gfc_code *gfc_append_code (gfc_code *, gfc_code *);
|
2641 |
|
|
void gfc_free_statement (gfc_code *);
|
2642 |
|
|
void gfc_free_statements (gfc_code *);
|
2643 |
|
|
|
2644 |
|
|
/* resolve.c */
|
2645 |
|
|
gfc_try gfc_resolve_expr (gfc_expr *);
|
2646 |
|
|
void gfc_resolve (gfc_namespace *);
|
2647 |
|
|
void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
|
2648 |
|
|
int gfc_impure_variable (gfc_symbol *);
|
2649 |
|
|
int gfc_pure (gfc_symbol *);
|
2650 |
|
|
int gfc_elemental (gfc_symbol *);
|
2651 |
|
|
gfc_try gfc_resolve_iterator (gfc_iterator *, bool);
|
2652 |
|
|
gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int);
|
2653 |
|
|
gfc_try gfc_resolve_index (gfc_expr *, int);
|
2654 |
|
|
gfc_try gfc_resolve_dim_arg (gfc_expr *);
|
2655 |
|
|
int gfc_is_formal_arg (void);
|
2656 |
|
|
void gfc_resolve_substring_charlen (gfc_expr *);
|
2657 |
|
|
match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
|
2658 |
|
|
gfc_expr *gfc_expr_to_initialize (gfc_expr *);
|
2659 |
|
|
bool gfc_type_is_extensible (gfc_symbol *sym);
|
2660 |
|
|
|
2661 |
|
|
|
2662 |
|
|
/* array.c */
|
2663 |
|
|
void gfc_free_array_spec (gfc_array_spec *);
|
2664 |
|
|
gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
|
2665 |
|
|
|
2666 |
|
|
gfc_try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
|
2667 |
|
|
gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
|
2668 |
|
|
gfc_try gfc_resolve_array_spec (gfc_array_spec *, int);
|
2669 |
|
|
|
2670 |
|
|
int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
|
2671 |
|
|
|
2672 |
|
|
gfc_expr *gfc_start_constructor (bt, int, locus *);
|
2673 |
|
|
void gfc_append_constructor (gfc_expr *, gfc_expr *);
|
2674 |
|
|
void gfc_free_constructor (gfc_constructor *);
|
2675 |
|
|
void gfc_simplify_iterator_var (gfc_expr *);
|
2676 |
|
|
gfc_try gfc_expand_constructor (gfc_expr *);
|
2677 |
|
|
int gfc_constant_ac (gfc_expr *);
|
2678 |
|
|
int gfc_expanded_ac (gfc_expr *);
|
2679 |
|
|
gfc_try gfc_resolve_character_array_constructor (gfc_expr *);
|
2680 |
|
|
gfc_try gfc_resolve_array_constructor (gfc_expr *);
|
2681 |
|
|
gfc_try gfc_check_constructor_type (gfc_expr *);
|
2682 |
|
|
gfc_try gfc_check_iter_variable (gfc_expr *);
|
2683 |
|
|
gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *));
|
2684 |
|
|
gfc_constructor *gfc_copy_constructor (gfc_constructor *);
|
2685 |
|
|
gfc_expr *gfc_get_array_element (gfc_expr *, int);
|
2686 |
|
|
gfc_try gfc_array_size (gfc_expr *, mpz_t *);
|
2687 |
|
|
gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
|
2688 |
|
|
gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
|
2689 |
|
|
gfc_array_ref *gfc_find_array_ref (gfc_expr *);
|
2690 |
|
|
void gfc_insert_constructor (gfc_expr *, gfc_constructor *);
|
2691 |
|
|
gfc_constructor *gfc_get_constructor (void);
|
2692 |
|
|
tree gfc_conv_array_initializer (tree type, gfc_expr *);
|
2693 |
|
|
gfc_try spec_size (gfc_array_spec *, mpz_t *);
|
2694 |
|
|
gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
|
2695 |
|
|
int gfc_is_compile_time_shape (gfc_array_spec *);
|
2696 |
|
|
|
2697 |
|
|
gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *);
|
2698 |
|
|
|
2699 |
|
|
|
2700 |
|
|
/* interface.c -- FIXME: some of these should be in symbol.c */
|
2701 |
|
|
void gfc_free_interface (gfc_interface *);
|
2702 |
|
|
int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
|
2703 |
|
|
int gfc_compare_types (gfc_typespec *, gfc_typespec *);
|
2704 |
|
|
int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
|
2705 |
|
|
char *, int);
|
2706 |
|
|
void gfc_check_interfaces (gfc_namespace *);
|
2707 |
|
|
void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
|
2708 |
|
|
void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
|
2709 |
|
|
gfc_symbol *gfc_search_interface (gfc_interface *, int,
|
2710 |
|
|
gfc_actual_arglist **);
|
2711 |
|
|
gfc_try gfc_extend_expr (gfc_expr *, bool *);
|
2712 |
|
|
void gfc_free_formal_arglist (gfc_formal_arglist *);
|
2713 |
|
|
gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
|
2714 |
|
|
gfc_try gfc_add_interface (gfc_symbol *);
|
2715 |
|
|
gfc_interface *gfc_current_interface_head (void);
|
2716 |
|
|
void gfc_set_current_interface_head (gfc_interface *);
|
2717 |
|
|
gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
|
2718 |
|
|
bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
|
2719 |
|
|
bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
|
2720 |
|
|
|
2721 |
|
|
/* io.c */
|
2722 |
|
|
extern gfc_st_label format_asterisk;
|
2723 |
|
|
|
2724 |
|
|
void gfc_free_open (gfc_open *);
|
2725 |
|
|
gfc_try gfc_resolve_open (gfc_open *);
|
2726 |
|
|
void gfc_free_close (gfc_close *);
|
2727 |
|
|
gfc_try gfc_resolve_close (gfc_close *);
|
2728 |
|
|
void gfc_free_filepos (gfc_filepos *);
|
2729 |
|
|
gfc_try gfc_resolve_filepos (gfc_filepos *);
|
2730 |
|
|
void gfc_free_inquire (gfc_inquire *);
|
2731 |
|
|
gfc_try gfc_resolve_inquire (gfc_inquire *);
|
2732 |
|
|
void gfc_free_dt (gfc_dt *);
|
2733 |
|
|
gfc_try gfc_resolve_dt (gfc_dt *, locus *);
|
2734 |
|
|
void gfc_free_wait (gfc_wait *);
|
2735 |
|
|
gfc_try gfc_resolve_wait (gfc_wait *);
|
2736 |
|
|
|
2737 |
|
|
/* module.c */
|
2738 |
|
|
void gfc_module_init_2 (void);
|
2739 |
|
|
void gfc_module_done_2 (void);
|
2740 |
|
|
void gfc_dump_module (const char *, int);
|
2741 |
|
|
bool gfc_check_access (gfc_access, gfc_access);
|
2742 |
|
|
void gfc_free_use_stmts (gfc_use_list *);
|
2743 |
|
|
|
2744 |
|
|
/* primary.c */
|
2745 |
|
|
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
|
2746 |
|
|
symbol_attribute gfc_expr_attr (gfc_expr *);
|
2747 |
|
|
match gfc_match_rvalue (gfc_expr **);
|
2748 |
|
|
match gfc_match_varspec (gfc_expr*, int, bool, bool);
|
2749 |
|
|
int gfc_check_digit (char, int);
|
2750 |
|
|
bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
|
2751 |
|
|
|
2752 |
|
|
/* trans.c */
|
2753 |
|
|
void gfc_generate_code (gfc_namespace *);
|
2754 |
|
|
void gfc_generate_module_code (gfc_namespace *);
|
2755 |
|
|
|
2756 |
|
|
/* bbt.c */
|
2757 |
|
|
typedef int (*compare_fn) (void *, void *);
|
2758 |
|
|
void gfc_insert_bbt (void *, void *, compare_fn);
|
2759 |
|
|
void gfc_delete_bbt (void *, void *, compare_fn);
|
2760 |
|
|
|
2761 |
|
|
/* dump-parse-tree.c */
|
2762 |
|
|
void gfc_dump_parse_tree (gfc_namespace *, FILE *);
|
2763 |
|
|
|
2764 |
|
|
/* parse.c */
|
2765 |
|
|
gfc_try gfc_parse_file (void);
|
2766 |
|
|
void gfc_global_used (gfc_gsymbol *, locus *);
|
2767 |
|
|
|
2768 |
|
|
/* dependency.c */
|
2769 |
|
|
int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
|
2770 |
|
|
int gfc_is_data_pointer (gfc_expr *);
|
2771 |
|
|
|
2772 |
|
|
/* check.c */
|
2773 |
|
|
gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
|
2774 |
|
|
|
2775 |
|
|
#endif /* GCC_GFORTRAN_H */
|