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