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

Provided by KDAB

Privacy Policy
Improve your Profiling and Debugging skills
Find out more

source code of gcc/fortran/gfortran.h