OSDN Git Service

gcc/
[pf3gnuchains/gcc-fork.git] / gcc / fortran / gfortran.h
1 /* gfortran header file
2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
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 a 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 /* The author remains confused to this day about the convention of
107    returning '0' for 'SUCCESS'... or was it the other way around?  The
108    following enum makes things much more readable.  We also start
109    values off at one instead of zero.  */
110
111 typedef enum
112 { SUCCESS = 1, FAILURE }
113 try;
114
115 /* This is returned by gfc_notification_std to know if, given the flags
116    that were given (-std=, -pedantic) we should issue an error, a warning
117    or nothing.  */
118
119 typedef enum
120 { SILENT, WARNING, ERROR }
121 notification;
122
123 /* Matchers return one of these three values.  The difference between
124    MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
125    successful, but that something non-syntactic is wrong and an error
126    has already been issued.  */
127
128 typedef enum
129 { MATCH_NO = 1, MATCH_YES, MATCH_ERROR }
130 match;
131
132 typedef enum
133 { FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
134 gfc_source_form;
135
136 /* Basic types.  BT_VOID is used by ISO C Binding so funcs like c_f_pointer
137    can take any arg with the pointer attribute as a param.  */
138 typedef enum
139 { BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX,
140   BT_LOGICAL, BT_CHARACTER, BT_DERIVED, BT_PROCEDURE, BT_HOLLERITH,
141   BT_VOID
142 }
143 bt;
144
145 /* Expression node types.  */
146 typedef enum
147 { EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
148   EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL
149 }
150 expr_t;
151
152 /* Array types.  */
153 typedef enum
154 { AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
155   AS_ASSUMED_SIZE, AS_UNKNOWN
156 }
157 array_type;
158
159 typedef enum
160 { AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN }
161 ar_type;
162
163 /* Statement label types.  */
164 typedef enum
165 { ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET,
166   ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
167 }
168 gfc_sl_type;
169
170 /* Intrinsic operators.  */
171 typedef enum
172 { GFC_INTRINSIC_BEGIN = 0,
173   INTRINSIC_NONE = -1, INTRINSIC_UPLUS = GFC_INTRINSIC_BEGIN,
174   INTRINSIC_UMINUS, INTRINSIC_PLUS, INTRINSIC_MINUS, INTRINSIC_TIMES,
175   INTRINSIC_DIVIDE, INTRINSIC_POWER, INTRINSIC_CONCAT,
176   INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV,
177   /* ==, /=, >, >=, <, <=  */
178   INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE,
179   INTRINSIC_LT, INTRINSIC_LE, 
180   /* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style)  */
181   INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
182   INTRINSIC_LT_OS, INTRINSIC_LE_OS, 
183   INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN, 
184   INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */
185 }
186 gfc_intrinsic_op;
187
188
189 /* This macro is the number of intrinsic operators that exist.
190    Assumptions are made about the numbering of the interface_op enums.  */
191 #define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
192
193 /* Arithmetic results.  */
194 typedef enum
195 { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
196   ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC
197 }
198 arith;
199
200 /* Statements.  */
201 typedef enum
202 {
203   ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_BACKSPACE, ST_BLOCK_DATA,
204   ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE,
205   ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF,
206   ST_ELSEWHERE, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO,
207   ST_END_FILE, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
208   ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
209   ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
210   ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO,
211   ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT, ST_INQUIRE, ST_INTERFACE,
212   ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
213   ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
214   ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE,
215   ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
216   ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
217   ST_ENUM, ST_ENUMERATOR, ST_END_ENUM,
218   ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
219   ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
220   ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
221   ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE,
222   ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
223   ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
224   ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
225   ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_PROCEDURE,
226   ST_NONE
227 }
228 gfc_statement;
229
230
231 /* Types of interfaces that we can have.  Assignment interfaces are
232    considered to be intrinsic operators.  */
233 typedef enum
234 {
235   INTERFACE_NAMELESS = 1, INTERFACE_GENERIC,
236   INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT
237 }
238 interface_type;
239
240 /* Symbol flavors: these are all mutually exclusive.
241    10 elements = 4 bits.  */
242 typedef enum sym_flavor
243 {
244   FL_UNKNOWN = 0, FL_PROGRAM, FL_BLOCK_DATA, FL_MODULE, FL_VARIABLE,
245   FL_PARAMETER, FL_LABEL, FL_PROCEDURE, FL_DERIVED, FL_NAMELIST,
246   FL_VOID
247 }
248 sym_flavor;
249
250 /* Procedure types.  7 elements = 3 bits.  */
251 typedef enum procedure_type
252 { PROC_UNKNOWN, PROC_MODULE, PROC_INTERNAL, PROC_DUMMY,
253   PROC_INTRINSIC, PROC_ST_FUNCTION, PROC_EXTERNAL
254 }
255 procedure_type;
256
257 /* Intent types.  */
258 typedef enum sym_intent
259 { INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT
260 }
261 sym_intent;
262
263 /* Access types.  */
264 typedef enum gfc_access
265 { ACCESS_UNKNOWN = 0, ACCESS_PUBLIC, ACCESS_PRIVATE
266 }
267 gfc_access;
268
269 /* Flags to keep track of where an interface came from.
270    4 elements = 2 bits.  */
271 typedef enum ifsrc
272 { IFSRC_UNKNOWN = 0, IFSRC_DECL, IFSRC_IFBODY, IFSRC_USAGE
273 }
274 ifsrc;
275
276 /* Whether a SAVE attribute was set explicitly or implicitly.  */
277 typedef enum save_state
278 { SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
279 }
280 save_state;
281
282 /* Strings for all symbol attributes.  We use these for dumping the
283    parse tree, in error messages, and also when reading and writing
284    modules.  In symbol.c.  */
285 extern const mstring flavors[];
286 extern const mstring procedures[];
287 extern const mstring intents[];
288 extern const mstring access_types[];
289 extern const mstring ifsrc_types[];
290 extern const mstring save_status[];
291
292 /* Enumeration of all the generic intrinsic functions.  Used by the
293    backend for identification of a function.  */
294
295 enum gfc_isym_id
296 {
297   /* GFC_ISYM_NONE is used for intrinsics which will never be seen by
298      the backend (eg. KIND).  */
299   GFC_ISYM_NONE = 0,
300   GFC_ISYM_ABORT,
301   GFC_ISYM_ABS,
302   GFC_ISYM_ACCESS,
303   GFC_ISYM_ACHAR,
304   GFC_ISYM_ACOS,
305   GFC_ISYM_ACOSH,
306   GFC_ISYM_ADJUSTL,
307   GFC_ISYM_ADJUSTR,
308   GFC_ISYM_AIMAG,
309   GFC_ISYM_AINT,
310   GFC_ISYM_ALARM,
311   GFC_ISYM_ALL,
312   GFC_ISYM_ALLOCATED,
313   GFC_ISYM_AND,
314   GFC_ISYM_ANINT,
315   GFC_ISYM_ANY,
316   GFC_ISYM_ASIN,
317   GFC_ISYM_ASINH,
318   GFC_ISYM_ASSOCIATED,
319   GFC_ISYM_ATAN,
320   GFC_ISYM_ATAN2,
321   GFC_ISYM_ATANH,
322   GFC_ISYM_BIT_SIZE,
323   GFC_ISYM_BTEST,
324   GFC_ISYM_CEILING,
325   GFC_ISYM_CHAR,
326   GFC_ISYM_CHDIR,
327   GFC_ISYM_CHMOD,
328   GFC_ISYM_CMPLX,
329   GFC_ISYM_COMMAND_ARGUMENT_COUNT,
330   GFC_ISYM_COMPLEX,
331   GFC_ISYM_CONJG,
332   GFC_ISYM_CONVERSION,
333   GFC_ISYM_COS,
334   GFC_ISYM_COSH,
335   GFC_ISYM_COUNT,
336   GFC_ISYM_CPU_TIME,
337   GFC_ISYM_CSHIFT,
338   GFC_ISYM_CTIME,
339   GFC_ISYM_DATE_AND_TIME,
340   GFC_ISYM_DBLE,
341   GFC_ISYM_DIGITS,
342   GFC_ISYM_DIM,
343   GFC_ISYM_DOT_PRODUCT,
344   GFC_ISYM_DPROD,
345   GFC_ISYM_DTIME,
346   GFC_ISYM_EOSHIFT,
347   GFC_ISYM_EPSILON,
348   GFC_ISYM_ERF,
349   GFC_ISYM_ERFC,
350   GFC_ISYM_ETIME,
351   GFC_ISYM_EXIT,
352   GFC_ISYM_EXP,
353   GFC_ISYM_EXPONENT,
354   GFC_ISYM_FDATE,
355   GFC_ISYM_FGET,
356   GFC_ISYM_FGETC,
357   GFC_ISYM_FLOOR,
358   GFC_ISYM_FLUSH,
359   GFC_ISYM_FNUM,
360   GFC_ISYM_FPUT,
361   GFC_ISYM_FPUTC,
362   GFC_ISYM_FRACTION,
363   GFC_ISYM_FREE,
364   GFC_ISYM_FSEEK,
365   GFC_ISYM_FSTAT,
366   GFC_ISYM_FTELL,
367   GFC_ISYM_GAMMA,
368   GFC_ISYM_GERROR,
369   GFC_ISYM_GETARG,
370   GFC_ISYM_GET_COMMAND,
371   GFC_ISYM_GET_COMMAND_ARGUMENT,
372   GFC_ISYM_GETCWD,
373   GFC_ISYM_GETENV,
374   GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
375   GFC_ISYM_GETGID,
376   GFC_ISYM_GETLOG,
377   GFC_ISYM_GETPID,
378   GFC_ISYM_GETUID,
379   GFC_ISYM_GMTIME,
380   GFC_ISYM_HOSTNM,
381   GFC_ISYM_HUGE,
382   GFC_ISYM_IACHAR,
383   GFC_ISYM_IAND,
384   GFC_ISYM_IARGC,
385   GFC_ISYM_IBCLR,
386   GFC_ISYM_IBITS,
387   GFC_ISYM_IBSET,
388   GFC_ISYM_ICHAR,
389   GFC_ISYM_IDATE,
390   GFC_ISYM_IEOR,
391   GFC_ISYM_IERRNO,
392   GFC_ISYM_INDEX,
393   GFC_ISYM_INT,
394   GFC_ISYM_INT2,
395   GFC_ISYM_INT8,
396   GFC_ISYM_IOR,
397   GFC_ISYM_IRAND,
398   GFC_ISYM_ISATTY,
399   GFC_ISYM_IS_IOSTAT_END,
400   GFC_ISYM_IS_IOSTAT_EOR,
401   GFC_ISYM_ISNAN,
402   GFC_ISYM_ISHFT,
403   GFC_ISYM_ISHFTC,
404   GFC_ISYM_ITIME,
405   GFC_ISYM_J0,
406   GFC_ISYM_J1,
407   GFC_ISYM_JN,
408   GFC_ISYM_KILL,
409   GFC_ISYM_KIND,
410   GFC_ISYM_LBOUND,
411   GFC_ISYM_LEN,
412   GFC_ISYM_LEN_TRIM,
413   GFC_ISYM_LGAMMA,
414   GFC_ISYM_LGE,
415   GFC_ISYM_LGT,
416   GFC_ISYM_LINK,
417   GFC_ISYM_LLE,
418   GFC_ISYM_LLT,
419   GFC_ISYM_LOC,
420   GFC_ISYM_LOG,
421   GFC_ISYM_LOG10,
422   GFC_ISYM_LOGICAL,
423   GFC_ISYM_LONG,
424   GFC_ISYM_LSHIFT,
425   GFC_ISYM_LSTAT,
426   GFC_ISYM_LTIME,
427   GFC_ISYM_MALLOC,
428   GFC_ISYM_MATMUL,
429   GFC_ISYM_MAX,
430   GFC_ISYM_MAXEXPONENT,
431   GFC_ISYM_MAXLOC,
432   GFC_ISYM_MAXVAL,
433   GFC_ISYM_MCLOCK,
434   GFC_ISYM_MCLOCK8,
435   GFC_ISYM_MERGE,
436   GFC_ISYM_MIN,
437   GFC_ISYM_MINEXPONENT,
438   GFC_ISYM_MINLOC,
439   GFC_ISYM_MINVAL,
440   GFC_ISYM_MOD,
441   GFC_ISYM_MODULO,
442   GFC_ISYM_MOVE_ALLOC,
443   GFC_ISYM_MVBITS,
444   GFC_ISYM_NEAREST,
445   GFC_ISYM_NEW_LINE,
446   GFC_ISYM_NINT,
447   GFC_ISYM_NOT,
448   GFC_ISYM_NULL,
449   GFC_ISYM_OR,
450   GFC_ISYM_PACK,
451   GFC_ISYM_PERROR,
452   GFC_ISYM_PRECISION,
453   GFC_ISYM_PRESENT,
454   GFC_ISYM_PRODUCT,
455   GFC_ISYM_RADIX,
456   GFC_ISYM_RAND,
457   GFC_ISYM_RANDOM_NUMBER,
458   GFC_ISYM_RANDOM_SEED,
459   GFC_ISYM_RANGE,
460   GFC_ISYM_REAL,
461   GFC_ISYM_RENAME,
462   GFC_ISYM_REPEAT,
463   GFC_ISYM_RESHAPE,
464   GFC_ISYM_RRSPACING,
465   GFC_ISYM_RSHIFT,
466   GFC_ISYM_SCALE,
467   GFC_ISYM_SCAN,
468   GFC_ISYM_SECNDS,
469   GFC_ISYM_SECOND,
470   GFC_ISYM_SET_EXPONENT,
471   GFC_ISYM_SHAPE,
472   GFC_ISYM_SIGN,
473   GFC_ISYM_SIGNAL,
474   GFC_ISYM_SI_KIND,
475   GFC_ISYM_SIN,
476   GFC_ISYM_SINH,
477   GFC_ISYM_SIZE,
478   GFC_ISYM_SLEEP,
479   GFC_ISYM_SIZEOF,
480   GFC_ISYM_SPACING,
481   GFC_ISYM_SPREAD,
482   GFC_ISYM_SQRT,
483   GFC_ISYM_SRAND,
484   GFC_ISYM_SR_KIND,
485   GFC_ISYM_STAT,
486   GFC_ISYM_SUM,
487   GFC_ISYM_SYMLINK,
488   GFC_ISYM_SYMLNK,
489   GFC_ISYM_SYSTEM,
490   GFC_ISYM_SYSTEM_CLOCK,
491   GFC_ISYM_TAN,
492   GFC_ISYM_TANH,
493   GFC_ISYM_TIME,
494   GFC_ISYM_TIME8,
495   GFC_ISYM_TINY,
496   GFC_ISYM_TRANSFER,
497   GFC_ISYM_TRANSPOSE,
498   GFC_ISYM_TRIM,
499   GFC_ISYM_TTYNAM,
500   GFC_ISYM_UBOUND,
501   GFC_ISYM_UMASK,
502   GFC_ISYM_UNLINK,
503   GFC_ISYM_UNPACK,
504   GFC_ISYM_VERIFY,
505   GFC_ISYM_XOR,
506   GFC_ISYM_Y0,
507   GFC_ISYM_Y1,
508   GFC_ISYM_YN
509 };
510 typedef enum gfc_isym_id gfc_isym_id;
511
512
513 /************************* Structures *****************************/
514
515 /* Used for keeping things in balanced binary trees.  */
516 #define BBT_HEADER(self) int priority; struct self *left, *right
517
518 #define NAMED_INTCST(a,b,c) a,
519 typedef enum
520 {
521   ISOFORTRANENV_INVALID = -1,
522 #include "iso-fortran-env.def"
523   ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
524 }
525 iso_fortran_env_symbol;
526 #undef NAMED_INTCST
527
528 #define NAMED_INTCST(a,b,c) a,
529 #define NAMED_REALCST(a,b,c) a,
530 #define NAMED_CMPXCST(a,b,c) a,
531 #define NAMED_LOGCST(a,b,c) a,
532 #define NAMED_CHARKNDCST(a,b,c) a,
533 #define NAMED_CHARCST(a,b,c) a,
534 #define DERIVED_TYPE(a,b,c) a,
535 #define PROCEDURE(a,b) a,
536 typedef enum
537 {
538   ISOCBINDING_INVALID = -1, 
539 #include "iso-c-binding.def"
540   ISOCBINDING_LAST,
541   ISOCBINDING_NUMBER = ISOCBINDING_LAST
542 }
543 iso_c_binding_symbol;
544 #undef NAMED_INTCST
545 #undef NAMED_REALCST
546 #undef NAMED_CMPXCST
547 #undef NAMED_LOGCST
548 #undef NAMED_CHARKNDCST
549 #undef NAMED_CHARCST
550 #undef DERIVED_TYPE
551 #undef PROCEDURE
552
553 typedef enum
554 {
555   INTMOD_NONE = 0, INTMOD_ISO_FORTRAN_ENV, INTMOD_ISO_C_BINDING
556 }
557 intmod_id;
558
559 typedef struct
560 {
561   char name[GFC_MAX_SYMBOL_LEN + 1];
562   int value;  /* Used for both integer and character values.  */
563   bt f90_type;
564 }
565 CInteropKind_t;
566
567 /* Array of structs, where the structs represent the C interop kinds.
568    The list will be implemented based on a hash of the kind name since
569    these could be accessed multiple times.
570    Declared in trans-types.c as a global, since it's in that file
571    that the list is initialized.  */
572 extern CInteropKind_t c_interop_kinds_table[];
573
574 /* Symbol attribute structure.  */
575 typedef struct
576 {
577   /* Variable attributes.  */
578   unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
579     optional:1, pointer:1, target:1, value:1, volatile_:1,
580     dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
581     implied_index:1;
582
583   ENUM_BITFIELD (save_state) save:2;
584
585   unsigned data:1,              /* Symbol is named in a DATA statement.  */
586     protected:1,                /* Symbol has been marked as protected.  */
587     use_assoc:1,                /* Symbol has been use-associated.  */
588     use_only:1,                 /* Symbol has been use-associated, with ONLY.  */
589     imported:1;                 /* Symbol has been associated by IMPORT.  */
590
591   unsigned in_namelist:1, in_common:1, in_equivalence:1;
592   unsigned function:1, subroutine:1, procedure:1;
593   unsigned generic:1, generic_copy:1;
594   unsigned implicit_type:1;     /* Type defined via implicit rules.  */
595   unsigned untyped:1;           /* No implicit type could be found.  */
596
597   unsigned is_bind_c:1;         /* say if is bound to C */
598
599   /* These flags are both in the typespec and attribute.  The attribute
600      list is what gets read from/written to a module file.  The typespec
601      is created from a decl being processed.  */
602   unsigned is_c_interop:1;      /* It's c interoperable.  */
603   unsigned is_iso_c:1;          /* Symbol is from iso_c_binding.  */
604
605   /* Function/subroutine attributes */
606   unsigned sequence:1, elemental:1, pure:1, recursive:1;
607   unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
608
609   /* This is set if the subroutine doesn't return.  Currently, this
610      is only possible for intrinsic subroutines.  */
611   unsigned noreturn:1;
612
613   /* Set if this procedure is an alternate entry point.  These procedures
614      don't have any code associated, and the backend will turn them into
615      thunks to the master function.  */
616   unsigned entry:1;
617
618   /* Set if this is the master function for a procedure with multiple
619      entry points.  */
620   unsigned entry_master:1;
621
622   /* Set if this is the master function for a function with multiple
623      entry points where characteristics of the entry points differ.  */
624   unsigned mixed_entry_master:1;
625
626   /* Set if a function must always be referenced by an explicit interface.  */
627   unsigned always_explicit:1;
628
629   /* Set if the symbol has been referenced in an expression.  No further
630      modification of type or type parameters is permitted.  */
631   unsigned referenced:1;
632
633   /* Set if the symbol has ambiguous interfaces.  */
634   unsigned ambiguous_interfaces:1;
635
636   /* Set if the is the symbol for the main program.  This is the least
637      cumbersome way to communicate this function property without
638      strcmp'ing with __MAIN everywhere.  */
639   unsigned is_main_program:1;
640
641   /* Mutually exclusive multibit attributes.  */
642   ENUM_BITFIELD (gfc_access) access:2;
643   ENUM_BITFIELD (sym_intent) intent:2;
644   ENUM_BITFIELD (sym_flavor) flavor:4;
645   ENUM_BITFIELD (ifsrc) if_source:2;
646
647   ENUM_BITFIELD (procedure_type) proc:3;
648
649   /* Special attributes for Cray pointers, pointees.  */
650   unsigned cray_pointer:1, cray_pointee:1;
651
652   /* The symbol is a derived type with allocatable components, pointer 
653      components or private components, possibly nested.  */
654   unsigned alloc_comp:1, pointer_comp:1, private_comp:1;
655
656   /* The namespace where the VOLATILE attribute has been set.  */
657   struct gfc_namespace *volatile_ns;
658 }
659 symbol_attribute;
660
661
662 /* The following three structures are used to identify a location in
663    the sources.
664
665    gfc_file is used to maintain a tree of the source files and how
666    they include each other
667
668    gfc_linebuf holds a single line of source code and information
669    which file it resides in
670
671    locus point to the sourceline and the character in the source
672    line.
673 */
674
675 typedef struct gfc_file
676 {
677   struct gfc_file *included_by, *next, *up;
678   int inclusion_line, line;
679   char *filename;
680 } gfc_file;
681
682 typedef struct gfc_linebuf
683 {
684 #ifdef USE_MAPPED_LOCATION
685   source_location location;
686 #else
687   int linenum;
688 #endif
689   struct gfc_file *file;
690   struct gfc_linebuf *next;
691
692   int truncated;
693
694   char line[1];
695 } gfc_linebuf;
696
697 #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
698
699 #ifdef USE_MAPPED_LOCATION
700 #define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
701 #else
702 #define gfc_linebuf_linenum(LBUF) ((LBUF)->linenum)
703 #endif
704
705 typedef struct
706 {
707   char *nextc;
708   gfc_linebuf *lb;
709 } locus;
710
711 /* In order for the "gfc" format checking to work correctly, you must
712    have declared a typedef locus first.  */
713 #if GCC_VERSION >= 4001
714 #define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
715 #else
716 #define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
717 #endif
718
719
720 extern int gfc_suppress_error;
721
722
723 /* Character length structures hold the expression that gives the
724    length of a character variable.  We avoid putting these into
725    gfc_typespec because doing so prevents us from doing structure
726    copies and forces us to deallocate any typespecs we create, as well
727    as structures that contain typespecs.  They also can have multiple
728    character typespecs pointing to them.
729
730    These structures form a singly linked list within the current
731    namespace and are deallocated with the namespace.  It is possible to
732    end up with gfc_charlen structures that have nothing pointing to them.  */
733
734 typedef struct gfc_charlen
735 {
736   struct gfc_expr *length;
737   struct gfc_charlen *next;
738   tree backend_decl;
739
740   int resolved;
741 }
742 gfc_charlen;
743
744 #define gfc_get_charlen() gfc_getmem(sizeof(gfc_charlen))
745
746 /* Type specification structure.  FIXME: derived and cl could be union???  */
747 typedef struct
748 {
749   bt type;
750   int kind;
751   struct gfc_symbol *derived;
752   gfc_charlen *cl;      /* For character types only.  */
753   int is_c_interop;
754   int is_iso_c;
755   bt f90_type; 
756 }
757 gfc_typespec;
758
759 /* Array specification.  */
760 typedef struct
761 {
762   int rank;     /* A rank of zero means that a variable is a scalar.  */
763   array_type type;
764   struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
765
766   /* These two fields are used with the Cray Pointer extension.  */
767   bool cray_pointee; /* True iff this spec belongs to a cray pointee.  */
768   bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to
769                         AS_EXPLICIT, but we want to remember that we
770                         did this.  */
771
772 }
773 gfc_array_spec;
774
775 #define gfc_get_array_spec() gfc_getmem(sizeof(gfc_array_spec))
776
777
778 /* Components of derived types.  */
779 typedef struct gfc_component
780 {
781   const char *name;
782   gfc_typespec ts;
783
784   int pointer, allocatable, dimension;
785   gfc_access access;
786   gfc_array_spec *as;
787
788   tree backend_decl;
789   locus loc;
790   struct gfc_expr *initializer;
791   struct gfc_component *next;
792 }
793 gfc_component;
794
795 #define gfc_get_component() gfc_getmem(sizeof(gfc_component))
796
797 /* Formal argument lists are lists of symbols.  */
798 typedef struct gfc_formal_arglist
799 {
800   /* Symbol representing the argument at this position in the arglist.  */
801   struct gfc_symbol *sym;
802   /* Points to the next formal argument.  */
803   struct gfc_formal_arglist *next;
804 }
805 gfc_formal_arglist;
806
807 #define gfc_get_formal_arglist() gfc_getmem(sizeof(gfc_formal_arglist))
808
809
810 /* The gfc_actual_arglist structure is for actual arguments.  */
811 typedef struct gfc_actual_arglist
812 {
813   const char *name;
814   /* Alternate return label when the expr member is null.  */
815   struct gfc_st_label *label;
816
817   /* This is set to the type of an eventual omitted optional
818      argument. This is used to determine if a hidden string length
819      argument has to be added to a function call.  */
820   bt missing_arg_type;
821
822   struct gfc_expr *expr;
823   struct gfc_actual_arglist *next;
824 }
825 gfc_actual_arglist;
826
827 #define gfc_get_actual_arglist() gfc_getmem(sizeof(gfc_actual_arglist))
828
829
830 /* Because a symbol can belong to multiple namelists, they must be
831    linked externally to the symbol itself.  */
832 typedef struct gfc_namelist
833 {
834   struct gfc_symbol *sym;
835   struct gfc_namelist *next;
836 }
837 gfc_namelist;
838
839 #define gfc_get_namelist() gfc_getmem(sizeof(gfc_namelist))
840
841 enum
842 {
843   OMP_LIST_PRIVATE,
844   OMP_LIST_FIRSTPRIVATE,
845   OMP_LIST_LASTPRIVATE,
846   OMP_LIST_COPYPRIVATE,
847   OMP_LIST_SHARED,
848   OMP_LIST_COPYIN,
849   OMP_LIST_PLUS,
850   OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
851   OMP_LIST_MULT,
852   OMP_LIST_SUB,
853   OMP_LIST_AND,
854   OMP_LIST_OR,
855   OMP_LIST_EQV,
856   OMP_LIST_NEQV,
857   OMP_LIST_MAX,
858   OMP_LIST_MIN,
859   OMP_LIST_IAND,
860   OMP_LIST_IOR,
861   OMP_LIST_IEOR,
862   OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR,
863   OMP_LIST_NUM
864 };
865
866 /* Because a symbol can belong to multiple namelists, they must be
867    linked externally to the symbol itself.  */
868 typedef struct gfc_omp_clauses
869 {
870   struct gfc_expr *if_expr;
871   struct gfc_expr *num_threads;
872   gfc_namelist *lists[OMP_LIST_NUM];
873   enum
874     {
875       OMP_SCHED_NONE,
876       OMP_SCHED_STATIC,
877       OMP_SCHED_DYNAMIC,
878       OMP_SCHED_GUIDED,
879       OMP_SCHED_RUNTIME
880     } sched_kind;
881   struct gfc_expr *chunk_size;
882   enum
883     {
884       OMP_DEFAULT_UNKNOWN,
885       OMP_DEFAULT_NONE,
886       OMP_DEFAULT_PRIVATE,
887       OMP_DEFAULT_SHARED
888     } default_sharing;
889   bool nowait, ordered;
890 }
891 gfc_omp_clauses;
892
893 #define gfc_get_omp_clauses() gfc_getmem(sizeof(gfc_omp_clauses))
894
895
896 /* The gfc_st_label structure is a doubly linked list attached to a
897    namespace that records the usage of statement labels within that
898    space.  */
899 /* TODO: Make format/statement specifics a union.  */
900 typedef struct gfc_st_label
901 {
902   BBT_HEADER(gfc_st_label);
903
904   int value;
905
906   gfc_sl_type defined, referenced;
907
908   struct gfc_expr *format;
909
910   tree backend_decl;
911
912   locus where;
913 }
914 gfc_st_label;
915
916
917 /* gfc_interface()-- Interfaces are lists of symbols strung together.  */
918 typedef struct gfc_interface
919 {
920   struct gfc_symbol *sym;
921   locus where;
922   struct gfc_interface *next;
923 }
924 gfc_interface;
925
926 #define gfc_get_interface() gfc_getmem(sizeof(gfc_interface))
927
928
929 /* User operator nodes.  These are like stripped down symbols.  */
930 typedef struct
931 {
932   const char *name;
933
934   gfc_interface *operator;
935   struct gfc_namespace *ns;
936   gfc_access access;
937 }
938 gfc_user_op;
939
940 /* Symbol nodes.  These are important things.  They are what the
941    standard refers to as "entities".  The possibly multiple names that
942    refer to the same entity are accomplished by a binary tree of
943    symtree structures that is balanced by the red-black method-- more
944    than one symtree node can point to any given symbol.  */
945
946 typedef struct gfc_symbol
947 {
948   const char *name;     /* Primary name, before renaming */
949   const char *module;   /* Module this symbol came from */
950   locus declared_at;
951
952   gfc_typespec ts;
953   symbol_attribute attr;
954
955   /* The interface member points to the formal argument list if the
956      symbol is a function or subroutine name.  If the symbol is a
957      generic name, the generic member points to the list of
958      interfaces.  */
959
960   gfc_interface *generic;
961   gfc_access component_access;
962
963   gfc_formal_arglist *formal;
964   struct gfc_namespace *formal_ns;
965
966   struct gfc_expr *value;       /* Parameter/Initializer value */
967   gfc_array_spec *as;
968   struct gfc_symbol *result;    /* function result symbol */
969   gfc_component *components;    /* Derived type components */
970
971   struct gfc_symbol *interface; /* For PROCEDURE declarations.  */
972
973   /* Defined only for Cray pointees; points to their pointer.  */
974   struct gfc_symbol *cp_pointer;
975
976   struct gfc_symbol *common_next;       /* Links for COMMON syms */
977
978   /* This is in fact a gfc_common_head but it is only used for pointer
979      comparisons to check if symbols are in the same common block.  */
980   struct gfc_common_head* common_head;
981
982   /* Make sure setup code for dummy arguments is generated in the correct
983      order.  */
984   int dummy_order;
985
986   int entry_id;
987
988   gfc_namelist *namelist, *namelist_tail;
989
990   /* Change management fields.  Symbols that might be modified by the
991      current statement have the mark member nonzero and are kept in a
992      singly linked list through the tlink field.  Of these symbols,
993      symbols with old_symbol equal to NULL are symbols created within
994      the current statement.  Otherwise, old_symbol points to a copy of
995      the old symbol.  */
996
997   struct gfc_symbol *old_symbol, *tlink;
998   unsigned mark:1, new:1;
999   /* Nonzero if all equivalences associated with this symbol have been
1000      processed.  */
1001   unsigned equiv_built:1;
1002   /* Set if this variable is used as an index name in a FORALL.  */
1003   unsigned forall_index:1;
1004   int refs;
1005   struct gfc_namespace *ns;     /* namespace containing this symbol */
1006
1007   tree backend_decl;
1008    
1009   /* Identity of the intrinsic module the symbol comes from, or
1010      INTMOD_NONE if it's not imported from a intrinsic module.  */
1011   intmod_id from_intmod;
1012   /* Identity of the symbol from intrinsic modules, from enums maintained
1013      separately by each intrinsic module.  Used together with from_intmod,
1014      it uniquely identifies a symbol from an intrinsic module.  */
1015   int intmod_sym_id;
1016
1017   /* This may be repetitive, since the typespec now has a binding
1018      label field.  */
1019   char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
1020   /* Store a reference to the common_block, if this symbol is in one.  */
1021   struct gfc_common_head *common_block;
1022 }
1023 gfc_symbol;
1024
1025
1026 /* This structure is used to keep track of symbols in common blocks.  */
1027 typedef struct gfc_common_head
1028 {
1029   locus where;
1030   char use_assoc, saved, threadprivate;
1031   char name[GFC_MAX_SYMBOL_LEN + 1];
1032   struct gfc_symbol *head;
1033   char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
1034   int is_bind_c;
1035 }
1036 gfc_common_head;
1037
1038 #define gfc_get_common_head() gfc_getmem(sizeof(gfc_common_head))
1039
1040
1041 /* A list of all the alternate entry points for a procedure.  */
1042
1043 typedef struct gfc_entry_list
1044 {
1045   /* The symbol for this entry point.  */
1046   gfc_symbol *sym;
1047   /* The zero-based id of this entry point.  */
1048   int id;
1049   /* The LABEL_EXPR marking this entry point.  */
1050   tree label;
1051   /* The nest item in the list.  */
1052   struct gfc_entry_list *next;
1053 }
1054 gfc_entry_list;
1055
1056 #define gfc_get_entry_list() \
1057   (gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))
1058
1059 /* Within a namespace, symbols are pointed to by symtree nodes that
1060    are linked together in a balanced binary tree.  There can be
1061    several symtrees pointing to the same symbol node via USE
1062    statements.  */
1063
1064 typedef struct gfc_symtree
1065 {
1066   BBT_HEADER (gfc_symtree);
1067   const char *name;
1068   int ambiguous;
1069   union
1070   {
1071     gfc_symbol *sym;            /* Symbol associated with this node */
1072     gfc_user_op *uop;
1073     gfc_common_head *common;
1074   }
1075   n;
1076
1077 }
1078 gfc_symtree;
1079
1080 /* A linked list of derived types in the namespace.  */
1081 typedef struct gfc_dt_list
1082 {
1083   struct gfc_symbol *derived;
1084   struct gfc_dt_list *next;
1085 }
1086 gfc_dt_list;
1087
1088 #define gfc_get_dt_list() gfc_getmem(sizeof(gfc_dt_list))
1089
1090   /* A list of all derived types.  */
1091   extern gfc_dt_list *gfc_derived_types;
1092
1093 /* A namespace describes the contents of procedure, module or
1094    interface block.  */
1095 /* ??? Anything else use these?  */
1096
1097 typedef struct gfc_namespace
1098 {
1099   /* Tree containing all the symbols in this namespace.  */
1100   gfc_symtree *sym_root;
1101   /* Tree containing all the user-defined operators in the namespace.  */
1102   gfc_symtree *uop_root;
1103   /* Tree containing all the common blocks.  */
1104   gfc_symtree *common_root;
1105
1106   /* If set_flag[letter] is set, an implicit type has been set for letter.  */
1107   int set_flag[GFC_LETTERS];
1108   /* Keeps track of the implicit types associated with the letters.  */
1109   gfc_typespec default_type[GFC_LETTERS];
1110
1111   /* If this is a namespace of a procedure, this points to the procedure.  */
1112   struct gfc_symbol *proc_name;
1113   /* If this is the namespace of a unit which contains executable
1114      code, this points to it.  */
1115   struct gfc_code *code;
1116
1117   /* Points to the equivalences set up in this namespace.  */
1118   struct gfc_equiv *equiv;
1119
1120   /* Points to the equivalence groups produced by trans_common.  */
1121   struct gfc_equiv_list *equiv_lists;
1122
1123   gfc_interface *operator[GFC_INTRINSIC_OPS];
1124
1125   /* Points to the parent namespace, i.e. the namespace of a module or
1126      procedure in which the procedure belonging to this namespace is
1127      contained. The parent namespace points to this namespace either
1128      directly via CONTAINED, or indirectly via the chain built by
1129      SIBLING.  */
1130   struct gfc_namespace *parent;
1131   /* CONTAINED points to the first contained namespace. Sibling
1132      namespaces are chained via SIBLING.  */
1133   struct gfc_namespace  *contained, *sibling;
1134
1135   gfc_common_head blank_common;
1136   gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];
1137
1138   gfc_st_label *st_labels;
1139   /* This list holds information about all the data initializers in
1140      this namespace.  */
1141   struct gfc_data *data;
1142
1143   gfc_charlen *cl_list;
1144
1145   int save_all, seen_save, seen_implicit_none;
1146
1147   /* Normally we don't need to refcount namespaces.  However when we read
1148      a module containing a function with multiple entry points, this
1149      will appear as several functions with the same formal namespace.  */
1150   int refs;
1151
1152   /* A list of all alternate entry points to this procedure (or NULL).  */
1153   gfc_entry_list *entries;
1154
1155   /* Set to 1 if namespace is a BLOCK DATA program unit.  */
1156   int is_block_data;
1157
1158   /* Set to 1 if namespace is an interface body with "IMPORT" used.  */
1159   int has_import_set;
1160 }
1161 gfc_namespace;
1162
1163 extern gfc_namespace *gfc_current_ns;
1164
1165 /* Global symbols are symbols of global scope. Currently we only use
1166    this to detect collisions already when parsing.
1167    TODO: Extend to verify procedure calls.  */
1168
1169 typedef struct gfc_gsymbol
1170 {
1171   BBT_HEADER(gfc_gsymbol);
1172
1173   const char *name;
1174   const char *sym_name;
1175   const char *mod_name;
1176   const char *binding_label;
1177   enum { GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
1178         GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA } type;
1179
1180   int defined, used;
1181   locus where;
1182 }
1183 gfc_gsymbol;
1184
1185 extern gfc_gsymbol *gfc_gsym_root;
1186
1187 /* Information on interfaces being built.  */
1188 typedef struct
1189 {
1190   interface_type type;
1191   gfc_symbol *sym;
1192   gfc_namespace *ns;
1193   gfc_user_op *uop;
1194   gfc_intrinsic_op op;
1195 }
1196 gfc_interface_info;
1197
1198 extern gfc_interface_info current_interface;
1199
1200
1201 /* Array reference.  */
1202 typedef struct gfc_array_ref
1203 {
1204   ar_type type;
1205   int dimen;                    /* # of components in the reference */
1206   locus where;
1207   gfc_array_spec *as;
1208
1209   locus c_where[GFC_MAX_DIMENSIONS];    /* All expressions can be NULL */
1210   struct gfc_expr *start[GFC_MAX_DIMENSIONS], *end[GFC_MAX_DIMENSIONS],
1211     *stride[GFC_MAX_DIMENSIONS];
1212
1213   enum
1214   { DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_UNKNOWN }
1215   dimen_type[GFC_MAX_DIMENSIONS];
1216
1217   struct gfc_expr *offset;
1218 }
1219 gfc_array_ref;
1220
1221 #define gfc_get_array_ref() gfc_getmem(sizeof(gfc_array_ref))
1222
1223
1224 /* Component reference nodes.  A variable is stored as an expression
1225    node that points to the base symbol.  After that, a singly linked
1226    list of component reference nodes gives the variable's complete
1227    resolution.  The array_ref component may be present and comes
1228    before the component component.  */
1229
1230 typedef enum
1231   { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING }
1232 ref_type;
1233
1234 typedef struct gfc_ref
1235 {
1236   ref_type type;
1237
1238   union
1239   {
1240     struct gfc_array_ref ar;
1241
1242     struct
1243     {
1244       gfc_component *component;
1245       gfc_symbol *sym;
1246     }
1247     c;
1248
1249     struct
1250     {
1251       struct gfc_expr *start, *end;     /* Substring */
1252       gfc_charlen *length;
1253     }
1254     ss;
1255
1256   }
1257   u;
1258
1259   struct gfc_ref *next;
1260 }
1261 gfc_ref;
1262
1263 #define gfc_get_ref() gfc_getmem(sizeof(gfc_ref))
1264
1265
1266 /* Structures representing intrinsic symbols and their arguments lists.  */
1267 typedef struct gfc_intrinsic_arg
1268 {
1269   char name[GFC_MAX_SYMBOL_LEN + 1];
1270
1271   gfc_typespec ts;
1272   int optional;
1273   gfc_actual_arglist *actual;
1274
1275   struct gfc_intrinsic_arg *next;
1276
1277 }
1278 gfc_intrinsic_arg;
1279
1280
1281 /* Specifies the various kinds of check functions used to verify the
1282    argument lists of intrinsic functions. fX with X an integer refer
1283    to check functions of intrinsics with X arguments. f1m is used for
1284    the MAX and MIN intrinsics which can have an arbitrary number of
1285    arguments, f3ml is used for the MINLOC and MAXLOC intrinsics as
1286    these have special semantics.  */
1287
1288 typedef union
1289 {
1290   try (*f0)(void);
1291   try (*f1)(struct gfc_expr *);
1292   try (*f1m)(gfc_actual_arglist *);
1293   try (*f2)(struct gfc_expr *, struct gfc_expr *);
1294   try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1295   try (*f3ml)(gfc_actual_arglist *);
1296   try (*f3red)(gfc_actual_arglist *);
1297   try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1298             struct gfc_expr *);
1299   try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1300             struct gfc_expr *, struct gfc_expr *);
1301 }
1302 gfc_check_f;
1303
1304 /* Like gfc_check_f, these specify the type of the simplification
1305    function associated with an intrinsic. The fX are just like in
1306    gfc_check_f. cc is used for type conversion functions.  */
1307
1308 typedef union
1309 {
1310   struct gfc_expr *(*f0)(void);
1311   struct gfc_expr *(*f1)(struct gfc_expr *);
1312   struct gfc_expr *(*f2)(struct gfc_expr *, struct gfc_expr *);
1313   struct gfc_expr *(*f3)(struct gfc_expr *, struct gfc_expr *,
1314                          struct gfc_expr *);
1315   struct gfc_expr *(*f4)(struct gfc_expr *, struct gfc_expr *,
1316                          struct gfc_expr *, struct gfc_expr *);
1317   struct gfc_expr *(*f5)(struct gfc_expr *, struct gfc_expr *,
1318                          struct gfc_expr *, struct gfc_expr *,
1319                          struct gfc_expr *);
1320   struct gfc_expr *(*cc)(struct gfc_expr *, bt, int);
1321 }
1322 gfc_simplify_f;
1323
1324 /* Again like gfc_check_f, these specify the type of the resolution
1325    function associated with an intrinsic. The fX are just like in
1326    gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort().  */
1327
1328 typedef union
1329 {
1330   void (*f0)(struct gfc_expr *);
1331   void (*f1)(struct gfc_expr *, struct gfc_expr *);
1332   void (*f1m)(struct gfc_expr *, struct gfc_actual_arglist *);
1333   void (*f2)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1334   void (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1335              struct gfc_expr *);
1336   void (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1337              struct gfc_expr *, struct gfc_expr *);
1338   void (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1339              struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1340   void (*s1)(struct gfc_code *);
1341 }
1342 gfc_resolve_f;
1343
1344
1345 typedef struct gfc_intrinsic_sym
1346 {
1347   const char *name, *lib_name;
1348   gfc_intrinsic_arg *formal;
1349   gfc_typespec ts;
1350   unsigned elemental:1, inquiry:1, transformational:1, pure:1, 
1351     generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1;
1352
1353   int standard;
1354
1355   gfc_simplify_f simplify;
1356   gfc_check_f check;
1357   gfc_resolve_f resolve;
1358   struct gfc_intrinsic_sym *specific_head, *next;
1359   gfc_isym_id id;
1360
1361 }
1362 gfc_intrinsic_sym;
1363
1364
1365 /* Expression nodes.  The expression node types deserve explanations,
1366    since the last couple can be easily misconstrued:
1367
1368    EXPR_OP         Operator node pointing to one or two other nodes
1369    EXPR_FUNCTION   Function call, symbol points to function's name
1370    EXPR_CONSTANT   A scalar constant: Logical, String, Real, Int or Complex
1371    EXPR_VARIABLE   An Lvalue with a root symbol and possible reference list
1372                    which expresses structure, array and substring refs.
1373    EXPR_NULL       The NULL pointer value (which also has a basic type).
1374    EXPR_SUBSTRING  A substring of a constant string
1375    EXPR_STRUCTURE  A structure constructor
1376    EXPR_ARRAY      An array constructor.  */
1377
1378 #include <gmp.h>
1379 #include <mpfr.h>
1380 #define GFC_RND_MODE GMP_RNDN
1381
1382 typedef struct gfc_expr
1383 {
1384   expr_t expr_type;
1385
1386   gfc_typespec ts;      /* These two refer to the overall expression */
1387
1388   int rank;
1389   mpz_t *shape;         /* Can be NULL if shape is unknown at compile time */
1390
1391   /* Nonnull for functions and structure constructors */
1392   gfc_symtree *symtree;
1393
1394   gfc_ref *ref;
1395
1396   locus where;
1397
1398   /* True if the expression is a call to a function that returns an array,
1399      and if we have decided not to allocate temporary data for that array.  */
1400   unsigned int inline_noncopying_intrinsic : 1;
1401
1402   /* Used to quickly find a given constructor by its offset.  */
1403   splay_tree con_by_offset;
1404
1405   /* If an expression comes from a Hollerith constant or compile-time
1406      evaluation of a transfer statement, it may have a prescribed target-
1407      memory representation, and these cannot always be backformed from
1408      the value.  */
1409   struct
1410   {
1411     int length;
1412     char *string;
1413   }
1414   representation;
1415
1416   union
1417   {
1418     int logical;
1419
1420     mpz_t integer;
1421
1422     mpfr_t real;
1423
1424     struct
1425     {
1426       mpfr_t r, i;
1427     }
1428     complex;
1429
1430     struct
1431     {
1432       gfc_intrinsic_op operator;
1433       gfc_user_op *uop;
1434       struct gfc_expr *op1, *op2;
1435     }
1436     op;
1437
1438     struct
1439     {
1440       gfc_actual_arglist *actual;
1441       const char *name; /* Points to the ultimate name of the function */
1442       gfc_intrinsic_sym *isym;
1443       gfc_symbol *esym;
1444     }
1445     function;
1446
1447     struct
1448     {
1449       int length;
1450       char *string;
1451     }
1452     character;
1453
1454     struct gfc_constructor *constructor;
1455   }
1456   value;
1457
1458 }
1459 gfc_expr;
1460
1461
1462 #define gfc_get_shape(rank) ((mpz_t *) gfc_getmem((rank)*sizeof(mpz_t)))
1463
1464 /* Structures for information associated with different kinds of
1465    numbers.  The first set of integer parameters define all there is
1466    to know about a particular kind.  The rest of the elements are
1467    computed from the first elements.  */
1468
1469 typedef struct
1470 {
1471   /* Values really representable by the target.  */
1472   mpz_t huge, pedantic_min_int, min_int;
1473
1474   int kind, radix, digits, bit_size, range;
1475
1476   /* True if the C type of the given name maps to this precision.
1477      Note that more than one bit can be set.  */
1478   unsigned int c_char : 1;
1479   unsigned int c_short : 1;
1480   unsigned int c_int : 1;
1481   unsigned int c_long : 1;
1482   unsigned int c_long_long : 1;
1483 }
1484 gfc_integer_info;
1485
1486 extern gfc_integer_info gfc_integer_kinds[];
1487
1488
1489 typedef struct
1490 {
1491   int kind, bit_size;
1492
1493   /* True if the C++ type bool, C99 type _Bool, maps to this precision.  */
1494   unsigned int c_bool : 1;
1495 }
1496 gfc_logical_info;
1497
1498 extern gfc_logical_info gfc_logical_kinds[];
1499
1500
1501 typedef struct
1502 {
1503   mpfr_t epsilon, huge, tiny, subnormal;
1504   int kind, radix, digits, min_exponent, max_exponent;
1505   int range, precision;
1506
1507   /* The precision of the type as reported by GET_MODE_PRECISION.  */
1508   int mode_precision;
1509
1510   /* True if the C type of the given name maps to this precision.
1511      Note that more than one bit can be set.  */
1512   unsigned int c_float : 1;
1513   unsigned int c_double : 1;
1514   unsigned int c_long_double : 1;
1515 }
1516 gfc_real_info;
1517
1518 extern gfc_real_info gfc_real_kinds[];
1519
1520
1521 /* Equivalence structures.  Equivalent lvalues are linked along the
1522    *eq pointer, equivalence sets are strung along the *next node.  */
1523 typedef struct gfc_equiv
1524 {
1525   struct gfc_equiv *next, *eq;
1526   gfc_expr *expr;
1527   const char *module;
1528   int used;
1529 }
1530 gfc_equiv;
1531
1532 #define gfc_get_equiv() gfc_getmem(sizeof(gfc_equiv))
1533
1534 /* Holds a single equivalence member after processing.  */
1535 typedef struct gfc_equiv_info
1536 {
1537   gfc_symbol *sym;
1538   HOST_WIDE_INT offset;
1539   HOST_WIDE_INT length;
1540   struct gfc_equiv_info *next;
1541 } gfc_equiv_info;
1542
1543 /* Holds equivalence groups, after they have been processed.  */
1544 typedef struct gfc_equiv_list
1545 {
1546   gfc_equiv_info *equiv;
1547   struct gfc_equiv_list *next;
1548 } gfc_equiv_list;
1549
1550 /* gfc_case stores the selector list of a case statement.  The *low
1551    and *high pointers can point to the same expression in the case of
1552    a single value.  If *high is NULL, the selection is from *low
1553    upwards, if *low is NULL the selection is *high downwards.
1554
1555    This structure has separate fields to allow single and double linked
1556    lists of CASEs at the same time.  The singe linked list along the NEXT
1557    field is a list of cases for a single CASE label.  The double linked
1558    list along the LEFT/RIGHT fields is used to detect overlap and to
1559    build a table of the cases for SELECT constructs with a CHARACTER
1560    case expression.  */
1561
1562 typedef struct gfc_case
1563 {
1564   /* Where we saw this case.  */
1565   locus where;
1566   int n;
1567
1568   /* Case range values.  If (low == high), it's a single value.  If one of
1569      the labels is NULL, it's an unbounded case.  If both are NULL, this
1570      represents the default case.  */
1571   gfc_expr *low, *high;
1572
1573   /* Next case label in the list of cases for a single CASE label.  */
1574   struct gfc_case *next;
1575
1576   /* Used for detecting overlap, and for code generation.  */
1577   struct gfc_case *left, *right;
1578
1579   /* True if this case label can never be matched.  */
1580   int unreachable;
1581 }
1582 gfc_case;
1583
1584 #define gfc_get_case() gfc_getmem(sizeof(gfc_case))
1585
1586
1587 typedef struct
1588 {
1589   gfc_expr *var, *start, *end, *step;
1590 }
1591 gfc_iterator;
1592
1593 #define gfc_get_iterator() gfc_getmem(sizeof(gfc_iterator))
1594
1595
1596 /* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements.  */
1597
1598 typedef struct gfc_alloc
1599 {
1600   gfc_expr *expr;
1601   struct gfc_alloc *next;
1602 }
1603 gfc_alloc;
1604
1605 #define gfc_get_alloc() gfc_getmem(sizeof(gfc_alloc))
1606
1607
1608 typedef struct
1609 {
1610   gfc_expr *unit, *file, *status, *access, *form, *recl,
1611     *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert;
1612   gfc_st_label *err;
1613 }
1614 gfc_open;
1615
1616
1617 typedef struct
1618 {
1619   gfc_expr *unit, *status, *iostat, *iomsg;
1620   gfc_st_label *err;
1621 }
1622 gfc_close;
1623
1624
1625 typedef struct
1626 {
1627   gfc_expr *unit, *iostat, *iomsg;
1628   gfc_st_label *err;
1629 }
1630 gfc_filepos;
1631
1632
1633 typedef struct
1634 {
1635   gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
1636     *name, *access, *sequential, *direct, *form, *formatted,
1637     *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
1638     *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos;
1639
1640   gfc_st_label *err;
1641
1642 }
1643 gfc_inquire;
1644
1645
1646 typedef struct
1647 {
1648   gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg;
1649
1650   gfc_symbol *namelist;
1651   /* A format_label of `format_asterisk' indicates the "*" format */
1652   gfc_st_label *format_label;
1653   gfc_st_label *err, *end, *eor;
1654
1655   locus eor_where, end_where, err_where;
1656 }
1657 gfc_dt;
1658
1659
1660 typedef struct gfc_forall_iterator
1661 {
1662   gfc_expr *var, *start, *end, *stride;
1663   struct gfc_forall_iterator *next;
1664 }
1665 gfc_forall_iterator;
1666
1667
1668 /* Executable statements that fill gfc_code structures.  */
1669 typedef enum
1670 {
1671   EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN,
1672   EXEC_GOTO, EXEC_CALL, EXEC_ASSIGN_CALL, EXEC_RETURN, EXEC_ENTRY,
1673   EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
1674   EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
1675   EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
1676   EXEC_ALLOCATE, EXEC_DEALLOCATE,
1677   EXEC_OPEN, EXEC_CLOSE,
1678   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
1679   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
1680   EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
1681   EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
1682   EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
1683   EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
1684   EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
1685   EXEC_OMP_END_SINGLE
1686 }
1687 gfc_exec_op;
1688
1689 typedef struct gfc_code
1690 {
1691   gfc_exec_op op;
1692
1693   struct gfc_code *block, *next;
1694   locus loc;
1695
1696   gfc_st_label *here, *label, *label2, *label3;
1697   gfc_symtree *symtree;
1698   gfc_expr *expr, *expr2;
1699   /* A name isn't sufficient to identify a subroutine, we need the actual
1700      symbol for the interface definition.
1701   const char *sub_name;  */
1702   gfc_symbol *resolved_sym;
1703
1704   union
1705   {
1706     gfc_actual_arglist *actual;
1707     gfc_case *case_list;
1708     gfc_iterator *iterator;
1709     gfc_alloc *alloc_list;
1710     gfc_open *open;
1711     gfc_close *close;
1712     gfc_filepos *filepos;
1713     gfc_inquire *inquire;
1714     gfc_dt *dt;
1715     gfc_forall_iterator *forall_iterator;
1716     struct gfc_code *whichloop;
1717     int stop_code;
1718     gfc_entry_list *entry;
1719     gfc_omp_clauses *omp_clauses;
1720     const char *omp_name;
1721     gfc_namelist *omp_namelist;
1722     bool omp_bool;
1723   }
1724   ext;          /* Points to additional structures required by statement */
1725
1726   /* Backend_decl is used for cycle and break labels in do loops, and
1727      probably for other constructs as well, once we translate them.  */
1728   tree backend_decl;
1729 }
1730 gfc_code;
1731
1732
1733 /* Storage for DATA statements.  */
1734 typedef struct gfc_data_variable
1735 {
1736   gfc_expr *expr;
1737   gfc_iterator iter;
1738   struct gfc_data_variable *list, *next;
1739 }
1740 gfc_data_variable;
1741
1742
1743 typedef struct gfc_data_value
1744 {
1745   unsigned int repeat;
1746   gfc_expr *expr;
1747   struct gfc_data_value *next;
1748 }
1749 gfc_data_value;
1750
1751
1752 typedef struct gfc_data
1753 {
1754   gfc_data_variable *var;
1755   gfc_data_value *value;
1756   locus where;
1757
1758   struct gfc_data *next;
1759 }
1760 gfc_data;
1761
1762 #define gfc_get_data_variable() gfc_getmem(sizeof(gfc_data_variable))
1763 #define gfc_get_data_value() gfc_getmem(sizeof(gfc_data_value))
1764 #define gfc_get_data() gfc_getmem(sizeof(gfc_data))
1765
1766
1767 /* Structure for holding compile options */
1768 typedef struct
1769 {
1770   char *module_dir;
1771   gfc_source_form source_form;
1772   /* Maximum line lengths in fixed- and free-form source, respectively.
1773      When fixed_line_length or free_line_length are 0, the whole line is used,
1774      regardless of length.
1775
1776      If the user requests a fixed_line_length <7 then gfc_init_options()
1777      emits a fatal error.  */
1778   int fixed_line_length;
1779   int free_line_length;
1780   /* Maximum number of continuation lines in fixed- and free-form source,
1781      respectively.  */
1782   int max_continue_fixed;
1783   int max_continue_free;
1784   int max_identifier_length;
1785   int verbose;
1786
1787   int warn_aliasing;
1788   int warn_ampersand;
1789   int warn_conversion;
1790   int warn_implicit_interface;
1791   int warn_line_truncation;
1792   int warn_surprising;
1793   int warn_tabs;
1794   int warn_underflow;
1795   int warn_character_truncation;
1796   int max_errors;
1797
1798   int flag_all_intrinsics;
1799   int flag_default_double;
1800   int flag_default_integer;
1801   int flag_default_real;
1802   int flag_dollar_ok;
1803   int flag_underscoring;
1804   int flag_second_underscore;
1805   int flag_implicit_none;
1806   int flag_max_stack_var_size;
1807   int flag_range_check;
1808   int flag_pack_derived;
1809   int flag_repack_arrays;
1810   int flag_preprocessed;
1811   int flag_f2c;
1812   int flag_automatic;
1813   int flag_backslash;
1814   int flag_backtrace;
1815   int flag_allow_leading_underscore;
1816   int flag_dump_core;
1817   int flag_external_blas;
1818   int blas_matmul_limit;
1819   int flag_cray_pointer;
1820   int flag_d_lines;
1821   int flag_openmp;
1822   int flag_sign_zero;
1823   int flag_module_private;
1824   int flag_recursive;
1825
1826   int fpe;
1827
1828   int warn_std;
1829   int allow_std;
1830   int warn_nonstd_intrinsics;
1831   int fshort_enums;
1832   int convert;
1833   int record_marker;
1834   int max_subrecord_length;
1835 }
1836 gfc_option_t;
1837
1838 extern gfc_option_t gfc_option;
1839
1840 /* Constructor nodes for array and structure constructors.  */
1841 typedef struct gfc_constructor
1842 {
1843   gfc_expr *expr;
1844   gfc_iterator *iterator;
1845   locus where;
1846   struct gfc_constructor *next;
1847   struct
1848   {
1849     mpz_t offset; /* Record the offset of array element which appears in
1850                      data statement like "data a(5)/4/".  */
1851     gfc_component *component; /* Record the component being initialized.  */
1852   }
1853   n;
1854   mpz_t repeat; /* Record the repeat number of initial values in data
1855                  statement like "data a/5*10/".  */
1856 }
1857 gfc_constructor;
1858
1859
1860 typedef struct iterator_stack
1861 {
1862   gfc_symtree *variable;
1863   mpz_t value;
1864   struct iterator_stack *prev;
1865 }
1866 iterator_stack;
1867 extern iterator_stack *iter_stack;
1868
1869 /************************ Function prototypes *************************/
1870
1871 /* data.c  */
1872 void gfc_formalize_init_value (gfc_symbol *);
1873 void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
1874 try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t);
1875 void gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t);
1876 void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
1877
1878 /* decl.c */
1879 bool gfc_in_match_data (void);
1880 void gfc_set_in_match_data (bool);
1881
1882 /* scanner.c */
1883 void gfc_scanner_done_1 (void);
1884 void gfc_scanner_init_1 (void);
1885
1886 void gfc_add_include_path (const char *, bool);
1887 void gfc_add_intrinsic_modules_path (const char *);
1888 void gfc_release_include_path (void);
1889 FILE *gfc_open_included_file (const char *, bool, bool);
1890 FILE *gfc_open_intrinsic_module (const char *);
1891
1892 int gfc_at_end (void);
1893 int gfc_at_eof (void);
1894 int gfc_at_bol (void);
1895 int gfc_at_eol (void);
1896 void gfc_advance_line (void);
1897 int gfc_check_include (void);
1898
1899 void gfc_skip_comments (void);
1900 int gfc_next_char_literal (int);
1901 int gfc_next_char (void);
1902 int gfc_peek_char (void);
1903 void gfc_error_recovery (void);
1904 void gfc_gobble_whitespace (void);
1905 try gfc_new_file (void);
1906 const char * gfc_read_orig_filename (const char *, const char **);
1907
1908 extern gfc_source_form gfc_current_form;
1909 extern const char *gfc_source_file;
1910 extern locus gfc_current_locus;
1911
1912 /* misc.c */
1913 void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
1914 void gfc_free (void *);
1915 int gfc_terminal_width (void);
1916 void gfc_clear_ts (gfc_typespec *);
1917 FILE *gfc_open_file (const char *);
1918 const char *gfc_basic_typename (bt);
1919 const char *gfc_typename (gfc_typespec *);
1920 const char *gfc_op2string (gfc_intrinsic_op);
1921 const char *gfc_code2string (const mstring *, int);
1922 int gfc_string2code (const mstring *, const char *);
1923 const char *gfc_intent_string (sym_intent);
1924
1925 void gfc_init_1 (void);
1926 void gfc_init_2 (void);
1927 void gfc_done_1 (void);
1928 void gfc_done_2 (void);
1929
1930 int get_c_kind (const char *, CInteropKind_t *);
1931
1932 /* options.c */
1933 unsigned int gfc_init_options (unsigned int, const char **);
1934 int gfc_handle_option (size_t, const char *, int);
1935 bool gfc_post_options (const char **);
1936
1937 /* iresolve.c */
1938 const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
1939
1940 /* error.c */
1941
1942 typedef struct gfc_error_buf
1943 {
1944   int flag;
1945   size_t allocated, index;
1946   char *message;
1947 } gfc_error_buf;
1948
1949 void gfc_error_init_1 (void);
1950 void gfc_buffer_error (int);
1951
1952 void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1953 void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1954 void gfc_clear_warning (void);
1955 void gfc_warning_check (void);
1956
1957 void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1958 void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1959 void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
1960 void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
1961 void gfc_clear_error (void);
1962 int gfc_error_check (void);
1963 int gfc_error_flag_test (void);
1964
1965 notification gfc_notification_std (int);
1966 try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
1967
1968 /* A general purpose syntax error.  */
1969 #define gfc_syntax_error(ST)    \
1970   gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
1971
1972 void gfc_push_error (gfc_error_buf *);
1973 void gfc_pop_error (gfc_error_buf *);
1974 void gfc_free_error (gfc_error_buf *);
1975
1976 void gfc_status (const char *, ...) ATTRIBUTE_PRINTF_1;
1977 void gfc_status_char (char);
1978
1979 void gfc_get_errors (int *, int *);
1980
1981 /* arith.c */
1982 void gfc_arith_init_1 (void);
1983 void gfc_arith_done_1 (void);
1984 gfc_expr *gfc_enum_initializer (gfc_expr *, locus);
1985 arith gfc_check_integer_range (mpz_t p, int kind);
1986
1987 /* trans-types.c */
1988 try gfc_validate_c_kind (gfc_typespec *);
1989 try gfc_check_any_c_kind (gfc_typespec *);
1990 int gfc_validate_kind (bt, int, bool);
1991 extern int gfc_index_integer_kind;
1992 extern int gfc_default_integer_kind;
1993 extern int gfc_max_integer_kind;
1994 extern int gfc_default_real_kind;
1995 extern int gfc_default_double_kind;
1996 extern int gfc_default_character_kind;
1997 extern int gfc_default_logical_kind;
1998 extern int gfc_default_complex_kind;
1999 extern int gfc_c_int_kind;
2000 extern int gfc_intio_kind;
2001 extern int gfc_charlen_int_kind;
2002 extern int gfc_numeric_storage_size;
2003 extern int gfc_character_storage_size;
2004
2005 /* symbol.c */
2006 void gfc_clear_new_implicit (void);
2007 try gfc_add_new_implicit_range (int, int);
2008 try gfc_merge_new_implicit (gfc_typespec *);
2009 void gfc_set_implicit_none (void);
2010 void gfc_check_function_type (gfc_namespace *);
2011 bool gfc_is_intrinsic_typename (const char *);
2012
2013 gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
2014 try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
2015
2016 void gfc_set_component_attr (gfc_component *, symbol_attribute *);
2017 void gfc_get_component_attr (symbol_attribute *, gfc_component *);
2018
2019 void gfc_set_sym_referenced (gfc_symbol *);
2020
2021 try gfc_add_attribute (symbol_attribute *, locus *);
2022 try gfc_add_allocatable (symbol_attribute *, locus *);
2023 try gfc_add_dimension (symbol_attribute *, const char *, locus *);
2024 try gfc_add_external (symbol_attribute *, locus *);
2025 try gfc_add_intrinsic (symbol_attribute *, locus *);
2026 try gfc_add_optional (symbol_attribute *, locus *);
2027 try gfc_add_pointer (symbol_attribute *, locus *);
2028 try gfc_add_cray_pointer (symbol_attribute *, locus *);
2029 try gfc_add_cray_pointee (symbol_attribute *, locus *);
2030 try gfc_mod_pointee_as (gfc_array_spec *);
2031 try gfc_add_protected (symbol_attribute *, const char *, locus *);
2032 try gfc_add_result (symbol_attribute *, const char *, locus *);
2033 try gfc_add_save (symbol_attribute *, const char *, locus *);
2034 try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
2035 try gfc_add_saved_common (symbol_attribute *, locus *);
2036 try gfc_add_target (symbol_attribute *, locus *);
2037 try gfc_add_dummy (symbol_attribute *, const char *, locus *);
2038 try gfc_add_generic (symbol_attribute *, const char *, locus *);
2039 try gfc_add_common (symbol_attribute *, locus *);
2040 try gfc_add_in_common (symbol_attribute *, const char *, locus *);
2041 try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
2042 try gfc_add_data (symbol_attribute *, const char *, locus *);
2043 try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
2044 try gfc_add_sequence (symbol_attribute *, const char *, locus *);
2045 try gfc_add_elemental (symbol_attribute *, locus *);
2046 try gfc_add_pure (symbol_attribute *, locus *);
2047 try gfc_add_recursive (symbol_attribute *, locus *);
2048 try gfc_add_function (symbol_attribute *, const char *, locus *);
2049 try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
2050 try gfc_add_volatile (symbol_attribute *, const char *, locus *);
2051 try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
2052
2053 try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
2054 try gfc_add_is_bind_c(symbol_attribute *, const char *, locus *, int);
2055 try gfc_add_value (symbol_attribute *, const char *, locus *);
2056 try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
2057 try gfc_add_entry (symbol_attribute *, const char *, locus *);
2058 try gfc_add_procedure (symbol_attribute *, procedure_type,
2059                        const char *, locus *);
2060 try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
2061 try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
2062                                 gfc_formal_arglist *, locus *);
2063 try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
2064
2065 void gfc_clear_attr (symbol_attribute *);
2066 try gfc_missing_attr (symbol_attribute *, locus *);
2067 try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
2068
2069 try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
2070 gfc_symbol *gfc_use_derived (gfc_symbol *);
2071 gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
2072 gfc_component *gfc_find_component (gfc_symbol *, const char *);
2073
2074 gfc_st_label *gfc_get_st_label (int);
2075 void gfc_free_st_label (gfc_st_label *);
2076 void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
2077 try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
2078
2079 gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
2080
2081 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
2082 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
2083 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
2084 gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
2085 gfc_user_op *gfc_get_uop (const char *);
2086 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
2087 void gfc_free_symbol (gfc_symbol *);
2088 gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
2089 int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
2090 int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
2091 int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
2092 try verify_c_interop (gfc_typespec *, const char *name, locus *where);
2093 try verify_c_interop_param (gfc_symbol *);
2094 try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
2095 try verify_bind_c_derived_type (gfc_symbol *);
2096 try verify_com_block_vars_c_interop (gfc_common_head *);
2097 void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *);
2098 gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int);
2099 int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **);
2100 int gfc_get_ha_symbol (const char *, gfc_symbol **);
2101 int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
2102
2103 int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
2104
2105 void gfc_undo_symbols (void);
2106 void gfc_commit_symbols (void);
2107 void gfc_commit_symbol (gfc_symbol *);
2108 void gfc_free_namespace (gfc_namespace *);
2109
2110 void gfc_symbol_init_2 (void);
2111 void gfc_symbol_done_2 (void);
2112
2113 void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
2114 void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
2115 void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
2116 void gfc_save_all (gfc_namespace *);
2117
2118 void gfc_symbol_state (void);
2119
2120 gfc_gsymbol *gfc_get_gsymbol (const char *);
2121 gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
2122
2123 void copy_formal_args (gfc_symbol *dest, gfc_symbol *src);
2124
2125 /* intrinsic.c */
2126 extern int gfc_init_expr;
2127
2128 /* Given a symbol that we have decided is intrinsic, mark it as such
2129    by placing it into a special module that is otherwise impossible to
2130    read or write.  */
2131
2132 #define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
2133
2134 void gfc_intrinsic_init_1 (void);
2135 void gfc_intrinsic_done_1 (void);
2136
2137 char gfc_type_letter (bt);
2138 gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
2139 try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
2140 try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
2141 int gfc_generic_intrinsic (const char *);
2142 int gfc_specific_intrinsic (const char *);
2143 int gfc_intrinsic_name (const char *, int);
2144 int gfc_intrinsic_actual_ok (const char *, const bool);
2145 gfc_intrinsic_sym *gfc_find_function (const char *);
2146 gfc_intrinsic_sym *gfc_find_subroutine (const char *);
2147
2148 match gfc_intrinsic_func_interface (gfc_expr *, int);
2149 match gfc_intrinsic_sub_interface (gfc_code *, int);
2150
2151 /* match.c -- FIXME */
2152 void gfc_free_iterator (gfc_iterator *, int);
2153 void gfc_free_forall_iterator (gfc_forall_iterator *);
2154 void gfc_free_alloc_list (gfc_alloc *);
2155 void gfc_free_namelist (gfc_namelist *);
2156 void gfc_free_equiv (gfc_equiv *);
2157 void gfc_free_data (gfc_data *);
2158 void gfc_free_case_list (gfc_case *);
2159
2160 /* matchexp.c -- FIXME too?  */
2161 gfc_expr *gfc_get_parentheses (gfc_expr *);
2162
2163 /* openmp.c */
2164 void gfc_free_omp_clauses (gfc_omp_clauses *);
2165 void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
2166 void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *);
2167 void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
2168 void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
2169
2170 /* expr.c */
2171 void gfc_free_actual_arglist (gfc_actual_arglist *);
2172 gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
2173 const char *gfc_extract_int (gfc_expr *, int *);
2174 gfc_expr *gfc_expr_to_initialize (gfc_expr *);
2175
2176 gfc_expr *gfc_build_conversion (gfc_expr *);
2177 void gfc_free_ref_list (gfc_ref *);
2178 void gfc_type_convert_binary (gfc_expr *);
2179 int gfc_is_constant_expr (gfc_expr *);
2180 try gfc_simplify_expr (gfc_expr *, int);
2181 int gfc_has_vector_index (gfc_expr *);
2182
2183 gfc_expr *gfc_get_expr (void);
2184 void gfc_free_expr (gfc_expr *);
2185 void gfc_replace_expr (gfc_expr *, gfc_expr *);
2186 gfc_expr *gfc_int_expr (int);
2187 gfc_expr *gfc_logical_expr (int, locus *);
2188 mpz_t *gfc_copy_shape (mpz_t *, int);
2189 mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
2190 gfc_expr *gfc_copy_expr (gfc_expr *);
2191
2192 try gfc_specification_expr (gfc_expr *);
2193
2194 int gfc_numeric_ts (gfc_typespec *);
2195 int gfc_kind_max (gfc_expr *, gfc_expr *);
2196
2197 try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *);
2198 try gfc_check_assign (gfc_expr *, gfc_expr *, int);
2199 try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
2200 try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
2201
2202 gfc_expr *gfc_default_initializer (gfc_typespec *);
2203 gfc_expr *gfc_get_variable_expr (gfc_symtree *);
2204
2205 void gfc_expr_set_symbols_referenced (gfc_expr *);
2206
2207 /* st.c */
2208 extern gfc_code new_st;
2209
2210 void gfc_clear_new_st (void);
2211 gfc_code *gfc_get_code (void);
2212 gfc_code *gfc_append_code (gfc_code *, gfc_code *);
2213 void gfc_free_statement (gfc_code *);
2214 void gfc_free_statements (gfc_code *);
2215
2216 /* resolve.c */
2217 try gfc_resolve_expr (gfc_expr *);
2218 void gfc_resolve (gfc_namespace *);
2219 void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
2220 int gfc_impure_variable (gfc_symbol *);
2221 int gfc_pure (gfc_symbol *);
2222 int gfc_elemental (gfc_symbol *);
2223 try gfc_resolve_iterator (gfc_iterator *, bool);
2224 try gfc_resolve_index (gfc_expr *, int);
2225 try gfc_resolve_dim_arg (gfc_expr *);
2226 int gfc_is_formal_arg (void);
2227 void gfc_resolve_substring_charlen (gfc_expr *);
2228 match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
2229
2230
2231 /* array.c */
2232 void gfc_free_array_spec (gfc_array_spec *);
2233 gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
2234
2235 try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
2236 gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
2237 try gfc_resolve_array_spec (gfc_array_spec *, int);
2238
2239 int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
2240
2241 gfc_expr *gfc_start_constructor (bt, int, locus *);
2242 void gfc_append_constructor (gfc_expr *, gfc_expr *);
2243 void gfc_free_constructor (gfc_constructor *);
2244 void gfc_simplify_iterator_var (gfc_expr *);
2245 try gfc_expand_constructor (gfc_expr *);
2246 int gfc_constant_ac (gfc_expr *);
2247 int gfc_expanded_ac (gfc_expr *);
2248 void gfc_resolve_character_array_constructor (gfc_expr *);
2249 try gfc_resolve_array_constructor (gfc_expr *);
2250 try gfc_check_constructor_type (gfc_expr *);
2251 try gfc_check_iter_variable (gfc_expr *);
2252 try gfc_check_constructor (gfc_expr *, try (*)(gfc_expr *));
2253 gfc_constructor *gfc_copy_constructor (gfc_constructor *);
2254 gfc_expr *gfc_get_array_element (gfc_expr *, int);
2255 try gfc_array_size (gfc_expr *, mpz_t *);
2256 try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
2257 try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
2258 gfc_array_ref *gfc_find_array_ref (gfc_expr *);
2259 void gfc_insert_constructor (gfc_expr *, gfc_constructor *);
2260 gfc_constructor *gfc_get_constructor (void);
2261 tree gfc_conv_array_initializer (tree type, gfc_expr *);
2262 try spec_size (gfc_array_spec *, mpz_t *);
2263 try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
2264 int gfc_is_compile_time_shape (gfc_array_spec *);
2265
2266 /* interface.c -- FIXME: some of these should be in symbol.c */
2267 void gfc_free_interface (gfc_interface *);
2268 int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
2269 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
2270 void gfc_check_interfaces (gfc_namespace *);
2271 void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
2272 gfc_symbol *gfc_search_interface (gfc_interface *, int,
2273                                   gfc_actual_arglist **);
2274 try gfc_extend_expr (gfc_expr *);
2275 void gfc_free_formal_arglist (gfc_formal_arglist *);
2276 try gfc_extend_assign (gfc_code *, gfc_namespace *);
2277 try gfc_add_interface (gfc_symbol *);
2278
2279 /* io.c */
2280 extern gfc_st_label format_asterisk;
2281
2282 void gfc_free_open (gfc_open *);
2283 try gfc_resolve_open (gfc_open *);
2284 void gfc_free_close (gfc_close *);
2285 try gfc_resolve_close (gfc_close *);
2286 void gfc_free_filepos (gfc_filepos *);
2287 try gfc_resolve_filepos (gfc_filepos *);
2288 void gfc_free_inquire (gfc_inquire *);
2289 try gfc_resolve_inquire (gfc_inquire *);
2290 void gfc_free_dt (gfc_dt *);
2291 try gfc_resolve_dt (gfc_dt *);
2292
2293 /* module.c */
2294 void gfc_module_init_2 (void);
2295 void gfc_module_done_2 (void);
2296 void gfc_dump_module (const char *, int);
2297 bool gfc_check_access (gfc_access, gfc_access);
2298
2299 /* primary.c */
2300 symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
2301 symbol_attribute gfc_expr_attr (gfc_expr *);
2302 match gfc_match_rvalue (gfc_expr **);
2303
2304 /* trans.c */
2305 void gfc_generate_code (gfc_namespace *);
2306 void gfc_generate_module_code (gfc_namespace *);
2307
2308 /* bbt.c */
2309 typedef int (*compare_fn) (void *, void *);
2310 void gfc_insert_bbt (void *, void *, compare_fn);
2311 void gfc_delete_bbt (void *, void *, compare_fn);
2312
2313 /* dump-parse-tree.c */
2314 void gfc_show_actual_arglist (gfc_actual_arglist *);
2315 void gfc_show_array_ref (gfc_array_ref *);
2316 void gfc_show_array_spec (gfc_array_spec *);
2317 void gfc_show_attr (symbol_attribute *);
2318 void gfc_show_code (int, gfc_code *);
2319 void gfc_show_components (gfc_symbol *);
2320 void gfc_show_constructor (gfc_constructor *);
2321 void gfc_show_equiv (gfc_equiv *);
2322 void gfc_show_expr (gfc_expr *);
2323 void gfc_show_namelist (gfc_namelist *);
2324 void gfc_show_namespace (gfc_namespace *);
2325 void gfc_show_ref (gfc_ref *);
2326 void gfc_show_symbol (gfc_symbol *);
2327 void gfc_show_typespec (gfc_typespec *);
2328
2329 /* parse.c */
2330 try gfc_parse_file (void);
2331 void global_used (gfc_gsymbol *, locus *);
2332
2333 /* dependency.c */
2334 int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
2335
2336 #endif /* GCC_GFORTRAN_H  */