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