OSDN Git Service

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