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