OSDN Git Service

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