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

Provided by KDAB

Privacy Policy
Update your C++ knowledge – Modern C++11/14/17 Training
Find out more

source code of gcc/fortran/gfortran.h