OSDN Git Service

fortran/
[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, volatile_: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
1228 typedef struct gfc_expr
1229 {
1230   expr_t expr_type;
1231
1232   gfc_typespec ts;      /* These two refer to the overall expression */
1233
1234   int rank;
1235   mpz_t *shape;         /* Can be NULL if shape is unknown at compile time */
1236
1237   /* Nonnull for functions and structure constructors */
1238   gfc_symtree *symtree;
1239
1240   gfc_ref *ref;
1241
1242   locus where;
1243
1244   /* True if it is converted from Hollerith constant.  */
1245   unsigned int from_H : 1;
1246   /* True if the expression is a call to a function that returns an array,
1247      and if we have decided not to allocate temporary data for that array.  */
1248   unsigned int inline_noncopying_intrinsic : 1;
1249
1250   union
1251   {
1252     int logical;
1253     mpz_t integer;
1254
1255     mpfr_t real;
1256
1257     struct
1258     {
1259       mpfr_t r, i;
1260     }
1261     complex;
1262
1263     struct
1264     {
1265       gfc_intrinsic_op operator;
1266       gfc_user_op *uop;
1267       struct gfc_expr *op1, *op2;
1268     }
1269     op;
1270
1271     struct
1272     {
1273       gfc_actual_arglist *actual;
1274       const char *name; /* Points to the ultimate name of the function */
1275       gfc_intrinsic_sym *isym;
1276       gfc_symbol *esym;
1277     }
1278     function;
1279
1280     struct
1281     {
1282       int length;
1283       char *string;
1284     }
1285     character;
1286
1287     struct gfc_constructor *constructor;
1288   }
1289   value;
1290
1291 }
1292 gfc_expr;
1293
1294
1295 #define gfc_get_shape(rank) ((mpz_t *) gfc_getmem((rank)*sizeof(mpz_t)))
1296
1297 /* Structures for information associated with different kinds of
1298    numbers.  The first set of integer parameters define all there is
1299    to know about a particular kind.  The rest of the elements are
1300    computed from the first elements.  */
1301
1302 typedef struct
1303 {
1304   /* Values really representable by the target.  */
1305   mpz_t huge, pedantic_min_int, min_int;
1306
1307   int kind, radix, digits, bit_size, range;
1308
1309   /* True if the C type of the given name maps to this precision.
1310      Note that more than one bit can be set.  */
1311   unsigned int c_char : 1;
1312   unsigned int c_short : 1;
1313   unsigned int c_int : 1;
1314   unsigned int c_long : 1;
1315   unsigned int c_long_long : 1;
1316 }
1317 gfc_integer_info;
1318
1319 extern gfc_integer_info gfc_integer_kinds[];
1320
1321
1322 typedef struct
1323 {
1324   int kind, bit_size;
1325
1326   /* True if the C++ type bool, C99 type _Bool, maps to this precision.  */
1327   unsigned int c_bool : 1;
1328 }
1329 gfc_logical_info;
1330
1331 extern gfc_logical_info gfc_logical_kinds[];
1332
1333
1334 typedef struct
1335 {
1336   mpfr_t epsilon, huge, tiny, subnormal;
1337   int kind, radix, digits, min_exponent, max_exponent;
1338   int range, precision;
1339
1340   /* The precision of the type as reported by GET_MODE_PRECISION.  */
1341   int mode_precision;
1342
1343   /* True if the C type of the given name maps to this precision.
1344      Note that more than one bit can be set.  */
1345   unsigned int c_float : 1;
1346   unsigned int c_double : 1;
1347   unsigned int c_long_double : 1;
1348 }
1349 gfc_real_info;
1350
1351 extern gfc_real_info gfc_real_kinds[];
1352
1353
1354 /* Equivalence structures.  Equivalent lvalues are linked along the
1355    *eq pointer, equivalence sets are strung along the *next node.  */
1356 typedef struct gfc_equiv
1357 {
1358   struct gfc_equiv *next, *eq;
1359   gfc_expr *expr;
1360   const char *module;
1361   int used;
1362 }
1363 gfc_equiv;
1364
1365 #define gfc_get_equiv() gfc_getmem(sizeof(gfc_equiv))
1366
1367 /* Holds a single equivalence member after processing.  */
1368 typedef struct gfc_equiv_info
1369 {
1370   gfc_symbol *sym;
1371   HOST_WIDE_INT offset;
1372   HOST_WIDE_INT length;
1373   struct gfc_equiv_info *next;
1374 } gfc_equiv_info;
1375
1376 /* Holds equivalence groups, after they have been processed.  */
1377 typedef struct gfc_equiv_list
1378 {
1379   gfc_equiv_info *equiv;
1380   struct gfc_equiv_list *next;
1381 } gfc_equiv_list;
1382
1383 /* gfc_case stores the selector list of a case statement.  The *low
1384    and *high pointers can point to the same expression in the case of
1385    a single value.  If *high is NULL, the selection is from *low
1386    upwards, if *low is NULL the selection is *high downwards.
1387
1388    This structure has separate fields to allow single and double linked
1389    lists of CASEs at the same time.  The singe linked list along the NEXT
1390    field is a list of cases for a single CASE label.  The double linked
1391    list along the LEFT/RIGHT fields is used to detect overlap and to
1392    build a table of the cases for SELECT constructs with a CHARACTER
1393    case expression.  */
1394
1395 typedef struct gfc_case
1396 {
1397   /* Where we saw this case.  */
1398   locus where;
1399   int n;
1400
1401   /* Case range values.  If (low == high), it's a single value.  If one of
1402      the labels is NULL, it's an unbounded case.  If both are NULL, this
1403      represents the default case.  */
1404   gfc_expr *low, *high;
1405
1406   /* Next case label in the list of cases for a single CASE label.  */
1407   struct gfc_case *next;
1408
1409   /* Used for detecting overlap, and for code generation.  */
1410   struct gfc_case *left, *right;
1411
1412   /* True if this case label can never be matched.  */
1413   int unreachable;
1414 }
1415 gfc_case;
1416
1417 #define gfc_get_case() gfc_getmem(sizeof(gfc_case))
1418
1419
1420 typedef struct
1421 {
1422   gfc_expr *var, *start, *end, *step;
1423 }
1424 gfc_iterator;
1425
1426 #define gfc_get_iterator() gfc_getmem(sizeof(gfc_iterator))
1427
1428
1429 /* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements.  */
1430
1431 typedef struct gfc_alloc
1432 {
1433   gfc_expr *expr;
1434   struct gfc_alloc *next;
1435 }
1436 gfc_alloc;
1437
1438 #define gfc_get_alloc() gfc_getmem(sizeof(gfc_alloc))
1439
1440
1441 typedef struct
1442 {
1443   gfc_expr *unit, *file, *status, *access, *form, *recl,
1444     *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert;
1445   gfc_st_label *err;
1446 }
1447 gfc_open;
1448
1449
1450 typedef struct
1451 {
1452   gfc_expr *unit, *status, *iostat, *iomsg;
1453   gfc_st_label *err;
1454 }
1455 gfc_close;
1456
1457
1458 typedef struct
1459 {
1460   gfc_expr *unit, *iostat, *iomsg;
1461   gfc_st_label *err;
1462 }
1463 gfc_filepos;
1464
1465
1466 typedef struct
1467 {
1468   gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
1469     *name, *access, *sequential, *direct, *form, *formatted,
1470     *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
1471     *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos;
1472
1473   gfc_st_label *err;
1474
1475 }
1476 gfc_inquire;
1477
1478
1479 typedef struct
1480 {
1481   gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg;
1482
1483   gfc_symbol *namelist;
1484   /* A format_label of `format_asterisk' indicates the "*" format */
1485   gfc_st_label *format_label;
1486   gfc_st_label *err, *end, *eor;
1487
1488   locus eor_where, end_where, err_where;
1489 }
1490 gfc_dt;
1491
1492
1493 typedef struct gfc_forall_iterator
1494 {
1495   gfc_expr *var, *start, *end, *stride;
1496   struct gfc_forall_iterator *next;
1497 }
1498 gfc_forall_iterator;
1499
1500
1501 /* Executable statements that fill gfc_code structures.  */
1502 typedef enum
1503 {
1504   EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN,
1505   EXEC_GOTO, EXEC_CALL, EXEC_ASSIGN_CALL, EXEC_RETURN, EXEC_ENTRY,
1506   EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
1507   EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
1508   EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
1509   EXEC_ALLOCATE, EXEC_DEALLOCATE,
1510   EXEC_OPEN, EXEC_CLOSE,
1511   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
1512   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
1513   EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
1514   EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
1515   EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
1516   EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
1517   EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
1518   EXEC_OMP_END_SINGLE
1519 }
1520 gfc_exec_op;
1521
1522 typedef struct gfc_code
1523 {
1524   gfc_exec_op op;
1525
1526   struct gfc_code *block, *next;
1527   locus loc;
1528
1529   gfc_st_label *here, *label, *label2, *label3;
1530   gfc_symtree *symtree;
1531   gfc_expr *expr, *expr2;
1532   /* A name isn't sufficient to identify a subroutine, we need the actual
1533      symbol for the interface definition.
1534   const char *sub_name;  */
1535   gfc_symbol *resolved_sym;
1536
1537   union
1538   {
1539     gfc_actual_arglist *actual;
1540     gfc_case *case_list;
1541     gfc_iterator *iterator;
1542     gfc_alloc *alloc_list;
1543     gfc_open *open;
1544     gfc_close *close;
1545     gfc_filepos *filepos;
1546     gfc_inquire *inquire;
1547     gfc_dt *dt;
1548     gfc_forall_iterator *forall_iterator;
1549     struct gfc_code *whichloop;
1550     int stop_code;
1551     gfc_entry_list *entry;
1552     gfc_omp_clauses *omp_clauses;
1553     const char *omp_name;
1554     gfc_namelist *omp_namelist;
1555     bool omp_bool;
1556   }
1557   ext;          /* Points to additional structures required by statement */
1558
1559   /* Backend_decl is used for cycle and break labels in do loops, and
1560      probably for other constructs as well, once we translate them.  */
1561   tree backend_decl;
1562 }
1563 gfc_code;
1564
1565
1566 /* Storage for DATA statements.  */
1567 typedef struct gfc_data_variable
1568 {
1569   gfc_expr *expr;
1570   gfc_iterator iter;
1571   struct gfc_data_variable *list, *next;
1572 }
1573 gfc_data_variable;
1574
1575
1576 typedef struct gfc_data_value
1577 {
1578   unsigned int repeat;
1579   gfc_expr *expr;
1580   struct gfc_data_value *next;
1581 }
1582 gfc_data_value;
1583
1584
1585 typedef struct gfc_data
1586 {
1587   gfc_data_variable *var;
1588   gfc_data_value *value;
1589   locus where;
1590
1591   struct gfc_data *next;
1592 }
1593 gfc_data;
1594
1595 #define gfc_get_data_variable() gfc_getmem(sizeof(gfc_data_variable))
1596 #define gfc_get_data_value() gfc_getmem(sizeof(gfc_data_value))
1597 #define gfc_get_data() gfc_getmem(sizeof(gfc_data))
1598
1599
1600 /* Structure for holding compile options */
1601 typedef struct
1602 {
1603   char *module_dir;
1604   gfc_source_form source_form;
1605   /* When fixed_line_length or free_line_length are 0, the whole line is used.
1606
1607      Default is -1, the maximum line length mandated by the respective source
1608      form is used:
1609      for FORM_FREE GFC_MAX_LINE (132)
1610      else 72.
1611
1612      If fixed_line_length or free_line_length is not 0 nor -1 then the user has
1613      requested a specific line-length.
1614
1615      If the user requests a fixed_line_length <7 then gfc_init_options()
1616      emits a fatal error.  */
1617   int fixed_line_length; /* maximum line length in fixed-form.  */
1618   int free_line_length; /* maximum line length in free-form.  */
1619   int max_continue_fixed;
1620   int max_continue_free;
1621   int max_identifier_length;
1622   int verbose;
1623
1624   int warn_aliasing;
1625   int warn_ampersand;
1626   int warn_conversion;
1627   int warn_implicit_interface;
1628   int warn_line_truncation;
1629   int warn_surprising;
1630   int warn_tabs;
1631   int warn_underflow;
1632
1633   int flag_all_intrinsics;
1634   int flag_default_double;
1635   int flag_default_integer;
1636   int flag_default_real;
1637   int flag_dollar_ok;
1638   int flag_underscoring;
1639   int flag_second_underscore;
1640   int flag_implicit_none;
1641   int flag_max_stack_var_size;
1642   int flag_module_access_private;
1643   int flag_no_backend;
1644   int flag_range_check;
1645   int flag_pack_derived;
1646   int flag_repack_arrays;
1647   int flag_preprocessed;
1648   int flag_f2c;
1649   int flag_automatic;
1650   int flag_backslash;
1651   int flag_external_blas;
1652   int blas_matmul_limit;
1653   int flag_cray_pointer;
1654   int flag_d_lines;
1655   int flag_openmp;
1656
1657   int q_kind;
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 }
1668 gfc_option_t;
1669
1670 extern gfc_option_t gfc_option;
1671
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 *);
1716 void gfc_release_include_path (void);
1717 FILE *gfc_open_included_file (const char *, bool);
1718
1719 int gfc_at_end (void);
1720 int gfc_at_eof (void);
1721 int gfc_at_bol (void);
1722 int gfc_at_eol (void);
1723 void gfc_advance_line (void);
1724 int gfc_check_include (void);
1725
1726 void gfc_skip_comments (void);
1727 int gfc_next_char_literal (int);
1728 int gfc_next_char (void);
1729 int gfc_peek_char (void);
1730 void gfc_error_recovery (void);
1731 void gfc_gobble_whitespace (void);
1732 try gfc_new_file (void);
1733 const char * gfc_read_orig_filename (const char *, const char **);
1734
1735 extern gfc_source_form gfc_current_form;
1736 extern const char *gfc_source_file;
1737 extern locus gfc_current_locus;
1738
1739 /* misc.c */
1740 void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
1741 void gfc_free (void *);
1742 int gfc_terminal_width(void);
1743 void gfc_clear_ts (gfc_typespec *);
1744 FILE *gfc_open_file (const char *);
1745 const char *gfc_basic_typename (bt);
1746 const char *gfc_typename (gfc_typespec *);
1747
1748 #define gfc_op2string(OP) (OP == INTRINSIC_ASSIGN ? \
1749                            "=" : gfc_code2string (intrinsic_operators, OP))
1750
1751 const char *gfc_code2string (const mstring *, int);
1752 int gfc_string2code (const mstring *, const char *);
1753 const char *gfc_intent_string (sym_intent);
1754
1755 void gfc_init_1 (void);
1756 void gfc_init_2 (void);
1757 void gfc_done_1 (void);
1758 void gfc_done_2 (void);
1759
1760 /* options.c */
1761 unsigned int gfc_init_options (unsigned int, const char **);
1762 int gfc_handle_option (size_t, const char *, int);
1763 bool gfc_post_options (const char **);
1764
1765 /* iresolve.c */
1766 const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
1767
1768 /* error.c */
1769
1770 typedef struct gfc_error_buf
1771 {
1772   int flag;
1773   size_t allocated, index;
1774   char *message;
1775 } gfc_error_buf;
1776
1777 void gfc_error_init_1 (void);
1778 void gfc_buffer_error (int);
1779
1780 void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1781 void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1782 void gfc_clear_warning (void);
1783 void gfc_warning_check (void);
1784
1785 void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1786 void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1787 void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
1788 void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
1789 void gfc_clear_error (void);
1790 int gfc_error_check (void);
1791
1792 notification gfc_notification_std (int);
1793 try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
1794
1795 /* A general purpose syntax error.  */
1796 #define gfc_syntax_error(ST)    \
1797   gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
1798
1799 void gfc_push_error (gfc_error_buf *);
1800 void gfc_pop_error (gfc_error_buf *);
1801 void gfc_free_error (gfc_error_buf *);
1802
1803 void gfc_status (const char *, ...) ATTRIBUTE_PRINTF_1;
1804 void gfc_status_char (char);
1805
1806 void gfc_get_errors (int *, int *);
1807
1808 /* arith.c */
1809 void gfc_arith_init_1 (void);
1810 void gfc_arith_done_1 (void);
1811 gfc_expr *gfc_enum_initializer (gfc_expr *, locus);
1812 arith gfc_check_integer_range (mpz_t p, int kind);
1813
1814 /* trans-types.c */
1815 int gfc_validate_kind (bt, int, bool);
1816 extern int gfc_index_integer_kind;
1817 extern int gfc_default_integer_kind;
1818 extern int gfc_max_integer_kind;
1819 extern int gfc_default_real_kind;
1820 extern int gfc_default_double_kind;
1821 extern int gfc_default_character_kind;
1822 extern int gfc_default_logical_kind;
1823 extern int gfc_default_complex_kind;
1824 extern int gfc_c_int_kind;
1825 extern int gfc_intio_kind;
1826
1827 /* symbol.c */
1828 void gfc_clear_new_implicit (void);
1829 try gfc_add_new_implicit_range (int, int);
1830 try gfc_merge_new_implicit (gfc_typespec *);
1831 void gfc_set_implicit_none (void);
1832
1833 gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
1834 try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
1835
1836 void gfc_set_component_attr (gfc_component *, symbol_attribute *);
1837 void gfc_get_component_attr (symbol_attribute *, gfc_component *);
1838
1839 void gfc_set_sym_referenced (gfc_symbol * sym);
1840
1841 try gfc_add_attribute (symbol_attribute *, locus *, unsigned int);
1842 try gfc_add_allocatable (symbol_attribute *, locus *);
1843 try gfc_add_dimension (symbol_attribute *, const char *, locus *);
1844 try gfc_add_external (symbol_attribute *, locus *);
1845 try gfc_add_intrinsic (symbol_attribute *, locus *);
1846 try gfc_add_optional (symbol_attribute *, locus *);
1847 try gfc_add_pointer (symbol_attribute *, locus *);
1848 try gfc_add_cray_pointer (symbol_attribute *, locus *);
1849 try gfc_add_cray_pointee (symbol_attribute *, locus *);
1850 try gfc_mod_pointee_as (gfc_array_spec *as);
1851 try gfc_add_result (symbol_attribute *, const char *, locus *);
1852 try gfc_add_save (symbol_attribute *, const char *, locus *);
1853 try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
1854 try gfc_add_saved_common (symbol_attribute *, locus *);
1855 try gfc_add_target (symbol_attribute *, locus *);
1856 try gfc_add_dummy (symbol_attribute *, const char *, locus *);
1857 try gfc_add_generic (symbol_attribute *, const char *, locus *);
1858 try gfc_add_common (symbol_attribute *, locus *);
1859 try gfc_add_in_common (symbol_attribute *, const char *, locus *);
1860 try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
1861 try gfc_add_data (symbol_attribute *, const char *, locus *);
1862 try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
1863 try gfc_add_sequence (symbol_attribute *, const char *, locus *);
1864 try gfc_add_elemental (symbol_attribute *, locus *);
1865 try gfc_add_pure (symbol_attribute *, locus *);
1866 try gfc_add_recursive (symbol_attribute *, locus *);
1867 try gfc_add_function (symbol_attribute *, const char *, locus *);
1868 try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
1869 try gfc_add_volatile (symbol_attribute *, const char *, locus *);
1870
1871 try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
1872 try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
1873 try gfc_add_entry (symbol_attribute *, const char *, locus *);
1874 try gfc_add_procedure (symbol_attribute *, procedure_type,
1875                        const char *, locus *);
1876 try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
1877 try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
1878                                 gfc_formal_arglist *, locus *);
1879 try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
1880
1881 void gfc_clear_attr (symbol_attribute *);
1882 try gfc_missing_attr (symbol_attribute *, locus *);
1883 try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
1884
1885 try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
1886 gfc_symbol *gfc_use_derived (gfc_symbol *);
1887 gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
1888 gfc_component *gfc_find_component (gfc_symbol *, const char *);
1889
1890 gfc_st_label *gfc_get_st_label (int);
1891 void gfc_free_st_label (gfc_st_label *);
1892 void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
1893 try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
1894
1895 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
1896 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
1897 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
1898 gfc_user_op *gfc_get_uop (const char *);
1899 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
1900 void gfc_free_symbol (gfc_symbol *);
1901 gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
1902 int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
1903 int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
1904 int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
1905 int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **);
1906 int gfc_get_ha_symbol (const char *, gfc_symbol **);
1907 int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
1908
1909 int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
1910
1911 void gfc_undo_symbols (void);
1912 void gfc_commit_symbols (void);
1913 void gfc_commit_symbol (gfc_symbol * sym);
1914 void gfc_free_namespace (gfc_namespace *);
1915
1916 void gfc_symbol_init_2 (void);
1917 void gfc_symbol_done_2 (void);
1918
1919 void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
1920 void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
1921 void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
1922 void gfc_save_all (gfc_namespace *);
1923
1924 void gfc_symbol_state (void);
1925
1926 gfc_gsymbol *gfc_get_gsymbol (const char *);
1927 gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
1928
1929 /* intrinsic.c */
1930 extern int gfc_init_expr;
1931
1932 /* Given a symbol that we have decided is intrinsic, mark it as such
1933    by placing it into a special module that is otherwise impossible to
1934    read or write.  */
1935
1936 #define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
1937
1938 void gfc_intrinsic_init_1 (void);
1939 void gfc_intrinsic_done_1 (void);
1940
1941 char gfc_type_letter (bt);
1942 gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
1943 try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
1944 try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
1945 int gfc_generic_intrinsic (const char *);
1946 int gfc_specific_intrinsic (const char *);
1947 int gfc_intrinsic_name (const char *, int);
1948 int gfc_intrinsic_actual_ok (const char *, const bool);
1949 gfc_intrinsic_sym *gfc_find_function (const char *);
1950
1951 match gfc_intrinsic_func_interface (gfc_expr *, int);
1952 match gfc_intrinsic_sub_interface (gfc_code *, int);
1953
1954 /* simplify.c */
1955 void gfc_simplify_init_1 (void);
1956
1957 /* match.c -- FIXME */
1958 void gfc_free_iterator (gfc_iterator *, int);
1959 void gfc_free_forall_iterator (gfc_forall_iterator *);
1960 void gfc_free_alloc_list (gfc_alloc *);
1961 void gfc_free_namelist (gfc_namelist *);
1962 void gfc_free_equiv (gfc_equiv *);
1963 void gfc_free_data (gfc_data *);
1964 void gfc_free_case_list (gfc_case *);
1965
1966 /* matchexp.c -- FIXME too?  */
1967 gfc_expr *gfc_get_parentheses (gfc_expr *);
1968
1969 /* openmp.c */
1970 void gfc_free_omp_clauses (gfc_omp_clauses *);
1971 void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
1972 void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *);
1973 void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
1974 void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
1975
1976 /* expr.c */
1977 void gfc_free_actual_arglist (gfc_actual_arglist *);
1978 gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
1979 const char *gfc_extract_int (gfc_expr *, int *);
1980 gfc_expr *gfc_expr_to_initialize (gfc_expr *);
1981
1982 gfc_expr *gfc_build_conversion (gfc_expr *);
1983 void gfc_free_ref_list (gfc_ref *);
1984 void gfc_type_convert_binary (gfc_expr *);
1985 int gfc_is_constant_expr (gfc_expr *);
1986 try gfc_simplify_expr (gfc_expr *, int);
1987 int gfc_has_vector_index (gfc_expr *);
1988
1989 gfc_expr *gfc_get_expr (void);
1990 void gfc_free_expr (gfc_expr *);
1991 void gfc_replace_expr (gfc_expr *, gfc_expr *);
1992 gfc_expr *gfc_int_expr (int);
1993 gfc_expr *gfc_logical_expr (int, locus *);
1994 mpz_t *gfc_copy_shape (mpz_t *, int);
1995 mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
1996 gfc_expr *gfc_copy_expr (gfc_expr *);
1997
1998 try gfc_specification_expr (gfc_expr *);
1999
2000 int gfc_numeric_ts (gfc_typespec *);
2001 int gfc_kind_max (gfc_expr *, gfc_expr *);
2002
2003 try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *);
2004 try gfc_check_assign (gfc_expr *, gfc_expr *, int);
2005 try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
2006 try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
2007
2008 gfc_expr *gfc_default_initializer (gfc_typespec *);
2009 gfc_expr *gfc_get_variable_expr (gfc_symtree *);
2010
2011 void gfc_expr_set_symbols_referenced (gfc_expr * expr);
2012
2013 /* st.c */
2014 extern gfc_code new_st;
2015
2016 void gfc_clear_new_st (void);
2017 gfc_code *gfc_get_code (void);
2018 gfc_code *gfc_append_code (gfc_code *, gfc_code *);
2019 void gfc_free_statement (gfc_code *);
2020 void gfc_free_statements (gfc_code *);
2021
2022 /* resolve.c */
2023 try gfc_resolve_expr (gfc_expr *);
2024 void gfc_resolve (gfc_namespace *);
2025 void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
2026 int gfc_impure_variable (gfc_symbol *);
2027 int gfc_pure (gfc_symbol *);
2028 int gfc_elemental (gfc_symbol *);
2029 try gfc_resolve_iterator (gfc_iterator *, bool);
2030 try gfc_resolve_index (gfc_expr *, int);
2031 try gfc_resolve_dim_arg (gfc_expr *);
2032 int gfc_is_formal_arg (void);
2033
2034 /* array.c */
2035 void gfc_free_array_spec (gfc_array_spec *);
2036 gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
2037
2038 try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
2039 gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
2040 try gfc_resolve_array_spec (gfc_array_spec *, int);
2041
2042 int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
2043
2044 gfc_expr *gfc_start_constructor (bt, int, locus *);
2045 void gfc_append_constructor (gfc_expr *, gfc_expr *);
2046 void gfc_free_constructor (gfc_constructor *);
2047 void gfc_simplify_iterator_var (gfc_expr *);
2048 try gfc_expand_constructor (gfc_expr *);
2049 int gfc_constant_ac (gfc_expr *);
2050 int gfc_expanded_ac (gfc_expr *);
2051 void gfc_resolve_character_array_constructor (gfc_expr *);
2052 try gfc_resolve_array_constructor (gfc_expr *);
2053 try gfc_check_constructor_type (gfc_expr *);
2054 try gfc_check_iter_variable (gfc_expr *);
2055 try gfc_check_constructor (gfc_expr *, try (*)(gfc_expr *));
2056 gfc_constructor *gfc_copy_constructor (gfc_constructor * src);
2057 gfc_expr *gfc_get_array_element (gfc_expr *, int);
2058 try gfc_array_size (gfc_expr *, mpz_t *);
2059 try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
2060 try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
2061 gfc_array_ref *gfc_find_array_ref (gfc_expr *);
2062 void gfc_insert_constructor (gfc_expr *, gfc_constructor *);
2063 gfc_constructor *gfc_get_constructor (void);
2064 tree gfc_conv_array_initializer (tree type, gfc_expr * expr);
2065 try spec_size (gfc_array_spec *, mpz_t *);
2066 int gfc_is_compile_time_shape (gfc_array_spec *);
2067
2068 /* interface.c -- FIXME: some of these should be in symbol.c */
2069 void gfc_free_interface (gfc_interface *);
2070 int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
2071 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
2072 void gfc_check_interfaces (gfc_namespace *);
2073 void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
2074 gfc_symbol *gfc_search_interface (gfc_interface *, int,
2075                                   gfc_actual_arglist **);
2076 try gfc_extend_expr (gfc_expr *);
2077 void gfc_free_formal_arglist (gfc_formal_arglist *);
2078 try gfc_extend_assign (gfc_code *, gfc_namespace *);
2079 try gfc_add_interface (gfc_symbol * sym);
2080
2081 /* io.c */
2082 extern gfc_st_label format_asterisk;
2083
2084 void gfc_free_open (gfc_open *);
2085 try gfc_resolve_open (gfc_open *);
2086 void gfc_free_close (gfc_close *);
2087 try gfc_resolve_close (gfc_close *);
2088 void gfc_free_filepos (gfc_filepos *);
2089 try gfc_resolve_filepos (gfc_filepos *);
2090 void gfc_free_inquire (gfc_inquire *);
2091 try gfc_resolve_inquire (gfc_inquire *);
2092 void gfc_free_dt (gfc_dt *);
2093 try gfc_resolve_dt (gfc_dt *);
2094
2095 /* module.c */
2096 void gfc_module_init_2 (void);
2097 void gfc_module_done_2 (void);
2098 void gfc_dump_module (const char *, int);
2099 bool gfc_check_access (gfc_access, gfc_access);
2100
2101 /* primary.c */
2102 symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
2103 symbol_attribute gfc_expr_attr (gfc_expr *);
2104
2105 /* trans.c */
2106 void gfc_generate_code (gfc_namespace *);
2107 void gfc_generate_module_code (gfc_namespace *);
2108
2109 /* bbt.c */
2110 typedef int (*compare_fn) (void *, void *);
2111 void gfc_insert_bbt (void *, void *, compare_fn);
2112 void gfc_delete_bbt (void *, void *, compare_fn);
2113
2114 /* dump-parse-tree.c */
2115 void gfc_show_actual_arglist (gfc_actual_arglist *);
2116 void gfc_show_array_ref (gfc_array_ref *);
2117 void gfc_show_array_spec (gfc_array_spec *);
2118 void gfc_show_attr (symbol_attribute *);
2119 void gfc_show_code (int, gfc_code *);
2120 void gfc_show_components (gfc_symbol *);
2121 void gfc_show_constructor (gfc_constructor *);
2122 void gfc_show_equiv (gfc_equiv *);
2123 void gfc_show_expr (gfc_expr *);
2124 void gfc_show_namelist (gfc_namelist *);
2125 void gfc_show_namespace (gfc_namespace *);
2126 void gfc_show_ref (gfc_ref *);
2127 void gfc_show_symbol (gfc_symbol *);
2128 void gfc_show_typespec (gfc_typespec *);
2129
2130 /* parse.c */
2131 try gfc_parse_file (void);
2132 void global_used (gfc_gsymbol *, locus *);
2133
2134 /* dependency.c */
2135 int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
2136
2137 #endif /* GCC_GFORTRAN_H  */