OSDN Git Service

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