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