1	/* gfortran header file
2	Copyright (C) 2000-2025 Free Software Foundation, Inc.
3	Contributed by Andy Vaught
4
5	This file is part of GCC.
6
7	GCC is free software; you can redistribute it and/or modify it under
8	the terms of the GNU General Public License as published by the Free
9	Software Foundation; either version 3, or (at your option) any later
10	version.
11
12	GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13	WARRANTY; without even the implied warranty of MERCHANTABILITY or
14	FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15	for more details.
16
17	You should have received a copy of the GNU General Public License
18	along with GCC; see the file COPYING3. If not see
19	<http://www.gnu.org/licenses/>. */
20
21	#ifndef GCC_GFORTRAN_H
22	#define GCC_GFORTRAN_H
23
24	/* It's probably insane to have this large of a header file, but it
25	seemed like everything had to be recompiled anyway when a change
26	was made to a header file, and there were ordering issues with
27	multiple header files. Besides, Microsoft's winnt.h was 250k last
28	time I looked, so by comparison this is perfectly reasonable. */
29
30	#ifndef GCC_CORETYPES_H
31	#error "gfortran.h must be included after coretypes.h"
32	#endif
33
34	/* In order for the format checking to accept the Fortran front end
35	diagnostic framework extensions, you must include this file before
36	diagnostic-core.h, not after. We override the definition of GCC_DIAG_STYLE
37	in c-common.h. */
38	#undef GCC_DIAG_STYLE
39	#define GCC_DIAG_STYLE __gcc_gfc__
40	#if defined(GCC_DIAGNOSTIC_CORE_H)
41	#error \
42	In order for the format checking to accept the Fortran front end diagnostic \
43	framework extensions, you must include this file before diagnostic-core.h, \
44	not after.
45	#endif
46
47	/* Declarations common to the front-end and library are put in
48	libgfortran/libgfortran_frontend.h */
49	#include "libgfortran.h"
50
51
52	#include "intl.h"
53	#include "splay-tree.h"
54
55	/* Major control parameters. */
56
57	#define GFC_MAX_SYMBOL_LEN 63 /* Must be at least 63 for F2003. */
58	#define GFC_LETTERS 26 /* Number of letters in the alphabet. */
59
60	#define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */
61
62
63	#define gfc_is_whitespace(c) ((c==' ') || (c=='\t') || (c=='\f'))
64
65	/* Macros to check for groups of structure-like types and flavors since
66	derived types, structures, maps, unions are often treated similarly. */
67	#define gfc_bt_struct(t) \
68	((t) == BT_DERIVED || (t) == BT_UNION)
69	#define gfc_fl_struct(f) \
70	((f) == FL_DERIVED || (f) == FL_UNION || (f) == FL_STRUCT)
71	#define case_bt_struct case BT_DERIVED: case BT_UNION
72	#define case_fl_struct case FL_DERIVED: case FL_UNION: case FL_STRUCT
73
74	/* Stringization. */
75	#define stringize(x) expand_macro(x)
76	#define expand_macro(x) # x
77
78	/* For the runtime library, a standard prefix is a requirement to
79	avoid cluttering the namespace with things nobody asked for. It's
80	ugly to look at and a pain to type when you add the prefix by hand,
81	so we hide it behind a macro. */
82	#define PREFIX(x) "_gfortran_" x
83	#define PREFIX_LEN 10
84
85	/* A prefix for internal variables, which are not user-visible. */
86	#if !defined (NO_DOT_IN_LABEL)
87	# define GFC_PREFIX(x) "_F." x
88	#elif !defined (NO_DOLLAR_IN_LABEL)
89	# define GFC_PREFIX(x) "_F$" x
90	#else
91	# define GFC_PREFIX(x) "_F_" x
92	#endif
93
94	#define BLANK_COMMON_NAME "__BLNK__"
95
96	/* Macro to initialize an mstring structure. */
97	#define minit(s, t) { s, NULL, t }
98
99	/* Structure for storing strings to be matched by gfc_match_string. */
100	typedef struct
101	{
102	const char *string;
103	const char *mp;
104	int tag;
105	}
106	mstring;
107
108	/* ISO_Fortran_binding.h
109	CAUTION: This has to be kept in sync with libgfortran. */
110
111	#define CFI_type_kind_shift 8
112	#define CFI_type_mask 0xFF
113	#define CFI_type_from_type_kind(t, k) (t + (k << CFI_type_kind_shift))
114
115	/* Constants, defined as macros. */
116	#define CFI_VERSION 1
117	#define CFI_MAX_RANK 15
118
119	/* Attributes. */
120	#define CFI_attribute_pointer 0
121	#define CFI_attribute_allocatable 1
122	#define CFI_attribute_other 2
123
124	#define CFI_type_mask 0xFF
125	#define CFI_type_kind_shift 8
126
127	/* Intrinsic types. Their kind number defines their storage size. */
128	#define CFI_type_Integer 1
129	#define CFI_type_Logical 2
130	#define CFI_type_Real 3
131	#define CFI_type_Complex 4
132	#define CFI_type_Character 5
133
134	/* Combined type (for more, see ISO_Fortran_binding.h). */
135	#define CFI_type_ucs4_char (CFI_type_Character + (4 << CFI_type_kind_shift))
136
137	/* Types with no kind. */
138	#define CFI_type_struct 6
139	#define CFI_type_cptr 7
140	#define CFI_type_cfunptr 8
141	#define CFI_type_other -1
142
143
144	/*************************** Enums *****************************/
145
146	/* Used when matching and resolving data I/O transfer statements. */
147
148	enum io_kind
149	{ M_READ, M_WRITE, M_PRINT, M_INQUIRE };
150
151
152	/* These are flags for identifying whether we are reading a character literal
153	between quotes or normal source code. */
154
155	enum gfc_instring
156	{ NONSTRING = 0, INSTRING_WARN, INSTRING_NOWARN };
157
158	/* This is returned by gfc_notification_std to know if, given the flags
159	that were given (-std=, -pedantic) we should issue an error, a warning
160	or nothing. */
161
162	enum notification
163	{ SILENT, WARNING, ERROR };
164
165	/* Matchers return one of these three values. The difference between
166	MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
167	successful, but that something non-syntactic is wrong and an error
168	has already been issued. */
169
170	enum match
171	{ MATCH_NO = 1, MATCH_YES, MATCH_ERROR };
172
173	/* Used for different Fortran source forms in places like scanner.cc. */
174	enum gfc_source_form
175	{ FORM_FREE, FORM_FIXED, FORM_UNKNOWN };
176
177	/* Expression node types. */
178	enum expr_t
179	{ EXPR_UNKNOWN = 0, EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
180	EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL, EXPR_PPC
181	};
182
183	/* Array types. */
184	enum array_type
185	{ AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
186	AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_ASSUMED_RANK,
187	AS_UNKNOWN
188	};
189
190	enum ar_type
191	{ AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN };
192
193	/* Statement label types. ST_LABEL_DO_TARGET is used for obsolescent warnings
194	related to shared DO terminations and DO targets which are neither END DO
195	nor CONTINUE; otherwise it is identical to ST_LABEL_TARGET. */
196	enum gfc_sl_type
197	{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET, ST_LABEL_DO_TARGET,
198	ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
199	};
200
201	/* Intrinsic operators. */
202	enum gfc_intrinsic_op
203	{ GFC_INTRINSIC_BEGIN = 0,
204	INTRINSIC_NONE = -1, INTRINSIC_UPLUS = GFC_INTRINSIC_BEGIN,
205	INTRINSIC_UMINUS, INTRINSIC_PLUS, INTRINSIC_MINUS, INTRINSIC_TIMES,
206	INTRINSIC_DIVIDE, INTRINSIC_POWER, INTRINSIC_CONCAT,
207	INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV,
208	/* ==, /=, >, >=, <, <= */
209	INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE,
210	INTRINSIC_LT, INTRINSIC_LE,
211	/* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style) */
212	INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
213	INTRINSIC_LT_OS, INTRINSIC_LE_OS,
214	INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN, INTRINSIC_PARENTHESES,
215	GFC_INTRINSIC_END, /* Sentinel */
216	/* User defined derived type pseudo operators. These are set beyond the
217	sentinel so that they are excluded from module_read and module_write. */
218	INTRINSIC_FORMATTED, INTRINSIC_UNFORMATTED
219	};
220
221	/* This macro is the number of intrinsic operators that exist.
222	Assumptions are made about the numbering of the interface_op enums. */
223	#define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
224
225	/* Arithmetic results. ARITH_NOT_REDUCED is used to keep track of expressions
226	that were not reduced by the arithmetic evaluation code. */
227	enum arith
228	{ ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
229	ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT,
230	ARITH_WRONGCONCAT, ARITH_INVALID_TYPE, ARITH_NOT_REDUCED,
231	ARITH_UNSIGNED_TRUNCATED, ARITH_UNSIGNED_NEGATIVE
232	};
233
234	/* Statements. */
235	enum 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. */
334	enum 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. */
343	enum 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. */
351	enum 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). */
358	enum sym_intent
359	{ INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT
360	};
361
362	/* Access types. */
363	enum 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. */
369	enum 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. */
377	enum save_state
378	{ SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
379	};
380
381	/* OpenACC 'routine' directive's level of parallelism. */
382	enum 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. */
394	extern const mstring flavors[];
395	extern const mstring procedures[];
396	extern const mstring intents[];
397	extern const mstring access_types[];
398	extern const mstring ifsrc_types[];
399	extern const mstring save_status[];
400
401	/* Strings for DTIO procedure names. In symbol.cc. */
402	extern const mstring dtio_procs[];
403
404	enum 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
410	enum 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
734	enum init_local_logical
735	{
736	GFC_INIT_LOGICAL_OFF = 0,
737	GFC_INIT_LOGICAL_FALSE,
738	GFC_INIT_LOGICAL_TRUE
739	};
740
741	enum init_local_character
742	{
743	GFC_INIT_CHARACTER_OFF = 0,
744	GFC_INIT_CHARACTER_ON
745	};
746
747	enum init_local_integer
748	{
749	GFC_INIT_INTEGER_OFF = 0,
750	GFC_INIT_INTEGER_ON
751	};
752
753	enum gfc_reverse
754	{
755	GFC_ENABLE_REVERSE,
756	GFC_FORWARD_SET,
757	GFC_REVERSE_SET,
758	GFC_INHIBIT_REVERSE
759	};
760
761	enum 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,
779	enum 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,
802	enum 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
820	enum 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
826	typedef 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	}
832	CInteropKind_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. */
839	extern CInteropKind_t c_interop_kinds_table[];
840
841	enum 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
849	enum gfc_omp_severity_type
850	{
851	OMP_SEVERITY_UNSET,
852	OMP_SEVERITY_WARNING,
853	OMP_SEVERITY_FATAL
854	};
855
856	enum 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. */
864	typedef 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	}
878	ext_attr_id_t;
879
880	typedef struct
881	{
882	const char *name;
883	unsigned id;
884	const char *middle_end_name;
885	}
886	ext_attr_t;
887
888	extern const ext_attr_t ext_attr_list[];
889
890	/* Symbol attribute structure. */
891	typedef 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	}
1053	symbol_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
1061	typedef unsigned int gfc_char_t;
1062	#elif HOST_BITS_PER_LONG >= 32
1063	typedef unsigned long gfc_char_t;
1064	#elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
1065	typedef 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
1084	typedef struct gfc_file
1085	{
1086	struct gfc_file *next, *up;
1087	int inclusion_line, line;
1088	char *filename;
1089	} gfc_file;
1090
1091	typedef 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. */
1108	typedef 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
1132	void gfc_push_suppress_errors (void);
1133	void gfc_pop_suppress_errors (void);
1134	bool 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
1148	typedef 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	}
1158	gfc_charlen;
1159
1160	#define gfc_get_charlen() XCNEW (gfc_charlen)
1161
1162	/* Type specification structure. */
1163	typedef 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	}
1183	gfc_typespec;
1184
1185	/* Array specification. */
1186	typedef 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	}
1201	gfc_array_spec;
1202
1203	#define gfc_get_array_spec() XCNEW (gfc_array_spec)
1204
1205
1206	/* Components of derived types. */
1207	typedef 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	}
1234	gfc_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. */
1240	typedef 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	}
1247	gfc_formal_arglist;
1248
1249	#define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
1250
1251
1252	struct gfc_dummy_arg;
1253
1254
1255	/* The gfc_actual_arglist structure is for actual arguments and
1256	for type parameter specification lists. */
1257	typedef 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	}
1273	gfc_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. */
1280	typedef struct gfc_namelist
1281	{
1282	struct gfc_symbol *sym;
1283	struct gfc_namelist *next;
1284	}
1285	gfc_namelist;
1286
1287	#define gfc_get_namelist() XCNEW (gfc_namelist)
1288
1289	/* Likewise to gfc_namelist, but contains expressions. */
1290	typedef struct gfc_expr_list
1291	{
1292	struct gfc_expr *expr;
1293	struct gfc_expr_list *next;
1294	}
1295	gfc_expr_list;
1296
1297	#define gfc_get_expr_list() XCNEW (gfc_expr_list)
1298
1299	enum 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
1317	enum 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
1331	enum 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
1362	enum 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
1375	enum 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
1386	enum 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
1397	typedef 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	}
1448	gfc_omp_namelist;
1449
1450	#define gfc_get_omp_namelist() XCNEW (gfc_omp_namelist)
1451
1452	enum
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
1499	enum 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
1509	enum 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
1519	enum 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
1528	enum 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
1537	enum 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
1552	enum 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
1562	enum 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
1586	enum 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
1596	enum gfc_omp_bind_type
1597	{
1598	OMP_BIND_UNSET,
1599	OMP_BIND_TEAMS,
1600	OMP_BIND_PARALLEL,
1601	OMP_BIND_THREAD
1602	};
1603
1604	typedef 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	}
1611	gfc_omp_assumptions;
1612
1613	#define gfc_get_omp_assumptions() XCNEW (gfc_omp_assumptions)
1614
1615
1616	typedef 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	}
1689	gfc_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
1696	typedef struct gfc_oacc_declare
1697	{
1698	struct gfc_oacc_declare *next;
1699	bool module_var;
1700	gfc_omp_clauses *clauses;
1701	locus loc;
1702	}
1703	gfc_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
1710	typedef 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	}
1719	gfc_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
1725	typedef 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
1741	typedef 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
1750	typedef 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
1762	typedef 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	}
1777	gfc_omp_declare_variant;
1778	#define gfc_get_omp_declare_variant() XCNEW (gfc_omp_declare_variant)
1779
1780	typedef 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
1792	typedef 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	}
1809	gfc_omp_udr;
1810	#define gfc_get_omp_udr() XCNEW (gfc_omp_udr)
1811
1812	typedef struct gfc_omp_namelist_udr
1813	{
1814	struct gfc_omp_udr *udr;
1815	struct gfc_code *combiner;
1816	struct gfc_code *initializer;
1817	}
1818	gfc_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
1824	typedef 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	}
1841	gfc_st_label;
1842
1843
1844	/* gfc_interface()-- Interfaces are lists of symbols strung together. */
1845	typedef struct gfc_interface
1846	{
1847	struct gfc_symbol *sym;
1848	locus where;
1849	struct gfc_interface *next;
1850	}
1851	gfc_interface;
1852
1853	#define gfc_get_interface() XCNEW (gfc_interface)
1854
1855	/* User operator nodes. These are like stripped down symbols. */
1856	typedef struct
1857	{
1858	const char *name;
1859
1860	gfc_interface *op;
1861	struct gfc_namespace *ns;
1862	gfc_access access;
1863	}
1864	gfc_user_op;
1865
1866
1867	/* A list of specific bindings that are associated with a generic spec. */
1868	typedef 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	}
1878	gfc_tbp_generic;
1879
1880	#define gfc_get_tbp_generic() XCNEW (gfc_tbp_generic)
1881
1882
1883	/* Data needed for type-bound procedures. */
1884	typedef 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	}
1915	gfc_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
1924	typedef 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	}
2092	gfc_symbol;
2093
2094
2095	struct 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. */
2104	typedef 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	}
2118	gfc_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
2125	typedef 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	}
2136	gfc_entry_list;
2137
2138	#define gfc_get_entry_list() XCNEW (gfc_entry_list)
2139
2140	/* Lists of rename info for the USE statement. */
2141
2142	typedef 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	}
2150	gfc_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
2156	typedef 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	}
2168	gfc_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
2177	typedef 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	}
2192	gfc_symtree;
2193
2194	/* A list of all derived types. */
2195	extern gfc_symbol *gfc_derived_types;
2196
2197	typedef 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	}
2204	gfc_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
2211	typedef struct gfc_was_finalized {
2212	gfc_expr *e;
2213	gfc_component *c;
2214	struct gfc_was_finalized *next;
2215	}
2216	gfc_was_finalized;
2217
2218	/* A namespace describes the contents of procedure, module, interface block
2219	or BLOCK construct. */
2220	/* ??? Anything else use these? */
2221
2222	typedef 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	}
2368	gfc_namespace;
2369
2370	extern gfc_namespace *gfc_current_ns;
2371	extern 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
2377	enum gfc_symbol_type
2378	{
2379	GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
2380	GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA
2381	};
2382
2383	typedef 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	}
2398	gfc_gsymbol;
2399
2400	extern gfc_gsymbol *gfc_gsym_root;
2401
2402	/* Information on interfaces being built. */
2403	typedef 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	}
2411	gfc_interface_info;
2412
2413	extern gfc_interface_info current_interface;
2414
2415
2416	/* Array reference. */
2417
2418	enum gfc_array_ref_dimen_type
2419	{
2420	DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_STAR, DIMEN_THIS_IMAGE, DIMEN_UNKNOWN
2421	};
2422
2423	enum gfc_array_ref_team_type
2424	{
2425	TEAM_UNKNOWN = 0, TEAM_UNSET, TEAM_TEAM, TEAM_NUMBER
2426	};
2427
2428	typedef 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	}
2446	gfc_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
2457	enum ref_type
2458	{ REF_ARRAY, REF_COMPONENT, REF_SUBSTRING, REF_INQUIRY };
2459
2460	enum inquiry_type
2461	{ INQUIRY_RE, INQUIRY_IM, INQUIRY_KIND, INQUIRY_LEN };
2462
2463	typedef 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	}
2492	gfc_ref;
2493
2494	#define gfc_get_ref() XCNEW (gfc_ref)
2495
2496
2497	/* Structures representing intrinsic symbols and their arguments lists. */
2498	typedef 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	}
2508	gfc_intrinsic_arg;
2509
2510
2511	typedef enum {
2512	GFC_UNDEFINED_DUMMY_ARG = 0,
2513	GFC_INTRINSIC_DUMMY_ARG,
2514	GFC_NON_INTRINSIC_DUMMY_ARG
2515	}
2516	gfc_dummy_arg_intrinsicness;
2517
2518	/* dummy arg of either an intrinsic or a user-defined procedure. */
2519	struct 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
2532	const char * gfc_dummy_arg_get_name (gfc_dummy_arg &);
2533	const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg &);
2534	bool 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
2544	typedef 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	}
2561	gfc_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
2567	typedef 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	}
2584	gfc_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
2590	typedef 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	}
2607	gfc_resolve_f;
2608
2609
2610	typedef 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	}
2628	gfc_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
2651	typedef 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. */
2659	typedef HOST_WIDE_INT gfc_charlen_t;
2660
2661	typedef 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	}
2804	gfc_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
2814	typedef 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	}
2829	gfc_integer_info;
2830
2831	extern gfc_integer_info gfc_integer_kinds[];
2832
2833	/* Unsigned numbers, experimental. */
2834
2835	typedef 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	}
2849	gfc_unsigned_info;
2850
2851	extern gfc_unsigned_info gfc_unsigned_kinds[];
2852
2853	typedef 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	}
2860	gfc_logical_info;
2861
2862	extern gfc_logical_info gfc_logical_kinds[];
2863
2864
2865	typedef 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	}
2884	gfc_real_info;
2885
2886	extern gfc_real_info gfc_real_kinds[];
2887
2888	typedef struct
2889	{
2890	int kind, bit_size;
2891	const char *name;
2892	}
2893	gfc_character_info;
2894
2895	extern 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. */
2900	typedef struct gfc_equiv
2901	{
2902	struct gfc_equiv *next, *eq;
2903	gfc_expr *expr;
2904	const char *module;
2905	int used;
2906	}
2907	gfc_equiv;
2908
2909	#define gfc_get_equiv() XCNEW (gfc_equiv)
2910
2911	/* Holds a single equivalence member after processing. */
2912	typedef 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. */
2921	typedef 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
2939	typedef 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	}
2962	gfc_case;
2963
2964	#define gfc_get_case() XCNEW (gfc_case)
2965
2966
2967	/* Annotations for loop constructs. */
2968	typedef struct
2969	{
2970	unsigned short unroll;
2971	bool ivdep;
2972	bool vector;
2973	bool novector;
2974	}
2975	gfc_loop_annot;
2976
2977
2978	typedef struct
2979	{
2980	gfc_expr *var, *start, *end, *step;
2981	gfc_loop_annot annot;
2982	}
2983	gfc_iterator;
2984
2985	#define gfc_get_iterator() XCNEW (gfc_iterator)
2986
2987
2988	/* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements. */
2989
2990	typedef struct gfc_alloc
2991	{
2992	gfc_expr *expr;
2993	struct gfc_alloc *next;
2994	}
2995	gfc_alloc;
2996
2997	#define gfc_get_alloc() XCNEW (gfc_alloc)
2998
2999
3000	typedef 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	}
3009	gfc_open;
3010
3011
3012	typedef struct
3013	{
3014	gfc_expr *unit, *status, *iostat, *iomsg;
3015	gfc_st_label *err;
3016	}
3017	gfc_close;
3018
3019
3020	typedef struct
3021	{
3022	gfc_expr *unit, *iostat, *iomsg;
3023	gfc_st_label *err;
3024	}
3025	gfc_filepos;
3026
3027
3028	typedef 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	}
3040	gfc_inquire;
3041
3042
3043	typedef struct
3044	{
3045	gfc_expr *unit, *iostat, *iomsg, *id;
3046	gfc_st_label *err, *end, *eor;
3047	}
3048	gfc_wait;
3049
3050
3051	typedef 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	}
3065	gfc_dt;
3066
3067
3068	typedef struct gfc_forall_iterator
3069	{
3070	gfc_expr *var, *start, *end, *stride;
3071	gfc_loop_annot annot;
3072	struct gfc_forall_iterator *next;
3073	}
3074	gfc_forall_iterator;
3075
3076
3077	/* Linked list to store associations in an ASSOCIATE statement. */
3078
3079	typedef 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	}
3107	gfc_association_list;
3108	#define gfc_get_association_list() XCNEW (gfc_association_list)
3109
3110
3111	/* Executable statements that fill gfc_code structures. */
3112	enum 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. */
3167	enum locality_type
3168	{
3169	LOCALITY_LOCAL = 0,
3170	LOCALITY_LOCAL_INIT,
3171	LOCALITY_SHARED,
3172	LOCALITY_REDUCE,
3173	LOCALITY_NUM
3174	};
3175
3176	struct sync_stat
3177	{
3178	gfc_expr *stat, *errmsg;
3179	};
3180
3181	typedef 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	}
3254	gfc_code;
3255
3256
3257	/* Storage for DATA statements. */
3258	typedef struct gfc_data_variable
3259	{
3260	gfc_expr *expr;
3261	gfc_iterator iter;
3262	struct gfc_data_variable *list, *next;
3263	}
3264	gfc_data_variable;
3265
3266
3267	typedef struct gfc_data_value
3268	{
3269	mpz_t repeat;
3270	gfc_expr *expr;
3271	struct gfc_data_value *next;
3272	}
3273	gfc_data_value;
3274
3275
3276	typedef struct gfc_data
3277	{
3278	gfc_data_variable *var;
3279	gfc_data_value *value;
3280	locus where;
3281
3282	struct gfc_data *next;
3283	}
3284	gfc_data;
3285
3286
3287	/* Structure for holding compile options */
3288	typedef 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	}
3317	gfc_option_t;
3318
3319	extern gfc_option_t gfc_option;
3320
3321	/* Constructor nodes for array and structure constructors. */
3322	typedef 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	}
3340	gfc_constructor;
3341
3342
3343	typedef struct iterator_stack
3344	{
3345	gfc_symtree *variable;
3346	mpz_t value;
3347	struct iterator_stack *prev;
3348	}
3349	iterator_stack;
3350	extern iterator_stack *iter_stack;
3351
3352
3353	/* Used for (possibly nested) SELECT TYPE statements. */
3354	typedef 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	}
3360	gfc_select_type_stack;
3361	extern 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
3367	typedef 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	}
3381	gfc_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
3391	inline bool
3392	gfc_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 */
3403	bool gfc_in_match_data (void);
3404	match gfc_match_char_spec (gfc_typespec *);
3405	extern int directive_unroll;
3406	extern bool directive_ivdep;
3407	extern bool directive_vector;
3408	extern bool directive_novector;
3409
3410	/* SIMD clause enum. */
3411	enum 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. */
3419	struct 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. */
3429	extern hash_map<nofree_string_hash, int> *gfc_vectorized_builtins;
3430
3431	/* Handling Parameterized Derived Types */
3432	bool gfc_insert_parameter_exprs (gfc_expr *, gfc_actual_arglist *);
3433	match 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 */
3444	void gfc_scanner_done_1 (void);
3445	void gfc_scanner_init_1 (void);
3446
3447	void gfc_add_include_path (const char *, bool, bool, bool, bool);
3448	void gfc_add_intrinsic_modules_path (const char *);
3449	void gfc_release_include_path (void);
3450	void gfc_check_include_dirs (bool);
3451	FILE *gfc_open_included_file (const char *, bool, bool);
3452
3453	bool gfc_at_end (void);
3454	bool gfc_at_eof (void);
3455	bool gfc_at_bol (void);
3456	bool gfc_at_eol (void);
3457	void gfc_advance_line (void);
3458	bool gfc_define_undef_line (void);
3459
3460	bool gfc_wide_is_printable (gfc_char_t);
3461	bool gfc_wide_is_digit (gfc_char_t);
3462	bool gfc_wide_fits_in_byte (gfc_char_t);
3463	gfc_char_t gfc_wide_tolower (gfc_char_t);
3464	gfc_char_t gfc_wide_toupper (gfc_char_t);
3465	size_t gfc_wide_strlen (const gfc_char_t *);
3466	int gfc_wide_strncasecmp (const gfc_char_t *, const char *, size_t);
3467	gfc_char_t *gfc_wide_memset (gfc_char_t *, gfc_char_t, size_t);
3468	char *gfc_widechar_to_char (const gfc_char_t *, int);
3469	gfc_char_t *gfc_char_to_widechar (const char *);
3470
3471	#define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
3472
3473	void gfc_skip_comments (void);
3474	gfc_char_t gfc_next_char_literal (gfc_instring);
3475	gfc_char_t gfc_next_char (void);
3476	char gfc_next_ascii_char (void);
3477	gfc_char_t gfc_peek_char (void);
3478	char gfc_peek_ascii_char (void);
3479	void gfc_error_recovery (void);
3480	void gfc_gobble_whitespace (void);
3481	void gfc_new_file (void);
3482	const char * gfc_read_orig_filename (const char *, const char **);
3483
3484	extern gfc_source_form gfc_current_form;
3485	extern const char *gfc_source_file;
3486	extern locus gfc_current_locus;
3487
3488	void gfc_start_source_files (void);
3489	void gfc_end_source_files (void);
3490
3491	/* misc.cc */
3492	void gfc_clear_ts (gfc_typespec *);
3493	FILE *gfc_open_file (const char *);
3494	const char *gfc_basic_typename (bt);
3495	const char *gfc_dummy_typename (gfc_typespec *);
3496	const char *gfc_typename (gfc_typespec *, bool for_hash = false);
3497	const char *gfc_typename (gfc_expr *);
3498	const char *gfc_op2string (gfc_intrinsic_op);
3499	const char *gfc_code2string (const mstring *, int);
3500	int gfc_string2code (const mstring *, const char *);
3501	const char *gfc_intent_string (sym_intent);
3502
3503	void gfc_init_1 (void);
3504	void gfc_init_2 (void);
3505	void gfc_done_1 (void);
3506	void gfc_done_2 (void);
3507
3508	int get_c_kind (const char *, CInteropKind_t *);
3509
3510	const char *gfc_closest_fuzzy_match (const char *, char **);
3511	inline void
3512	vec_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
3521	HOST_WIDE_INT gfc_mpz_get_hwi (mpz_t);
3522	void gfc_mpz_set_hwi (mpz_t, const HOST_WIDE_INT);
3523
3524	/* options.cc */
3525	unsigned int gfc_option_lang_mask (void);
3526	void gfc_init_options_struct (struct gcc_options *);
3527	void gfc_init_options (unsigned int,
3528	struct cl_decoded_option *);
3529	bool gfc_handle_option (size_t, const char *, HOST_WIDE_INT, int, location_t,
3530	const struct cl_option_handlers *);
3531	bool gfc_post_options (const char **);
3532	char *gfc_get_option_string (void);
3533
3534	/* f95-lang.cc */
3535	void gfc_maybe_initialize_eh (void);
3536
3537	/* iresolve.cc */
3538	const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
3539	bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
3540
3541	/* error.cc */
3542	locus gfc_get_location_range (locus *, unsigned, locus *, unsigned, locus *);
3543	location_t gfc_get_location_with_offset (locus *, unsigned);
3544	inline location_t
3545	gfc_get_location (locus *loc)
3546	{
3547	return gfc_get_location_with_offset (loc, 0);
3548	}
3549
3550	void gfc_error_init_1 (void);
3551	void gfc_diagnostics_init (void);
3552	void gfc_diagnostics_finish (void);
3553	void gfc_buffer_error (bool);
3554
3555	const char *gfc_print_wide_char (gfc_char_t);
3556
3557	bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3558	bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3559	bool gfc_warning_internal (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3560	bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
3561	ATTRIBUTE_GCC_GFC(3,4);
3562
3563	void gfc_clear_warning (void);
3564	void gfc_warning_check (void);
3565
3566	void gfc_error_opt (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
3567	void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
3568	void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
3569	void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
3570	void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
3571	void gfc_clear_error (void);
3572	bool gfc_error_check (void);
3573	bool gfc_error_flag_test (void);
3574	bool gfc_buffered_p (void);
3575
3576	notification gfc_notification_std (int);
3577	bool 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. */
3584	struct gfc_error_buffer
3585	{
3586	bool flag;
3587	diagnostic_buffer buffer;
3588
3589	gfc_error_buffer();
3590	};
3591
3592	void gfc_push_error (gfc_error_buffer *);
3593	void gfc_pop_error (gfc_error_buffer *);
3594	void gfc_free_error (gfc_error_buffer *);
3595
3596	void gfc_get_errors (int *, int *);
3597	void gfc_errors_to_warnings (bool);
3598
3599	/* arith.cc */
3600	void gfc_arith_init_1 (void);
3601	void gfc_arith_done_1 (void);
3602	arith gfc_check_integer_range (mpz_t p, int kind);
3603	arith gfc_check_unsigned_range (mpz_t p, int kind);
3604	bool gfc_check_character_range (gfc_char_t, int);
3605	const char *gfc_arith_error (arith);
3606	void gfc_reduce_unsigned (gfc_expr *e);
3607
3608	extern bool gfc_seen_div0;
3609
3610	/* trans-types.cc */
3611	int gfc_validate_kind (bt, int, bool);
3612	int gfc_get_int_kind_from_width_isofortranenv (int size);
3613	int gfc_get_uint_kind_from_width_isofortranenv (int size);
3614	int gfc_get_real_kind_from_width_isofortranenv (int size);
3615	tree gfc_get_union_type (gfc_symbol *);
3616	tree gfc_get_derived_type (gfc_symbol * derived, int codimen = 0);
3617	extern int gfc_index_integer_kind;
3618	extern int gfc_default_integer_kind;
3619	extern int gfc_default_unsigned_kind;
3620	extern int gfc_max_integer_kind;
3621	extern int gfc_default_real_kind;
3622	extern int gfc_default_double_kind;
3623	extern int gfc_default_character_kind;
3624	extern int gfc_default_logical_kind;
3625	extern int gfc_default_complex_kind;
3626	extern int gfc_c_int_kind;
3627	extern int gfc_c_uint_kind;
3628	extern int gfc_c_intptr_kind;
3629	extern int gfc_atomic_int_kind;
3630	extern int gfc_atomic_logical_kind;
3631	extern int gfc_intio_kind;
3632	extern int gfc_charlen_int_kind;
3633	extern int gfc_size_kind;
3634	extern int gfc_numeric_storage_size;
3635	extern 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 */
3642	void gfc_clear_new_implicit (void);
3643	bool gfc_add_new_implicit_range (int, int);
3644	bool gfc_merge_new_implicit (gfc_typespec *);
3645	void gfc_set_implicit_none (bool, bool, locus *);
3646	void gfc_check_function_type (gfc_namespace *);
3647	bool gfc_is_intrinsic_typename (const char *);
3648	bool gfc_check_conflict (symbol_attribute *, const char *, locus *);
3649
3650	gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
3651	bool gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
3652
3653	void gfc_set_sym_referenced (gfc_symbol *);
3654
3655	bool gfc_add_attribute (symbol_attribute *, locus *);
3656	bool gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
3657	bool gfc_add_allocatable (symbol_attribute *, locus *);
3658	bool gfc_add_codimension (symbol_attribute *, const char *, locus *);
3659	bool gfc_add_contiguous (symbol_attribute *, const char *, locus *);
3660	bool gfc_add_dimension (symbol_attribute *, const char *, locus *);
3661	bool gfc_add_external (symbol_attribute *, locus *);
3662	bool gfc_add_intrinsic (symbol_attribute *, locus *);
3663	bool gfc_add_optional (symbol_attribute *, locus *);
3664	bool gfc_add_kind (symbol_attribute *, locus *);
3665	bool gfc_add_len (symbol_attribute *, locus *);
3666	bool gfc_add_pointer (symbol_attribute *, locus *);
3667	bool gfc_add_cray_pointer (symbol_attribute *, locus *);
3668	bool gfc_add_cray_pointee (symbol_attribute *, locus *);
3669	match gfc_mod_pointee_as (gfc_array_spec *);
3670	bool gfc_add_protected (symbol_attribute *, const char *, locus *);
3671	bool gfc_add_result (symbol_attribute *, const char *, locus *);
3672	bool gfc_add_automatic (symbol_attribute *, const char *, locus *);
3673	bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
3674	bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
3675	bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *);
3676	bool gfc_add_omp_declare_target_link (symbol_attribute *, const char *,
3677	locus *);
3678	bool gfc_add_target (symbol_attribute *, locus *);
3679	bool gfc_add_dummy (symbol_attribute *, const char *, locus *);
3680	bool gfc_add_generic (symbol_attribute *, const char *, locus *);
3681	bool gfc_add_in_common (symbol_attribute *, const char *, locus *);
3682	bool gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
3683	bool gfc_add_data (symbol_attribute *, const char *, locus *);
3684	bool gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
3685	bool gfc_add_sequence (symbol_attribute *, const char *, locus *);
3686	bool gfc_add_elemental (symbol_attribute *, locus *);
3687	bool gfc_add_pure (symbol_attribute *, locus *);
3688	bool gfc_add_recursive (symbol_attribute *, locus *);
3689	bool gfc_add_function (symbol_attribute *, const char *, locus *);
3690	bool gfc_add_subroutine (symbol_attribute *, const char *, locus *);
3691	bool gfc_add_volatile (symbol_attribute *, const char *, locus *);
3692	bool gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
3693	bool gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
3694	bool gfc_add_abstract (symbol_attribute* attr, locus* where);
3695
3696	bool gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
3697	bool gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
3698	bool gfc_add_extension (symbol_attribute *, locus *);
3699	bool gfc_add_value (symbol_attribute *, const char *, locus *);
3700	bool gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
3701	bool gfc_add_entry (symbol_attribute *, const char *, locus *);
3702	bool gfc_add_procedure (symbol_attribute *, procedure_type,
3703	const char *, locus *);
3704	bool gfc_add_intent (symbol_attribute *, sym_intent, locus *);
3705	bool gfc_add_explicit_interface (gfc_symbol *, ifsrc,
3706	gfc_formal_arglist *, locus *);
3707	bool gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
3708
3709	void gfc_clear_attr (symbol_attribute *);
3710	bool gfc_missing_attr (symbol_attribute *, locus *);
3711	bool gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
3712	int gfc_copy_dummy_sym (gfc_symbol **, gfc_symbol *, int);
3713	bool gfc_add_component (gfc_symbol *, const char *, gfc_component **);
3714	gfc_symbol *gfc_use_derived (gfc_symbol *);
3715	gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool,
3716	gfc_ref **);
3717	int gfc_find_derived_types (gfc_symbol *, gfc_namespace *, const char *,
3718	bool stash = false);
3719
3720	gfc_st_label *gfc_get_st_label (int);
3721	void gfc_free_st_label (gfc_st_label *);
3722	void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
3723	bool gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
3724
3725	gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
3726	gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
3727	gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
3728	gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
3729	gfc_user_op *gfc_get_uop (const char *);
3730	gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
3731	void gfc_free_symbol (gfc_symbol *&);
3732	bool gfc_release_symbol (gfc_symbol *&);
3733	gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *, locus * = NULL);
3734	gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
3735	int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
3736	bool gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
3737	int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **,
3738	locus * = NULL);
3739	bool gfc_verify_c_interop (gfc_typespec *);
3740	bool gfc_verify_c_interop_param (gfc_symbol *);
3741	bool verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
3742	bool verify_bind_c_derived_type (gfc_symbol *);
3743	bool verify_com_block_vars_c_interop (gfc_common_head *);
3744	gfc_symtree *generate_isocbinding_symbol (const char *, iso_c_binding_symbol,
3745	const char *, gfc_symtree *, bool);
3746	void gfc_save_symbol_data (gfc_symbol *);
3747	int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool,
3748	locus * = NULL);
3749	int gfc_get_ha_symbol (const char *, gfc_symbol **, locus * = NULL);
3750	int gfc_get_ha_sym_tree (const char *, gfc_symtree **, locus * = NULL);
3751
3752	void gfc_drop_last_undo_checkpoint (void);
3753	void gfc_restore_last_undo_checkpoint (void);
3754	void gfc_undo_symbols (void);
3755	void gfc_commit_symbols (void);
3756	void gfc_commit_symbol (gfc_symbol *);
3757	gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
3758	void gfc_free_namespace (gfc_namespace *&);
3759
3760	void gfc_symbol_init_2 (void);
3761	void gfc_symbol_done_2 (void);
3762
3763	void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
3764	void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
3765	void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
3766	void gfc_save_all (gfc_namespace *);
3767
3768	void gfc_enforce_clean_symbol_state (void);
3769
3770	gfc_gsymbol *gfc_get_gsymbol (const char *, bool bind_c);
3771	gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
3772	gfc_gsymbol *gfc_find_case_gsymbol (gfc_gsymbol *, const char *);
3773	void gfc_traverse_gsymbol (gfc_gsymbol *, void (*)(gfc_gsymbol *, void *), void *);
3774
3775	gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
3776	gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
3777	bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
3778	bool gfc_pdt_is_instance_of (gfc_symbol *, gfc_symbol *);
3779	bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
3780
3781	void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *,
3782	gfc_actual_arglist *, bool copy_type = false);
3783
3784	void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.cc, too */
3785
3786	bool gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
3787	gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
3788
3789	bool gfc_is_associate_pointer (gfc_symbol*);
3790	gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
3791	gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *);
3792
3793	gfc_namespace * gfc_get_procedure_ns (gfc_symbol *);
3794	gfc_namespace * gfc_get_spec_ns (gfc_symbol *);
3795
3796	/* intrinsic.cc -- true if working in an init-expr, false otherwise. */
3797	extern 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
3805	void gfc_intrinsic_init_1 (void);
3806	void gfc_intrinsic_done_1 (void);
3807
3808	char gfc_type_letter (bt, bool logical_equals_int = false);
3809	int gfc_type_abi_kind (bt, int);
3810	inline int
3811	gfc_type_abi_kind (gfc_typespec *ts)
3812	{
3813	return gfc_type_abi_kind (ts->type, ts->kind);
3814	}
3815	gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
3816	gfc_symbol *gfc_get_intrinsic_function_symbol (gfc_expr *);
3817	gfc_symbol *gfc_find_intrinsic_symbol (gfc_expr *);
3818	bool gfc_convert_type (gfc_expr *, gfc_typespec *, int);
3819	bool gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int,
3820	bool array = false);
3821	bool gfc_convert_chartype (gfc_expr *, gfc_typespec *);
3822	bool gfc_generic_intrinsic (const char *);
3823	bool gfc_specific_intrinsic (const char *);
3824	bool gfc_is_intrinsic (gfc_symbol*, int, locus);
3825	bool gfc_intrinsic_actual_ok (const char *, const bool);
3826	gfc_intrinsic_sym *gfc_find_function (const char *);
3827	gfc_intrinsic_sym *gfc_find_subroutine (const char *);
3828	gfc_intrinsic_sym *gfc_intrinsic_function_by_id (gfc_isym_id);
3829	gfc_intrinsic_sym *gfc_intrinsic_subroutine_by_id (gfc_isym_id);
3830	gfc_isym_id gfc_isym_id_by_intmod (intmod_id, int);
3831	gfc_isym_id gfc_isym_id_by_intmod_sym (gfc_symbol *);
3832
3833
3834	match gfc_intrinsic_func_interface (gfc_expr *, int);
3835	match gfc_intrinsic_sub_interface (gfc_code *, int);
3836
3837	void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
3838	bool gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
3839	bool, locus);
3840
3841	/* match.cc -- FIXME */
3842	void gfc_free_iterator (gfc_iterator *, int);
3843	void gfc_free_forall_iterator (gfc_forall_iterator *);
3844	void gfc_free_alloc_list (gfc_alloc *);
3845	void gfc_free_namelist (gfc_namelist *);
3846	void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool, bool, bool);
3847	void gfc_free_equiv (gfc_equiv *);
3848	void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
3849	void gfc_free_data (gfc_data *);
3850	void gfc_reject_data (gfc_namespace *);
3851	void gfc_free_case_list (gfc_case *);
3852
3853	/* matchexp.cc -- FIXME too? */
3854	gfc_expr *gfc_get_parentheses (gfc_expr *);
3855
3856	/* openmp.cc */
3857	struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
3858	bool gfc_omp_requires_add_clause (gfc_omp_requires_kind, const char *,
3859	locus *, const char *);
3860	void gfc_check_omp_requires (gfc_namespace *, int);
3861	void gfc_free_omp_clauses (gfc_omp_clauses *);
3862	void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
3863	void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list);
3864	void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
3865	void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
3866	void gfc_free_omp_udr (gfc_omp_udr *);
3867	void gfc_free_omp_variants (gfc_omp_variant *);
3868	gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
3869	void gfc_resolve_omp_allocate (gfc_namespace *, gfc_omp_namelist *);
3870	void gfc_resolve_omp_assumptions (gfc_omp_assumptions *);
3871	void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
3872	void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool);
3873	void gfc_resolve_omp_local_vars (gfc_namespace *);
3874	void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
3875	void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
3876	void gfc_resolve_omp_declare (gfc_namespace *);
3877	void gfc_resolve_omp_udrs (gfc_symtree *);
3878	void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
3879	void gfc_omp_restore_state (struct gfc_omp_saved_state *);
3880	void gfc_free_expr_list (gfc_expr_list *);
3881	void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
3882	void gfc_resolve_oacc_declare (gfc_namespace *);
3883	void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
3884	void gfc_resolve_oacc_routines (gfc_namespace *);
3885
3886	/* expr.cc */
3887	void gfc_free_actual_arglist (gfc_actual_arglist *);
3888	gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
3889
3890	bool gfc_extract_int (gfc_expr *, int *, int = 0);
3891	bool gfc_extract_hwi (gfc_expr *, HOST_WIDE_INT *, int = 0);
3892
3893	bool is_CFI_desc (gfc_symbol *, gfc_expr *);
3894	bool is_subref_array (gfc_expr *);
3895	bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
3896	bool gfc_is_not_contiguous (gfc_expr *);
3897	bool gfc_check_init_expr (gfc_expr *);
3898
3899	gfc_expr *gfc_build_conversion (gfc_expr *);
3900	void gfc_free_ref_list (gfc_ref *);
3901	void gfc_type_convert_binary (gfc_expr *, int);
3902	bool gfc_is_constant_expr (gfc_expr *);
3903	bool gfc_simplify_expr (gfc_expr *, int);
3904	bool gfc_try_simplify_expr (gfc_expr *, int);
3905	bool gfc_has_vector_index (gfc_expr *);
3906	bool gfc_is_ptr_fcn (gfc_expr *);
3907
3908	gfc_expr *gfc_get_expr (void);
3909	gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
3910	gfc_expr *gfc_get_null_expr (locus *);
3911	gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *, gfc_expr *);
3912	gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *);
3913	gfc_expr *gfc_get_constant_expr (bt, int, locus *);
3914	gfc_expr *gfc_get_character_expr (int, locus *, const char *, gfc_charlen_t len);
3915	gfc_expr *gfc_get_int_expr (int, locus *, HOST_WIDE_INT);
3916	gfc_expr *gfc_get_unsigned_expr (int, locus *, HOST_WIDE_INT);
3917	gfc_expr *gfc_get_logical_expr (int, locus *, bool);
3918	gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
3919
3920	void gfc_clear_shape (mpz_t *shape, int rank);
3921	void gfc_free_shape (mpz_t **shape, int rank);
3922	void gfc_free_expr (gfc_expr *);
3923	void gfc_replace_expr (gfc_expr *, gfc_expr *);
3924	mpz_t *gfc_copy_shape (mpz_t *, int);
3925	mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
3926	gfc_expr *gfc_copy_expr (gfc_expr *);
3927	gfc_ref* gfc_copy_ref (gfc_ref*);
3928
3929	bool gfc_specification_expr (gfc_expr *);
3930
3931	bool gfc_numeric_ts (gfc_typespec *);
3932	int gfc_kind_max (gfc_expr *, gfc_expr *);
3933
3934	bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
3935	bool gfc_check_assign (gfc_expr *, gfc_expr *, int, bool c = true);
3936	bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
3937	bool suppres_type_test = false,
3938	bool is_init_expr = false);
3939	bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
3940
3941	gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *);
3942	void gfc_apply_init (gfc_typespec *, symbol_attribute *, gfc_expr *);
3943	bool gfc_has_default_initializer (gfc_symbol *);
3944	gfc_expr *gfc_default_initializer (gfc_typespec *);
3945	gfc_expr *gfc_generate_initializer (gfc_typespec *, bool);
3946	gfc_expr *gfc_get_variable_expr (gfc_symtree *);
3947	void gfc_add_full_array_ref (gfc_expr *, gfc_array_spec *);
3948	gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
3949
3950	gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
3951
3952	bool gfc_traverse_expr (gfc_expr *, gfc_symbol *,
3953	bool (*)(gfc_expr *, gfc_symbol *, int*),
3954	int);
3955	void gfc_expr_set_symbols_referenced (gfc_expr *);
3956	bool gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
3957	bool gfc_derived_parameter_expr (gfc_expr *);
3958	gfc_param_spec_type gfc_spec_list_type (gfc_actual_arglist *, gfc_symbol *);
3959	gfc_component * gfc_get_proc_ptr_comp (gfc_expr *);
3960	bool gfc_is_proc_ptr_comp (gfc_expr *);
3961	bool gfc_is_alloc_class_scalar_function (gfc_expr *);
3962	bool gfc_is_class_array_function (gfc_expr *);
3963
3964	bool gfc_ref_this_image (gfc_ref *ref);
3965	bool gfc_is_coindexed (gfc_expr *);
3966	bool gfc_is_coarray (gfc_expr *);
3967	bool gfc_has_ultimate_allocatable (gfc_expr *);
3968	bool gfc_has_ultimate_pointer (gfc_expr *);
3969	gfc_expr *gfc_find_team_co (gfc_expr *,
3970	gfc_array_ref_team_type req_team_type = TEAM_TEAM);
3971	gfc_expr* gfc_find_stat_co (gfc_expr *);
3972	gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
3973	locus, unsigned, ...);
3974	bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
3975	gfc_expr* gfc_pdt_find_component_copy_initializer (gfc_symbol *, const char *);
3976
3977
3978	/* st.cc */
3979	extern gfc_code new_st;
3980
3981	void gfc_clear_new_st (void);
3982	gfc_code *gfc_get_code (gfc_exec_op);
3983	gfc_code *gfc_append_code (gfc_code *, gfc_code *);
3984	void gfc_free_statement (gfc_code *);
3985	void gfc_free_statements (gfc_code *);
3986	void gfc_free_association_list (gfc_association_list *);
3987
3988	/* resolve.cc */
3989	void gfc_expression_rank (gfc_expr *);
3990	bool gfc_op_rank_conformable (gfc_expr *, gfc_expr *);
3991	bool gfc_resolve_ref (gfc_expr *);
3992	void gfc_fixup_inferred_type_refs (gfc_expr *);
3993	bool gfc_resolve_expr (gfc_expr *);
3994	void gfc_resolve (gfc_namespace *);
3995	void gfc_resolve_code (gfc_code *, gfc_namespace *);
3996	void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
3997	void gfc_resolve_formal_arglist (gfc_symbol *);
3998	bool gfc_impure_variable (gfc_symbol *);
3999	bool gfc_pure (gfc_symbol *);
4000	bool gfc_implicit_pure (gfc_symbol *);
4001	void gfc_unset_implicit_pure (gfc_symbol *);
4002	bool gfc_elemental (gfc_symbol *);
4003	bool gfc_resolve_iterator (gfc_iterator *, bool, bool);
4004	bool find_forall_index (gfc_expr *, gfc_symbol *, int);
4005	bool gfc_resolve_index (gfc_expr *, int);
4006	bool gfc_resolve_dim_arg (gfc_expr *);
4007	bool gfc_resolve_substring (gfc_ref *, bool *);
4008	void gfc_resolve_substring_charlen (gfc_expr *);
4009	void gfc_resolve_sync_stat (struct sync_stat *);
4010	gfc_expr *gfc_expr_to_initialize (gfc_expr *);
4011	bool gfc_type_is_extensible (gfc_symbol *);
4012	bool gfc_resolve_intrinsic (gfc_symbol *, locus *);
4013	bool gfc_explicit_interface_required (gfc_symbol *, char *, int);
4014	extern int gfc_do_concurrent_flag;
4015	const char* gfc_lookup_function_fuzzy (const char *, gfc_symtree *);
4016	bool gfc_pure_function (gfc_expr *e, const char **name);
4017	bool gfc_implicit_pure_function (gfc_expr *e);
4018
4019	/* coarray.cc */
4020	void gfc_coarray_rewrite (gfc_namespace *);
4021
4022	/* array.cc */
4023	gfc_iterator *gfc_copy_iterator (gfc_iterator *);
4024
4025	void gfc_free_array_spec (gfc_array_spec *);
4026	gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
4027
4028	bool gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
4029	gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
4030	bool gfc_resolve_array_spec (gfc_array_spec *, int);
4031
4032	bool gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
4033
4034	void gfc_simplify_iterator_var (gfc_expr *);
4035	bool gfc_expand_constructor (gfc_expr *, bool);
4036	bool gfc_constant_ac (gfc_expr *);
4037	bool gfc_expanded_ac (gfc_expr *);
4038	bool gfc_resolve_character_array_constructor (gfc_expr *);
4039	bool gfc_resolve_array_constructor (gfc_expr *);
4040	bool gfc_check_constructor_type (gfc_expr *);
4041	bool gfc_check_iter_variable (gfc_expr *);
4042	bool gfc_check_constructor (gfc_expr *, bool (*)(gfc_expr *));
4043	bool gfc_array_size (gfc_expr *, mpz_t *);
4044	bool gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
4045	bool gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
4046	gfc_array_ref *gfc_find_array_ref (gfc_expr *, bool a = false);
4047	tree gfc_conv_array_initializer (tree type, gfc_expr *);
4048	bool spec_size (gfc_array_spec *, mpz_t *);
4049	bool spec_dimen_size (gfc_array_spec *, int, mpz_t *);
4050	bool gfc_is_compile_time_shape (gfc_array_spec *);
4051
4052	bool 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 */
4055	void gfc_free_interface (gfc_interface *);
4056	void gfc_drop_interface_elements_before (gfc_interface **, gfc_interface *);
4057	bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
4058	bool gfc_compare_types (gfc_typespec *, gfc_typespec *);
4059	bool gfc_check_dummy_characteristics (gfc_symbol *, gfc_symbol *,
4060	bool, char *, int);
4061	bool gfc_check_result_characteristics (gfc_symbol *, gfc_symbol *,
4062	char *, int);
4063	bool gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
4064	char *, int, const char *, const char *,
4065	bool *bad_result_characteristics = NULL);
4066	void gfc_check_interfaces (gfc_namespace *);
4067	bool gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
4068	void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
4069	gfc_symbol *gfc_search_interface (gfc_interface *, int,
4070	gfc_actual_arglist **);
4071	match gfc_extend_expr (gfc_expr *);
4072	void gfc_free_formal_arglist (gfc_formal_arglist *);
4073	bool gfc_extend_assign (gfc_code *, gfc_namespace *);
4074	bool gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus);
4075	bool gfc_add_interface (gfc_symbol *);
4076	gfc_interface *&gfc_current_interface_head (void);
4077	void gfc_set_current_interface_head (gfc_interface *);
4078	gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
4079	bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
4080	bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
4081	bool gfc_has_vector_subscript (gfc_expr*);
4082	gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
4083	bool gfc_check_typebound_override (gfc_symtree*, gfc_symtree*);
4084	void gfc_check_dtio_interfaces (gfc_symbol*);
4085	gfc_symtree* gfc_find_typebound_dtio_proc (gfc_symbol *, bool, bool);
4086	gfc_symbol* gfc_find_specific_dtio_proc (gfc_symbol*, bool, bool);
4087	void gfc_get_formal_from_actual_arglist (gfc_symbol *, gfc_actual_arglist *);
4088	bool gfc_compare_actual_formal (gfc_actual_arglist **, gfc_formal_arglist *,
4089	int, int, bool, locus *);
4090
4091
4092	/* io.cc */
4093	extern gfc_st_label format_asterisk;
4094
4095	void gfc_free_open (gfc_open *);
4096	bool gfc_resolve_open (gfc_open *, locus *);
4097	void gfc_free_close (gfc_close *);
4098	bool gfc_resolve_close (gfc_close *, locus *);
4099	void gfc_free_filepos (gfc_filepos *);
4100	bool gfc_resolve_filepos (gfc_filepos *, locus *);
4101	void gfc_free_inquire (gfc_inquire *);
4102	bool gfc_resolve_inquire (gfc_inquire *);
4103	void gfc_free_dt (gfc_dt *);
4104	bool gfc_resolve_dt (gfc_code *, gfc_dt *, locus *);
4105	void gfc_free_wait (gfc_wait *);
4106	bool gfc_resolve_wait (gfc_wait *);
4107
4108	/* module.cc */
4109	void gfc_module_init_2 (void);
4110	void gfc_module_done_2 (void);
4111	void gfc_dump_module (const char *, int);
4112	bool gfc_check_symbol_access (gfc_symbol *);
4113	void gfc_free_use_stmts (gfc_use_list *);
4114	void gfc_save_module_list ();
4115	void gfc_restore_old_module_list ();
4116	const char *gfc_dt_lower_string (const char *);
4117	const char *gfc_dt_upper_string (const char *);
4118
4119	/* primary.cc */
4120	symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
4121	symbol_attribute gfc_expr_attr (gfc_expr *);
4122	symbol_attribute gfc_caf_attr (gfc_expr *, bool i = false, bool *r = NULL);
4123	bool is_inquiry_ref (const char *, gfc_ref **);
4124	match gfc_match_rvalue (gfc_expr **);
4125	match gfc_match_varspec (gfc_expr*, int, bool, bool);
4126	bool gfc_check_digit (char, int);
4127	bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
4128	bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
4129	gfc_expr **,
4130	gfc_actual_arglist **, bool);
4131
4132	/* trans.cc */
4133	void gfc_generate_code (gfc_namespace *);
4134	void gfc_generate_module_code (gfc_namespace *);
4135
4136	/* trans-intrinsic.cc */
4137	bool gfc_inline_intrinsic_function_p (gfc_expr *);
4138
4139	/* trans-openmp.cc */
4140	int gfc_expr_list_len (gfc_expr_list *);
4141
4142	/* bbt.cc */
4143	typedef int (*compare_fn) (void *, void *);
4144	void gfc_insert_bbt (void *, void *, compare_fn);
4145	void * gfc_delete_bbt (void *, void *, compare_fn);
4146
4147	/* dump-parse-tree.cc */
4148	void gfc_dump_parse_tree (gfc_namespace *, FILE *);
4149	void gfc_dump_c_prototypes (FILE *);
4150	void gfc_dump_external_c_prototypes (FILE *);
4151	void gfc_dump_global_symbols (FILE *);
4152	void debug (gfc_symbol *);
4153	void debug (gfc_expr *);
4154
4155	/* parse.cc */
4156	bool gfc_parse_file (void);
4157	void gfc_global_used (gfc_gsymbol *, locus *);
4158	gfc_namespace* gfc_build_block_ns (gfc_namespace *);
4159	gfc_statement match_omp_directive (void);
4160	bool is_omp_declarative_stmt (gfc_statement);
4161
4162	/* dependency.cc */
4163	int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
4164	int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
4165	bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *);
4166
4167	/* check.cc */
4168	bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
4169	bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*,
4170	size_t*, size_t*, size_t*);
4171	bool gfc_boz2int (gfc_expr *, int);
4172	bool gfc_boz2uint (gfc_expr *, int);
4173	bool gfc_boz2real (gfc_expr *, int);
4174	bool gfc_invalid_boz (const char *, locus *);
4175	bool gfc_invalid_null_arg (gfc_expr *);
4176
4177	bool gfc_invalid_unsigned_ops (gfc_expr *, gfc_expr *);
4178
4179	/* class.cc */
4180	void gfc_fix_class_refs (gfc_expr *e);
4181	void gfc_add_component_ref (gfc_expr *, const char *);
4182	void 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")
4190	bool gfc_is_class_array_ref (gfc_expr *, bool *);
4191	bool gfc_is_class_scalar_expr (gfc_expr *);
4192	bool gfc_is_class_container_ref (gfc_expr *e);
4193	gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *);
4194	unsigned int gfc_hash_value (gfc_symbol *);
4195	gfc_expr *gfc_get_len_component (gfc_expr *e, int);
4196	bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
4197	gfc_array_spec **);
4198	void gfc_change_class (gfc_typespec *, symbol_attribute *,
4199	gfc_array_spec *, int, int);
4200	gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
4201	gfc_symbol *gfc_find_vtab (gfc_typespec *);
4202	gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, bool*,
4203	const char*, bool, locus*);
4204	gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, bool*,
4205	const char*, bool, locus*);
4206	gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, bool*,
4207	gfc_intrinsic_op, bool,
4208	locus*);
4209	gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
4210	bool gfc_is_finalizable (gfc_symbol *, gfc_expr **);
4211	bool 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
4242	void gfc_run_passes (gfc_namespace *);
4243
4244	typedef int (*walk_code_fn_t) (gfc_code **, int *, void *);
4245	typedef int (*walk_expr_fn_t) (gfc_expr **, int *, void *);
4246
4247	int gfc_dummy_code_callback (gfc_code **, int *, void *);
4248	int gfc_expr_walker (gfc_expr **, walk_expr_fn_t, void *);
4249	int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *);
4250	bool gfc_has_dimen_vector_ref (gfc_expr *e);
4251	void gfc_check_externals (gfc_namespace *);
4252	bool gfc_fix_implicit_pure (gfc_namespace *);
4253
4254	/* simplify.cc */
4255
4256	void gfc_convert_mpz_to_signed (mpz_t, int);
4257	gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
4258	bool gfc_is_constant_array_expr (gfc_expr *);
4259	bool gfc_is_size_zero_array (gfc_expr *);
4260	void gfc_convert_mpz_to_unsigned (mpz_t, int, bool sign = true);
4261
4262	/* trans-array.cc */
4263
4264	bool gfc_is_reallocatable_lhs (gfc_expr *);
4265
4266	/* trans-decl.cc */
4267
4268	void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool);
4269	void gfc_adjust_builtins (void);
4270	void gfc_add_caf_accessor (gfc_expr *, gfc_expr *);
4271
4272	#endif /* GCC_GFORTRAN_H */
4273