OSDN Git Service

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