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