OSDN Git Service

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