OSDN Git Service

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