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