Branch data Line data Source code
1 : : /* gfortran header file
2 : : Copyright (C) 2000-2024 Free Software Foundation, Inc.
3 : : Contributed by Andy Vaught
4 : :
5 : : This file is part of GCC.
6 : :
7 : : GCC is free software; you can redistribute it and/or modify it under
8 : : the terms of the GNU General Public License as published by the Free
9 : : Software Foundation; either version 3, or (at your option) any later
10 : : version.
11 : :
12 : : GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 : : WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 : : FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 : : for more details.
16 : :
17 : : You should have received a copy of the GNU General Public License
18 : : along with GCC; see the file COPYING3. If not see
19 : : <http://www.gnu.org/licenses/>. */
20 : :
21 : : #ifndef GCC_GFORTRAN_H
22 : : #define GCC_GFORTRAN_H
23 : :
24 : : /* It's probably insane to have this large of a header file, but it
25 : : seemed like everything had to be recompiled anyway when a change
26 : : was made to a header file, and there were ordering issues with
27 : : multiple header files. Besides, Microsoft's winnt.h was 250k last
28 : : time I looked, so by comparison this is perfectly reasonable. */
29 : :
30 : : #ifndef GCC_CORETYPES_H
31 : : #error "gfortran.h must be included after coretypes.h"
32 : : #endif
33 : :
34 : : /* In order for the format checking to accept the Fortran front end
35 : : diagnostic framework extensions, you must include this file before
36 : : diagnostic-core.h, not after. We override the definition of GCC_DIAG_STYLE
37 : : in c-common.h. */
38 : : #undef GCC_DIAG_STYLE
39 : : #define GCC_DIAG_STYLE __gcc_gfc__
40 : : #if defined(GCC_DIAGNOSTIC_CORE_H)
41 : : #error \
42 : : In order for the format checking to accept the Fortran front end diagnostic \
43 : : framework extensions, you must include this file before diagnostic-core.h, \
44 : : not after.
45 : : #endif
46 : :
47 : : /* Declarations common to the front-end and library are put in
48 : : libgfortran/libgfortran_frontend.h */
49 : : #include "libgfortran.h"
50 : :
51 : :
52 : : #include "intl.h"
53 : : #include "splay-tree.h"
54 : :
55 : : /* Major control parameters. */
56 : :
57 : : #define GFC_MAX_SYMBOL_LEN 63 /* Must be at least 63 for F2003. */
58 : : #define GFC_LETTERS 26 /* Number of letters in the alphabet. */
59 : :
60 : : #define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */
61 : :
62 : :
63 : : #define gfc_is_whitespace(c) ((c==' ') || (c=='\t') || (c=='\f'))
64 : :
65 : : /* Macros to check for groups of structure-like types and flavors since
66 : : derived types, structures, maps, unions are often treated similarly. */
67 : : #define gfc_bt_struct(t) \
68 : : ((t) == BT_DERIVED || (t) == BT_UNION)
69 : : #define gfc_fl_struct(f) \
70 : : ((f) == FL_DERIVED || (f) == FL_UNION || (f) == FL_STRUCT)
71 : : #define case_bt_struct case BT_DERIVED: case BT_UNION
72 : : #define case_fl_struct case FL_DERIVED: case FL_UNION: case FL_STRUCT
73 : :
74 : : /* Stringization. */
75 : : #define stringize(x) expand_macro(x)
76 : : #define expand_macro(x) # x
77 : :
78 : : /* For the runtime library, a standard prefix is a requirement to
79 : : avoid cluttering the namespace with things nobody asked for. It's
80 : : ugly to look at and a pain to type when you add the prefix by hand,
81 : : so we hide it behind a macro. */
82 : : #define PREFIX(x) "_gfortran_" x
83 : : #define PREFIX_LEN 10
84 : :
85 : : /* A prefix for internal variables, which are not user-visible. */
86 : : #if !defined (NO_DOT_IN_LABEL)
87 : : # define GFC_PREFIX(x) "_F." x
88 : : #elif !defined (NO_DOLLAR_IN_LABEL)
89 : : # define GFC_PREFIX(x) "_F$" x
90 : : #else
91 : : # define GFC_PREFIX(x) "_F_" x
92 : : #endif
93 : :
94 : : #define BLANK_COMMON_NAME "__BLNK__"
95 : :
96 : : /* Macro to initialize an mstring structure. */
97 : : #define minit(s, t) { s, NULL, t }
98 : :
99 : : /* Structure for storing strings to be matched by gfc_match_string. */
100 : : typedef struct
101 : : {
102 : : const char *string;
103 : : const char *mp;
104 : : int tag;
105 : : }
106 : : mstring;
107 : :
108 : : /* ISO_Fortran_binding.h
109 : : CAUTION: This has to be kept in sync with libgfortran. */
110 : :
111 : : #define CFI_type_kind_shift 8
112 : : #define CFI_type_mask 0xFF
113 : : #define CFI_type_from_type_kind(t, k) (t + (k << CFI_type_kind_shift))
114 : :
115 : : /* Constants, defined as macros. */
116 : : #define CFI_VERSION 1
117 : : #define CFI_MAX_RANK 15
118 : :
119 : : /* Attributes. */
120 : : #define CFI_attribute_pointer 0
121 : : #define CFI_attribute_allocatable 1
122 : : #define CFI_attribute_other 2
123 : :
124 : : #define CFI_type_mask 0xFF
125 : : #define CFI_type_kind_shift 8
126 : :
127 : : /* Intrinsic types. Their kind number defines their storage size. */
128 : : #define CFI_type_Integer 1
129 : : #define CFI_type_Logical 2
130 : : #define CFI_type_Real 3
131 : : #define CFI_type_Complex 4
132 : : #define CFI_type_Character 5
133 : :
134 : : /* Combined type (for more, see ISO_Fortran_binding.h). */
135 : : #define CFI_type_ucs4_char (CFI_type_Character + (4 << CFI_type_kind_shift))
136 : :
137 : : /* Types with no kind. */
138 : : #define CFI_type_struct 6
139 : : #define CFI_type_cptr 7
140 : : #define CFI_type_cfunptr 8
141 : : #define CFI_type_other -1
142 : :
143 : :
144 : : /*************************** Enums *****************************/
145 : :
146 : : /* Used when matching and resolving data I/O transfer statements. */
147 : :
148 : : enum io_kind
149 : : { M_READ, M_WRITE, M_PRINT, M_INQUIRE };
150 : :
151 : :
152 : : /* These are flags for identifying whether we are reading a character literal
153 : : between quotes or normal source code. */
154 : :
155 : : enum gfc_instring
156 : : { NONSTRING = 0, INSTRING_WARN, INSTRING_NOWARN };
157 : :
158 : : /* This is returned by gfc_notification_std to know if, given the flags
159 : : that were given (-std=, -pedantic) we should issue an error, a warning
160 : : or nothing. */
161 : :
162 : : enum notification
163 : : { SILENT, WARNING, ERROR };
164 : :
165 : : /* Matchers return one of these three values. The difference between
166 : : MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
167 : : successful, but that something non-syntactic is wrong and an error
168 : : has already been issued. */
169 : :
170 : : enum match
171 : : { MATCH_NO = 1, MATCH_YES, MATCH_ERROR };
172 : :
173 : : /* Used for different Fortran source forms in places like scanner.cc. */
174 : : enum gfc_source_form
175 : : { FORM_FREE, FORM_FIXED, FORM_UNKNOWN };
176 : :
177 : : /* Expression node types. */
178 : : enum expr_t
179 : : { EXPR_UNKNOWN = 0, EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
180 : : EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL, EXPR_PPC
181 : : };
182 : :
183 : : /* Array types. */
184 : : enum array_type
185 : : { AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
186 : : AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_ASSUMED_RANK,
187 : : AS_UNKNOWN
188 : : };
189 : :
190 : : enum ar_type
191 : : { AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN };
192 : :
193 : : /* Statement label types. ST_LABEL_DO_TARGET is used for obsolescent warnings
194 : : related to shared DO terminations and DO targets which are neither END DO
195 : : nor CONTINUE; otherwise it is identical to ST_LABEL_TARGET. */
196 : : enum gfc_sl_type
197 : : { ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET, ST_LABEL_DO_TARGET,
198 : : ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
199 : : };
200 : :
201 : : /* Intrinsic operators. */
202 : : enum gfc_intrinsic_op
203 : : { GFC_INTRINSIC_BEGIN = 0,
204 : : INTRINSIC_NONE = -1, INTRINSIC_UPLUS = GFC_INTRINSIC_BEGIN,
205 : : INTRINSIC_UMINUS, INTRINSIC_PLUS, INTRINSIC_MINUS, INTRINSIC_TIMES,
206 : : INTRINSIC_DIVIDE, INTRINSIC_POWER, INTRINSIC_CONCAT,
207 : : INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV,
208 : : /* ==, /=, >, >=, <, <= */
209 : : INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE,
210 : : INTRINSIC_LT, INTRINSIC_LE,
211 : : /* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style) */
212 : : INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
213 : : INTRINSIC_LT_OS, INTRINSIC_LE_OS,
214 : : INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN, INTRINSIC_PARENTHESES,
215 : : GFC_INTRINSIC_END, /* Sentinel */
216 : : /* User defined derived type pseudo operators. These are set beyond the
217 : : sentinel so that they are excluded from module_read and module_write. */
218 : : INTRINSIC_FORMATTED, INTRINSIC_UNFORMATTED
219 : : };
220 : :
221 : : /* This macro is the number of intrinsic operators that exist.
222 : : Assumptions are made about the numbering of the interface_op enums. */
223 : : #define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
224 : :
225 : : /* Arithmetic results. ARITH_NOT_REDUCED is used to keep track of expressions
226 : : that were not reduced by the arithmetic evaluation code. */
227 : : enum arith
228 : : { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
229 : : ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT,
230 : : ARITH_WRONGCONCAT, ARITH_INVALID_TYPE, ARITH_NOT_REDUCED
231 : : };
232 : :
233 : : /* Statements. */
234 : : enum gfc_statement
235 : : {
236 : : ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_ASSOCIATE,
237 : : ST_BACKSPACE, ST_BLOCK, ST_BLOCK_DATA,
238 : : ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE,
239 : : ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF,
240 : : ST_ELSEWHERE, ST_END_ASSOCIATE, ST_END_BLOCK, ST_END_BLOCK_DATA,
241 : : ST_ENDDO, ST_IMPLIED_ENDDO, ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL,
242 : : ST_END_FUNCTION, ST_ENDIF, ST_END_INTERFACE, ST_END_MODULE, ST_END_SUBMODULE,
243 : : ST_END_PROGRAM, ST_END_SELECT, ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE,
244 : : ST_ENTRY, ST_EQUIVALENCE, ST_ERROR_STOP, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK,
245 : : ST_FORMAT, ST_FUNCTION, ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE,
246 : : ST_IMPORT, ST_INQUIRE, ST_INTERFACE, ST_SYNC_ALL, ST_SYNC_MEMORY,
247 : : ST_SYNC_IMAGES, ST_PARAMETER, ST_MODULE, ST_SUBMODULE, ST_MODULE_PROC,
248 : : ST_NAMELIST, ST_NULLIFY, ST_OPEN, ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC,
249 : : ST_READ, ST_RETURN, ST_REWIND, ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE,
250 : : ST_WHERE_BLOCK, ST_WHERE, ST_WAIT, ST_WRITE, ST_ASSIGNMENT,
251 : : ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE, ST_SIMPLE_IF,
252 : : ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT, ST_ENUM,
253 : : ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
254 : : ST_SELECT_RANK, ST_RANK, ST_STRUCTURE_DECL, ST_END_STRUCTURE,
255 : : ST_UNION, ST_END_UNION, ST_MAP, ST_END_MAP,
256 : : ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
257 : : ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS, ST_OACC_DATA,
258 : : ST_OACC_END_DATA, ST_OACC_HOST_DATA, ST_OACC_END_HOST_DATA, ST_OACC_LOOP,
259 : : ST_OACC_END_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE, ST_OACC_WAIT,
260 : : ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
261 : : ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL,
262 : : ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE,
263 : : ST_OACC_ATOMIC, ST_OACC_END_ATOMIC,
264 : : ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
265 : : ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
266 : : ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
267 : : ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE,
268 : : ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
269 : : ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
270 : : ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
271 : : ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
272 : : ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_OMP_CANCEL, ST_OMP_CANCELLATION_POINT,
273 : : ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, ST_OMP_SIMD, ST_OMP_END_SIMD,
274 : : ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD,
275 : : ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_REDUCTION,
276 : : ST_OMP_TARGET, ST_OMP_END_TARGET, ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA,
277 : : ST_OMP_TARGET_UPDATE, ST_OMP_DECLARE_TARGET, ST_OMP_DECLARE_VARIANT,
278 : : ST_OMP_TEAMS, ST_OMP_END_TEAMS, ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE,
279 : : ST_OMP_DISTRIBUTE_SIMD, ST_OMP_END_DISTRIBUTE_SIMD,
280 : : ST_OMP_DISTRIBUTE_PARALLEL_DO, ST_OMP_END_DISTRIBUTE_PARALLEL_DO,
281 : : ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD,
282 : : ST_OMP_TARGET_TEAMS, ST_OMP_END_TARGET_TEAMS, ST_OMP_TEAMS_DISTRIBUTE,
283 : : ST_OMP_END_TEAMS_DISTRIBUTE, ST_OMP_TEAMS_DISTRIBUTE_SIMD,
284 : : ST_OMP_END_TEAMS_DISTRIBUTE_SIMD, ST_OMP_TARGET_TEAMS_DISTRIBUTE,
285 : : ST_OMP_END_TARGET_TEAMS_DISTRIBUTE, ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD,
286 : : ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD, ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO,
287 : : ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO,
288 : : ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO,
289 : : ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO,
290 : : ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
291 : : ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
292 : : ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
293 : : ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
294 : : ST_OMP_TARGET_PARALLEL, ST_OMP_END_TARGET_PARALLEL,
295 : : ST_OMP_TARGET_PARALLEL_DO, ST_OMP_END_TARGET_PARALLEL_DO,
296 : : ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD,
297 : : ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA,
298 : : ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD,
299 : : ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, ST_OMP_DEPOBJ,
300 : : ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
301 : : ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
302 : : ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
303 : : ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM,
304 : : ST_END_TEAM, ST_SYNC_TEAM, ST_OMP_PARALLEL_MASTER,
305 : : ST_OMP_END_PARALLEL_MASTER, ST_OMP_PARALLEL_MASTER_TASKLOOP,
306 : : ST_OMP_END_PARALLEL_MASTER_TASKLOOP, ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD,
307 : : ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD, ST_OMP_MASTER_TASKLOOP,
308 : : ST_OMP_END_MASTER_TASKLOOP, ST_OMP_MASTER_TASKLOOP_SIMD,
309 : : ST_OMP_END_MASTER_TASKLOOP_SIMD, ST_OMP_LOOP, ST_OMP_END_LOOP,
310 : : ST_OMP_PARALLEL_LOOP, ST_OMP_END_PARALLEL_LOOP, ST_OMP_TEAMS_LOOP,
311 : : ST_OMP_END_TEAMS_LOOP, ST_OMP_TARGET_PARALLEL_LOOP,
312 : : ST_OMP_END_TARGET_PARALLEL_LOOP, ST_OMP_TARGET_TEAMS_LOOP,
313 : : ST_OMP_END_TARGET_TEAMS_LOOP, ST_OMP_MASKED, ST_OMP_END_MASKED,
314 : : ST_OMP_PARALLEL_MASKED, ST_OMP_END_PARALLEL_MASKED,
315 : : ST_OMP_PARALLEL_MASKED_TASKLOOP, ST_OMP_END_PARALLEL_MASKED_TASKLOOP,
316 : : ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
317 : : ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP,
318 : : ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD,
319 : : ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE,
320 : : ST_OMP_ERROR, ST_OMP_ASSUME, ST_OMP_END_ASSUME, ST_OMP_ASSUMES,
321 : : ST_OMP_ALLOCATE, ST_OMP_ALLOCATE_EXEC,
322 : : ST_OMP_ALLOCATORS, ST_OMP_END_ALLOCATORS,
323 : : /* Note: gfc_match_omp_nothing returns ST_NONE. */
324 : : ST_OMP_NOTHING, ST_NONE,
325 : : ST_OMP_UNROLL, ST_OMP_END_UNROLL,
326 : : ST_OMP_TILE, ST_OMP_END_TILE, ST_OMP_INTEROP
327 : : };
328 : :
329 : : /* Types of interfaces that we can have. Assignment interfaces are
330 : : considered to be intrinsic operators. */
331 : : enum interface_type
332 : : {
333 : : INTERFACE_NAMELESS = 1, INTERFACE_GENERIC,
334 : : INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT,
335 : : INTERFACE_DTIO
336 : : };
337 : :
338 : : /* Symbol flavors: these are all mutually exclusive.
339 : : 12 elements = 4 bits. */
340 : : enum sym_flavor
341 : : {
342 : : FL_UNKNOWN = 0, FL_PROGRAM, FL_BLOCK_DATA, FL_MODULE, FL_VARIABLE,
343 : : FL_PARAMETER, FL_LABEL, FL_PROCEDURE, FL_DERIVED, FL_NAMELIST,
344 : : FL_UNION, FL_STRUCT, FL_VOID
345 : : };
346 : :
347 : : /* Procedure types. 7 elements = 3 bits. */
348 : : enum procedure_type
349 : : { PROC_UNKNOWN, PROC_MODULE, PROC_INTERNAL, PROC_DUMMY,
350 : : PROC_INTRINSIC, PROC_ST_FUNCTION, PROC_EXTERNAL
351 : : };
352 : :
353 : : /* Intent types. Note that these values are also used in another enum in
354 : : decl.cc (match_attr_spec). */
355 : : enum sym_intent
356 : : { INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT
357 : : };
358 : :
359 : : /* Access types. */
360 : : enum gfc_access
361 : : { ACCESS_UNKNOWN = 0, ACCESS_PUBLIC, ACCESS_PRIVATE
362 : : };
363 : :
364 : : /* Flags to keep track of where an interface came from.
365 : : 3 elements = 2 bits. */
366 : : enum ifsrc
367 : : { IFSRC_UNKNOWN = 0, /* Interface unknown, only return type may be known. */
368 : : IFSRC_DECL, /* FUNCTION or SUBROUTINE declaration. */
369 : : IFSRC_IFBODY /* INTERFACE statement or PROCEDURE statement
370 : : with explicit interface. */
371 : : };
372 : :
373 : : /* Whether a SAVE attribute was set explicitly or implicitly. */
374 : : enum save_state
375 : : { SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
376 : : };
377 : :
378 : : /* OpenACC 'routine' directive's level of parallelism. */
379 : : enum oacc_routine_lop
380 : : { OACC_ROUTINE_LOP_NONE = 0,
381 : : OACC_ROUTINE_LOP_GANG,
382 : : OACC_ROUTINE_LOP_WORKER,
383 : : OACC_ROUTINE_LOP_VECTOR,
384 : : OACC_ROUTINE_LOP_SEQ,
385 : : OACC_ROUTINE_LOP_ERROR
386 : : };
387 : :
388 : : /* Strings for all symbol attributes. We use these for dumping the
389 : : parse tree, in error messages, and also when reading and writing
390 : : modules. In symbol.cc. */
391 : : extern const mstring flavors[];
392 : : extern const mstring procedures[];
393 : : extern const mstring intents[];
394 : : extern const mstring access_types[];
395 : : extern const mstring ifsrc_types[];
396 : : extern const mstring save_status[];
397 : :
398 : : /* Strings for DTIO procedure names. In symbol.cc. */
399 : : extern const mstring dtio_procs[];
400 : :
401 : : enum dtio_codes
402 : : { DTIO_RF = 0, DTIO_WF, DTIO_RUF, DTIO_WUF };
403 : :
404 : : /* Enumeration of all the generic intrinsic functions. Used by the
405 : : backend for identification of a function. */
406 : :
407 : : enum gfc_isym_id
408 : : {
409 : : /* GFC_ISYM_NONE is used for intrinsics which will never be seen by
410 : : the backend (e.g. KIND). */
411 : : GFC_ISYM_NONE = 0,
412 : : GFC_ISYM_ABORT,
413 : : GFC_ISYM_ABS,
414 : : GFC_ISYM_ACCESS,
415 : : GFC_ISYM_ACHAR,
416 : : GFC_ISYM_ACOS,
417 : : GFC_ISYM_ACOSD,
418 : : GFC_ISYM_ACOSH,
419 : : GFC_ISYM_ADJUSTL,
420 : : GFC_ISYM_ADJUSTR,
421 : : GFC_ISYM_AIMAG,
422 : : GFC_ISYM_AINT,
423 : : GFC_ISYM_ALARM,
424 : : GFC_ISYM_ALL,
425 : : GFC_ISYM_ALLOCATED,
426 : : GFC_ISYM_AND,
427 : : GFC_ISYM_ANINT,
428 : : GFC_ISYM_ANY,
429 : : GFC_ISYM_ASIN,
430 : : GFC_ISYM_ASIND,
431 : : GFC_ISYM_ASINH,
432 : : GFC_ISYM_ASSOCIATED,
433 : : GFC_ISYM_ATAN,
434 : : GFC_ISYM_ATAN2,
435 : : GFC_ISYM_ATAN2D,
436 : : GFC_ISYM_ATAND,
437 : : GFC_ISYM_ATANH,
438 : : GFC_ISYM_ATOMIC_ADD,
439 : : GFC_ISYM_ATOMIC_AND,
440 : : GFC_ISYM_ATOMIC_CAS,
441 : : GFC_ISYM_ATOMIC_DEF,
442 : : GFC_ISYM_ATOMIC_FETCH_ADD,
443 : : GFC_ISYM_ATOMIC_FETCH_AND,
444 : : GFC_ISYM_ATOMIC_FETCH_OR,
445 : : GFC_ISYM_ATOMIC_FETCH_XOR,
446 : : GFC_ISYM_ATOMIC_OR,
447 : : GFC_ISYM_ATOMIC_REF,
448 : : GFC_ISYM_ATOMIC_XOR,
449 : : GFC_ISYM_BGE,
450 : : GFC_ISYM_BGT,
451 : : GFC_ISYM_BIT_SIZE,
452 : : GFC_ISYM_BLE,
453 : : GFC_ISYM_BLT,
454 : : GFC_ISYM_BTEST,
455 : : GFC_ISYM_CAF_GET,
456 : : GFC_ISYM_CAF_SEND,
457 : : GFC_ISYM_CEILING,
458 : : GFC_ISYM_CHAR,
459 : : GFC_ISYM_CHDIR,
460 : : GFC_ISYM_CHMOD,
461 : : GFC_ISYM_CMPLX,
462 : : GFC_ISYM_CO_BROADCAST,
463 : : GFC_ISYM_CO_MAX,
464 : : GFC_ISYM_CO_MIN,
465 : : GFC_ISYM_CO_REDUCE,
466 : : GFC_ISYM_CO_SUM,
467 : : GFC_ISYM_COMMAND_ARGUMENT_COUNT,
468 : : GFC_ISYM_COMPILER_OPTIONS,
469 : : GFC_ISYM_COMPILER_VERSION,
470 : : GFC_ISYM_COMPLEX,
471 : : GFC_ISYM_CONJG,
472 : : GFC_ISYM_CONVERSION,
473 : : GFC_ISYM_COS,
474 : : GFC_ISYM_COSD,
475 : : GFC_ISYM_COSH,
476 : : GFC_ISYM_COTAN,
477 : : GFC_ISYM_COTAND,
478 : : GFC_ISYM_COUNT,
479 : : GFC_ISYM_CPU_TIME,
480 : : GFC_ISYM_CSHIFT,
481 : : GFC_ISYM_CTIME,
482 : : GFC_ISYM_C_ASSOCIATED,
483 : : GFC_ISYM_C_F_POINTER,
484 : : GFC_ISYM_C_F_PROCPOINTER,
485 : : GFC_ISYM_C_FUNLOC,
486 : : GFC_ISYM_C_LOC,
487 : : GFC_ISYM_C_SIZEOF,
488 : : GFC_ISYM_DATE_AND_TIME,
489 : : GFC_ISYM_DBLE,
490 : : GFC_ISYM_DFLOAT,
491 : : GFC_ISYM_DIGITS,
492 : : GFC_ISYM_DIM,
493 : : GFC_ISYM_DOT_PRODUCT,
494 : : GFC_ISYM_DPROD,
495 : : GFC_ISYM_DSHIFTL,
496 : : GFC_ISYM_DSHIFTR,
497 : : GFC_ISYM_DTIME,
498 : : GFC_ISYM_EOSHIFT,
499 : : GFC_ISYM_EPSILON,
500 : : GFC_ISYM_ERF,
501 : : GFC_ISYM_ERFC,
502 : : GFC_ISYM_ERFC_SCALED,
503 : : GFC_ISYM_ETIME,
504 : : GFC_ISYM_EVENT_QUERY,
505 : : GFC_ISYM_EXECUTE_COMMAND_LINE,
506 : : GFC_ISYM_EXIT,
507 : : GFC_ISYM_EXP,
508 : : GFC_ISYM_EXPONENT,
509 : : GFC_ISYM_EXTENDS_TYPE_OF,
510 : : GFC_ISYM_FAILED_IMAGES,
511 : : GFC_ISYM_FDATE,
512 : : GFC_ISYM_FE_RUNTIME_ERROR,
513 : : GFC_ISYM_FGET,
514 : : GFC_ISYM_FGETC,
515 : : GFC_ISYM_FINDLOC,
516 : : GFC_ISYM_FLOAT,
517 : : GFC_ISYM_FLOOR,
518 : : GFC_ISYM_FLUSH,
519 : : GFC_ISYM_FNUM,
520 : : GFC_ISYM_FPUT,
521 : : GFC_ISYM_FPUTC,
522 : : GFC_ISYM_FRACTION,
523 : : GFC_ISYM_FREE,
524 : : GFC_ISYM_FSEEK,
525 : : GFC_ISYM_FSTAT,
526 : : GFC_ISYM_FTELL,
527 : : GFC_ISYM_TGAMMA,
528 : : GFC_ISYM_GERROR,
529 : : GFC_ISYM_GETARG,
530 : : GFC_ISYM_GET_COMMAND,
531 : : GFC_ISYM_GET_COMMAND_ARGUMENT,
532 : : GFC_ISYM_GETCWD,
533 : : GFC_ISYM_GETENV,
534 : : GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
535 : : GFC_ISYM_GETGID,
536 : : GFC_ISYM_GETLOG,
537 : : GFC_ISYM_GETPID,
538 : : GFC_ISYM_GET_TEAM,
539 : : GFC_ISYM_GETUID,
540 : : GFC_ISYM_GMTIME,
541 : : GFC_ISYM_HOSTNM,
542 : : GFC_ISYM_HUGE,
543 : : GFC_ISYM_HYPOT,
544 : : GFC_ISYM_IACHAR,
545 : : GFC_ISYM_IALL,
546 : : GFC_ISYM_IAND,
547 : : GFC_ISYM_IANY,
548 : : GFC_ISYM_IARGC,
549 : : GFC_ISYM_IBCLR,
550 : : GFC_ISYM_IBITS,
551 : : GFC_ISYM_IBSET,
552 : : GFC_ISYM_ICHAR,
553 : : GFC_ISYM_IDATE,
554 : : GFC_ISYM_IEOR,
555 : : GFC_ISYM_IERRNO,
556 : : GFC_ISYM_IMAGE_INDEX,
557 : : GFC_ISYM_IMAGE_STATUS,
558 : : GFC_ISYM_INDEX,
559 : : GFC_ISYM_INT,
560 : : GFC_ISYM_INT2,
561 : : GFC_ISYM_INT8,
562 : : GFC_ISYM_IOR,
563 : : GFC_ISYM_IPARITY,
564 : : GFC_ISYM_IRAND,
565 : : GFC_ISYM_ISATTY,
566 : : GFC_ISYM_IS_CONTIGUOUS,
567 : : GFC_ISYM_IS_IOSTAT_END,
568 : : GFC_ISYM_IS_IOSTAT_EOR,
569 : : GFC_ISYM_ISNAN,
570 : : GFC_ISYM_ISHFT,
571 : : GFC_ISYM_ISHFTC,
572 : : GFC_ISYM_ITIME,
573 : : GFC_ISYM_J0,
574 : : GFC_ISYM_J1,
575 : : GFC_ISYM_JN,
576 : : GFC_ISYM_JN2,
577 : : GFC_ISYM_KILL,
578 : : GFC_ISYM_KIND,
579 : : GFC_ISYM_LBOUND,
580 : : GFC_ISYM_LCOBOUND,
581 : : GFC_ISYM_LEADZ,
582 : : GFC_ISYM_LEN,
583 : : GFC_ISYM_LEN_TRIM,
584 : : GFC_ISYM_LGAMMA,
585 : : GFC_ISYM_LGE,
586 : : GFC_ISYM_LGT,
587 : : GFC_ISYM_LINK,
588 : : GFC_ISYM_LLE,
589 : : GFC_ISYM_LLT,
590 : : GFC_ISYM_LOC,
591 : : GFC_ISYM_LOG,
592 : : GFC_ISYM_LOG10,
593 : : GFC_ISYM_LOGICAL,
594 : : GFC_ISYM_LONG,
595 : : GFC_ISYM_LSHIFT,
596 : : GFC_ISYM_LSTAT,
597 : : GFC_ISYM_LTIME,
598 : : GFC_ISYM_MALLOC,
599 : : GFC_ISYM_MASKL,
600 : : GFC_ISYM_MASKR,
601 : : GFC_ISYM_MATMUL,
602 : : GFC_ISYM_MAX,
603 : : GFC_ISYM_MAXEXPONENT,
604 : : GFC_ISYM_MAXLOC,
605 : : GFC_ISYM_MAXVAL,
606 : : GFC_ISYM_MCLOCK,
607 : : GFC_ISYM_MCLOCK8,
608 : : GFC_ISYM_MERGE,
609 : : GFC_ISYM_MERGE_BITS,
610 : : GFC_ISYM_MIN,
611 : : GFC_ISYM_MINEXPONENT,
612 : : GFC_ISYM_MINLOC,
613 : : GFC_ISYM_MINVAL,
614 : : GFC_ISYM_MOD,
615 : : GFC_ISYM_MODULO,
616 : : GFC_ISYM_MOVE_ALLOC,
617 : : GFC_ISYM_MVBITS,
618 : : GFC_ISYM_NEAREST,
619 : : GFC_ISYM_NEW_LINE,
620 : : GFC_ISYM_NINT,
621 : : GFC_ISYM_NORM2,
622 : : GFC_ISYM_NOT,
623 : : GFC_ISYM_NULL,
624 : : GFC_ISYM_NUM_IMAGES,
625 : : GFC_ISYM_OR,
626 : : GFC_ISYM_PACK,
627 : : GFC_ISYM_PARITY,
628 : : GFC_ISYM_PERROR,
629 : : GFC_ISYM_POPCNT,
630 : : GFC_ISYM_POPPAR,
631 : : GFC_ISYM_PRECISION,
632 : : GFC_ISYM_PRESENT,
633 : : GFC_ISYM_PRODUCT,
634 : : GFC_ISYM_RADIX,
635 : : GFC_ISYM_RAND,
636 : : GFC_ISYM_RANDOM_INIT,
637 : : GFC_ISYM_RANDOM_NUMBER,
638 : : GFC_ISYM_RANDOM_SEED,
639 : : GFC_ISYM_RANGE,
640 : : GFC_ISYM_RANK,
641 : : GFC_ISYM_REAL,
642 : : GFC_ISYM_REALPART,
643 : : GFC_ISYM_RENAME,
644 : : GFC_ISYM_REPEAT,
645 : : GFC_ISYM_RESHAPE,
646 : : GFC_ISYM_RRSPACING,
647 : : GFC_ISYM_RSHIFT,
648 : : GFC_ISYM_SAME_TYPE_AS,
649 : : GFC_ISYM_SC_KIND,
650 : : GFC_ISYM_SCALE,
651 : : GFC_ISYM_SCAN,
652 : : GFC_ISYM_SECNDS,
653 : : GFC_ISYM_SECOND,
654 : : GFC_ISYM_SET_EXPONENT,
655 : : GFC_ISYM_SHAPE,
656 : : GFC_ISYM_SHIFTA,
657 : : GFC_ISYM_SHIFTL,
658 : : GFC_ISYM_SHIFTR,
659 : : GFC_ISYM_BACKTRACE,
660 : : GFC_ISYM_SIGN,
661 : : GFC_ISYM_SIGNAL,
662 : : GFC_ISYM_SI_KIND,
663 : : GFC_ISYM_SIN,
664 : : GFC_ISYM_SIND,
665 : : GFC_ISYM_SINH,
666 : : GFC_ISYM_SIZE,
667 : : GFC_ISYM_SL_KIND,
668 : : GFC_ISYM_SLEEP,
669 : : GFC_ISYM_SIZEOF,
670 : : GFC_ISYM_SNGL,
671 : : GFC_ISYM_SPACING,
672 : : GFC_ISYM_SPREAD,
673 : : GFC_ISYM_SQRT,
674 : : GFC_ISYM_SRAND,
675 : : GFC_ISYM_SR_KIND,
676 : : GFC_ISYM_STAT,
677 : : GFC_ISYM_STOPPED_IMAGES,
678 : : GFC_ISYM_STORAGE_SIZE,
679 : : GFC_ISYM_STRIDE,
680 : : GFC_ISYM_SUM,
681 : : GFC_ISYM_SYMLINK,
682 : : GFC_ISYM_SYMLNK,
683 : : GFC_ISYM_SYSTEM,
684 : : GFC_ISYM_SYSTEM_CLOCK,
685 : : GFC_ISYM_TAN,
686 : : GFC_ISYM_TAND,
687 : : GFC_ISYM_TANH,
688 : : GFC_ISYM_TEAM_NUMBER,
689 : : GFC_ISYM_THIS_IMAGE,
690 : : GFC_ISYM_TIME,
691 : : GFC_ISYM_TIME8,
692 : : GFC_ISYM_TINY,
693 : : GFC_ISYM_TRAILZ,
694 : : GFC_ISYM_TRANSFER,
695 : : GFC_ISYM_TRANSPOSE,
696 : : GFC_ISYM_TRIM,
697 : : GFC_ISYM_TTYNAM,
698 : : GFC_ISYM_UBOUND,
699 : : GFC_ISYM_UCOBOUND,
700 : : GFC_ISYM_UMASK,
701 : : GFC_ISYM_UNLINK,
702 : : GFC_ISYM_UNPACK,
703 : : GFC_ISYM_VERIFY,
704 : : GFC_ISYM_XOR,
705 : : GFC_ISYM_Y0,
706 : : GFC_ISYM_Y1,
707 : : GFC_ISYM_YN,
708 : : GFC_ISYM_YN2
709 : : };
710 : :
711 : : enum init_local_logical
712 : : {
713 : : GFC_INIT_LOGICAL_OFF = 0,
714 : : GFC_INIT_LOGICAL_FALSE,
715 : : GFC_INIT_LOGICAL_TRUE
716 : : };
717 : :
718 : : enum init_local_character
719 : : {
720 : : GFC_INIT_CHARACTER_OFF = 0,
721 : : GFC_INIT_CHARACTER_ON
722 : : };
723 : :
724 : : enum init_local_integer
725 : : {
726 : : GFC_INIT_INTEGER_OFF = 0,
727 : : GFC_INIT_INTEGER_ON
728 : : };
729 : :
730 : : enum gfc_reverse
731 : : {
732 : : GFC_ENABLE_REVERSE,
733 : : GFC_FORWARD_SET,
734 : : GFC_REVERSE_SET,
735 : : GFC_INHIBIT_REVERSE
736 : : };
737 : :
738 : : enum gfc_param_spec_type
739 : : {
740 : : SPEC_EXPLICIT,
741 : : SPEC_ASSUMED,
742 : : SPEC_DEFERRED
743 : : };
744 : :
745 : : /************************* Structures *****************************/
746 : :
747 : : /* Used for keeping things in balanced binary trees. */
748 : : #define BBT_HEADER(self) int priority; struct self *left, *right
749 : :
750 : : #define NAMED_INTCST(a,b,c,d) a,
751 : : #define NAMED_KINDARRAY(a,b,c,d) a,
752 : : #define NAMED_FUNCTION(a,b,c,d) a,
753 : : #define NAMED_SUBROUTINE(a,b,c,d) a,
754 : : #define NAMED_DERIVED_TYPE(a,b,c,d) a,
755 : : enum iso_fortran_env_symbol
756 : : {
757 : : ISOFORTRANENV_INVALID = -1,
758 : : #include "iso-fortran-env.def"
759 : : ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
760 : : };
761 : : #undef NAMED_INTCST
762 : : #undef NAMED_KINDARRAY
763 : : #undef NAMED_FUNCTION
764 : : #undef NAMED_SUBROUTINE
765 : : #undef NAMED_DERIVED_TYPE
766 : :
767 : : #define NAMED_INTCST(a,b,c,d) a,
768 : : #define NAMED_REALCST(a,b,c,d) a,
769 : : #define NAMED_CMPXCST(a,b,c,d) a,
770 : : #define NAMED_LOGCST(a,b,c) a,
771 : : #define NAMED_CHARKNDCST(a,b,c) a,
772 : : #define NAMED_CHARCST(a,b,c) a,
773 : : #define DERIVED_TYPE(a,b,c) a,
774 : : #define NAMED_FUNCTION(a,b,c,d) a,
775 : : #define NAMED_SUBROUTINE(a,b,c,d) a,
776 : : enum iso_c_binding_symbol
777 : : {
778 : : ISOCBINDING_INVALID = -1,
779 : : #include "iso-c-binding.def"
780 : : ISOCBINDING_LAST,
781 : : ISOCBINDING_NUMBER = ISOCBINDING_LAST
782 : : };
783 : : #undef NAMED_INTCST
784 : : #undef NAMED_REALCST
785 : : #undef NAMED_CMPXCST
786 : : #undef NAMED_LOGCST
787 : : #undef NAMED_CHARKNDCST
788 : : #undef NAMED_CHARCST
789 : : #undef DERIVED_TYPE
790 : : #undef NAMED_FUNCTION
791 : : #undef NAMED_SUBROUTINE
792 : :
793 : : enum intmod_id
794 : : {
795 : : INTMOD_NONE = 0, INTMOD_ISO_FORTRAN_ENV, INTMOD_ISO_C_BINDING,
796 : : INTMOD_IEEE_FEATURES, INTMOD_IEEE_EXCEPTIONS, INTMOD_IEEE_ARITHMETIC
797 : : };
798 : :
799 : : typedef struct
800 : : {
801 : : char name[GFC_MAX_SYMBOL_LEN + 1];
802 : : int value; /* Used for both integer and character values. */
803 : : bt f90_type;
804 : : }
805 : : CInteropKind_t;
806 : :
807 : : /* Array of structs, where the structs represent the C interop kinds.
808 : : The list will be implemented based on a hash of the kind name since
809 : : these could be accessed multiple times.
810 : : Declared in trans-types.cc as a global, since it's in that file
811 : : that the list is initialized. */
812 : : extern CInteropKind_t c_interop_kinds_table[];
813 : :
814 : : enum gfc_omp_device_type
815 : : {
816 : : OMP_DEVICE_TYPE_UNSET,
817 : : OMP_DEVICE_TYPE_HOST,
818 : : OMP_DEVICE_TYPE_NOHOST,
819 : : OMP_DEVICE_TYPE_ANY
820 : : };
821 : :
822 : : enum gfc_omp_severity_type
823 : : {
824 : : OMP_SEVERITY_UNSET,
825 : : OMP_SEVERITY_WARNING,
826 : : OMP_SEVERITY_FATAL
827 : : };
828 : :
829 : : enum gfc_omp_at_type
830 : : {
831 : : OMP_AT_UNSET,
832 : : OMP_AT_COMPILATION,
833 : : OMP_AT_EXECUTION
834 : : };
835 : :
836 : : /* Structure and list of supported extension attributes. */
837 : : typedef enum
838 : : {
839 : : EXT_ATTR_DLLIMPORT = 0,
840 : : EXT_ATTR_DLLEXPORT,
841 : : EXT_ATTR_STDCALL,
842 : : EXT_ATTR_CDECL,
843 : : EXT_ATTR_FASTCALL,
844 : : EXT_ATTR_NO_ARG_CHECK,
845 : : EXT_ATTR_DEPRECATED,
846 : : EXT_ATTR_NOINLINE,
847 : : EXT_ATTR_NORETURN,
848 : : EXT_ATTR_WEAK,
849 : : EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
850 : : }
851 : : ext_attr_id_t;
852 : :
853 : : typedef struct
854 : : {
855 : : const char *name;
856 : : unsigned id;
857 : : const char *middle_end_name;
858 : : }
859 : : ext_attr_t;
860 : :
861 : : extern const ext_attr_t ext_attr_list[];
862 : :
863 : : /* Symbol attribute structure. */
864 : : typedef struct
865 : : {
866 : : /* Variable attributes. */
867 : : unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
868 : : optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
869 : : dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
870 : : implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
871 : : contiguous:1, fe_temp: 1, automatic: 1;
872 : :
873 : : /* For CLASS containers, the pointer attribute is sometimes set internally
874 : : even though it was not directly specified. In this case, keep the
875 : : "real" (original) value here. */
876 : : unsigned class_pointer:1;
877 : :
878 : : ENUM_BITFIELD (save_state) save:2;
879 : :
880 : : unsigned data:1, /* Symbol is named in a DATA statement. */
881 : : is_protected:1, /* Symbol has been marked as protected. */
882 : : use_assoc:1, /* Symbol has been use-associated. */
883 : : used_in_submodule:1, /* Symbol has been use-associated in a
884 : : submodule. Needed since these entities must
885 : : be set host associated to be compliant. */
886 : : use_only:1, /* Symbol has been use-associated, with ONLY. */
887 : : use_rename:1, /* Symbol has been use-associated and renamed. */
888 : : imported:1, /* Symbol has been associated by IMPORT. */
889 : : host_assoc:1; /* Symbol has been host associated. */
890 : :
891 : : unsigned in_namelist:1, in_common:1, in_equivalence:1;
892 : : unsigned function:1, subroutine:1, procedure:1;
893 : : unsigned generic:1, generic_copy:1;
894 : : unsigned implicit_type:1; /* Type defined via implicit rules. */
895 : : unsigned untyped:1; /* No implicit type could be found. */
896 : :
897 : : unsigned is_bind_c:1; /* say if is bound to C. */
898 : : unsigned extension:8; /* extension level of a derived type. */
899 : : unsigned is_class:1; /* is a CLASS container. */
900 : : unsigned class_ok:1; /* is a CLASS object with correct attributes. */
901 : : unsigned vtab:1; /* is a derived type vtab, pointed to by CLASS objects. */
902 : : unsigned vtype:1; /* is a derived type of a vtab. */
903 : :
904 : : /* These flags are both in the typespec and attribute. The attribute
905 : : list is what gets read from/written to a module file. The typespec
906 : : is created from a decl being processed. */
907 : : unsigned is_c_interop:1; /* It's c interoperable. */
908 : : unsigned is_iso_c:1; /* Symbol is from iso_c_binding. */
909 : :
910 : : /* Function/subroutine attributes */
911 : : unsigned sequence:1, elemental:1, pure:1, recursive:1;
912 : : unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
913 : :
914 : : /* Set if this is a module function or subroutine. Note that it is an
915 : : attribute because it appears as a prefix in the declaration like
916 : : PURE, etc.. */
917 : : unsigned module_procedure:1;
918 : :
919 : : /* Set if a (public) symbol [e.g. generic name] exposes this symbol,
920 : : which is relevant for private module procedures. */
921 : : unsigned public_used:1;
922 : :
923 : : /* This is set if a contained procedure could be declared pure. This is
924 : : used for certain optimizations that require the result or arguments
925 : : cannot alias. Note that this is zero for PURE procedures. */
926 : : unsigned implicit_pure:1;
927 : :
928 : : /* This is set for a procedure that contains expressions referencing
929 : : arrays coming from outside its namespace.
930 : : This is used to force the creation of a temporary when the LHS of
931 : : an array assignment may be used by an elemental procedure appearing
932 : : on the RHS. */
933 : : unsigned array_outer_dependency:1;
934 : :
935 : : /* This is set if the subroutine doesn't return. Currently, this
936 : : is only possible for intrinsic subroutines. */
937 : : unsigned noreturn:1;
938 : :
939 : : /* Set if this procedure is an alternate entry point. These procedures
940 : : don't have any code associated, and the backend will turn them into
941 : : thunks to the master function. */
942 : : unsigned entry:1;
943 : :
944 : : /* Set if this is the master function for a procedure with multiple
945 : : entry points. */
946 : : unsigned entry_master:1;
947 : :
948 : : /* Set if this is the master function for a function with multiple
949 : : entry points where characteristics of the entry points differ. */
950 : : unsigned mixed_entry_master:1;
951 : :
952 : : /* Set if a function must always be referenced by an explicit interface. */
953 : : unsigned always_explicit:1;
954 : :
955 : : /* Set if the symbol is generated and, hence, standard violations
956 : : shouldn't be flaged. */
957 : : unsigned artificial:1;
958 : :
959 : : /* Set if the symbol has been referenced in an expression. No further
960 : : modification of type or type parameters is permitted. */
961 : : unsigned referenced:1;
962 : :
963 : : /* Set if this is the symbol for the main program. */
964 : : unsigned is_main_program:1;
965 : :
966 : : /* Mutually exclusive multibit attributes. */
967 : : ENUM_BITFIELD (gfc_access) access:2;
968 : : ENUM_BITFIELD (sym_intent) intent:2;
969 : : ENUM_BITFIELD (sym_flavor) flavor:4;
970 : : ENUM_BITFIELD (ifsrc) if_source:2;
971 : :
972 : : ENUM_BITFIELD (procedure_type) proc:3;
973 : :
974 : : /* Special attributes for Cray pointers, pointees. */
975 : : unsigned cray_pointer:1, cray_pointee:1;
976 : :
977 : : /* The symbol is a derived type with allocatable components, pointer
978 : : components or private components, procedure pointer components,
979 : : possibly nested. zero_comp is true if the derived type has no
980 : : component at all. defined_assign_comp is true if the derived
981 : : type or a (sub-)component has a typebound defined assignment.
982 : : unlimited_polymorphic flags the type of the container for these
983 : : entities. */
984 : : unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
985 : : private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1,
986 : : event_comp:1, defined_assign_comp:1, unlimited_polymorphic:1,
987 : : has_dtio_procs:1, caf_token:1;
988 : :
989 : : /* This is a temporary selector for SELECT TYPE/RANK or an associate
990 : : variable for SELECT TYPE/RANK or ASSOCIATE. */
991 : : unsigned select_type_temporary:1, select_rank_temporary:1, associate_var:1;
992 : :
993 : : /* These are the attributes required for parameterized derived
994 : : types. */
995 : : unsigned pdt_kind:1, pdt_len:1, pdt_type:1, pdt_template:1,
996 : : pdt_array:1, pdt_string:1;
997 : :
998 : : /* This is omp_{out,in,priv,orig} artificial variable in
999 : : !$OMP DECLARE REDUCTION. */
1000 : : unsigned omp_udr_artificial_var:1;
1001 : :
1002 : : /* Mentioned in OMP DECLARE TARGET. */
1003 : : unsigned omp_declare_target:1;
1004 : : unsigned omp_declare_target_link:1;
1005 : : unsigned omp_declare_target_indirect:1;
1006 : : ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
1007 : : unsigned omp_allocate:1;
1008 : :
1009 : : /* Mentioned in OACC DECLARE. */
1010 : : unsigned oacc_declare_create:1;
1011 : : unsigned oacc_declare_copyin:1;
1012 : : unsigned oacc_declare_deviceptr:1;
1013 : : unsigned oacc_declare_device_resident:1;
1014 : : unsigned oacc_declare_link:1;
1015 : :
1016 : : /* OpenACC 'routine' directive's level of parallelism. */
1017 : : ENUM_BITFIELD (oacc_routine_lop) oacc_routine_lop:3;
1018 : : unsigned oacc_routine_nohost:1;
1019 : :
1020 : : /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
1021 : : unsigned ext_attr:EXT_ATTR_NUM;
1022 : :
1023 : : /* The namespace where the attribute has been set. */
1024 : : struct gfc_namespace *volatile_ns, *asynchronous_ns;
1025 : : }
1026 : : symbol_attribute;
1027 : :
1028 : :
1029 : : /* We need to store source lines as sequences of multibyte source
1030 : : characters. We define here a type wide enough to hold any multibyte
1031 : : source character, just like libcpp does. A 32-bit type is enough. */
1032 : :
1033 : : #if HOST_BITS_PER_INT >= 32
1034 : : typedef unsigned int gfc_char_t;
1035 : : #elif HOST_BITS_PER_LONG >= 32
1036 : : typedef unsigned long gfc_char_t;
1037 : : #elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
1038 : : typedef unsigned long long gfc_char_t;
1039 : : #else
1040 : : # error "Cannot find an integer type with at least 32 bits"
1041 : : #endif
1042 : :
1043 : :
1044 : : /* The following three structures are used to identify a location in
1045 : : the sources.
1046 : :
1047 : : gfc_file is used to maintain a tree of the source files and how
1048 : : they include each other
1049 : :
1050 : : gfc_linebuf holds a single line of source code and information
1051 : : which file it resides in
1052 : :
1053 : : locus point to the sourceline and the character in the source
1054 : : line.
1055 : : */
1056 : :
1057 : : typedef struct gfc_file
1058 : : {
1059 : : struct gfc_file *next, *up;
1060 : : int inclusion_line, line;
1061 : : char *filename;
1062 : : } gfc_file;
1063 : :
1064 : : typedef struct gfc_linebuf
1065 : : {
1066 : : location_t location;
1067 : : struct gfc_file *file;
1068 : : struct gfc_linebuf *next;
1069 : :
1070 : : int truncated;
1071 : : bool dbg_emitted;
1072 : :
1073 : : gfc_char_t line[1];
1074 : : } gfc_linebuf;
1075 : :
1076 : : #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
1077 : :
1078 : : #define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
1079 : :
1080 : : typedef struct
1081 : : {
1082 : : gfc_char_t *nextc;
1083 : : gfc_linebuf *lb;
1084 : : } locus;
1085 : :
1086 : : /* In order for the "gfc" format checking to work correctly, you must
1087 : : have declared a typedef locus first. */
1088 : : #if GCC_VERSION >= 4001
1089 : : #define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
1090 : : #else
1091 : : #define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
1092 : : #endif
1093 : :
1094 : :
1095 : : /* Suppress error messages or re-enable them. */
1096 : :
1097 : : void gfc_push_suppress_errors (void);
1098 : : void gfc_pop_suppress_errors (void);
1099 : : bool gfc_query_suppress_errors (void);
1100 : :
1101 : :
1102 : : /* Character length structures hold the expression that gives the
1103 : : length of a character variable. We avoid putting these into
1104 : : gfc_typespec because doing so prevents us from doing structure
1105 : : copies and forces us to deallocate any typespecs we create, as well
1106 : : as structures that contain typespecs. They also can have multiple
1107 : : character typespecs pointing to them.
1108 : :
1109 : : These structures form a singly linked list within the current
1110 : : namespace and are deallocated with the namespace. It is possible to
1111 : : end up with gfc_charlen structures that have nothing pointing to them. */
1112 : :
1113 : : typedef struct gfc_charlen
1114 : : {
1115 : : struct gfc_expr *length;
1116 : : struct gfc_charlen *next;
1117 : : bool length_from_typespec; /* Length from explicit array ctor typespec? */
1118 : : tree backend_decl;
1119 : : tree passed_length; /* Length argument explicitly passed. */
1120 : :
1121 : : int resolved;
1122 : : }
1123 : : gfc_charlen;
1124 : :
1125 : : #define gfc_get_charlen() XCNEW (gfc_charlen)
1126 : :
1127 : : /* Type specification structure. */
1128 : : typedef struct
1129 : : {
1130 : : bt type;
1131 : : int kind;
1132 : :
1133 : : union
1134 : : {
1135 : : struct gfc_symbol *derived; /* For derived types only. */
1136 : : gfc_charlen *cl; /* For character types only. */
1137 : : int pad; /* For hollerith types only. */
1138 : : }
1139 : : u;
1140 : :
1141 : : struct gfc_symbol *interface; /* For PROCEDURE declarations. */
1142 : : int is_c_interop;
1143 : : int is_iso_c;
1144 : : bt f90_type;
1145 : : bool deferred;
1146 : : gfc_symbol *interop_kind;
1147 : : }
1148 : : gfc_typespec;
1149 : :
1150 : : /* Array specification. */
1151 : : typedef struct
1152 : : {
1153 : : int rank; /* A scalar has a rank of 0, an assumed-rank array has -1. */
1154 : : int corank;
1155 : : array_type type, cotype;
1156 : : struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
1157 : :
1158 : : /* These two fields are used with the Cray Pointer extension. */
1159 : : bool cray_pointee; /* True iff this spec belongs to a cray pointee. */
1160 : : bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to
1161 : : AS_EXPLICIT, but we want to remember that we
1162 : : did this. */
1163 : :
1164 : : bool resolved;
1165 : : }
1166 : : gfc_array_spec;
1167 : :
1168 : : #define gfc_get_array_spec() XCNEW (gfc_array_spec)
1169 : :
1170 : :
1171 : : /* Components of derived types. */
1172 : : typedef struct gfc_component
1173 : : {
1174 : : const char *name;
1175 : : gfc_typespec ts;
1176 : :
1177 : : symbol_attribute attr;
1178 : : gfc_array_spec *as;
1179 : :
1180 : : tree backend_decl;
1181 : : /* Used to cache a FIELD_DECL matching this same component
1182 : : but applied to a different backend containing type that was
1183 : : generated by gfc_nonrestricted_type. */
1184 : : tree norestrict_decl;
1185 : : locus loc;
1186 : : struct gfc_expr *initializer;
1187 : : /* Used in parameterized derived type declarations to store parameterized
1188 : : kind expressions. */
1189 : : struct gfc_expr *kind_expr;
1190 : : struct gfc_actual_arglist *param_list;
1191 : :
1192 : : struct gfc_component *next;
1193 : :
1194 : : /* Needed for procedure pointer components. */
1195 : : struct gfc_typebound_proc *tb;
1196 : : /* When allocatable/pointer and in a coarray the associated token. */
1197 : : tree caf_token;
1198 : : }
1199 : : gfc_component;
1200 : :
1201 : : #define gfc_get_component() XCNEW (gfc_component)
1202 : :
1203 : : /* Formal argument lists are lists of symbols. */
1204 : : typedef struct gfc_formal_arglist
1205 : : {
1206 : : /* Symbol representing the argument at this position in the arglist. */
1207 : : struct gfc_symbol *sym;
1208 : : /* Points to the next formal argument. */
1209 : : struct gfc_formal_arglist *next;
1210 : : }
1211 : : gfc_formal_arglist;
1212 : :
1213 : : #define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
1214 : :
1215 : :
1216 : : struct gfc_dummy_arg;
1217 : :
1218 : :
1219 : : /* The gfc_actual_arglist structure is for actual arguments and
1220 : : for type parameter specification lists. */
1221 : : typedef struct gfc_actual_arglist
1222 : : {
1223 : : const char *name;
1224 : : /* Alternate return label when the expr member is null. */
1225 : : struct gfc_st_label *label;
1226 : :
1227 : : gfc_param_spec_type spec_type;
1228 : :
1229 : : struct gfc_expr *expr;
1230 : :
1231 : : /* The dummy arg this actual arg is associated with, if the interface
1232 : : is explicit. NULL otherwise. */
1233 : : gfc_dummy_arg *associated_dummy;
1234 : :
1235 : : struct gfc_actual_arglist *next;
1236 : : }
1237 : : gfc_actual_arglist;
1238 : :
1239 : : #define gfc_get_actual_arglist() XCNEW (gfc_actual_arglist)
1240 : :
1241 : :
1242 : : /* Because a symbol can belong to multiple namelists, they must be
1243 : : linked externally to the symbol itself. */
1244 : : typedef struct gfc_namelist
1245 : : {
1246 : : struct gfc_symbol *sym;
1247 : : struct gfc_namelist *next;
1248 : : }
1249 : : gfc_namelist;
1250 : :
1251 : : #define gfc_get_namelist() XCNEW (gfc_namelist)
1252 : :
1253 : : /* Likewise to gfc_namelist, but contains expressions. */
1254 : : typedef struct gfc_expr_list
1255 : : {
1256 : : struct gfc_expr *expr;
1257 : : struct gfc_expr_list *next;
1258 : : }
1259 : : gfc_expr_list;
1260 : :
1261 : : #define gfc_get_expr_list() XCNEW (gfc_expr_list)
1262 : :
1263 : : enum gfc_omp_reduction_op
1264 : : {
1265 : : OMP_REDUCTION_NONE = -1,
1266 : : OMP_REDUCTION_PLUS = INTRINSIC_PLUS,
1267 : : OMP_REDUCTION_MINUS = INTRINSIC_MINUS,
1268 : : OMP_REDUCTION_TIMES = INTRINSIC_TIMES,
1269 : : OMP_REDUCTION_AND = INTRINSIC_AND,
1270 : : OMP_REDUCTION_OR = INTRINSIC_OR,
1271 : : OMP_REDUCTION_EQV = INTRINSIC_EQV,
1272 : : OMP_REDUCTION_NEQV = INTRINSIC_NEQV,
1273 : : OMP_REDUCTION_MAX = GFC_INTRINSIC_END,
1274 : : OMP_REDUCTION_MIN,
1275 : : OMP_REDUCTION_IAND,
1276 : : OMP_REDUCTION_IOR,
1277 : : OMP_REDUCTION_IEOR,
1278 : : OMP_REDUCTION_USER
1279 : : };
1280 : :
1281 : : enum gfc_omp_depend_doacross_op
1282 : : {
1283 : : OMP_DEPEND_UNSET,
1284 : : OMP_DEPEND_IN,
1285 : : OMP_DEPEND_OUT,
1286 : : OMP_DEPEND_INOUT,
1287 : : OMP_DEPEND_INOUTSET,
1288 : : OMP_DEPEND_MUTEXINOUTSET,
1289 : : OMP_DEPEND_DEPOBJ,
1290 : : OMP_DEPEND_SINK_FIRST,
1291 : : OMP_DOACROSS_SINK_FIRST,
1292 : : OMP_DOACROSS_SINK
1293 : : };
1294 : :
1295 : : enum gfc_omp_map_op
1296 : : {
1297 : : OMP_MAP_ALLOC,
1298 : : OMP_MAP_IF_PRESENT,
1299 : : OMP_MAP_ATTACH,
1300 : : OMP_MAP_TO,
1301 : : OMP_MAP_FROM,
1302 : : OMP_MAP_TOFROM,
1303 : : OMP_MAP_DELETE,
1304 : : OMP_MAP_DETACH,
1305 : : OMP_MAP_FORCE_ALLOC,
1306 : : OMP_MAP_FORCE_TO,
1307 : : OMP_MAP_FORCE_FROM,
1308 : : OMP_MAP_FORCE_TOFROM,
1309 : : OMP_MAP_FORCE_PRESENT,
1310 : : OMP_MAP_FORCE_DEVICEPTR,
1311 : : OMP_MAP_DEVICE_RESIDENT,
1312 : : OMP_MAP_LINK,
1313 : : OMP_MAP_RELEASE,
1314 : : OMP_MAP_ALWAYS_TO,
1315 : : OMP_MAP_ALWAYS_FROM,
1316 : : OMP_MAP_ALWAYS_TOFROM,
1317 : : OMP_MAP_PRESENT_ALLOC,
1318 : : OMP_MAP_PRESENT_TO,
1319 : : OMP_MAP_PRESENT_FROM,
1320 : : OMP_MAP_PRESENT_TOFROM,
1321 : : OMP_MAP_ALWAYS_PRESENT_TO,
1322 : : OMP_MAP_ALWAYS_PRESENT_FROM,
1323 : : OMP_MAP_ALWAYS_PRESENT_TOFROM
1324 : : };
1325 : :
1326 : : enum gfc_omp_defaultmap
1327 : : {
1328 : : OMP_DEFAULTMAP_UNSET,
1329 : : OMP_DEFAULTMAP_ALLOC,
1330 : : OMP_DEFAULTMAP_TO,
1331 : : OMP_DEFAULTMAP_FROM,
1332 : : OMP_DEFAULTMAP_TOFROM,
1333 : : OMP_DEFAULTMAP_FIRSTPRIVATE,
1334 : : OMP_DEFAULTMAP_NONE,
1335 : : OMP_DEFAULTMAP_DEFAULT,
1336 : : OMP_DEFAULTMAP_PRESENT
1337 : : };
1338 : :
1339 : : enum gfc_omp_defaultmap_category
1340 : : {
1341 : : OMP_DEFAULTMAP_CAT_UNCATEGORIZED,
1342 : : OMP_DEFAULTMAP_CAT_ALL,
1343 : : OMP_DEFAULTMAP_CAT_SCALAR,
1344 : : OMP_DEFAULTMAP_CAT_AGGREGATE,
1345 : : OMP_DEFAULTMAP_CAT_ALLOCATABLE,
1346 : : OMP_DEFAULTMAP_CAT_POINTER,
1347 : : OMP_DEFAULTMAP_CAT_NUM
1348 : : };
1349 : :
1350 : : enum gfc_omp_linear_op
1351 : : {
1352 : : OMP_LINEAR_DEFAULT,
1353 : : OMP_LINEAR_REF,
1354 : : OMP_LINEAR_VAL,
1355 : : OMP_LINEAR_UVAL
1356 : : };
1357 : :
1358 : : /* For use in OpenMP clauses in case we need extra information
1359 : : (aligned clause alignment, linear clause step, etc.). */
1360 : :
1361 : : typedef struct gfc_omp_namelist
1362 : : {
1363 : : struct gfc_symbol *sym;
1364 : : struct gfc_expr *expr;
1365 : : union
1366 : : {
1367 : : gfc_omp_reduction_op reduction_op;
1368 : : gfc_omp_depend_doacross_op depend_doacross_op;
1369 : : struct
1370 : : {
1371 : : ENUM_BITFIELD (gfc_omp_map_op) op:8;
1372 : : bool readonly;
1373 : : } map;
1374 : : gfc_expr *align;
1375 : : struct
1376 : : {
1377 : : ENUM_BITFIELD (gfc_omp_linear_op) op:4;
1378 : : bool old_modifier;
1379 : : } linear;
1380 : : struct gfc_common_head *common;
1381 : : struct gfc_symbol *memspace_sym;
1382 : : bool lastprivate_conditional;
1383 : : bool present_modifier;
1384 : : struct
1385 : : {
1386 : : char *str;
1387 : : int len;
1388 : : bool target;
1389 : : bool targetsync;
1390 : : } init;
1391 : : } u;
1392 : : union
1393 : : {
1394 : : struct gfc_omp_namelist_udr *udr;
1395 : : gfc_namespace *ns;
1396 : : gfc_expr *allocator;
1397 : : struct gfc_symbol *traits_sym;
1398 : : struct gfc_omp_namelist *duplicate_of;
1399 : : int *interop_int;
1400 : : } u2;
1401 : : struct gfc_omp_namelist *next;
1402 : : locus where;
1403 : : }
1404 : : gfc_omp_namelist;
1405 : :
1406 : : #define gfc_get_omp_namelist() XCNEW (gfc_omp_namelist)
1407 : :
1408 : : enum
1409 : : {
1410 : : OMP_LIST_FIRST,
1411 : : OMP_LIST_PRIVATE = OMP_LIST_FIRST,
1412 : : OMP_LIST_FIRSTPRIVATE,
1413 : : OMP_LIST_LASTPRIVATE,
1414 : : OMP_LIST_COPYPRIVATE,
1415 : : OMP_LIST_SHARED,
1416 : : OMP_LIST_COPYIN,
1417 : : OMP_LIST_UNIFORM,
1418 : : OMP_LIST_AFFINITY,
1419 : : OMP_LIST_ALIGNED,
1420 : : OMP_LIST_LINEAR,
1421 : : OMP_LIST_DEPEND,
1422 : : OMP_LIST_MAP,
1423 : : OMP_LIST_TO,
1424 : : OMP_LIST_FROM,
1425 : : OMP_LIST_SCAN_IN,
1426 : : OMP_LIST_SCAN_EX,
1427 : : OMP_LIST_REDUCTION,
1428 : : OMP_LIST_REDUCTION_INSCAN,
1429 : : OMP_LIST_REDUCTION_TASK,
1430 : : OMP_LIST_IN_REDUCTION,
1431 : : OMP_LIST_TASK_REDUCTION,
1432 : : OMP_LIST_DEVICE_RESIDENT,
1433 : : OMP_LIST_LINK,
1434 : : OMP_LIST_USE_DEVICE,
1435 : : OMP_LIST_CACHE,
1436 : : OMP_LIST_IS_DEVICE_PTR,
1437 : : OMP_LIST_USE_DEVICE_PTR,
1438 : : OMP_LIST_USE_DEVICE_ADDR,
1439 : : OMP_LIST_NONTEMPORAL,
1440 : : OMP_LIST_ALLOCATE,
1441 : : OMP_LIST_HAS_DEVICE_ADDR,
1442 : : OMP_LIST_ENTER,
1443 : : OMP_LIST_USES_ALLOCATORS,
1444 : : OMP_LIST_INIT,
1445 : : OMP_LIST_USE,
1446 : : OMP_LIST_DESTROY,
1447 : : OMP_LIST_NUM /* Must be the last. */
1448 : : };
1449 : :
1450 : : /* Because a symbol can belong to multiple namelists, they must be
1451 : : linked externally to the symbol itself. */
1452 : :
1453 : : enum gfc_omp_sched_kind
1454 : : {
1455 : : OMP_SCHED_NONE,
1456 : : OMP_SCHED_STATIC,
1457 : : OMP_SCHED_DYNAMIC,
1458 : : OMP_SCHED_GUIDED,
1459 : : OMP_SCHED_RUNTIME,
1460 : : OMP_SCHED_AUTO
1461 : : };
1462 : :
1463 : : enum gfc_omp_default_sharing
1464 : : {
1465 : : OMP_DEFAULT_UNKNOWN,
1466 : : OMP_DEFAULT_NONE,
1467 : : OMP_DEFAULT_PRIVATE,
1468 : : OMP_DEFAULT_SHARED,
1469 : : OMP_DEFAULT_FIRSTPRIVATE,
1470 : : OMP_DEFAULT_PRESENT
1471 : : };
1472 : :
1473 : : enum gfc_omp_proc_bind_kind
1474 : : {
1475 : : OMP_PROC_BIND_UNKNOWN,
1476 : : OMP_PROC_BIND_PRIMARY,
1477 : : OMP_PROC_BIND_MASTER,
1478 : : OMP_PROC_BIND_SPREAD,
1479 : : OMP_PROC_BIND_CLOSE
1480 : : };
1481 : :
1482 : : enum gfc_omp_cancel_kind
1483 : : {
1484 : : OMP_CANCEL_UNKNOWN,
1485 : : OMP_CANCEL_PARALLEL,
1486 : : OMP_CANCEL_SECTIONS,
1487 : : OMP_CANCEL_DO,
1488 : : OMP_CANCEL_TASKGROUP
1489 : : };
1490 : :
1491 : : enum gfc_omp_if_kind
1492 : : {
1493 : : OMP_IF_CANCEL,
1494 : : OMP_IF_PARALLEL,
1495 : : OMP_IF_SIMD,
1496 : : OMP_IF_TASK,
1497 : : OMP_IF_TASKLOOP,
1498 : : OMP_IF_TARGET,
1499 : : OMP_IF_TARGET_DATA,
1500 : : OMP_IF_TARGET_UPDATE,
1501 : : OMP_IF_TARGET_ENTER_DATA,
1502 : : OMP_IF_TARGET_EXIT_DATA,
1503 : : OMP_IF_LAST
1504 : : };
1505 : :
1506 : : enum gfc_omp_atomic_op
1507 : : {
1508 : : GFC_OMP_ATOMIC_UNSET = 0,
1509 : : GFC_OMP_ATOMIC_UPDATE = 1,
1510 : : GFC_OMP_ATOMIC_READ = 2,
1511 : : GFC_OMP_ATOMIC_WRITE = 3,
1512 : : GFC_OMP_ATOMIC_MASK = 3,
1513 : : GFC_OMP_ATOMIC_SWAP = 16
1514 : : };
1515 : :
1516 : : enum gfc_omp_requires_kind
1517 : : {
1518 : : /* Keep in sync with gfc_namespace, esp. with omp_req_mem_order. */
1519 : : OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST = 1, /* 001 */
1520 : : OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL = 2, /* 010 */
1521 : : OMP_REQ_ATOMIC_MEM_ORDER_RELAXED = 3, /* 011 */
1522 : : OMP_REQ_ATOMIC_MEM_ORDER_ACQUIRE = 4, /* 100 */
1523 : : OMP_REQ_ATOMIC_MEM_ORDER_RELEASE = 5, /* 101 */
1524 : : OMP_REQ_REVERSE_OFFLOAD = (1 << 3),
1525 : : OMP_REQ_UNIFIED_ADDRESS = (1 << 4),
1526 : : OMP_REQ_UNIFIED_SHARED_MEMORY = (1 << 5),
1527 : : OMP_REQ_DYNAMIC_ALLOCATORS = (1 << 6),
1528 : : OMP_REQ_TARGET_MASK = (OMP_REQ_REVERSE_OFFLOAD
1529 : : | OMP_REQ_UNIFIED_ADDRESS
1530 : : | OMP_REQ_UNIFIED_SHARED_MEMORY),
1531 : : OMP_REQ_ATOMIC_MEM_ORDER_MASK = (OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST
1532 : : | OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL
1533 : : | OMP_REQ_ATOMIC_MEM_ORDER_RELAXED
1534 : : | OMP_REQ_ATOMIC_MEM_ORDER_ACQUIRE
1535 : : | OMP_REQ_ATOMIC_MEM_ORDER_RELEASE)
1536 : : };
1537 : :
1538 : : enum gfc_omp_memorder
1539 : : {
1540 : : OMP_MEMORDER_UNSET,
1541 : : OMP_MEMORDER_SEQ_CST,
1542 : : OMP_MEMORDER_ACQ_REL,
1543 : : OMP_MEMORDER_RELEASE,
1544 : : OMP_MEMORDER_ACQUIRE,
1545 : : OMP_MEMORDER_RELAXED
1546 : : };
1547 : :
1548 : : enum gfc_omp_bind_type
1549 : : {
1550 : : OMP_BIND_UNSET,
1551 : : OMP_BIND_TEAMS,
1552 : : OMP_BIND_PARALLEL,
1553 : : OMP_BIND_THREAD
1554 : : };
1555 : :
1556 : : typedef struct gfc_omp_assumptions
1557 : : {
1558 : : int n_absent, n_contains;
1559 : : enum gfc_statement *absent, *contains;
1560 : : gfc_expr_list *holds;
1561 : : bool no_openmp:1, no_openmp_routines:1, no_parallelism:1;
1562 : : }
1563 : : gfc_omp_assumptions;
1564 : :
1565 : : #define gfc_get_omp_assumptions() XCNEW (gfc_omp_assumptions)
1566 : :
1567 : :
1568 : : typedef struct gfc_omp_clauses
1569 : : {
1570 : : gfc_omp_namelist *lists[OMP_LIST_NUM];
1571 : : struct gfc_expr *if_expr;
1572 : : struct gfc_expr *if_exprs[OMP_IF_LAST];
1573 : : struct gfc_expr *self_expr;
1574 : : struct gfc_expr *final_expr;
1575 : : struct gfc_expr *num_threads;
1576 : : struct gfc_expr *chunk_size;
1577 : : struct gfc_expr *safelen_expr;
1578 : : struct gfc_expr *simdlen_expr;
1579 : : struct gfc_expr *num_teams_lower;
1580 : : struct gfc_expr *num_teams_upper;
1581 : : struct gfc_expr *device;
1582 : : struct gfc_expr *thread_limit;
1583 : : struct gfc_expr *grainsize;
1584 : : struct gfc_expr *filter;
1585 : : struct gfc_expr *hint;
1586 : : struct gfc_expr *num_tasks;
1587 : : struct gfc_expr *priority;
1588 : : struct gfc_expr *detach;
1589 : : struct gfc_expr *depobj;
1590 : : struct gfc_expr *dist_chunk_size;
1591 : : struct gfc_expr *message;
1592 : : struct gfc_omp_assumptions *assume;
1593 : : struct gfc_expr_list *sizes_list;
1594 : : const char *critical_name;
1595 : : enum gfc_omp_default_sharing default_sharing;
1596 : : enum gfc_omp_atomic_op atomic_op;
1597 : : enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
1598 : : int collapse, orderedc;
1599 : : int partial;
1600 : : unsigned nowait:1, ordered:1, untied:1, mergeable:1, ancestor:1;
1601 : : unsigned inbranch:1, notinbranch:1, nogroup:1;
1602 : : unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
1603 : : unsigned simd:1, threads:1, doacross_source:1, depend_source:1, destroy:1;
1604 : : unsigned order_unconstrained:1, order_reproducible:1, capture:1;
1605 : : unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
1606 : : unsigned non_rectangular:1, order_concurrent:1;
1607 : : unsigned contains_teams_construct:1, target_first_st_is_teams:1;
1608 : : unsigned contained_in_target_construct:1, indirect:1;
1609 : : unsigned full:1, erroneous:1;
1610 : : ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
1611 : : ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
1612 : : ENUM_BITFIELD (gfc_omp_memorder) memorder:3;
1613 : : ENUM_BITFIELD (gfc_omp_memorder) fail:3;
1614 : : ENUM_BITFIELD (gfc_omp_cancel_kind) cancel:3;
1615 : : ENUM_BITFIELD (gfc_omp_proc_bind_kind) proc_bind:3;
1616 : : ENUM_BITFIELD (gfc_omp_depend_doacross_op) depobj_update:4;
1617 : : ENUM_BITFIELD (gfc_omp_bind_type) bind:2;
1618 : : ENUM_BITFIELD (gfc_omp_at_type) at:2;
1619 : : ENUM_BITFIELD (gfc_omp_severity_type) severity:2;
1620 : : ENUM_BITFIELD (gfc_omp_sched_kind) dist_sched_kind:3;
1621 : :
1622 : : /* OpenACC. */
1623 : : struct gfc_expr *async_expr;
1624 : : struct gfc_expr *gang_static_expr;
1625 : : struct gfc_expr *gang_num_expr;
1626 : : struct gfc_expr *worker_expr;
1627 : : struct gfc_expr *vector_expr;
1628 : : struct gfc_expr *num_gangs_expr;
1629 : : struct gfc_expr *num_workers_expr;
1630 : : struct gfc_expr *vector_length_expr;
1631 : : gfc_expr_list *wait_list;
1632 : : gfc_expr_list *tile_list;
1633 : : unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
1634 : : unsigned par_auto:1, gang_static:1;
1635 : : unsigned if_present:1, finalize:1;
1636 : : unsigned nohost:1;
1637 : : locus loc;
1638 : : }
1639 : : gfc_omp_clauses;
1640 : :
1641 : : #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
1642 : :
1643 : :
1644 : : /* Node in the linked list used for storing !$oacc declare constructs. */
1645 : :
1646 : : typedef struct gfc_oacc_declare
1647 : : {
1648 : : struct gfc_oacc_declare *next;
1649 : : bool module_var;
1650 : : gfc_omp_clauses *clauses;
1651 : : locus loc;
1652 : : }
1653 : : gfc_oacc_declare;
1654 : :
1655 : : #define gfc_get_oacc_declare() XCNEW (gfc_oacc_declare)
1656 : :
1657 : :
1658 : : /* Node in the linked list used for storing !$omp declare simd constructs. */
1659 : :
1660 : : typedef struct gfc_omp_declare_simd
1661 : : {
1662 : : struct gfc_omp_declare_simd *next;
1663 : : locus where; /* Where the !$omp declare simd construct occurred. */
1664 : :
1665 : : gfc_symbol *proc_name;
1666 : :
1667 : : gfc_omp_clauses *clauses;
1668 : : }
1669 : : gfc_omp_declare_simd;
1670 : : #define gfc_get_omp_declare_simd() XCNEW (gfc_omp_declare_simd)
1671 : :
1672 : : /* For OpenMP trait selector enum types and tables. */
1673 : : #include "omp-selectors.h"
1674 : :
1675 : : typedef struct gfc_omp_trait_property
1676 : : {
1677 : : struct gfc_omp_trait_property *next;
1678 : : enum omp_tp_type property_kind;
1679 : : bool is_name : 1;
1680 : :
1681 : : union
1682 : : {
1683 : : gfc_expr *expr;
1684 : : gfc_symbol *sym;
1685 : : gfc_omp_clauses *clauses;
1686 : : char *name;
1687 : : };
1688 : : } gfc_omp_trait_property;
1689 : : #define gfc_get_omp_trait_property() XCNEW (gfc_omp_trait_property)
1690 : :
1691 : : typedef struct gfc_omp_selector
1692 : : {
1693 : : struct gfc_omp_selector *next;
1694 : : enum omp_ts_code code;
1695 : : gfc_expr *score;
1696 : : struct gfc_omp_trait_property *properties;
1697 : : } gfc_omp_selector;
1698 : : #define gfc_get_omp_selector() XCNEW (gfc_omp_selector)
1699 : :
1700 : : typedef struct gfc_omp_set_selector
1701 : : {
1702 : : struct gfc_omp_set_selector *next;
1703 : : enum omp_tss_code code;
1704 : : struct gfc_omp_selector *trait_selectors;
1705 : : } gfc_omp_set_selector;
1706 : : #define gfc_get_omp_set_selector() XCNEW (gfc_omp_set_selector)
1707 : :
1708 : :
1709 : : /* Node in the linked list used for storing !$omp declare variant
1710 : : constructs. */
1711 : :
1712 : : typedef struct gfc_omp_declare_variant
1713 : : {
1714 : : struct gfc_omp_declare_variant *next;
1715 : : locus where; /* Where the !$omp declare variant construct occurred. */
1716 : :
1717 : : struct gfc_symtree *base_proc_symtree;
1718 : : struct gfc_symtree *variant_proc_symtree;
1719 : :
1720 : : gfc_omp_set_selector *set_selectors;
1721 : :
1722 : : bool checked_p : 1; /* Set if previously checked for errors. */
1723 : : bool error_p : 1; /* Set if error found in directive. */
1724 : : }
1725 : : gfc_omp_declare_variant;
1726 : : #define gfc_get_omp_declare_variant() XCNEW (gfc_omp_declare_variant)
1727 : :
1728 : :
1729 : : typedef struct gfc_omp_udr
1730 : : {
1731 : : struct gfc_omp_udr *next;
1732 : : locus where; /* Where the !$omp declare reduction construct occurred. */
1733 : :
1734 : : const char *name;
1735 : : gfc_typespec ts;
1736 : : gfc_omp_reduction_op rop;
1737 : :
1738 : : struct gfc_symbol *omp_out;
1739 : : struct gfc_symbol *omp_in;
1740 : : struct gfc_namespace *combiner_ns;
1741 : :
1742 : : struct gfc_symbol *omp_priv;
1743 : : struct gfc_symbol *omp_orig;
1744 : : struct gfc_namespace *initializer_ns;
1745 : : }
1746 : : gfc_omp_udr;
1747 : : #define gfc_get_omp_udr() XCNEW (gfc_omp_udr)
1748 : :
1749 : : typedef struct gfc_omp_namelist_udr
1750 : : {
1751 : : struct gfc_omp_udr *udr;
1752 : : struct gfc_code *combiner;
1753 : : struct gfc_code *initializer;
1754 : : }
1755 : : gfc_omp_namelist_udr;
1756 : : #define gfc_get_omp_namelist_udr() XCNEW (gfc_omp_namelist_udr)
1757 : :
1758 : : /* The gfc_st_label structure is a BBT attached to a namespace that
1759 : : records the usage of statement labels within that space. */
1760 : :
1761 : : typedef struct gfc_st_label
1762 : : {
1763 : : BBT_HEADER(gfc_st_label);
1764 : :
1765 : : int value;
1766 : :
1767 : : gfc_sl_type defined, referenced;
1768 : :
1769 : : struct gfc_expr *format;
1770 : :
1771 : : tree backend_decl;
1772 : :
1773 : : locus where;
1774 : :
1775 : : gfc_namespace *ns;
1776 : : }
1777 : : gfc_st_label;
1778 : :
1779 : :
1780 : : /* gfc_interface()-- Interfaces are lists of symbols strung together. */
1781 : : typedef struct gfc_interface
1782 : : {
1783 : : struct gfc_symbol *sym;
1784 : : locus where;
1785 : : struct gfc_interface *next;
1786 : : }
1787 : : gfc_interface;
1788 : :
1789 : : #define gfc_get_interface() XCNEW (gfc_interface)
1790 : :
1791 : : /* User operator nodes. These are like stripped down symbols. */
1792 : : typedef struct
1793 : : {
1794 : : const char *name;
1795 : :
1796 : : gfc_interface *op;
1797 : : struct gfc_namespace *ns;
1798 : : gfc_access access;
1799 : : }
1800 : : gfc_user_op;
1801 : :
1802 : :
1803 : : /* A list of specific bindings that are associated with a generic spec. */
1804 : : typedef struct gfc_tbp_generic
1805 : : {
1806 : : /* The parser sets specific_st, upon resolution we look for the corresponding
1807 : : gfc_typebound_proc and set specific for further use. */
1808 : : struct gfc_symtree* specific_st;
1809 : : struct gfc_typebound_proc* specific;
1810 : :
1811 : : struct gfc_tbp_generic* next;
1812 : : bool is_operator;
1813 : : }
1814 : : gfc_tbp_generic;
1815 : :
1816 : : #define gfc_get_tbp_generic() XCNEW (gfc_tbp_generic)
1817 : :
1818 : :
1819 : : /* Data needed for type-bound procedures. */
1820 : : typedef struct gfc_typebound_proc
1821 : : {
1822 : : locus where; /* Where the PROCEDURE/GENERIC definition was. */
1823 : :
1824 : : union
1825 : : {
1826 : : struct gfc_symtree* specific; /* The interface if DEFERRED. */
1827 : : gfc_tbp_generic* generic;
1828 : : }
1829 : : u;
1830 : :
1831 : : gfc_access access;
1832 : : const char* pass_arg; /* Argument-name for PASS. NULL if not specified. */
1833 : :
1834 : : /* The overridden type-bound proc (or GENERIC with this name in the
1835 : : parent-type) or NULL if non. */
1836 : : struct gfc_typebound_proc* overridden;
1837 : :
1838 : : /* Once resolved, we use the position of pass_arg in the formal arglist of
1839 : : the binding-target procedure to identify it. The first argument has
1840 : : number 1 here, the second 2, and so on. */
1841 : : unsigned pass_arg_num;
1842 : :
1843 : : unsigned nopass:1; /* Whether we have NOPASS (PASS otherwise). */
1844 : : unsigned non_overridable:1;
1845 : : unsigned deferred:1;
1846 : : unsigned is_generic:1;
1847 : : unsigned function:1, subroutine:1;
1848 : : unsigned error:1; /* Ignore it, when an error occurred during resolution. */
1849 : : unsigned ppc:1;
1850 : : }
1851 : : gfc_typebound_proc;
1852 : :
1853 : :
1854 : : /* Symbol nodes. These are important things. They are what the
1855 : : standard refers to as "entities". The possibly multiple names that
1856 : : refer to the same entity are accomplished by a binary tree of
1857 : : symtree structures that is balanced by the red-black method-- more
1858 : : than one symtree node can point to any given symbol. */
1859 : :
1860 : : typedef struct gfc_symbol
1861 : : {
1862 : : const char *name; /* Primary name, before renaming */
1863 : : const char *module; /* Module this symbol came from */
1864 : : locus declared_at;
1865 : :
1866 : : gfc_typespec ts;
1867 : : symbol_attribute attr;
1868 : :
1869 : : /* The formal member points to the formal argument list if the
1870 : : symbol is a function or subroutine name. If the symbol is a
1871 : : generic name, the generic member points to the list of
1872 : : interfaces. */
1873 : :
1874 : : gfc_interface *generic;
1875 : : gfc_access component_access;
1876 : :
1877 : : gfc_formal_arglist *formal;
1878 : : struct gfc_namespace *formal_ns;
1879 : : struct gfc_namespace *f2k_derived;
1880 : :
1881 : : /* List of PDT parameter expressions */
1882 : : struct gfc_actual_arglist *param_list;
1883 : :
1884 : : struct gfc_expr *value; /* Parameter/Initializer value */
1885 : : gfc_array_spec *as;
1886 : : struct gfc_symbol *result; /* function result symbol */
1887 : : gfc_component *components; /* Derived type components */
1888 : :
1889 : : /* Defined only for Cray pointees; points to their pointer. */
1890 : : struct gfc_symbol *cp_pointer;
1891 : :
1892 : : int entry_id; /* Used in resolve.cc for entries. */
1893 : :
1894 : : /* CLASS hashed name for declared and dynamic types in the class. */
1895 : : int hash_value;
1896 : :
1897 : : struct gfc_symbol *common_next; /* Links for COMMON syms */
1898 : :
1899 : : /* This is only used for pointer comparisons to check if symbols
1900 : : are in the same common block.
1901 : : In opposition to common_block, the common_head pointer takes into account
1902 : : equivalences: if A is in a common block C and A and B are in equivalence,
1903 : : then both A and B have common_head pointing to C, while A's common_block
1904 : : points to C and B's is NULL. */
1905 : : struct gfc_common_head* common_head;
1906 : :
1907 : : /* Make sure initialization code is generated in the correct order. */
1908 : : int decl_order;
1909 : :
1910 : : gfc_namelist *namelist, *namelist_tail;
1911 : :
1912 : : /* The tlink field is used in the front end to carry the module
1913 : : declaration of separate module procedures so that the characteristics
1914 : : can be compared with the corresponding declaration in a submodule. In
1915 : : translation this field carries a linked list of symbols that require
1916 : : deferred initialization. */
1917 : : struct gfc_symbol *tlink;
1918 : :
1919 : : /* Change management fields. Symbols that might be modified by the
1920 : : current statement have the mark member nonzero. Of these symbols,
1921 : : symbols with old_symbol equal to NULL are symbols created within
1922 : : the current statement. Otherwise, old_symbol points to a copy of
1923 : : the old symbol. gfc_new is used in symbol.cc to flag new symbols.
1924 : : comp_mark is used to indicate variables which have component accesses
1925 : : in OpenMP/OpenACC directive clauses (cf. c-typeck.cc:c_finish_omp_clauses,
1926 : : map_field_head).
1927 : : data_mark is used to check duplicate mappings for OpenMP data-sharing
1928 : : clauses (see firstprivate_head/lastprivate_head in the above function).
1929 : : dev_mark is used to check duplicate mappings for OpenMP
1930 : : is_device_ptr/has_device_addr clauses (see is_on_device_head in above
1931 : : function).
1932 : : gen_mark is used to check duplicate mappings for OpenMP
1933 : : use_device_ptr/use_device_addr/private/shared clauses (see generic_head in
1934 : : above functon).
1935 : : reduc_mark is used to check duplicate mappings for OpenMP reduction
1936 : : clauses. */
1937 : : struct gfc_symbol *old_symbol;
1938 : : unsigned mark:1, comp_mark:1, data_mark:1, dev_mark:1, gen_mark:1;
1939 : : unsigned reduc_mark:1, gfc_new:1;
1940 : :
1941 : : /* Nonzero if all equivalences associated with this symbol have been
1942 : : processed. */
1943 : : unsigned equiv_built:1;
1944 : : /* Set if this variable is used as an index name in a FORALL. */
1945 : : unsigned forall_index:1;
1946 : : /* Set if the symbol is used in a function result specification . */
1947 : : unsigned fn_result_spec:1;
1948 : : /* Set if the symbol spec. depends on an old-style function result. */
1949 : : unsigned fn_result_dep:1;
1950 : : /* Used to avoid multiple resolutions of a single symbol. */
1951 : : /* = 2 if this has already been resolved as an intrinsic,
1952 : : in gfc_resolve_intrinsic,
1953 : : = 1 if it has been resolved in resolve_symbol. */
1954 : : unsigned resolve_symbol_called:2;
1955 : : /* Set if this is a module function or subroutine with the
1956 : : abbreviated declaration in a submodule. */
1957 : : unsigned abr_modproc_decl:1;
1958 : : /* Set if a previous error or warning has occurred and no other
1959 : : should be reported. */
1960 : : unsigned error:1;
1961 : : /* Set if the dummy argument of a procedure could be an array despite
1962 : : being called with a scalar actual argument. */
1963 : : unsigned maybe_array:1;
1964 : : /* Set if this should be passed by value, but is not a VALUE argument
1965 : : according to the Fortran standard. */
1966 : : unsigned pass_as_value:1;
1967 : : /* Set if an allocatable array variable has been allocated in the current
1968 : : scope. Used in the suppression of uninitialized warnings in reallocation
1969 : : on assignment. */
1970 : : unsigned allocated_in_scope:1;
1971 : :
1972 : : /* Reference counter, used for memory management.
1973 : :
1974 : : Some symbols may be present in more than one namespace, for example
1975 : : function and subroutine symbols are present both in the outer namespace and
1976 : : the procedure body namespace. Freeing symbols with the namespaces they are
1977 : : in would result in double free for those symbols. This field counts
1978 : : references and is used to delay the memory release until the last reference
1979 : : to the symbol is removed.
1980 : :
1981 : : Not every symbol pointer is accounted for reference counting. Fields
1982 : : gfc_symtree::n::sym are, and gfc_finalizer::proc_sym as well. But most of
1983 : : them (dummy arguments, generic list elements, etc) are "weak" pointers;
1984 : : the reference count isn't updated when they are assigned, and they are
1985 : : ignored when the surrounding structure memory is released. This is not a
1986 : : problem because there is always a namespace as surrounding context and
1987 : : symbols have a name they can be referred with in that context, so the
1988 : : namespace keeps the symbol from being freed, keeping the pointer valid.
1989 : : When the namespace ceases to exist, and the symbols with it, the other
1990 : : structures referencing symbols cease to exist as well. */
1991 : : int refs;
1992 : :
1993 : : struct gfc_namespace *ns; /* namespace containing this symbol */
1994 : :
1995 : : tree backend_decl;
1996 : :
1997 : : /* Identity of the intrinsic module the symbol comes from, or
1998 : : INTMOD_NONE if it's not imported from a intrinsic module. */
1999 : : intmod_id from_intmod;
2000 : : /* Identity of the symbol from intrinsic modules, from enums maintained
2001 : : separately by each intrinsic module. Used together with from_intmod,
2002 : : it uniquely identifies a symbol from an intrinsic module. */
2003 : : int intmod_sym_id;
2004 : :
2005 : : /* This may be repetitive, since the typespec now has a binding
2006 : : label field. */
2007 : : const char* binding_label;
2008 : : /* Store a reference to the common_block, if this symbol is in one. */
2009 : : struct gfc_common_head *common_block;
2010 : :
2011 : : /* Link to corresponding association-list if this is an associate name. */
2012 : : struct gfc_association_list *assoc;
2013 : :
2014 : : /* Link to next entry in derived type list */
2015 : : struct gfc_symbol *dt_next;
2016 : : }
2017 : : gfc_symbol;
2018 : :
2019 : :
2020 : : struct gfc_undo_change_set
2021 : : {
2022 : : vec<gfc_symbol *> syms;
2023 : : vec<gfc_typebound_proc *> tbps;
2024 : : gfc_undo_change_set *previous;
2025 : : };
2026 : :
2027 : :
2028 : : /* This structure is used to keep track of symbols in common blocks. */
2029 : : typedef struct gfc_common_head
2030 : : {
2031 : : locus where;
2032 : : char use_assoc, saved, threadprivate;
2033 : : unsigned char omp_declare_target : 1;
2034 : : unsigned char omp_declare_target_link : 1;
2035 : : ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
2036 : : /* Provide sufficient space to hold "symbol.symbol.eq.1234567890". */
2037 : : char name[2*GFC_MAX_SYMBOL_LEN + 1 + 14 + 1];
2038 : : struct gfc_symbol *head;
2039 : : const char* binding_label;
2040 : : int is_bind_c;
2041 : : int refs;
2042 : : }
2043 : : gfc_common_head;
2044 : :
2045 : : #define gfc_get_common_head() XCNEW (gfc_common_head)
2046 : :
2047 : :
2048 : : /* A list of all the alternate entry points for a procedure. */
2049 : :
2050 : : typedef struct gfc_entry_list
2051 : : {
2052 : : /* The symbol for this entry point. */
2053 : : gfc_symbol *sym;
2054 : : /* The zero-based id of this entry point. */
2055 : : int id;
2056 : : /* The LABEL_EXPR marking this entry point. */
2057 : : tree label;
2058 : : /* The next item in the list. */
2059 : : struct gfc_entry_list *next;
2060 : : }
2061 : : gfc_entry_list;
2062 : :
2063 : : #define gfc_get_entry_list() XCNEW (gfc_entry_list)
2064 : :
2065 : : /* Lists of rename info for the USE statement. */
2066 : :
2067 : : typedef struct gfc_use_rename
2068 : : {
2069 : : char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
2070 : : struct gfc_use_rename *next;
2071 : : int found;
2072 : : gfc_intrinsic_op op;
2073 : : locus where;
2074 : : }
2075 : : gfc_use_rename;
2076 : :
2077 : : #define gfc_get_use_rename() XCNEW (gfc_use_rename);
2078 : :
2079 : : /* A list of all USE statements in a namespace. */
2080 : :
2081 : : typedef struct gfc_use_list
2082 : : {
2083 : : const char *module_name;
2084 : : const char *submodule_name;
2085 : : bool intrinsic;
2086 : : bool non_intrinsic;
2087 : : bool only_flag;
2088 : : struct gfc_use_rename *rename;
2089 : : locus where;
2090 : : /* Next USE statement. */
2091 : : struct gfc_use_list *next;
2092 : : }
2093 : : gfc_use_list;
2094 : :
2095 : : #define gfc_get_use_list() XCNEW (gfc_use_list)
2096 : :
2097 : : /* Within a namespace, symbols are pointed to by symtree nodes that
2098 : : are linked together in a balanced binary tree. There can be
2099 : : several symtrees pointing to the same symbol node via USE
2100 : : statements. */
2101 : :
2102 : : typedef struct gfc_symtree
2103 : : {
2104 : : BBT_HEADER (gfc_symtree);
2105 : : const char *name;
2106 : : int ambiguous;
2107 : : union
2108 : : {
2109 : : gfc_symbol *sym; /* Symbol associated with this node */
2110 : : gfc_user_op *uop;
2111 : : gfc_common_head *common;
2112 : : gfc_typebound_proc *tb;
2113 : : gfc_omp_udr *omp_udr;
2114 : : }
2115 : : n;
2116 : : }
2117 : : gfc_symtree;
2118 : :
2119 : : /* A list of all derived types. */
2120 : : extern gfc_symbol *gfc_derived_types;
2121 : :
2122 : : typedef struct gfc_oacc_routine_name
2123 : : {
2124 : : struct gfc_symbol *sym;
2125 : : struct gfc_omp_clauses *clauses;
2126 : : struct gfc_oacc_routine_name *next;
2127 : : locus loc;
2128 : : }
2129 : : gfc_oacc_routine_name;
2130 : :
2131 : : #define gfc_get_oacc_routine_name() XCNEW (gfc_oacc_routine_name)
2132 : :
2133 : : /* Node in linked list to see what has already been finalized
2134 : : earlier. */
2135 : :
2136 : : typedef struct gfc_was_finalized {
2137 : : gfc_expr *e;
2138 : : gfc_component *c;
2139 : : struct gfc_was_finalized *next;
2140 : : }
2141 : : gfc_was_finalized;
2142 : :
2143 : : /* A namespace describes the contents of procedure, module, interface block
2144 : : or BLOCK construct. */
2145 : : /* ??? Anything else use these? */
2146 : :
2147 : : typedef struct gfc_namespace
2148 : : {
2149 : : /* Tree containing all the symbols in this namespace. */
2150 : : gfc_symtree *sym_root;
2151 : : /* Tree containing all the user-defined operators in the namespace. */
2152 : : gfc_symtree *uop_root;
2153 : : /* Tree containing all the common blocks. */
2154 : : gfc_symtree *common_root;
2155 : : /* Tree containing all the OpenMP user defined reductions. */
2156 : : gfc_symtree *omp_udr_root;
2157 : :
2158 : : /* Tree containing type-bound procedures. */
2159 : : gfc_symtree *tb_sym_root;
2160 : : /* Type-bound user operators. */
2161 : : gfc_symtree *tb_uop_root;
2162 : : /* For derived-types, store type-bound intrinsic operators here. */
2163 : : gfc_typebound_proc *tb_op[GFC_INTRINSIC_OPS];
2164 : : /* Linked list of finalizer procedures. */
2165 : : struct gfc_finalizer *finalizers;
2166 : :
2167 : : /* If set_flag[letter] is set, an implicit type has been set for letter. */
2168 : : int set_flag[GFC_LETTERS];
2169 : : /* Keeps track of the implicit types associated with the letters. */
2170 : : gfc_typespec default_type[GFC_LETTERS];
2171 : : /* Store the positions of IMPLICIT statements. */
2172 : : locus implicit_loc[GFC_LETTERS];
2173 : :
2174 : : /* If this is a namespace of a procedure, this points to the procedure. */
2175 : : struct gfc_symbol *proc_name;
2176 : : /* If this is the namespace of a unit which contains executable
2177 : : code, this points to it. */
2178 : : struct gfc_code *code;
2179 : :
2180 : : /* Points to the equivalences set up in this namespace. */
2181 : : struct gfc_equiv *equiv, *old_equiv;
2182 : :
2183 : : /* Points to the equivalence groups produced by trans_common. */
2184 : : struct gfc_equiv_list *equiv_lists;
2185 : :
2186 : : gfc_interface *op[GFC_INTRINSIC_OPS];
2187 : :
2188 : : /* Points to the parent namespace, i.e. the namespace of a module or
2189 : : procedure in which the procedure belonging to this namespace is
2190 : : contained. The parent namespace points to this namespace either
2191 : : directly via CONTAINED, or indirectly via the chain built by
2192 : : SIBLING. */
2193 : : struct gfc_namespace *parent;
2194 : : /* CONTAINED points to the first contained namespace. Sibling
2195 : : namespaces are chained via SIBLING. */
2196 : : struct gfc_namespace *contained, *sibling;
2197 : :
2198 : : gfc_common_head blank_common;
2199 : : gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];
2200 : :
2201 : : gfc_st_label *st_labels;
2202 : : /* This list holds information about all the data initializers in
2203 : : this namespace. */
2204 : : struct gfc_data *data, *old_data;
2205 : :
2206 : : /* !$ACC DECLARE. */
2207 : : gfc_oacc_declare *oacc_declare;
2208 : :
2209 : : /* !$ACC ROUTINE clauses. */
2210 : : gfc_omp_clauses *oacc_routine_clauses;
2211 : :
2212 : : /* !$ACC TASK AFFINITY iterator symbols. */
2213 : : gfc_symbol *omp_affinity_iterators;
2214 : :
2215 : : /* !$ACC ROUTINE names. */
2216 : : gfc_oacc_routine_name *oacc_routine_names;
2217 : :
2218 : : gfc_charlen *cl_list;
2219 : :
2220 : : gfc_symbol *derived_types;
2221 : :
2222 : : int save_all, seen_save, seen_implicit_none;
2223 : :
2224 : : /* Normally we don't need to refcount namespaces. However when we read
2225 : : a module containing a function with multiple entry points, this
2226 : : will appear as several functions with the same formal namespace. */
2227 : : int refs;
2228 : :
2229 : : /* A list of all alternate entry points to this procedure (or NULL). */
2230 : : gfc_entry_list *entries;
2231 : :
2232 : : /* A list of USE statements in this namespace. */
2233 : : gfc_use_list *use_stmts;
2234 : :
2235 : : /* Linked list of !$omp declare simd constructs. */
2236 : : struct gfc_omp_declare_simd *omp_declare_simd;
2237 : :
2238 : : /* Linked list of !$omp declare variant constructs. */
2239 : : struct gfc_omp_declare_variant *omp_declare_variant;
2240 : :
2241 : : /* OpenMP assumptions and allocate for static/stack vars. */
2242 : : struct gfc_omp_assumptions *omp_assumes;
2243 : : struct gfc_omp_namelist *omp_allocate;
2244 : :
2245 : : /* A hash set for the gfc expressions that have already
2246 : : been finalized in this namespace. */
2247 : :
2248 : : gfc_was_finalized *was_finalized;
2249 : :
2250 : : /* Set to 1 if namespace is a BLOCK DATA program unit. */
2251 : : unsigned is_block_data:1;
2252 : :
2253 : : /* Set to 1 if namespace is an interface body with "IMPORT" used. */
2254 : : unsigned has_import_set:1;
2255 : :
2256 : : /* Set to 1 if the namespace uses "IMPLICIT NONE (export)". */
2257 : : unsigned has_implicit_none_export:1;
2258 : :
2259 : : /* Set to 1 if resolved has been called for this namespace.
2260 : : Holds -1 during resolution. */
2261 : : signed resolved:2;
2262 : :
2263 : : /* Set when resolve_types has been called for this namespace. */
2264 : : unsigned types_resolved:1;
2265 : :
2266 : : /* Set if the associate_name in a select type statement is an
2267 : : inferred type. */
2268 : : unsigned assoc_name_inferred:1;
2269 : :
2270 : : /* Set to 1 if code has been generated for this namespace. */
2271 : : unsigned translated:1;
2272 : :
2273 : : /* Set to 1 if symbols in this namespace should be 'construct entities',
2274 : : i.e. for BLOCK local variables. */
2275 : : unsigned construct_entities:1;
2276 : :
2277 : : /* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */
2278 : : unsigned omp_udr_ns:1;
2279 : :
2280 : : /* Set to 1 for !$ACC ROUTINE namespaces. */
2281 : : unsigned oacc_routine:1;
2282 : :
2283 : : /* Set to 1 if there are any calls to procedures with implicit interface. */
2284 : : unsigned implicit_interface_calls:1;
2285 : :
2286 : : /* OpenMP requires. */
2287 : : unsigned omp_requires:7;
2288 : : unsigned omp_target_seen:1;
2289 : :
2290 : : /* Set to 1 if this is an implicit OMP structured block. */
2291 : : unsigned omp_structured_block:1;
2292 : : }
2293 : : gfc_namespace;
2294 : :
2295 : : extern gfc_namespace *gfc_current_ns;
2296 : : extern gfc_namespace *gfc_global_ns_list;
2297 : :
2298 : : /* Global symbols are symbols of global scope. Currently we only use
2299 : : this to detect collisions already when parsing.
2300 : : TODO: Extend to verify procedure calls. */
2301 : :
2302 : : enum gfc_symbol_type
2303 : : {
2304 : : GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
2305 : : GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA
2306 : : };
2307 : :
2308 : : typedef struct gfc_gsymbol
2309 : : {
2310 : : BBT_HEADER(gfc_gsymbol);
2311 : :
2312 : : const char *name;
2313 : : const char *sym_name;
2314 : : const char *mod_name;
2315 : : const char *binding_label;
2316 : : enum gfc_symbol_type type;
2317 : :
2318 : : int defined, used;
2319 : : bool bind_c;
2320 : : locus where;
2321 : : gfc_namespace *ns;
2322 : : }
2323 : : gfc_gsymbol;
2324 : :
2325 : : extern gfc_gsymbol *gfc_gsym_root;
2326 : :
2327 : : /* Information on interfaces being built. */
2328 : : typedef struct
2329 : : {
2330 : : interface_type type;
2331 : : gfc_symbol *sym;
2332 : : gfc_namespace *ns;
2333 : : gfc_user_op *uop;
2334 : : gfc_intrinsic_op op;
2335 : : }
2336 : : gfc_interface_info;
2337 : :
2338 : : extern gfc_interface_info current_interface;
2339 : :
2340 : :
2341 : : /* Array reference. */
2342 : :
2343 : : enum gfc_array_ref_dimen_type
2344 : : {
2345 : : DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_STAR, DIMEN_THIS_IMAGE, DIMEN_UNKNOWN
2346 : : };
2347 : :
2348 : : typedef struct gfc_array_ref
2349 : : {
2350 : : ar_type type;
2351 : : int dimen; /* # of components in the reference */
2352 : : int codimen;
2353 : : bool in_allocate; /* For coarray checks. */
2354 : : gfc_expr *team;
2355 : : gfc_expr *stat;
2356 : : locus where;
2357 : : gfc_array_spec *as;
2358 : :
2359 : : locus c_where[GFC_MAX_DIMENSIONS]; /* All expressions can be NULL */
2360 : : struct gfc_expr *start[GFC_MAX_DIMENSIONS], *end[GFC_MAX_DIMENSIONS],
2361 : : *stride[GFC_MAX_DIMENSIONS];
2362 : :
2363 : : enum gfc_array_ref_dimen_type dimen_type[GFC_MAX_DIMENSIONS];
2364 : : }
2365 : : gfc_array_ref;
2366 : :
2367 : : #define gfc_get_array_ref() XCNEW (gfc_array_ref)
2368 : :
2369 : :
2370 : : /* Component reference nodes. A variable is stored as an expression
2371 : : node that points to the base symbol. After that, a singly linked
2372 : : list of component reference nodes gives the variable's complete
2373 : : resolution. The array_ref component may be present and comes
2374 : : before the component component. */
2375 : :
2376 : : enum ref_type
2377 : : { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING, REF_INQUIRY };
2378 : :
2379 : : enum inquiry_type
2380 : : { INQUIRY_RE, INQUIRY_IM, INQUIRY_KIND, INQUIRY_LEN };
2381 : :
2382 : : typedef struct gfc_ref
2383 : : {
2384 : : ref_type type;
2385 : :
2386 : : union
2387 : : {
2388 : : struct gfc_array_ref ar;
2389 : :
2390 : : struct
2391 : : {
2392 : : gfc_component *component;
2393 : : gfc_symbol *sym;
2394 : : }
2395 : : c;
2396 : :
2397 : : struct
2398 : : {
2399 : : struct gfc_expr *start, *end; /* Substring */
2400 : : gfc_charlen *length;
2401 : : }
2402 : : ss;
2403 : :
2404 : : inquiry_type i;
2405 : :
2406 : : }
2407 : : u;
2408 : :
2409 : : struct gfc_ref *next;
2410 : : }
2411 : : gfc_ref;
2412 : :
2413 : : #define gfc_get_ref() XCNEW (gfc_ref)
2414 : :
2415 : :
2416 : : /* Structures representing intrinsic symbols and their arguments lists. */
2417 : : typedef struct gfc_intrinsic_arg
2418 : : {
2419 : : char name[GFC_MAX_SYMBOL_LEN + 1];
2420 : :
2421 : : gfc_typespec ts;
2422 : : unsigned optional:1, value:1;
2423 : : ENUM_BITFIELD (sym_intent) intent:2;
2424 : :
2425 : : struct gfc_intrinsic_arg *next;
2426 : : }
2427 : : gfc_intrinsic_arg;
2428 : :
2429 : :
2430 : : typedef enum {
2431 : : GFC_UNDEFINED_DUMMY_ARG = 0,
2432 : : GFC_INTRINSIC_DUMMY_ARG,
2433 : : GFC_NON_INTRINSIC_DUMMY_ARG
2434 : : }
2435 : : gfc_dummy_arg_intrinsicness;
2436 : :
2437 : : /* dummy arg of either an intrinsic or a user-defined procedure. */
2438 : : struct gfc_dummy_arg
2439 : : {
2440 : : gfc_dummy_arg_intrinsicness intrinsicness;
2441 : :
2442 : : union {
2443 : : gfc_intrinsic_arg *intrinsic;
2444 : : gfc_formal_arglist *non_intrinsic;
2445 : : } u;
2446 : : };
2447 : :
2448 : : #define gfc_get_dummy_arg() XCNEW (gfc_dummy_arg)
2449 : :
2450 : :
2451 : : const char * gfc_dummy_arg_get_name (gfc_dummy_arg &);
2452 : : const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg &);
2453 : : bool gfc_dummy_arg_is_optional (gfc_dummy_arg &);
2454 : :
2455 : :
2456 : : /* Specifies the various kinds of check functions used to verify the
2457 : : argument lists of intrinsic functions. fX with X an integer refer
2458 : : to check functions of intrinsics with X arguments. f1m is used for
2459 : : the MAX and MIN intrinsics which can have an arbitrary number of
2460 : : arguments, f4ml is used for the MINLOC and MAXLOC intrinsics as
2461 : : these have special semantics. */
2462 : :
2463 : : typedef union
2464 : : {
2465 : : bool (*f0)(void);
2466 : : bool (*f1)(struct gfc_expr *);
2467 : : bool (*f1m)(gfc_actual_arglist *);
2468 : : bool (*f2)(struct gfc_expr *, struct gfc_expr *);
2469 : : bool (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
2470 : : bool (*f5ml)(gfc_actual_arglist *);
2471 : : bool (*f6fl)(gfc_actual_arglist *);
2472 : : bool (*f3red)(gfc_actual_arglist *);
2473 : : bool (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
2474 : : struct gfc_expr *);
2475 : : bool (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
2476 : : struct gfc_expr *, struct gfc_expr *);
2477 : : }
2478 : : gfc_check_f;
2479 : :
2480 : : /* Like gfc_check_f, these specify the type of the simplification
2481 : : function associated with an intrinsic. The fX are just like in
2482 : : gfc_check_f. cc is used for type conversion functions. */
2483 : :
2484 : : typedef union
2485 : : {
2486 : : struct gfc_expr *(*f0)(void);
2487 : : struct gfc_expr *(*f1)(struct gfc_expr *);
2488 : : struct gfc_expr *(*f2)(struct gfc_expr *, struct gfc_expr *);
2489 : : struct gfc_expr *(*f3)(struct gfc_expr *, struct gfc_expr *,
2490 : : struct gfc_expr *);
2491 : : struct gfc_expr *(*f4)(struct gfc_expr *, struct gfc_expr *,
2492 : : struct gfc_expr *, struct gfc_expr *);
2493 : : struct gfc_expr *(*f5)(struct gfc_expr *, struct gfc_expr *,
2494 : : struct gfc_expr *, struct gfc_expr *,
2495 : : struct gfc_expr *);
2496 : : struct gfc_expr *(*f6)(struct gfc_expr *, struct gfc_expr *,
2497 : : struct gfc_expr *, struct gfc_expr *,
2498 : : struct gfc_expr *, struct gfc_expr *);
2499 : : struct gfc_expr *(*cc)(struct gfc_expr *, bt, int);
2500 : : }
2501 : : gfc_simplify_f;
2502 : :
2503 : : /* Again like gfc_check_f, these specify the type of the resolution
2504 : : function associated with an intrinsic. The fX are just like in
2505 : : gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort(). */
2506 : :
2507 : : typedef union
2508 : : {
2509 : : void (*f0)(struct gfc_expr *);
2510 : : void (*f1)(struct gfc_expr *, struct gfc_expr *);
2511 : : void (*f1m)(struct gfc_expr *, struct gfc_actual_arglist *);
2512 : : void (*f2)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
2513 : : void (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
2514 : : struct gfc_expr *);
2515 : : void (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
2516 : : struct gfc_expr *, struct gfc_expr *);
2517 : : void (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
2518 : : struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
2519 : : void (*f6)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
2520 : : struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
2521 : : struct gfc_expr *);
2522 : : void (*s1)(struct gfc_code *);
2523 : : }
2524 : : gfc_resolve_f;
2525 : :
2526 : :
2527 : : typedef struct gfc_intrinsic_sym
2528 : : {
2529 : : const char *name, *lib_name;
2530 : : gfc_intrinsic_arg *formal;
2531 : : gfc_typespec ts;
2532 : : unsigned elemental:1, inquiry:1, transformational:1, pure:1,
2533 : : generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1,
2534 : : from_module:1, vararg:1;
2535 : :
2536 : : int standard;
2537 : :
2538 : : gfc_simplify_f simplify;
2539 : : gfc_check_f check;
2540 : : gfc_resolve_f resolve;
2541 : : struct gfc_intrinsic_sym *specific_head, *next;
2542 : : gfc_isym_id id;
2543 : :
2544 : : }
2545 : : gfc_intrinsic_sym;
2546 : :
2547 : :
2548 : : /* Expression nodes. The expression node types deserve explanations,
2549 : : since the last couple can be easily misconstrued:
2550 : :
2551 : : EXPR_OP Operator node pointing to one or two other nodes
2552 : : EXPR_FUNCTION Function call, symbol points to function's name
2553 : : EXPR_CONSTANT A scalar constant: Logical, String, Real, Int or Complex
2554 : : EXPR_VARIABLE An Lvalue with a root symbol and possible reference list
2555 : : which expresses structure, array and substring refs.
2556 : : EXPR_NULL The NULL pointer value (which also has a basic type).
2557 : : EXPR_SUBSTRING A substring of a constant string
2558 : : EXPR_STRUCTURE A structure constructor
2559 : : EXPR_ARRAY An array constructor.
2560 : : EXPR_COMPCALL Function (or subroutine) call of a procedure pointer
2561 : : component or type-bound procedure. */
2562 : :
2563 : : #include <mpfr.h>
2564 : : #include <mpc.h>
2565 : : #define GFC_RND_MODE MPFR_RNDN
2566 : : #define GFC_MPC_RND_MODE MPC_RNDNN
2567 : :
2568 : : typedef splay_tree gfc_constructor_base;
2569 : :
2570 : :
2571 : : /* This should be an unsigned variable of type size_t. But to handle
2572 : : compiling to a 64-bit target from a 32-bit host, we need to use a
2573 : : HOST_WIDE_INT. Also, occasionally the string length field is used
2574 : : as a flag with values -1 and -2, see e.g. gfc_add_assign_aux_vars.
2575 : : So it needs to be signed. */
2576 : : typedef HOST_WIDE_INT gfc_charlen_t;
2577 : :
2578 : : typedef struct gfc_expr
2579 : : {
2580 : : expr_t expr_type;
2581 : :
2582 : : gfc_typespec ts; /* These two refer to the overall expression */
2583 : :
2584 : : int rank; /* 0 indicates a scalar, -1 an assumed-rank array. */
2585 : : int corank; /* same as rank, but for coarrays. */
2586 : : mpz_t *shape; /* Can be NULL if shape is unknown at compile time */
2587 : :
2588 : : /* Nonnull for functions and structure constructors, may also used to hold the
2589 : : base-object for component calls. */
2590 : : gfc_symtree *symtree;
2591 : :
2592 : : gfc_ref *ref;
2593 : :
2594 : : locus where;
2595 : :
2596 : : /* Used to store the base expression in component calls, when the expression
2597 : : is not a variable. */
2598 : : struct gfc_expr *base_expr;
2599 : :
2600 : : /* is_snan denotes a signalling not-a-number. */
2601 : : unsigned int is_snan : 1;
2602 : :
2603 : : /* Sometimes, when an error has been emitted, it is necessary to prevent
2604 : : it from recurring. */
2605 : : unsigned int error : 1;
2606 : :
2607 : : /* Mark an expression where a user operator has been substituted by
2608 : : a function call in interface.cc(gfc_extend_expr). */
2609 : : unsigned int user_operator : 1;
2610 : :
2611 : : /* Mark an expression as being a MOLD argument of ALLOCATE. */
2612 : : unsigned int mold : 1;
2613 : :
2614 : : /* Will require finalization after use. */
2615 : : unsigned int must_finalize : 1;
2616 : :
2617 : : /* Set this if no range check should be performed on this expression. */
2618 : :
2619 : : unsigned int no_bounds_check : 1;
2620 : :
2621 : : /* Set this if a matmul expression has already been evaluated for conversion
2622 : : to a BLAS call. */
2623 : :
2624 : : unsigned int external_blas : 1;
2625 : :
2626 : : /* Set this if resolution has already happened. It could be harmful
2627 : : if done again. */
2628 : :
2629 : : unsigned int do_not_resolve_again : 1;
2630 : :
2631 : : /* Set this if no warning should be given somewhere in a lower level. */
2632 : :
2633 : : unsigned int do_not_warn : 1;
2634 : :
2635 : : /* Set this if the expression came from expanding an array constructor. */
2636 : : unsigned int from_constructor : 1;
2637 : :
2638 : : /* If an expression comes from a Hollerith constant or compile-time
2639 : : evaluation of a transfer statement, it may have a prescribed target-
2640 : : memory representation, and these cannot always be backformed from
2641 : : the value. */
2642 : : struct
2643 : : {
2644 : : gfc_charlen_t length;
2645 : : char *string;
2646 : : }
2647 : : representation;
2648 : :
2649 : : struct
2650 : : {
2651 : : int len; /* Length of BOZ string without terminating NULL. */
2652 : : int rdx; /* Radix of BOZ. */
2653 : : char *str; /* BOZ string with NULL terminating character. */
2654 : : }
2655 : : boz;
2656 : :
2657 : : union
2658 : : {
2659 : : int logical;
2660 : :
2661 : : io_kind iokind;
2662 : :
2663 : : mpz_t integer;
2664 : :
2665 : : mpfr_t real;
2666 : :
2667 : : mpc_t complex;
2668 : :
2669 : : struct
2670 : : {
2671 : : gfc_intrinsic_op op;
2672 : : gfc_user_op *uop;
2673 : : struct gfc_expr *op1, *op2;
2674 : : }
2675 : : op;
2676 : :
2677 : : struct
2678 : : {
2679 : : gfc_actual_arglist *actual;
2680 : : const char *name; /* Points to the ultimate name of the function */
2681 : : gfc_intrinsic_sym *isym;
2682 : : gfc_symbol *esym;
2683 : : }
2684 : : function;
2685 : :
2686 : : struct
2687 : : {
2688 : : gfc_actual_arglist* actual;
2689 : : const char* name;
2690 : : /* Base-object, whose component was called. NULL means that it should
2691 : : be taken from symtree/ref. */
2692 : : struct gfc_expr* base_object;
2693 : : gfc_typebound_proc* tbp; /* Should overlap with esym. */
2694 : :
2695 : : /* For type-bound operators, we want to call PASS procedures but already
2696 : : have the full arglist; mark this, so that it is not extended by the
2697 : : PASS argument. */
2698 : : unsigned ignore_pass:1;
2699 : :
2700 : : /* Do assign-calls rather than calls, that is appropriate dependency
2701 : : checking. */
2702 : : unsigned assign:1;
2703 : : }
2704 : : compcall;
2705 : :
2706 : : struct
2707 : : {
2708 : : gfc_charlen_t length;
2709 : : gfc_char_t *string;
2710 : : }
2711 : : character;
2712 : :
2713 : : gfc_constructor_base constructor;
2714 : : }
2715 : : value;
2716 : :
2717 : : /* Used to store PDT expression lists associated with expressions. */
2718 : : gfc_actual_arglist *param_list;
2719 : :
2720 : : }
2721 : : gfc_expr;
2722 : :
2723 : :
2724 : : #define gfc_get_shape(rank) (XCNEWVEC (mpz_t, (rank)))
2725 : :
2726 : : /* Structures for information associated with different kinds of
2727 : : numbers. The first set of integer parameters define all there is
2728 : : to know about a particular kind. The rest of the elements are
2729 : : computed from the first elements. */
2730 : :
2731 : : typedef struct
2732 : : {
2733 : : /* Values really representable by the target. */
2734 : : mpz_t huge, pedantic_min_int, min_int;
2735 : :
2736 : : int kind, radix, digits, bit_size, range;
2737 : :
2738 : : /* True if the C type of the given name maps to this precision.
2739 : : Note that more than one bit can be set. */
2740 : : unsigned int c_char : 1;
2741 : : unsigned int c_short : 1;
2742 : : unsigned int c_int : 1;
2743 : : unsigned int c_long : 1;
2744 : : unsigned int c_long_long : 1;
2745 : : }
2746 : : gfc_integer_info;
2747 : :
2748 : : extern gfc_integer_info gfc_integer_kinds[];
2749 : :
2750 : :
2751 : : typedef struct
2752 : : {
2753 : : int kind, bit_size;
2754 : :
2755 : : /* True if the C++ type bool, C99 type _Bool, maps to this precision. */
2756 : : unsigned int c_bool : 1;
2757 : : }
2758 : : gfc_logical_info;
2759 : :
2760 : : extern gfc_logical_info gfc_logical_kinds[];
2761 : :
2762 : :
2763 : : typedef struct
2764 : : {
2765 : : mpfr_t epsilon, huge, tiny, subnormal;
2766 : : int kind, abi_kind, radix, digits, min_exponent, max_exponent;
2767 : : int range, precision;
2768 : :
2769 : : /* The precision of the type as reported by GET_MODE_PRECISION. */
2770 : : int mode_precision;
2771 : :
2772 : : /* True if the C type of the given name maps to this precision.
2773 : : Note that more than one bit can be set. */
2774 : : unsigned int c_float : 1;
2775 : : unsigned int c_double : 1;
2776 : : unsigned int c_long_double : 1;
2777 : : unsigned int c_float128 : 1;
2778 : : /* True if for _Float128 C23 IEC 60559 *f128 APIs should be used
2779 : : instead of libquadmath *q APIs. */
2780 : : unsigned int use_iec_60559 : 1;
2781 : : }
2782 : : gfc_real_info;
2783 : :
2784 : : extern gfc_real_info gfc_real_kinds[];
2785 : :
2786 : : typedef struct
2787 : : {
2788 : : int kind, bit_size;
2789 : : const char *name;
2790 : : }
2791 : : gfc_character_info;
2792 : :
2793 : : extern gfc_character_info gfc_character_kinds[];
2794 : :
2795 : :
2796 : : /* Equivalence structures. Equivalent lvalues are linked along the
2797 : : *eq pointer, equivalence sets are strung along the *next node. */
2798 : : typedef struct gfc_equiv
2799 : : {
2800 : : struct gfc_equiv *next, *eq;
2801 : : gfc_expr *expr;
2802 : : const char *module;
2803 : : int used;
2804 : : }
2805 : : gfc_equiv;
2806 : :
2807 : : #define gfc_get_equiv() XCNEW (gfc_equiv)
2808 : :
2809 : : /* Holds a single equivalence member after processing. */
2810 : : typedef struct gfc_equiv_info
2811 : : {
2812 : : gfc_symbol *sym;
2813 : : HOST_WIDE_INT offset;
2814 : : HOST_WIDE_INT length;
2815 : : struct gfc_equiv_info *next;
2816 : : } gfc_equiv_info;
2817 : :
2818 : : /* Holds equivalence groups, after they have been processed. */
2819 : : typedef struct gfc_equiv_list
2820 : : {
2821 : : gfc_equiv_info *equiv;
2822 : : struct gfc_equiv_list *next;
2823 : : } gfc_equiv_list;
2824 : :
2825 : : /* gfc_case stores the selector list of a case statement. The *low
2826 : : and *high pointers can point to the same expression in the case of
2827 : : a single value. If *high is NULL, the selection is from *low
2828 : : upwards, if *low is NULL the selection is *high downwards.
2829 : :
2830 : : This structure has separate fields to allow single and double linked
2831 : : lists of CASEs at the same time. The singe linked list along the NEXT
2832 : : field is a list of cases for a single CASE label. The double linked
2833 : : list along the LEFT/RIGHT fields is used to detect overlap and to
2834 : : build a table of the cases for SELECT constructs with a CHARACTER
2835 : : case expression. */
2836 : :
2837 : : typedef struct gfc_case
2838 : : {
2839 : : /* Where we saw this case. */
2840 : : locus where;
2841 : : int n;
2842 : :
2843 : : /* Case range values. If (low == high), it's a single value. If one of
2844 : : the labels is NULL, it's an unbounded case. If both are NULL, this
2845 : : represents the default case. */
2846 : : gfc_expr *low, *high;
2847 : :
2848 : : /* Only used for SELECT TYPE. */
2849 : : gfc_typespec ts;
2850 : :
2851 : : /* Next case label in the list of cases for a single CASE label. */
2852 : : struct gfc_case *next;
2853 : :
2854 : : /* Used for detecting overlap, and for code generation. */
2855 : : struct gfc_case *left, *right;
2856 : :
2857 : : /* True if this case label can never be matched. */
2858 : : int unreachable;
2859 : : }
2860 : : gfc_case;
2861 : :
2862 : : #define gfc_get_case() XCNEW (gfc_case)
2863 : :
2864 : :
2865 : : /* Annotations for loop constructs. */
2866 : : typedef struct
2867 : : {
2868 : : unsigned short unroll;
2869 : : bool ivdep;
2870 : : bool vector;
2871 : : bool novector;
2872 : : }
2873 : : gfc_loop_annot;
2874 : :
2875 : :
2876 : : typedef struct
2877 : : {
2878 : : gfc_expr *var, *start, *end, *step;
2879 : : gfc_loop_annot annot;
2880 : : }
2881 : : gfc_iterator;
2882 : :
2883 : : #define gfc_get_iterator() XCNEW (gfc_iterator)
2884 : :
2885 : :
2886 : : /* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements. */
2887 : :
2888 : : typedef struct gfc_alloc
2889 : : {
2890 : : gfc_expr *expr;
2891 : : struct gfc_alloc *next;
2892 : : }
2893 : : gfc_alloc;
2894 : :
2895 : : #define gfc_get_alloc() XCNEW (gfc_alloc)
2896 : :
2897 : :
2898 : : typedef struct
2899 : : {
2900 : : gfc_expr *unit, *file, *status, *access, *form, *recl,
2901 : : *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
2902 : : *decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit,
2903 : : *share, *cc;
2904 : : char readonly;
2905 : : gfc_st_label *err;
2906 : : }
2907 : : gfc_open;
2908 : :
2909 : :
2910 : : typedef struct
2911 : : {
2912 : : gfc_expr *unit, *status, *iostat, *iomsg;
2913 : : gfc_st_label *err;
2914 : : }
2915 : : gfc_close;
2916 : :
2917 : :
2918 : : typedef struct
2919 : : {
2920 : : gfc_expr *unit, *iostat, *iomsg;
2921 : : gfc_st_label *err;
2922 : : }
2923 : : gfc_filepos;
2924 : :
2925 : :
2926 : : typedef struct
2927 : : {
2928 : : gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
2929 : : *name, *access, *sequential, *direct, *form, *formatted,
2930 : : *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
2931 : : *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
2932 : : *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id,
2933 : : *iqstream, *share, *cc;
2934 : :
2935 : : gfc_st_label *err;
2936 : :
2937 : : }
2938 : : gfc_inquire;
2939 : :
2940 : :
2941 : : typedef struct
2942 : : {
2943 : : gfc_expr *unit, *iostat, *iomsg, *id;
2944 : : gfc_st_label *err, *end, *eor;
2945 : : }
2946 : : gfc_wait;
2947 : :
2948 : :
2949 : : typedef struct
2950 : : {
2951 : : gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
2952 : : *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
2953 : : *sign, *extra_comma, *dt_io_kind, *udtio;
2954 : : char dec_ext;
2955 : :
2956 : : gfc_symbol *namelist;
2957 : : /* A format_label of `format_asterisk' indicates the "*" format */
2958 : : gfc_st_label *format_label;
2959 : : gfc_st_label *err, *end, *eor;
2960 : :
2961 : : locus eor_where, end_where, err_where;
2962 : : }
2963 : : gfc_dt;
2964 : :
2965 : :
2966 : : typedef struct gfc_forall_iterator
2967 : : {
2968 : : gfc_expr *var, *start, *end, *stride;
2969 : : gfc_loop_annot annot;
2970 : : struct gfc_forall_iterator *next;
2971 : : }
2972 : : gfc_forall_iterator;
2973 : :
2974 : :
2975 : : /* Linked list to store associations in an ASSOCIATE statement. */
2976 : :
2977 : : typedef struct gfc_association_list
2978 : : {
2979 : : struct gfc_association_list *next;
2980 : :
2981 : : /* Whether this is association to a variable that can be changed; otherwise,
2982 : : it's association to an expression and the name may not be used as
2983 : : lvalue. */
2984 : : unsigned variable:1;
2985 : :
2986 : : /* True if this struct is currently only linked to from a gfc_symbol rather
2987 : : than as part of a real list in gfc_code->ext.block.assoc. This may
2988 : : happen for SELECT TYPE temporaries and must be considered
2989 : : for memory handling. */
2990 : : unsigned dangling:1;
2991 : :
2992 : : char name[GFC_MAX_SYMBOL_LEN + 1];
2993 : : gfc_symtree *st; /* Symtree corresponding to name. */
2994 : : locus where;
2995 : :
2996 : : gfc_expr *target;
2997 : :
2998 : : /* Used for inferring the derived type of an associate name, whose selector
2999 : : is a sibling derived type function that has not yet been parsed. */
3000 : : gfc_symbol *derived_types;
3001 : : unsigned inferred_type:1;
3002 : : }
3003 : : gfc_association_list;
3004 : : #define gfc_get_association_list() XCNEW (gfc_association_list)
3005 : :
3006 : :
3007 : : /* Executable statements that fill gfc_code structures. */
3008 : : enum gfc_exec_op
3009 : : {
3010 : : EXEC_NOP = 1, EXEC_END_NESTED_BLOCK, EXEC_END_BLOCK, EXEC_ASSIGN,
3011 : : EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP,
3012 : : EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN,
3013 : : EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
3014 : : EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_CONCURRENT, EXEC_DO_WHILE,
3015 : : EXEC_SELECT, EXEC_BLOCK, EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
3016 : : EXEC_CALL_PPC, EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE,
3017 : : EXEC_SELECT_TYPE, EXEC_SELECT_RANK, EXEC_SYNC_ALL, EXEC_SYNC_MEMORY,
3018 : : EXEC_SYNC_IMAGES, EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
3019 : : EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
3020 : : EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
3021 : : EXEC_FORM_TEAM, EXEC_CHANGE_TEAM, EXEC_END_TEAM, EXEC_SYNC_TEAM,
3022 : : EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, EXEC_FAIL_IMAGE,
3023 : : EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_SERIAL_LOOP,
3024 : : EXEC_OACC_ROUTINE, EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_SERIAL,
3025 : : EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE,
3026 : : EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA,
3027 : : EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE,
3028 : : EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
3029 : : EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
3030 : : EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
3031 : : EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
3032 : : EXEC_OMP_ASSUME, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
3033 : : EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT,
3034 : : EXEC_OMP_TASKYIELD, EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT,
3035 : : EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD,
3036 : : EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_TARGET, EXEC_OMP_TARGET_DATA,
3037 : : EXEC_OMP_TEAMS, EXEC_OMP_DISTRIBUTE, EXEC_OMP_DISTRIBUTE_SIMD,
3038 : : EXEC_OMP_DISTRIBUTE_PARALLEL_DO, EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD,
3039 : : EXEC_OMP_TARGET_TEAMS, EXEC_OMP_TEAMS_DISTRIBUTE,
3040 : : EXEC_OMP_TEAMS_DISTRIBUTE_SIMD, EXEC_OMP_TARGET_TEAMS_DISTRIBUTE,
3041 : : EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD,
3042 : : EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO,
3043 : : EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO,
3044 : : EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
3045 : : EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
3046 : : EXEC_OMP_TARGET_UPDATE, EXEC_OMP_END_CRITICAL,
3047 : : EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA,
3048 : : EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO,
3049 : : EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD,
3050 : : EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ,
3051 : : EXEC_OMP_PARALLEL_MASTER, EXEC_OMP_PARALLEL_MASTER_TASKLOOP,
3052 : : EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD, EXEC_OMP_MASTER_TASKLOOP,
3053 : : EXEC_OMP_MASTER_TASKLOOP_SIMD, EXEC_OMP_LOOP, EXEC_OMP_PARALLEL_LOOP,
3054 : : EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP,
3055 : : EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
3056 : : EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
3057 : : EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
3058 : : EXEC_OMP_UNROLL, EXEC_OMP_TILE, EXEC_OMP_INTEROP,
3059 : : EXEC_OMP_ERROR, EXEC_OMP_ALLOCATE, EXEC_OMP_ALLOCATORS
3060 : : };
3061 : :
3062 : : typedef struct gfc_code
3063 : : {
3064 : : gfc_exec_op op;
3065 : :
3066 : : struct gfc_code *block, *next;
3067 : : locus loc;
3068 : :
3069 : : gfc_st_label *here, *label1, *label2, *label3;
3070 : : gfc_symtree *symtree;
3071 : : gfc_expr *expr1, *expr2, *expr3, *expr4;
3072 : : /* A name isn't sufficient to identify a subroutine, we need the actual
3073 : : symbol for the interface definition.
3074 : : const char *sub_name; */
3075 : : gfc_symbol *resolved_sym;
3076 : : gfc_intrinsic_sym *resolved_isym;
3077 : :
3078 : : union
3079 : : {
3080 : : gfc_actual_arglist *actual;
3081 : : gfc_iterator *iterator;
3082 : :
3083 : : struct
3084 : : {
3085 : : gfc_typespec ts;
3086 : : gfc_alloc *list;
3087 : : /* Take the array specification from expr3 to allocate arrays
3088 : : without an explicit array specification. */
3089 : : unsigned arr_spec_from_expr3:1;
3090 : : /* expr3 is not explicit */
3091 : : unsigned expr3_not_explicit:1;
3092 : : }
3093 : : alloc;
3094 : :
3095 : : struct
3096 : : {
3097 : : gfc_namespace *ns;
3098 : : gfc_association_list *assoc;
3099 : : gfc_case *case_list;
3100 : : }
3101 : : block;
3102 : :
3103 : : gfc_open *open;
3104 : : gfc_close *close;
3105 : : gfc_filepos *filepos;
3106 : : gfc_inquire *inquire;
3107 : : gfc_wait *wait;
3108 : : gfc_dt *dt;
3109 : : gfc_forall_iterator *forall_iterator;
3110 : : struct gfc_code *which_construct;
3111 : : int stop_code;
3112 : : gfc_entry_list *entry;
3113 : : gfc_oacc_declare *oacc_declare;
3114 : : gfc_omp_clauses *omp_clauses;
3115 : : const char *omp_name;
3116 : : gfc_omp_namelist *omp_namelist;
3117 : : bool omp_bool;
3118 : : }
3119 : : ext; /* Points to additional structures required by statement */
3120 : :
3121 : : /* Cycle and break labels in constructs. */
3122 : : tree cycle_label;
3123 : : tree exit_label;
3124 : : }
3125 : : gfc_code;
3126 : :
3127 : :
3128 : : /* Storage for DATA statements. */
3129 : : typedef struct gfc_data_variable
3130 : : {
3131 : : gfc_expr *expr;
3132 : : gfc_iterator iter;
3133 : : struct gfc_data_variable *list, *next;
3134 : : }
3135 : : gfc_data_variable;
3136 : :
3137 : :
3138 : : typedef struct gfc_data_value
3139 : : {
3140 : : mpz_t repeat;
3141 : : gfc_expr *expr;
3142 : : struct gfc_data_value *next;
3143 : : }
3144 : : gfc_data_value;
3145 : :
3146 : :
3147 : : typedef struct gfc_data
3148 : : {
3149 : : gfc_data_variable *var;
3150 : : gfc_data_value *value;
3151 : : locus where;
3152 : :
3153 : : struct gfc_data *next;
3154 : : }
3155 : : gfc_data;
3156 : :
3157 : :
3158 : : /* Structure for holding compile options */
3159 : : typedef struct
3160 : : {
3161 : : char *module_dir;
3162 : : gfc_source_form source_form;
3163 : : int max_continue_fixed;
3164 : : int max_continue_free;
3165 : : int max_identifier_length;
3166 : :
3167 : : int max_errors;
3168 : :
3169 : : int flag_preprocessed;
3170 : : int flag_d_lines;
3171 : : int flag_init_integer;
3172 : : long flag_init_integer_value;
3173 : : int flag_init_logical;
3174 : : int flag_init_character;
3175 : : char flag_init_character_value;
3176 : : int disable_omp_is_initial_device;
3177 : :
3178 : : int fpe;
3179 : : int fpe_summary;
3180 : : int rtcheck;
3181 : :
3182 : : int warn_std;
3183 : : int allow_std;
3184 : : }
3185 : : gfc_option_t;
3186 : :
3187 : : extern gfc_option_t gfc_option;
3188 : :
3189 : : /* Constructor nodes for array and structure constructors. */
3190 : : typedef struct gfc_constructor
3191 : : {
3192 : : gfc_constructor_base base;
3193 : : mpz_t offset; /* Offset within a constructor, used as
3194 : : key within base. */
3195 : :
3196 : : gfc_expr *expr;
3197 : : gfc_iterator *iterator;
3198 : : locus where;
3199 : :
3200 : : union
3201 : : {
3202 : : gfc_component *component; /* Record the component being initialized. */
3203 : : }
3204 : : n;
3205 : : mpz_t repeat; /* Record the repeat number of initial values in data
3206 : : statement like "data a/5*10/". */
3207 : : }
3208 : : gfc_constructor;
3209 : :
3210 : :
3211 : : typedef struct iterator_stack
3212 : : {
3213 : : gfc_symtree *variable;
3214 : : mpz_t value;
3215 : : struct iterator_stack *prev;
3216 : : }
3217 : : iterator_stack;
3218 : : extern iterator_stack *iter_stack;
3219 : :
3220 : :
3221 : : /* Used for (possibly nested) SELECT TYPE statements. */
3222 : : typedef struct gfc_select_type_stack
3223 : : {
3224 : : gfc_symbol *selector; /* Current selector variable. */
3225 : : gfc_symtree *tmp; /* Current temporary variable. */
3226 : : struct gfc_select_type_stack *prev; /* Previous element on stack. */
3227 : : }
3228 : : gfc_select_type_stack;
3229 : : extern gfc_select_type_stack *select_type_stack;
3230 : : #define gfc_get_select_type_stack() XCNEW (gfc_select_type_stack)
3231 : :
3232 : :
3233 : : /* Node in the linked list used for storing finalizer procedures. */
3234 : :
3235 : : typedef struct gfc_finalizer
3236 : : {
3237 : : struct gfc_finalizer* next;
3238 : : locus where; /* Where the FINAL declaration occurred. */
3239 : :
3240 : : /* Up to resolution, we want the gfc_symbol, there we lookup the corresponding
3241 : : symtree and later need only that. This way, we can access and call the
3242 : : finalizers from every context as they should be "always accessible". I
3243 : : don't make this a union because we need the information whether proc_sym is
3244 : : still referenced or not for dereferencing it on deleting a gfc_finalizer
3245 : : structure. */
3246 : : gfc_symbol* proc_sym;
3247 : : gfc_symtree* proc_tree;
3248 : : }
3249 : : gfc_finalizer;
3250 : : #define gfc_get_finalizer() XCNEW (gfc_finalizer)
3251 : :
3252 : :
3253 : : /************************ Function prototypes *************************/
3254 : :
3255 : :
3256 : : /* Returns true if the type specified in TS is a character type whose length
3257 : : is the constant one. Otherwise returns false. */
3258 : :
3259 : : inline bool
3260 : 21749 : gfc_length_one_character_type_p (gfc_typespec *ts)
3261 : : {
3262 : 21749 : return ts->type == BT_CHARACTER
3263 : 721 : && ts->u.cl
3264 : 721 : && ts->u.cl->length
3265 : 720 : && ts->u.cl->length->expr_type == EXPR_CONSTANT
3266 : 720 : && ts->u.cl->length->ts.type == BT_INTEGER
3267 : 22469 : && mpz_cmp_ui (ts->u.cl->length->value.integer, 1) == 0;
3268 : : }
3269 : :
3270 : : /* decl.cc */
3271 : : bool gfc_in_match_data (void);
3272 : : match gfc_match_char_spec (gfc_typespec *);
3273 : : extern int directive_unroll;
3274 : : extern bool directive_ivdep;
3275 : : extern bool directive_vector;
3276 : : extern bool directive_novector;
3277 : :
3278 : : /* SIMD clause enum. */
3279 : : enum gfc_simd_clause
3280 : : {
3281 : : SIMD_NONE = (1 << 0),
3282 : : SIMD_INBRANCH = (1 << 1),
3283 : : SIMD_NOTINBRANCH = (1 << 2)
3284 : : };
3285 : :
3286 : : /* Tuple for parsing of vectorized built-ins. */
3287 : : struct gfc_vect_builtin_tuple
3288 : : {
3289 : : gfc_vect_builtin_tuple (const char *n, gfc_simd_clause t)
3290 : : : name (n), simd_type (t) {}
3291 : :
3292 : : const char *name;
3293 : : gfc_simd_clause simd_type;
3294 : : };
3295 : :
3296 : : /* Map of middle-end built-ins that should be vectorized. */
3297 : : extern hash_map<nofree_string_hash, int> *gfc_vectorized_builtins;
3298 : :
3299 : : /* Handling Parameterized Derived Types */
3300 : : bool gfc_insert_parameter_exprs (gfc_expr *, gfc_actual_arglist *);
3301 : : match gfc_get_pdt_instance (gfc_actual_arglist *, gfc_symbol **,
3302 : : gfc_actual_arglist **);
3303 : :
3304 : :
3305 : : /* Given a symbol, test whether it is a module procedure in a submodule */
3306 : : #define gfc_submodule_procedure(attr) \
3307 : : (gfc_state_stack->previous && gfc_state_stack->previous->previous \
3308 : : && gfc_state_stack->previous->previous->state == COMP_SUBMODULE \
3309 : : && attr->module_procedure)
3310 : :
3311 : : /* scanner.cc */
3312 : : void gfc_scanner_done_1 (void);
3313 : : void gfc_scanner_init_1 (void);
3314 : :
3315 : : void gfc_add_include_path (const char *, bool, bool, bool, bool);
3316 : : void gfc_add_intrinsic_modules_path (const char *);
3317 : : void gfc_release_include_path (void);
3318 : : void gfc_check_include_dirs (bool);
3319 : : FILE *gfc_open_included_file (const char *, bool, bool);
3320 : :
3321 : : bool gfc_at_end (void);
3322 : : bool gfc_at_eof (void);
3323 : : bool gfc_at_bol (void);
3324 : : bool gfc_at_eol (void);
3325 : : void gfc_advance_line (void);
3326 : : bool gfc_define_undef_line (void);
3327 : :
3328 : : bool gfc_wide_is_printable (gfc_char_t);
3329 : : bool gfc_wide_is_digit (gfc_char_t);
3330 : : bool gfc_wide_fits_in_byte (gfc_char_t);
3331 : : gfc_char_t gfc_wide_tolower (gfc_char_t);
3332 : : gfc_char_t gfc_wide_toupper (gfc_char_t);
3333 : : size_t gfc_wide_strlen (const gfc_char_t *);
3334 : : int gfc_wide_strncasecmp (const gfc_char_t *, const char *, size_t);
3335 : : gfc_char_t *gfc_wide_memset (gfc_char_t *, gfc_char_t, size_t);
3336 : : char *gfc_widechar_to_char (const gfc_char_t *, int);
3337 : : gfc_char_t *gfc_char_to_widechar (const char *);
3338 : :
3339 : : #define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
3340 : :
3341 : : void gfc_skip_comments (void);
3342 : : gfc_char_t gfc_next_char_literal (gfc_instring);
3343 : : gfc_char_t gfc_next_char (void);
3344 : : char gfc_next_ascii_char (void);
3345 : : gfc_char_t gfc_peek_char (void);
3346 : : char gfc_peek_ascii_char (void);
3347 : : void gfc_error_recovery (void);
3348 : : void gfc_gobble_whitespace (void);
3349 : : void gfc_new_file (void);
3350 : : const char * gfc_read_orig_filename (const char *, const char **);
3351 : :
3352 : : extern gfc_source_form gfc_current_form;
3353 : : extern const char *gfc_source_file;
3354 : : extern locus gfc_current_locus;
3355 : :
3356 : : void gfc_start_source_files (void);
3357 : : void gfc_end_source_files (void);
3358 : :
3359 : : /* misc.cc */
3360 : : void gfc_clear_ts (gfc_typespec *);
3361 : : FILE *gfc_open_file (const char *);
3362 : : const char *gfc_basic_typename (bt);
3363 : : const char *gfc_dummy_typename (gfc_typespec *);
3364 : : const char *gfc_typename (gfc_typespec *, bool for_hash = false);
3365 : : const char *gfc_typename (gfc_expr *);
3366 : : const char *gfc_op2string (gfc_intrinsic_op);
3367 : : const char *gfc_code2string (const mstring *, int);
3368 : : int gfc_string2code (const mstring *, const char *);
3369 : : const char *gfc_intent_string (sym_intent);
3370 : :
3371 : : void gfc_init_1 (void);
3372 : : void gfc_init_2 (void);
3373 : : void gfc_done_1 (void);
3374 : : void gfc_done_2 (void);
3375 : :
3376 : : int get_c_kind (const char *, CInteropKind_t *);
3377 : :
3378 : : const char *gfc_closest_fuzzy_match (const char *, char **);
3379 : : inline void
3380 : 577 : vec_push (char **&optr, size_t &osz, const char *elt)
3381 : : {
3382 : : /* {auto,}vec.safe_push () replacement. Don't ask.. */
3383 : : // if (strlen (elt) < 4) return; premature optimization: eliminated by cutoff
3384 : 577 : optr = XRESIZEVEC (char *, optr, osz + 2);
3385 : 577 : optr[osz] = CONST_CAST (char *, elt);
3386 : 577 : optr[++osz] = NULL;
3387 : 577 : }
3388 : :
3389 : : HOST_WIDE_INT gfc_mpz_get_hwi (mpz_t);
3390 : : void gfc_mpz_set_hwi (mpz_t, const HOST_WIDE_INT);
3391 : :
3392 : : /* options.cc */
3393 : : unsigned int gfc_option_lang_mask (void);
3394 : : void gfc_init_options_struct (struct gcc_options *);
3395 : : void gfc_init_options (unsigned int,
3396 : : struct cl_decoded_option *);
3397 : : bool gfc_handle_option (size_t, const char *, HOST_WIDE_INT, int, location_t,
3398 : : const struct cl_option_handlers *);
3399 : : bool gfc_post_options (const char **);
3400 : : char *gfc_get_option_string (void);
3401 : :
3402 : : /* f95-lang.cc */
3403 : : void gfc_maybe_initialize_eh (void);
3404 : :
3405 : : /* iresolve.cc */
3406 : : const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
3407 : : bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
3408 : :
3409 : : /* error.cc */
3410 : : void gfc_error_init_1 (void);
3411 : : void gfc_diagnostics_init (void);
3412 : : void gfc_diagnostics_finish (void);
3413 : : void gfc_buffer_error (bool);
3414 : :
3415 : : const char *gfc_print_wide_char (gfc_char_t);
3416 : :
3417 : : bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3418 : : bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3419 : : bool gfc_warning_internal (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3420 : : bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
3421 : : ATTRIBUTE_GCC_GFC(3,4);
3422 : :
3423 : : void gfc_clear_warning (void);
3424 : : void gfc_warning_check (void);
3425 : :
3426 : : void gfc_error_opt (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3427 : : void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
3428 : : void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
3429 : : void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
3430 : : void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
3431 : : void gfc_clear_error (void);
3432 : : bool gfc_error_check (void);
3433 : : bool gfc_error_flag_test (void);
3434 : : bool gfc_buffered_p (void);
3435 : :
3436 : : notification gfc_notification_std (int);
3437 : : bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3438 : :
3439 : : /* A general purpose syntax error. */
3440 : : #define gfc_syntax_error(ST) \
3441 : : gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
3442 : :
3443 : : #include "pretty-print.h" /* For output_buffer. */
3444 : 7173438 : struct gfc_error_buffer
3445 : : {
3446 : : bool flag;
3447 : : output_buffer buffer;
3448 : 7173441 : gfc_error_buffer(void) : flag(false), buffer() {}
3449 : : };
3450 : :
3451 : : void gfc_push_error (gfc_error_buffer *);
3452 : : void gfc_pop_error (gfc_error_buffer *);
3453 : : void gfc_free_error (gfc_error_buffer *);
3454 : :
3455 : : void gfc_get_errors (int *, int *);
3456 : : void gfc_errors_to_warnings (bool);
3457 : :
3458 : : /* arith.cc */
3459 : : void gfc_arith_init_1 (void);
3460 : : void gfc_arith_done_1 (void);
3461 : : arith gfc_check_integer_range (mpz_t p, int kind);
3462 : : bool gfc_check_character_range (gfc_char_t, int);
3463 : :
3464 : : extern bool gfc_seen_div0;
3465 : :
3466 : : /* trans-types.cc */
3467 : : int gfc_validate_kind (bt, int, bool);
3468 : : int gfc_get_int_kind_from_width_isofortranenv (int size);
3469 : : int gfc_get_real_kind_from_width_isofortranenv (int size);
3470 : : tree gfc_get_union_type (gfc_symbol *);
3471 : : tree gfc_get_derived_type (gfc_symbol * derived, int codimen = 0);
3472 : : extern int gfc_index_integer_kind;
3473 : : extern int gfc_default_integer_kind;
3474 : : extern int gfc_max_integer_kind;
3475 : : extern int gfc_default_real_kind;
3476 : : extern int gfc_default_double_kind;
3477 : : extern int gfc_default_character_kind;
3478 : : extern int gfc_default_logical_kind;
3479 : : extern int gfc_default_complex_kind;
3480 : : extern int gfc_c_int_kind;
3481 : : extern int gfc_c_intptr_kind;
3482 : : extern int gfc_atomic_int_kind;
3483 : : extern int gfc_atomic_logical_kind;
3484 : : extern int gfc_intio_kind;
3485 : : extern int gfc_charlen_int_kind;
3486 : : extern int gfc_size_kind;
3487 : : extern int gfc_numeric_storage_size;
3488 : : extern int gfc_character_storage_size;
3489 : :
3490 : : #define gfc_logical_4_kind 4
3491 : : #define gfc_integer_4_kind 4
3492 : : #define gfc_real_4_kind 4
3493 : :
3494 : : /* symbol.cc */
3495 : : void gfc_clear_new_implicit (void);
3496 : : bool gfc_add_new_implicit_range (int, int);
3497 : : bool gfc_merge_new_implicit (gfc_typespec *);
3498 : : void gfc_set_implicit_none (bool, bool, locus *);
3499 : : void gfc_check_function_type (gfc_namespace *);
3500 : : bool gfc_is_intrinsic_typename (const char *);
3501 : : bool gfc_check_conflict (symbol_attribute *, const char *, locus *);
3502 : :
3503 : : gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
3504 : : bool gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
3505 : :
3506 : : void gfc_set_sym_referenced (gfc_symbol *);
3507 : :
3508 : : bool gfc_add_attribute (symbol_attribute *, locus *);
3509 : : bool gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
3510 : : bool gfc_add_allocatable (symbol_attribute *, locus *);
3511 : : bool gfc_add_codimension (symbol_attribute *, const char *, locus *);
3512 : : bool gfc_add_contiguous (symbol_attribute *, const char *, locus *);
3513 : : bool gfc_add_dimension (symbol_attribute *, const char *, locus *);
3514 : : bool gfc_add_external (symbol_attribute *, locus *);
3515 : : bool gfc_add_intrinsic (symbol_attribute *, locus *);
3516 : : bool gfc_add_optional (symbol_attribute *, locus *);
3517 : : bool gfc_add_kind (symbol_attribute *, locus *);
3518 : : bool gfc_add_len (symbol_attribute *, locus *);
3519 : : bool gfc_add_pointer (symbol_attribute *, locus *);
3520 : : bool gfc_add_cray_pointer (symbol_attribute *, locus *);
3521 : : bool gfc_add_cray_pointee (symbol_attribute *, locus *);
3522 : : match gfc_mod_pointee_as (gfc_array_spec *);
3523 : : bool gfc_add_protected (symbol_attribute *, const char *, locus *);
3524 : : bool gfc_add_result (symbol_attribute *, const char *, locus *);
3525 : : bool gfc_add_automatic (symbol_attribute *, const char *, locus *);
3526 : : bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
3527 : : bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
3528 : : bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *);
3529 : : bool gfc_add_omp_declare_target_link (symbol_attribute *, const char *,
3530 : : locus *);
3531 : : bool gfc_add_target (symbol_attribute *, locus *);
3532 : : bool gfc_add_dummy (symbol_attribute *, const char *, locus *);
3533 : : bool gfc_add_generic (symbol_attribute *, const char *, locus *);
3534 : : bool gfc_add_in_common (symbol_attribute *, const char *, locus *);
3535 : : bool gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
3536 : : bool gfc_add_data (symbol_attribute *, const char *, locus *);
3537 : : bool gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
3538 : : bool gfc_add_sequence (symbol_attribute *, const char *, locus *);
3539 : : bool gfc_add_elemental (symbol_attribute *, locus *);
3540 : : bool gfc_add_pure (symbol_attribute *, locus *);
3541 : : bool gfc_add_recursive (symbol_attribute *, locus *);
3542 : : bool gfc_add_function (symbol_attribute *, const char *, locus *);
3543 : : bool gfc_add_subroutine (symbol_attribute *, const char *, locus *);
3544 : : bool gfc_add_volatile (symbol_attribute *, const char *, locus *);
3545 : : bool gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
3546 : : bool gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
3547 : : bool gfc_add_abstract (symbol_attribute* attr, locus* where);
3548 : :
3549 : : bool gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
3550 : : bool gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
3551 : : bool gfc_add_extension (symbol_attribute *, locus *);
3552 : : bool gfc_add_value (symbol_attribute *, const char *, locus *);
3553 : : bool gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
3554 : : bool gfc_add_entry (symbol_attribute *, const char *, locus *);
3555 : : bool gfc_add_procedure (symbol_attribute *, procedure_type,
3556 : : const char *, locus *);
3557 : : bool gfc_add_intent (symbol_attribute *, sym_intent, locus *);
3558 : : bool gfc_add_explicit_interface (gfc_symbol *, ifsrc,
3559 : : gfc_formal_arglist *, locus *);
3560 : : bool gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
3561 : :
3562 : : void gfc_clear_attr (symbol_attribute *);
3563 : : bool gfc_missing_attr (symbol_attribute *, locus *);
3564 : : bool gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
3565 : : int gfc_copy_dummy_sym (gfc_symbol **, gfc_symbol *, int);
3566 : : bool gfc_add_component (gfc_symbol *, const char *, gfc_component **);
3567 : : gfc_symbol *gfc_use_derived (gfc_symbol *);
3568 : : gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool,
3569 : : gfc_ref **);
3570 : : int gfc_find_derived_types (gfc_symbol *, gfc_namespace *, const char *,
3571 : : bool stash = false);
3572 : :
3573 : : gfc_st_label *gfc_get_st_label (int);
3574 : : void gfc_free_st_label (gfc_st_label *);
3575 : : void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
3576 : : bool gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
3577 : :
3578 : : gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
3579 : : gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
3580 : : gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
3581 : : gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
3582 : : gfc_user_op *gfc_get_uop (const char *);
3583 : : gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
3584 : : void gfc_free_symbol (gfc_symbol *&);
3585 : : bool gfc_release_symbol (gfc_symbol *&);
3586 : : gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
3587 : : gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
3588 : : int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
3589 : : bool gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
3590 : : int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
3591 : : bool gfc_verify_c_interop (gfc_typespec *);
3592 : : bool gfc_verify_c_interop_param (gfc_symbol *);
3593 : : bool verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
3594 : : bool verify_bind_c_derived_type (gfc_symbol *);
3595 : : bool verify_com_block_vars_c_interop (gfc_common_head *);
3596 : : gfc_symtree *generate_isocbinding_symbol (const char *, iso_c_binding_symbol,
3597 : : const char *, gfc_symtree *, bool);
3598 : : void gfc_save_symbol_data (gfc_symbol *);
3599 : : int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
3600 : : int gfc_get_ha_symbol (const char *, gfc_symbol **);
3601 : : int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
3602 : :
3603 : : void gfc_drop_last_undo_checkpoint (void);
3604 : : void gfc_restore_last_undo_checkpoint (void);
3605 : : void gfc_undo_symbols (void);
3606 : : void gfc_commit_symbols (void);
3607 : : void gfc_commit_symbol (gfc_symbol *);
3608 : : gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
3609 : : void gfc_free_namespace (gfc_namespace *&);
3610 : :
3611 : : void gfc_symbol_init_2 (void);
3612 : : void gfc_symbol_done_2 (void);
3613 : :
3614 : : void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
3615 : : void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
3616 : : void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
3617 : : void gfc_save_all (gfc_namespace *);
3618 : :
3619 : : void gfc_enforce_clean_symbol_state (void);
3620 : :
3621 : : gfc_gsymbol *gfc_get_gsymbol (const char *, bool bind_c);
3622 : : gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
3623 : : gfc_gsymbol *gfc_find_case_gsymbol (gfc_gsymbol *, const char *);
3624 : : void gfc_traverse_gsymbol (gfc_gsymbol *, void (*)(gfc_gsymbol *, void *), void *);
3625 : :
3626 : : gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
3627 : : gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
3628 : : bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
3629 : : bool gfc_pdt_is_instance_of (gfc_symbol *, gfc_symbol *);
3630 : : bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
3631 : :
3632 : : void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *,
3633 : : gfc_actual_arglist *, bool copy_type = false);
3634 : :
3635 : : void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.cc, too */
3636 : :
3637 : : bool gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
3638 : : gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
3639 : :
3640 : : bool gfc_is_associate_pointer (gfc_symbol*);
3641 : : gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
3642 : : gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *);
3643 : :
3644 : : gfc_namespace * gfc_get_procedure_ns (gfc_symbol *);
3645 : : gfc_namespace * gfc_get_spec_ns (gfc_symbol *);
3646 : :
3647 : : /* intrinsic.cc -- true if working in an init-expr, false otherwise. */
3648 : : extern bool gfc_init_expr_flag;
3649 : :
3650 : : /* Given a symbol that we have decided is intrinsic, mark it as such
3651 : : by placing it into a special module that is otherwise impossible to
3652 : : read or write. */
3653 : :
3654 : : #define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
3655 : :
3656 : : void gfc_intrinsic_init_1 (void);
3657 : : void gfc_intrinsic_done_1 (void);
3658 : :
3659 : : char gfc_type_letter (bt, bool logical_equals_int = false);
3660 : : int gfc_type_abi_kind (bt, int);
3661 : : inline int
3662 : 15073769 : gfc_type_abi_kind (gfc_typespec *ts)
3663 : : {
3664 : 15073769 : return gfc_type_abi_kind (ts->type, ts->kind);
3665 : : }
3666 : : gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
3667 : : gfc_symbol *gfc_get_intrinsic_function_symbol (gfc_expr *);
3668 : : gfc_symbol *gfc_find_intrinsic_symbol (gfc_expr *);
3669 : : bool gfc_convert_type (gfc_expr *, gfc_typespec *, int);
3670 : : bool gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int,
3671 : : bool array = false);
3672 : : bool gfc_convert_chartype (gfc_expr *, gfc_typespec *);
3673 : : bool gfc_generic_intrinsic (const char *);
3674 : : bool gfc_specific_intrinsic (const char *);
3675 : : bool gfc_is_intrinsic (gfc_symbol*, int, locus);
3676 : : bool gfc_intrinsic_actual_ok (const char *, const bool);
3677 : : gfc_intrinsic_sym *gfc_find_function (const char *);
3678 : : gfc_intrinsic_sym *gfc_find_subroutine (const char *);
3679 : : gfc_intrinsic_sym *gfc_intrinsic_function_by_id (gfc_isym_id);
3680 : : gfc_intrinsic_sym *gfc_intrinsic_subroutine_by_id (gfc_isym_id);
3681 : : gfc_isym_id gfc_isym_id_by_intmod (intmod_id, int);
3682 : : gfc_isym_id gfc_isym_id_by_intmod_sym (gfc_symbol *);
3683 : :
3684 : :
3685 : : match gfc_intrinsic_func_interface (gfc_expr *, int);
3686 : : match gfc_intrinsic_sub_interface (gfc_code *, int);
3687 : :
3688 : : void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
3689 : : bool gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
3690 : : bool, locus);
3691 : :
3692 : : /* match.cc -- FIXME */
3693 : : void gfc_free_iterator (gfc_iterator *, int);
3694 : : void gfc_free_forall_iterator (gfc_forall_iterator *);
3695 : : void gfc_free_alloc_list (gfc_alloc *);
3696 : : void gfc_free_namelist (gfc_namelist *);
3697 : : void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool, bool, bool);
3698 : : void gfc_free_equiv (gfc_equiv *);
3699 : : void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
3700 : : void gfc_free_data (gfc_data *);
3701 : : void gfc_reject_data (gfc_namespace *);
3702 : : void gfc_free_case_list (gfc_case *);
3703 : :
3704 : : /* matchexp.cc -- FIXME too? */
3705 : : gfc_expr *gfc_get_parentheses (gfc_expr *);
3706 : :
3707 : : /* openmp.cc */
3708 : : struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
3709 : : bool gfc_omp_requires_add_clause (gfc_omp_requires_kind, const char *,
3710 : : locus *, const char *);
3711 : : void gfc_check_omp_requires (gfc_namespace *, int);
3712 : : void gfc_free_omp_clauses (gfc_omp_clauses *);
3713 : : void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
3714 : : void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list);
3715 : : void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
3716 : : void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
3717 : : void gfc_free_omp_udr (gfc_omp_udr *);
3718 : : gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
3719 : : void gfc_resolve_omp_allocate (gfc_namespace *, gfc_omp_namelist *);
3720 : : void gfc_resolve_omp_assumptions (gfc_omp_assumptions *);
3721 : : void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
3722 : : void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool);
3723 : : void gfc_resolve_omp_local_vars (gfc_namespace *);
3724 : : void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
3725 : : void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
3726 : : void gfc_resolve_omp_declare_simd (gfc_namespace *);
3727 : : void gfc_resolve_omp_udrs (gfc_symtree *);
3728 : : void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
3729 : : void gfc_omp_restore_state (struct gfc_omp_saved_state *);
3730 : : void gfc_free_expr_list (gfc_expr_list *);
3731 : : void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
3732 : : void gfc_resolve_oacc_declare (gfc_namespace *);
3733 : : void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
3734 : : void gfc_resolve_oacc_routines (gfc_namespace *);
3735 : :
3736 : : /* expr.cc */
3737 : : void gfc_free_actual_arglist (gfc_actual_arglist *);
3738 : : gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
3739 : :
3740 : : bool gfc_extract_int (gfc_expr *, int *, int = 0);
3741 : : bool gfc_extract_hwi (gfc_expr *, HOST_WIDE_INT *, int = 0);
3742 : :
3743 : : bool is_CFI_desc (gfc_symbol *, gfc_expr *);
3744 : : bool is_subref_array (gfc_expr *);
3745 : : bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
3746 : : bool gfc_is_not_contiguous (gfc_expr *);
3747 : : bool gfc_check_init_expr (gfc_expr *);
3748 : :
3749 : : gfc_expr *gfc_build_conversion (gfc_expr *);
3750 : : void gfc_free_ref_list (gfc_ref *);
3751 : : void gfc_type_convert_binary (gfc_expr *, int);
3752 : : bool gfc_is_constant_expr (gfc_expr *);
3753 : : bool gfc_simplify_expr (gfc_expr *, int);
3754 : : bool gfc_try_simplify_expr (gfc_expr *, int);
3755 : : bool gfc_has_vector_index (gfc_expr *);
3756 : : bool gfc_is_ptr_fcn (gfc_expr *);
3757 : :
3758 : : gfc_expr *gfc_get_expr (void);
3759 : : gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
3760 : : gfc_expr *gfc_get_null_expr (locus *);
3761 : : gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *, gfc_expr *);
3762 : : gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *);
3763 : : gfc_expr *gfc_get_constant_expr (bt, int, locus *);
3764 : : gfc_expr *gfc_get_character_expr (int, locus *, const char *, gfc_charlen_t len);
3765 : : gfc_expr *gfc_get_int_expr (int, locus *, HOST_WIDE_INT);
3766 : : gfc_expr *gfc_get_logical_expr (int, locus *, bool);
3767 : : gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
3768 : :
3769 : : void gfc_clear_shape (mpz_t *shape, int rank);
3770 : : void gfc_free_shape (mpz_t **shape, int rank);
3771 : : void gfc_free_expr (gfc_expr *);
3772 : : void gfc_replace_expr (gfc_expr *, gfc_expr *);
3773 : : mpz_t *gfc_copy_shape (mpz_t *, int);
3774 : : mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
3775 : : gfc_expr *gfc_copy_expr (gfc_expr *);
3776 : : gfc_ref* gfc_copy_ref (gfc_ref*);
3777 : :
3778 : : bool gfc_specification_expr (gfc_expr *);
3779 : :
3780 : : bool gfc_numeric_ts (gfc_typespec *);
3781 : : int gfc_kind_max (gfc_expr *, gfc_expr *);
3782 : :
3783 : : bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
3784 : : bool gfc_check_assign (gfc_expr *, gfc_expr *, int, bool c = true);
3785 : : bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
3786 : : bool suppres_type_test = false,
3787 : : bool is_init_expr = false);
3788 : : bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
3789 : :
3790 : : gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *);
3791 : : void gfc_apply_init (gfc_typespec *, symbol_attribute *, gfc_expr *);
3792 : : bool gfc_has_default_initializer (gfc_symbol *);
3793 : : gfc_expr *gfc_default_initializer (gfc_typespec *);
3794 : : gfc_expr *gfc_generate_initializer (gfc_typespec *, bool);
3795 : : gfc_expr *gfc_get_variable_expr (gfc_symtree *);
3796 : : void gfc_add_full_array_ref (gfc_expr *, gfc_array_spec *);
3797 : : gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
3798 : :
3799 : : gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
3800 : :
3801 : : bool gfc_traverse_expr (gfc_expr *, gfc_symbol *,
3802 : : bool (*)(gfc_expr *, gfc_symbol *, int*),
3803 : : int);
3804 : : void gfc_expr_set_symbols_referenced (gfc_expr *);
3805 : : bool gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
3806 : : bool gfc_derived_parameter_expr (gfc_expr *);
3807 : : gfc_param_spec_type gfc_spec_list_type (gfc_actual_arglist *, gfc_symbol *);
3808 : : gfc_component * gfc_get_proc_ptr_comp (gfc_expr *);
3809 : : bool gfc_is_proc_ptr_comp (gfc_expr *);
3810 : : bool gfc_is_alloc_class_scalar_function (gfc_expr *);
3811 : : bool gfc_is_class_array_function (gfc_expr *);
3812 : :
3813 : : bool gfc_ref_this_image (gfc_ref *ref);
3814 : : bool gfc_is_coindexed (gfc_expr *);
3815 : : bool gfc_is_coarray (gfc_expr *);
3816 : : bool gfc_has_ultimate_allocatable (gfc_expr *);
3817 : : bool gfc_has_ultimate_pointer (gfc_expr *);
3818 : : gfc_expr* gfc_find_team_co (gfc_expr *);
3819 : : gfc_expr* gfc_find_stat_co (gfc_expr *);
3820 : : gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
3821 : : locus, unsigned, ...);
3822 : : bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
3823 : : gfc_expr* gfc_pdt_find_component_copy_initializer (gfc_symbol *, const char *);
3824 : :
3825 : :
3826 : : /* st.cc */
3827 : : extern gfc_code new_st;
3828 : :
3829 : : void gfc_clear_new_st (void);
3830 : : gfc_code *gfc_get_code (gfc_exec_op);
3831 : : gfc_code *gfc_append_code (gfc_code *, gfc_code *);
3832 : : void gfc_free_statement (gfc_code *);
3833 : : void gfc_free_statements (gfc_code *);
3834 : : void gfc_free_association_list (gfc_association_list *);
3835 : :
3836 : : /* resolve.cc */
3837 : : void gfc_expression_rank (gfc_expr *);
3838 : : bool gfc_op_rank_conformable (gfc_expr *, gfc_expr *);
3839 : : bool gfc_resolve_ref (gfc_expr *);
3840 : : void gfc_fixup_inferred_type_refs (gfc_expr *);
3841 : : bool gfc_resolve_expr (gfc_expr *);
3842 : : void gfc_resolve (gfc_namespace *);
3843 : : void gfc_resolve_code (gfc_code *, gfc_namespace *);
3844 : : void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
3845 : : void gfc_resolve_formal_arglist (gfc_symbol *);
3846 : : bool gfc_impure_variable (gfc_symbol *);
3847 : : bool gfc_pure (gfc_symbol *);
3848 : : bool gfc_implicit_pure (gfc_symbol *);
3849 : : void gfc_unset_implicit_pure (gfc_symbol *);
3850 : : bool gfc_elemental (gfc_symbol *);
3851 : : bool gfc_resolve_iterator (gfc_iterator *, bool, bool);
3852 : : bool find_forall_index (gfc_expr *, gfc_symbol *, int);
3853 : : bool gfc_resolve_index (gfc_expr *, int);
3854 : : bool gfc_resolve_dim_arg (gfc_expr *);
3855 : : bool gfc_resolve_substring (gfc_ref *, bool *);
3856 : : void gfc_resolve_substring_charlen (gfc_expr *);
3857 : : gfc_expr *gfc_expr_to_initialize (gfc_expr *);
3858 : : bool gfc_type_is_extensible (gfc_symbol *);
3859 : : bool gfc_resolve_intrinsic (gfc_symbol *, locus *);
3860 : : bool gfc_explicit_interface_required (gfc_symbol *, char *, int);
3861 : : extern int gfc_do_concurrent_flag;
3862 : : const char* gfc_lookup_function_fuzzy (const char *, gfc_symtree *);
3863 : : bool gfc_pure_function (gfc_expr *e, const char **name);
3864 : : bool gfc_implicit_pure_function (gfc_expr *e);
3865 : :
3866 : :
3867 : : /* array.cc */
3868 : : gfc_iterator *gfc_copy_iterator (gfc_iterator *);
3869 : :
3870 : : void gfc_free_array_spec (gfc_array_spec *);
3871 : : gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
3872 : :
3873 : : bool gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
3874 : : gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
3875 : : bool gfc_resolve_array_spec (gfc_array_spec *, int);
3876 : :
3877 : : bool gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
3878 : :
3879 : : void gfc_simplify_iterator_var (gfc_expr *);
3880 : : bool gfc_expand_constructor (gfc_expr *, bool);
3881 : : bool gfc_constant_ac (gfc_expr *);
3882 : : bool gfc_expanded_ac (gfc_expr *);
3883 : : bool gfc_resolve_character_array_constructor (gfc_expr *);
3884 : : bool gfc_resolve_array_constructor (gfc_expr *);
3885 : : bool gfc_check_constructor_type (gfc_expr *);
3886 : : bool gfc_check_iter_variable (gfc_expr *);
3887 : : bool gfc_check_constructor (gfc_expr *, bool (*)(gfc_expr *));
3888 : : bool gfc_array_size (gfc_expr *, mpz_t *);
3889 : : bool gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
3890 : : bool gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
3891 : : gfc_array_ref *gfc_find_array_ref (gfc_expr *, bool a = false);
3892 : : tree gfc_conv_array_initializer (tree type, gfc_expr *);
3893 : : bool spec_size (gfc_array_spec *, mpz_t *);
3894 : : bool spec_dimen_size (gfc_array_spec *, int, mpz_t *);
3895 : : bool gfc_is_compile_time_shape (gfc_array_spec *);
3896 : :
3897 : : bool gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
3898 : :
3899 : : /* interface.cc -- FIXME: some of these should be in symbol.cc */
3900 : : void gfc_free_interface (gfc_interface *);
3901 : : void gfc_drop_interface_elements_before (gfc_interface **, gfc_interface *);
3902 : : bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
3903 : : bool gfc_compare_types (gfc_typespec *, gfc_typespec *);
3904 : : bool gfc_check_dummy_characteristics (gfc_symbol *, gfc_symbol *,
3905 : : bool, char *, int);
3906 : : bool gfc_check_result_characteristics (gfc_symbol *, gfc_symbol *,
3907 : : char *, int);
3908 : : bool gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
3909 : : char *, int, const char *, const char *,
3910 : : bool *bad_result_characteristics = NULL);
3911 : : void gfc_check_interfaces (gfc_namespace *);
3912 : : bool gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
3913 : : void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
3914 : : gfc_symbol *gfc_search_interface (gfc_interface *, int,
3915 : : gfc_actual_arglist **);
3916 : : match gfc_extend_expr (gfc_expr *);
3917 : : void gfc_free_formal_arglist (gfc_formal_arglist *);
3918 : : bool gfc_extend_assign (gfc_code *, gfc_namespace *);
3919 : : bool gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus);
3920 : : bool gfc_add_interface (gfc_symbol *);
3921 : : gfc_interface *&gfc_current_interface_head (void);
3922 : : void gfc_set_current_interface_head (gfc_interface *);
3923 : : gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
3924 : : bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
3925 : : bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
3926 : : bool gfc_has_vector_subscript (gfc_expr*);
3927 : : gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
3928 : : bool gfc_check_typebound_override (gfc_symtree*, gfc_symtree*);
3929 : : void gfc_check_dtio_interfaces (gfc_symbol*);
3930 : : gfc_symtree* gfc_find_typebound_dtio_proc (gfc_symbol *, bool, bool);
3931 : : gfc_symbol* gfc_find_specific_dtio_proc (gfc_symbol*, bool, bool);
3932 : : void gfc_get_formal_from_actual_arglist (gfc_symbol *, gfc_actual_arglist *);
3933 : : bool gfc_compare_actual_formal (gfc_actual_arglist **, gfc_formal_arglist *,
3934 : : int, int, bool, locus *);
3935 : :
3936 : :
3937 : : /* io.cc */
3938 : : extern gfc_st_label format_asterisk;
3939 : :
3940 : : void gfc_free_open (gfc_open *);
3941 : : bool gfc_resolve_open (gfc_open *, locus *);
3942 : : void gfc_free_close (gfc_close *);
3943 : : bool gfc_resolve_close (gfc_close *, locus *);
3944 : : void gfc_free_filepos (gfc_filepos *);
3945 : : bool gfc_resolve_filepos (gfc_filepos *, locus *);
3946 : : void gfc_free_inquire (gfc_inquire *);
3947 : : bool gfc_resolve_inquire (gfc_inquire *);
3948 : : void gfc_free_dt (gfc_dt *);
3949 : : bool gfc_resolve_dt (gfc_code *, gfc_dt *, locus *);
3950 : : void gfc_free_wait (gfc_wait *);
3951 : : bool gfc_resolve_wait (gfc_wait *);
3952 : :
3953 : : /* module.cc */
3954 : : void gfc_module_init_2 (void);
3955 : : void gfc_module_done_2 (void);
3956 : : void gfc_dump_module (const char *, int);
3957 : : bool gfc_check_symbol_access (gfc_symbol *);
3958 : : void gfc_free_use_stmts (gfc_use_list *);
3959 : : void gfc_save_module_list ();
3960 : : void gfc_restore_old_module_list ();
3961 : : const char *gfc_dt_lower_string (const char *);
3962 : : const char *gfc_dt_upper_string (const char *);
3963 : :
3964 : : /* primary.cc */
3965 : : symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
3966 : : symbol_attribute gfc_expr_attr (gfc_expr *);
3967 : : symbol_attribute gfc_caf_attr (gfc_expr *, bool i = false, bool *r = NULL);
3968 : : bool is_inquiry_ref (const char *, gfc_ref **);
3969 : : match gfc_match_rvalue (gfc_expr **);
3970 : : match gfc_match_varspec (gfc_expr*, int, bool, bool);
3971 : : bool gfc_check_digit (char, int);
3972 : : bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
3973 : : bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
3974 : : gfc_expr **,
3975 : : gfc_actual_arglist **, bool);
3976 : :
3977 : : /* trans.cc */
3978 : : void gfc_generate_code (gfc_namespace *);
3979 : : void gfc_generate_module_code (gfc_namespace *);
3980 : :
3981 : : /* trans-intrinsic.cc */
3982 : : bool gfc_inline_intrinsic_function_p (gfc_expr *);
3983 : :
3984 : : /* trans-openmp.cc */
3985 : : int gfc_expr_list_len (gfc_expr_list *);
3986 : :
3987 : : /* bbt.cc */
3988 : : typedef int (*compare_fn) (void *, void *);
3989 : : void gfc_insert_bbt (void *, void *, compare_fn);
3990 : : void * gfc_delete_bbt (void *, void *, compare_fn);
3991 : :
3992 : : /* dump-parse-tree.cc */
3993 : : void gfc_dump_parse_tree (gfc_namespace *, FILE *);
3994 : : void gfc_dump_c_prototypes (gfc_namespace *, FILE *);
3995 : : void gfc_dump_external_c_prototypes (FILE *);
3996 : : void gfc_dump_global_symbols (FILE *);
3997 : : void debug (gfc_symbol *);
3998 : : void debug (gfc_expr *);
3999 : :
4000 : : /* parse.cc */
4001 : : bool gfc_parse_file (void);
4002 : : void gfc_global_used (gfc_gsymbol *, locus *);
4003 : : gfc_namespace* gfc_build_block_ns (gfc_namespace *);
4004 : :
4005 : : /* dependency.cc */
4006 : : int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
4007 : : int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
4008 : : bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *);
4009 : :
4010 : : /* check.cc */
4011 : : bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
4012 : : bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*,
4013 : : size_t*, size_t*, size_t*);
4014 : : bool gfc_boz2int (gfc_expr *, int);
4015 : : bool gfc_boz2real (gfc_expr *, int);
4016 : : bool gfc_invalid_boz (const char *, locus *);
4017 : : bool gfc_invalid_null_arg (gfc_expr *);
4018 : :
4019 : :
4020 : : /* class.cc */
4021 : : void gfc_fix_class_refs (gfc_expr *e);
4022 : : void gfc_add_component_ref (gfc_expr *, const char *);
4023 : : void gfc_add_class_array_ref (gfc_expr *);
4024 : : #define gfc_add_data_component(e) gfc_add_component_ref(e,"_data")
4025 : : #define gfc_add_vptr_component(e) gfc_add_component_ref(e,"_vptr")
4026 : : #define gfc_add_len_component(e) gfc_add_component_ref(e,"_len")
4027 : : #define gfc_add_hash_component(e) gfc_add_component_ref(e,"_hash")
4028 : : #define gfc_add_size_component(e) gfc_add_component_ref(e,"_size")
4029 : : #define gfc_add_def_init_component(e) gfc_add_component_ref(e,"_def_init")
4030 : : #define gfc_add_final_component(e) gfc_add_component_ref(e,"_final")
4031 : : bool gfc_is_class_array_ref (gfc_expr *, bool *);
4032 : : bool gfc_is_class_scalar_expr (gfc_expr *);
4033 : : bool gfc_is_class_container_ref (gfc_expr *e);
4034 : : gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *);
4035 : : unsigned int gfc_hash_value (gfc_symbol *);
4036 : : gfc_expr *gfc_get_len_component (gfc_expr *e, int);
4037 : : bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
4038 : : gfc_array_spec **);
4039 : : void gfc_change_class (gfc_typespec *, symbol_attribute *,
4040 : : gfc_array_spec *, int, int);
4041 : : gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
4042 : : gfc_symbol *gfc_find_vtab (gfc_typespec *);
4043 : : gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, bool*,
4044 : : const char*, bool, locus*);
4045 : : gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, bool*,
4046 : : const char*, bool, locus*);
4047 : : gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, bool*,
4048 : : gfc_intrinsic_op, bool,
4049 : : locus*);
4050 : : gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
4051 : : bool gfc_is_finalizable (gfc_symbol *, gfc_expr **);
4052 : : bool gfc_may_be_finalized (gfc_typespec);
4053 : :
4054 : : #define CLASS_DATA(sym) sym->ts.u.derived->components
4055 : : #define UNLIMITED_POLY(sym) \
4056 : : (sym != NULL && sym->ts.type == BT_CLASS \
4057 : : && CLASS_DATA (sym) \
4058 : : && CLASS_DATA (sym)->ts.u.derived \
4059 : : && CLASS_DATA (sym)->ts.u.derived->attr.unlimited_polymorphic)
4060 : : #define IS_CLASS_ARRAY(sym) \
4061 : : (sym->ts.type == BT_CLASS \
4062 : : && CLASS_DATA (sym) \
4063 : : && CLASS_DATA (sym)->attr.dimension \
4064 : : && !CLASS_DATA (sym)->attr.class_pointer)
4065 : : #define IS_CLASS_COARRAY_OR_ARRAY(sym) \
4066 : : (sym->ts.type == BT_CLASS && CLASS_DATA (sym) \
4067 : : && (CLASS_DATA (sym)->attr.dimension \
4068 : : || CLASS_DATA (sym)->attr.codimension) \
4069 : : && !CLASS_DATA (sym)->attr.class_pointer)
4070 : : #define IS_POINTER(sym) \
4071 : : (sym->ts.type == BT_CLASS && sym->attr.class_ok && CLASS_DATA (sym) \
4072 : : ? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer)
4073 : : #define IS_PROC_POINTER(sym) \
4074 : : (sym->ts.type == BT_CLASS && sym->attr.class_ok && CLASS_DATA (sym) \
4075 : : ? CLASS_DATA (sym)->attr.proc_pointer : sym->attr.proc_pointer)
4076 : : #define IS_INFERRED_TYPE(expr) \
4077 : : (expr && expr->expr_type == EXPR_VARIABLE \
4078 : : && expr->symtree->n.sym->assoc \
4079 : : && expr->symtree->n.sym->assoc->inferred_type)
4080 : :
4081 : : /* frontend-passes.cc */
4082 : :
4083 : : void gfc_run_passes (gfc_namespace *);
4084 : :
4085 : : typedef int (*walk_code_fn_t) (gfc_code **, int *, void *);
4086 : : typedef int (*walk_expr_fn_t) (gfc_expr **, int *, void *);
4087 : :
4088 : : int gfc_dummy_code_callback (gfc_code **, int *, void *);
4089 : : int gfc_expr_walker (gfc_expr **, walk_expr_fn_t, void *);
4090 : : int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *);
4091 : : bool gfc_has_dimen_vector_ref (gfc_expr *e);
4092 : : void gfc_check_externals (gfc_namespace *);
4093 : : bool gfc_fix_implicit_pure (gfc_namespace *);
4094 : :
4095 : : /* simplify.cc */
4096 : :
4097 : : void gfc_convert_mpz_to_signed (mpz_t, int);
4098 : : gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
4099 : : bool gfc_is_constant_array_expr (gfc_expr *);
4100 : : bool gfc_is_size_zero_array (gfc_expr *);
4101 : :
4102 : : /* trans-array.cc */
4103 : :
4104 : : bool gfc_is_reallocatable_lhs (gfc_expr *);
4105 : :
4106 : : /* trans-decl.cc */
4107 : :
4108 : : void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool);
4109 : : void gfc_adjust_builtins (void);
4110 : :
4111 : : #endif /* GCC_GFORTRAN_H */
|
