OSDN Git Service

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