OSDN Git Service

PR libfortran/20006
[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
436   /* Set if this is the master function for a procedure with multiple
437      entry points.  */
438   unsigned entry_master:1;
439
440   /* Set if this is the master function for a function with multiple
441      entry points where characteristics of the entry points differ.  */
442   unsigned mixed_entry_master:1;
443
444   /* Set if a function must always be referenced by an explicit interface.  */
445   unsigned always_explicit:1;
446
447   /* Set if the symbol has been referenced in an expression.  No further
448      modification of type or type parameters is permitted.  */
449   unsigned referenced:1;
450
451   /* Set if the is the symbol for the main program.  This is the least
452      cumbersome way to communicate this function property without
453      strcmp'ing with __MAIN everywhere.  */
454   unsigned is_main_program:1;
455
456   /* Mutually exclusive multibit attributes.  */
457   ENUM_BITFIELD (gfc_access) access:2;
458   ENUM_BITFIELD (sym_intent) intent:2;
459   ENUM_BITFIELD (sym_flavor) flavor:4;
460   ENUM_BITFIELD (ifsrc) if_source:2;
461
462   ENUM_BITFIELD (procedure_type) proc:3;
463
464 }
465 symbol_attribute;
466
467
468 /* The following three structures are used to identify a location in
469    the sources. 
470    
471    gfc_file is used to maintain a tree of the source files and how
472    they include each other
473
474    gfc_linebuf holds a single line of source code and information
475    which file it resides in
476
477    locus point to the sourceline and the character in the source
478    line.  
479 */
480
481 typedef struct gfc_file 
482 {
483   struct gfc_file *included_by, *next, *up;
484   int inclusion_line, line;
485   char *filename;
486 } gfc_file;
487
488 typedef struct gfc_linebuf 
489 {
490 #ifdef USE_MAPPED_LOCATION
491   source_location location;
492 #else
493   int linenum;
494 #endif
495   struct gfc_file *file;
496   struct gfc_linebuf *next;
497
498   int truncated;
499
500   char line[1];
501 } gfc_linebuf;
502
503 #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
504
505 typedef struct 
506 {
507   char *nextc;
508   gfc_linebuf *lb;
509 } locus;
510
511 /* In order for the "gfc" format checking to work correctly, you must
512    have declared a typedef locus first.  */
513 #if GCC_VERSION >= 4001
514 #define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
515 #else
516 #define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
517 #endif
518
519
520 #include <limits.h>
521 #ifndef PATH_MAX
522 # include <sys/param.h>
523 # define PATH_MAX MAXPATHLEN
524 #endif
525
526
527 extern int gfc_suppress_error;
528
529
530 /* Character length structures hold the expression that gives the
531    length of a character variable.  We avoid putting these into
532    gfc_typespec because doing so prevents us from doing structure
533    copies and forces us to deallocate any typespecs we create, as well
534    as structures that contain typespecs.  They also can have multiple
535    character typespecs pointing to them.
536
537    These structures form a singly linked list within the current
538    namespace and are deallocated with the namespace.  It is possible to
539    end up with gfc_charlen structures that have nothing pointing to them.  */
540
541 typedef struct gfc_charlen
542 {
543   struct gfc_expr *length;
544   struct gfc_charlen *next;
545   tree backend_decl;
546 }
547 gfc_charlen;
548
549 #define gfc_get_charlen() gfc_getmem(sizeof(gfc_charlen))
550
551 /* Type specification structure.  FIXME: derived and cl could be union???  */
552 typedef struct
553 {
554   bt type;
555   int kind;
556   struct gfc_symbol *derived;
557   gfc_charlen *cl;      /* For character types only.  */
558 }
559 gfc_typespec;
560
561 /* Array specification.  */
562 typedef struct
563 {
564   int rank;     /* A rank of zero means that a variable is a scalar.  */
565   array_type type;
566   struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
567 }
568 gfc_array_spec;
569
570 #define gfc_get_array_spec() gfc_getmem(sizeof(gfc_array_spec))
571
572
573 /* Components of derived types.  */
574 typedef struct gfc_component
575 {
576   const char *name;
577   gfc_typespec ts;
578
579   int pointer, dimension;
580   gfc_array_spec *as;
581
582   tree backend_decl;
583   locus loc;
584   struct gfc_expr *initializer;
585   struct gfc_component *next;
586 }
587 gfc_component;
588
589 #define gfc_get_component() gfc_getmem(sizeof(gfc_component))
590
591 /* Formal argument lists are lists of symbols.  */
592 typedef struct gfc_formal_arglist
593 {
594   /* Symbol representing the argument at this position in the arglist.  */
595   struct gfc_symbol *sym;
596   /* Points to the next formal argument.  */
597   struct gfc_formal_arglist *next;
598 }
599 gfc_formal_arglist;
600
601 #define gfc_get_formal_arglist() gfc_getmem(sizeof(gfc_formal_arglist))
602
603
604 /* The gfc_actual_arglist structure is for actual arguments.  */
605 typedef struct gfc_actual_arglist
606 {
607   const char *name;
608   /* Alternate return label when the expr member is null.  */
609   struct gfc_st_label *label;
610
611   /* This is set to the type of an eventual omitted optional
612      argument. This is used to determine if a hidden string length
613      argument has to be added to a function call.  */
614   bt missing_arg_type;
615
616   struct gfc_expr *expr;
617   struct gfc_actual_arglist *next;
618 }
619 gfc_actual_arglist;
620
621 #define gfc_get_actual_arglist() gfc_getmem(sizeof(gfc_actual_arglist))
622
623
624 /* Because a symbol can belong to multiple namelists, they must be
625    linked externally to the symbol itself.  */
626 typedef struct gfc_namelist
627 {
628   struct gfc_symbol *sym;
629   struct gfc_namelist *next;
630 }
631 gfc_namelist;
632
633 #define gfc_get_namelist() gfc_getmem(sizeof(gfc_namelist))
634
635
636 /* The gfc_st_label structure is a doubly linked list attached to a
637    namespace that records the usage of statement labels within that
638    space.  */
639 /* TODO: Make format/statement specifics a union.  */
640 typedef struct gfc_st_label
641 {
642   int value;
643
644   gfc_sl_type defined, referenced;
645
646   struct gfc_expr *format;
647
648   tree backend_decl;
649
650   locus where;
651
652   struct gfc_st_label *prev, *next;
653 }
654 gfc_st_label;
655
656
657 /* gfc_interface()-- Interfaces are lists of symbols strung together.  */
658 typedef struct gfc_interface
659 {
660   struct gfc_symbol *sym;
661   locus where;
662   struct gfc_interface *next;
663 }
664 gfc_interface;
665
666 #define gfc_get_interface() gfc_getmem(sizeof(gfc_interface))
667
668
669 /* User operator nodes.  These are like stripped down symbols.  */
670 typedef struct
671 {
672   const char *name;
673
674   gfc_interface *operator;
675   struct gfc_namespace *ns;
676   gfc_access access;
677 }
678 gfc_user_op;
679
680 /* Symbol nodes.  These are important things.  They are what the
681    standard refers to as "entities".  The possibly multiple names that
682    refer to the same entity are accomplished by a binary tree of
683    symtree structures that is balanced by the red-black method-- more
684    than one symtree node can point to any given symbol.  */
685
686 typedef struct gfc_symbol
687 {
688   const char *name;     /* Primary name, before renaming */
689   const char *module;   /* Module this symbol came from */
690   locus declared_at;
691
692   gfc_typespec ts;
693   symbol_attribute attr;
694
695   /* The interface member points to the formal argument list if the
696      symbol is a function or subroutine name.  If the symbol is a
697      generic name, the generic member points to the list of
698      interfaces.  */
699
700   gfc_interface *generic;
701   gfc_access component_access;
702
703   gfc_formal_arglist *formal;
704   struct gfc_namespace *formal_ns;
705
706   struct gfc_expr *value;       /* Parameter/Initializer value */
707   gfc_array_spec *as;
708   struct gfc_symbol *result;    /* function result symbol */
709   gfc_component *components;    /* Derived type components */
710
711   struct gfc_symbol *common_next;       /* Links for COMMON syms */
712   /* Make sure setup code for dummy arguments is generated in the correct
713      order.  */
714   int dummy_order;
715
716   gfc_namelist *namelist, *namelist_tail;
717
718   /* Change management fields.  Symbols that might be modified by the
719      current statement have the mark member nonzero and are kept in a
720      singly linked list through the tlink field.  Of these symbols,
721      symbols with old_symbol equal to NULL are symbols created within
722      the current statement.  Otherwise, old_symbol points to a copy of
723      the old symbol.  */
724
725   struct gfc_symbol *old_symbol, *tlink;
726   unsigned mark:1, new:1;
727   /* Nonzero if all equivalences associated with this symbol have been
728      processed.  */
729   unsigned equiv_built:1;
730   int refs;
731   struct gfc_namespace *ns;     /* namespace containing this symbol */
732
733   tree backend_decl;
734 }
735 gfc_symbol;
736
737
738 /* This structure is used to keep track of symbols in common blocks.  */
739
740 typedef struct
741 {
742   locus where;
743   int use_assoc, saved;
744   char name[GFC_MAX_SYMBOL_LEN + 1];
745   gfc_symbol *head;
746
747 gfc_common_head;
748
749 #define gfc_get_common_head() gfc_getmem(sizeof(gfc_common_head))
750
751
752 /* A list of all the alternate entry points for a procedure.  */
753
754 typedef struct gfc_entry_list
755 {
756   /* The symbol for this entry point.  */
757   gfc_symbol *sym;
758   /* The zero-based id of this entry point.  */
759   int id;
760   /* The LABEL_EXPR marking this entry point.  */
761   tree label;
762   /* The nest item in the list.  */
763   struct gfc_entry_list *next;
764 }
765 gfc_entry_list;
766
767 #define gfc_get_entry_list() \
768   (gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))
769
770 /* Within a namespace, symbols are pointed to by symtree nodes that
771    are linked together in a balanced binary tree.  There can be
772    several symtrees pointing to the same symbol node via USE
773    statements.  */
774
775 #define BBT_HEADER(self) int priority; struct self *left, *right
776
777 typedef struct gfc_symtree
778 {
779   BBT_HEADER (gfc_symtree);
780   const char *name;
781   int ambiguous;
782   union
783   {
784     gfc_symbol *sym;            /* Symbol associated with this node */
785     gfc_user_op *uop;
786     gfc_common_head *common;
787   }
788   n;
789
790 }
791 gfc_symtree;
792
793
794 /* A namespace describes the contents of procedure, module or
795    interface block.  */
796 /* ??? Anything else use these?  */
797
798 typedef struct gfc_namespace
799 {
800   /* Tree containing all the symbols in this namespace.  */
801   gfc_symtree *sym_root;
802   /* Tree containing all the user-defined operators in the namespace.  */
803   gfc_symtree *uop_root;
804   /* Tree containing all the common blocks.  */
805   gfc_symtree *common_root;     
806
807   /* If set_flag[letter] is set, an implicit type has been set for letter.  */
808   int set_flag[GFC_LETTERS];
809   /* Keeps track of the implicit types associated with the letters.  */
810   gfc_typespec default_type[GFC_LETTERS];
811
812   /* If this is a namespace of a procedure, this points to the procedure.  */
813   struct gfc_symbol *proc_name;
814   /* If this is the namespace of a unit which contains executable
815      code, this points to it.  */
816   struct gfc_code *code;
817
818   /* Points to the equivalences set up in this namespace.  */
819   struct gfc_equiv *equiv;
820   gfc_interface *operator[GFC_INTRINSIC_OPS];
821
822   /* Points to the parent namespace, i.e. the namespace of a module or
823      procedure in which the procedure belonging to this namespace is
824      contained. The parent namespace points to this namespace either
825      directly via CONTAINED, or indirectly via the chain built by
826      SIBLING.  */
827   struct gfc_namespace *parent;
828   /* CONTAINED points to the first contained namespace. Sibling
829      namespaces are chained via SIBLING.  */
830   struct gfc_namespace  *contained, *sibling;
831
832   gfc_common_head blank_common;
833   gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];
834
835   gfc_st_label *st_labels;
836   /* This list holds information about all the data initializers in
837      this namespace.  */
838   struct gfc_data *data;
839
840   gfc_charlen *cl_list;
841
842   int save_all, seen_save, seen_implicit_none;
843
844   /* Normally we don't need to refcount namespaces.  However when we read
845      a module containing a function with multiple entry points, this
846      will appear as several functions with the same formal namespace.  */
847   int refs;
848
849   /* A list of all alternate entry points to this procedure (or NULL).  */
850   gfc_entry_list *entries;
851
852   /* Set to 1 if namespace is a BLOCK DATA program unit.  */
853   int is_block_data;
854 }
855 gfc_namespace;
856
857 extern gfc_namespace *gfc_current_ns;
858
859 /* Global symbols are symbols of global scope. Currently we only use
860    this to detect collisions already when parsing.
861    TODO: Extend to verify procedure calls.  */
862
863 typedef struct gfc_gsymbol
864 {
865   BBT_HEADER(gfc_gsymbol);
866
867   const char *name;
868   enum { GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
869         GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA } type;
870
871   int defined, used;
872   locus where;
873 }
874 gfc_gsymbol;
875
876 extern gfc_gsymbol *gfc_gsym_root;
877
878 /* Information on interfaces being built.  */
879 typedef struct
880 {
881   interface_type type;
882   gfc_symbol *sym;
883   gfc_namespace *ns;
884   gfc_user_op *uop;
885   gfc_intrinsic_op op;
886 }
887 gfc_interface_info;
888
889 extern gfc_interface_info current_interface;
890
891
892 /* Array reference.  */
893 typedef struct gfc_array_ref
894 {
895   ar_type type;
896   int dimen;                    /* # of components in the reference */
897   locus where;
898   gfc_array_spec *as;
899
900   locus c_where[GFC_MAX_DIMENSIONS];    /* All expressions can be NULL */
901   struct gfc_expr *start[GFC_MAX_DIMENSIONS], *end[GFC_MAX_DIMENSIONS],
902     *stride[GFC_MAX_DIMENSIONS];
903
904   enum
905   { DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_UNKNOWN }
906   dimen_type[GFC_MAX_DIMENSIONS];
907
908   struct gfc_expr *offset;
909 }
910 gfc_array_ref;
911
912 #define gfc_get_array_ref() gfc_getmem(sizeof(gfc_array_ref))
913
914
915 /* Component reference nodes.  A variable is stored as an expression
916    node that points to the base symbol.  After that, a singly linked
917    list of component reference nodes gives the variable's complete
918    resolution.  The array_ref component may be present and comes
919    before the component component.  */
920
921 typedef enum
922   { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING }
923 ref_type;
924
925 typedef struct gfc_ref
926 {
927   ref_type type;
928
929   union
930   {
931     struct gfc_array_ref ar;
932
933     struct
934     {
935       gfc_component *component;
936       gfc_symbol *sym;
937     }
938     c;
939
940     struct
941     {
942       struct gfc_expr *start, *end;     /* Substring */
943       gfc_charlen *length;
944     }
945     ss;
946
947   }
948   u;
949
950   struct gfc_ref *next;
951 }
952 gfc_ref;
953
954 #define gfc_get_ref() gfc_getmem(sizeof(gfc_ref))
955
956
957 /* Structures representing intrinsic symbols and their arguments lists.  */
958 typedef struct gfc_intrinsic_arg
959 {
960   char name[GFC_MAX_SYMBOL_LEN + 1];
961
962   gfc_typespec ts;
963   int optional;
964   gfc_actual_arglist *actual;
965
966   struct gfc_intrinsic_arg *next;
967
968 }
969 gfc_intrinsic_arg;
970
971
972 /* Specifies the various kinds of check functions used to verify the
973    argument lists of intrinsic functions. fX with X an integer refer
974    to check functions of intrinsics with X arguments. f1m is used for
975    the MAX and MIN intrinsics which can have an arbitrary number of
976    arguments, f3ml is used for the MINLOC and MAXLOC intrinsics as
977    these have special semantics.  */
978
979 typedef union
980 {
981   try (*f0)(void);
982   try (*f1)(struct gfc_expr *);
983   try (*f1m)(gfc_actual_arglist *);
984   try (*f2)(struct gfc_expr *, struct gfc_expr *);
985   try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
986   try (*f3ml)(gfc_actual_arglist *);
987   try (*f3red)(gfc_actual_arglist *);
988   try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
989             struct gfc_expr *);
990   try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
991             struct gfc_expr *, struct gfc_expr *);
992 }
993 gfc_check_f;
994
995 /* Like gfc_check_f, these specify the type of the simplification
996    function associated with an intrinsic. The fX are just like in
997    gfc_check_f. cc is used for type conversion functions.  */
998
999 typedef union
1000 {
1001   struct gfc_expr *(*f0)(void);
1002   struct gfc_expr *(*f1)(struct gfc_expr *);
1003   struct gfc_expr *(*f2)(struct gfc_expr *, struct gfc_expr *);
1004   struct gfc_expr *(*f3)(struct gfc_expr *, struct gfc_expr *,
1005                          struct gfc_expr *);
1006   struct gfc_expr *(*f4)(struct gfc_expr *, struct gfc_expr *,
1007                          struct gfc_expr *, struct gfc_expr *);
1008   struct gfc_expr *(*f5)(struct gfc_expr *, struct gfc_expr *,
1009                          struct gfc_expr *, struct gfc_expr *,
1010                          struct gfc_expr *);
1011   struct gfc_expr *(*cc)(struct gfc_expr *, bt, int);
1012 }
1013 gfc_simplify_f;
1014
1015 /* Again like gfc_check_f, these specify the type of the resolution
1016    function associated with an intrinsic. The fX are just like in
1017    gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort().
1018    */
1019
1020 typedef union
1021 {
1022   void (*f0)(struct gfc_expr *);
1023   void (*f1)(struct gfc_expr *, struct gfc_expr *);
1024   void (*f1m)(struct gfc_expr *, struct gfc_actual_arglist *);
1025   void (*f2)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1026   void (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1027              struct gfc_expr *);
1028   void (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1029              struct gfc_expr *, struct gfc_expr *);
1030   void (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1031              struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1032   void (*s1)(struct gfc_code *);
1033 }
1034 gfc_resolve_f;
1035
1036
1037 typedef struct gfc_intrinsic_sym
1038 {
1039   const char *name, *lib_name;
1040   gfc_intrinsic_arg *formal;
1041   gfc_typespec ts;
1042   int elemental, pure, generic, specific, actual_ok, standard;
1043
1044   gfc_simplify_f simplify;
1045   gfc_check_f check;
1046   gfc_resolve_f resolve;
1047   struct gfc_intrinsic_sym *specific_head, *next;
1048   gfc_generic_isym_id generic_id;
1049
1050 }
1051 gfc_intrinsic_sym;
1052
1053
1054 /* Expression nodes.  The expression node types deserve explanations,
1055    since the last couple can be easily misconstrued:
1056
1057    EXPR_OP         Operator node pointing to one or two other nodes
1058    EXPR_FUNCTION   Function call, symbol points to function's name
1059    EXPR_CONSTANT   A scalar constant: Logical, String, Real, Int or Complex
1060    EXPR_VARIABLE   An Lvalue with a root symbol and possible reference list
1061                    which expresses structure, array and substring refs.
1062    EXPR_NULL       The NULL pointer value (which also has a basic type).
1063    EXPR_SUBSTRING  A substring of a constant string
1064    EXPR_STRUCTURE  A structure constructor
1065    EXPR_ARRAY      An array constructor.  */
1066
1067 #include <gmp.h>
1068 #include <mpfr.h>
1069 #define GFC_RND_MODE GMP_RNDN
1070
1071 typedef struct gfc_expr
1072 {
1073   expr_t expr_type;
1074
1075   gfc_typespec ts;      /* These two refer to the overall expression */
1076
1077   int rank;
1078   mpz_t *shape;         /* Can be NULL if shape is unknown at compile time */
1079
1080   /* Nonnull for functions and structure constructors */
1081   gfc_symtree *symtree;
1082
1083   gfc_ref *ref;
1084
1085   locus where;
1086
1087   /* True if it is converted from Hollerith constant.  */
1088   unsigned int from_H : 1;
1089
1090   union
1091   {
1092     int logical;
1093     mpz_t integer;
1094
1095     mpfr_t real;
1096
1097     struct
1098     {
1099       mpfr_t r, i;
1100     }
1101     complex;
1102
1103     struct
1104     {
1105       gfc_intrinsic_op operator;
1106       gfc_user_op *uop;
1107       struct gfc_expr *op1, *op2;
1108     }
1109     op;
1110
1111     struct
1112     {
1113       gfc_actual_arglist *actual;
1114       const char *name; /* Points to the ultimate name of the function */
1115       gfc_intrinsic_sym *isym;
1116       gfc_symbol *esym;
1117     }
1118     function;
1119
1120     struct
1121     {
1122       int length;
1123       char *string;
1124     }
1125     character;
1126
1127     struct gfc_constructor *constructor;
1128   }
1129   value;
1130
1131 }
1132 gfc_expr;
1133
1134
1135 #define gfc_get_shape(rank) ((mpz_t *) gfc_getmem((rank)*sizeof(mpz_t)))
1136
1137 /* Structures for information associated with different kinds of
1138    numbers.  The first set of integer parameters define all there is
1139    to know about a particular kind.  The rest of the elements are
1140    computed from the first elements.  */
1141
1142 typedef struct
1143 {
1144   /* Values really representable by the target.  */
1145   mpz_t huge, pedantic_min_int, min_int, max_int;
1146
1147   int kind, radix, digits, bit_size, range;
1148
1149   /* True if the C type of the given name maps to this precision.
1150      Note that more than one bit can be set.  */
1151   unsigned int c_char : 1;
1152   unsigned int c_short : 1;
1153   unsigned int c_int : 1;
1154   unsigned int c_long : 1;
1155   unsigned int c_long_long : 1;
1156 }
1157 gfc_integer_info;
1158
1159 extern gfc_integer_info gfc_integer_kinds[];
1160
1161
1162 typedef struct
1163 {
1164   int kind, bit_size;
1165
1166   /* True if the C++ type bool, C99 type _Bool, maps to this precision.  */
1167   unsigned int c_bool : 1;
1168 }
1169 gfc_logical_info;
1170
1171 extern gfc_logical_info gfc_logical_kinds[];
1172
1173
1174 typedef struct
1175 {
1176   mpfr_t epsilon, huge, tiny, subnormal;
1177   int kind, radix, digits, min_exponent, max_exponent;
1178   int range, precision;
1179
1180   /* The precision of the type as reported by GET_MODE_PRECISION.  */
1181   int mode_precision;
1182
1183   /* True if the C type of the given name maps to this precision.
1184      Note that more than one bit can be set.  */
1185   unsigned int c_float : 1;
1186   unsigned int c_double : 1;
1187   unsigned int c_long_double : 1;
1188 }
1189 gfc_real_info;
1190
1191 extern gfc_real_info gfc_real_kinds[];
1192
1193
1194 /* Equivalence structures.  Equivalent lvalues are linked along the
1195    *eq pointer, equivalence sets are strung along the *next node.  */
1196 typedef struct gfc_equiv
1197 {
1198   struct gfc_equiv *next, *eq;
1199   gfc_expr *expr;
1200   int used;
1201 }
1202 gfc_equiv;
1203
1204 #define gfc_get_equiv() gfc_getmem(sizeof(gfc_equiv))
1205
1206
1207 /* gfc_case stores the selector list of a case statement.  The *low
1208    and *high pointers can point to the same expression in the case of
1209    a single value.  If *high is NULL, the selection is from *low
1210    upwards, if *low is NULL the selection is *high downwards.
1211
1212    This structure has separate fields to allow single and double linked
1213    lists of CASEs at the same time.  The singe linked list along the NEXT
1214    field is a list of cases for a single CASE label.  The double linked
1215    list along the LEFT/RIGHT fields is used to detect overlap and to
1216    build a table of the cases for SELECT constructs with a CHARACTER
1217    case expression.  */
1218
1219 typedef struct gfc_case
1220 {
1221   /* Where we saw this case.  */
1222   locus where;
1223   int n;
1224
1225   /* Case range values.  If (low == high), it's a single value.  If one of
1226      the labels is NULL, it's an unbounded case.  If both are NULL, this
1227      represents the default case.  */
1228   gfc_expr *low, *high;
1229
1230   /* Next case label in the list of cases for a single CASE label.  */
1231   struct gfc_case *next;
1232
1233   /* Used for detecting overlap, and for code generation.  */
1234   struct gfc_case *left, *right;
1235
1236   /* True if this case label can never be matched.  */
1237   int unreachable;
1238 }
1239 gfc_case;
1240
1241 #define gfc_get_case() gfc_getmem(sizeof(gfc_case))
1242
1243
1244 typedef struct
1245 {
1246   gfc_expr *var, *start, *end, *step;
1247 }
1248 gfc_iterator;
1249
1250 #define gfc_get_iterator() gfc_getmem(sizeof(gfc_iterator))
1251
1252
1253 /* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements.  */
1254
1255 typedef struct gfc_alloc
1256 {
1257   gfc_expr *expr;
1258   struct gfc_alloc *next;
1259 }
1260 gfc_alloc;
1261
1262 #define gfc_get_alloc() gfc_getmem(sizeof(gfc_alloc))
1263
1264
1265 typedef struct
1266 {
1267   gfc_expr *unit, *file, *status, *access, *form, *recl,
1268     *blank, *position, *action, *delim, *pad, *iostat;
1269   gfc_st_label *err;
1270 }
1271 gfc_open;
1272
1273
1274 typedef struct
1275 {
1276   gfc_expr *unit, *status, *iostat;
1277   gfc_st_label *err;
1278 }
1279 gfc_close;
1280
1281
1282 typedef struct
1283 {
1284   gfc_expr *unit, *iostat;
1285   gfc_st_label *err;
1286 }
1287 gfc_filepos;
1288
1289
1290 typedef struct
1291 {
1292   gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
1293     *name, *access, *sequential, *direct, *form, *formatted,
1294     *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
1295     *write, *readwrite, *delim, *pad, *iolength;
1296
1297   gfc_st_label *err;
1298
1299 }
1300 gfc_inquire;
1301
1302
1303 typedef struct
1304 {
1305   gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size;
1306
1307   gfc_symbol *namelist;
1308   /* A format_label of `format_asterisk' indicates the "*" format */
1309   gfc_st_label *format_label;
1310   gfc_st_label *err, *end, *eor;
1311
1312   locus eor_where, end_where;
1313 }
1314 gfc_dt;
1315
1316
1317 typedef struct gfc_forall_iterator
1318 {
1319   gfc_expr *var, *start, *end, *stride;
1320   struct gfc_forall_iterator *next;
1321 }
1322 gfc_forall_iterator;
1323
1324
1325 /* Executable statements that fill gfc_code structures.  */
1326 typedef enum
1327 {
1328   EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN,
1329   EXEC_GOTO, EXEC_CALL, EXEC_RETURN, EXEC_ENTRY,
1330   EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE,
1331   EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
1332   EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
1333   EXEC_ALLOCATE, EXEC_DEALLOCATE,
1334   EXEC_OPEN, EXEC_CLOSE,
1335   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
1336   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH
1337 }
1338 gfc_exec_op;
1339
1340 typedef struct gfc_code
1341 {
1342   gfc_exec_op op;
1343
1344   struct gfc_code *block, *next;
1345   locus loc;
1346
1347   gfc_st_label *here, *label, *label2, *label3;
1348   gfc_symtree *symtree;
1349   gfc_expr *expr, *expr2;
1350   /* A name isn't sufficient to identify a subroutine, we need the actual
1351      symbol for the interface definition.
1352   const char *sub_name;  */
1353   gfc_symbol *resolved_sym;
1354
1355   union
1356   {
1357     gfc_actual_arglist *actual;
1358     gfc_case *case_list;
1359     gfc_iterator *iterator;
1360     gfc_alloc *alloc_list;
1361     gfc_open *open;
1362     gfc_close *close;
1363     gfc_filepos *filepos;
1364     gfc_inquire *inquire;
1365     gfc_dt *dt;
1366     gfc_forall_iterator *forall_iterator;
1367     struct gfc_code *whichloop;
1368     int stop_code;
1369     gfc_entry_list *entry;
1370   }
1371   ext;          /* Points to additional structures required by statement */
1372
1373   /* Backend_decl is used for cycle and break labels in do loops, and
1374    * probably for other constructs as well, once we translate them.  */
1375   tree backend_decl;
1376 }
1377 gfc_code;
1378
1379
1380 /* Storage for DATA statements.  */
1381 typedef struct gfc_data_variable
1382 {
1383   gfc_expr *expr;
1384   gfc_iterator iter;
1385   struct gfc_data_variable *list, *next;
1386 }
1387 gfc_data_variable;
1388
1389
1390 typedef struct gfc_data_value
1391 {
1392   unsigned int repeat;
1393   gfc_expr *expr;
1394   struct gfc_data_value *next;
1395 }
1396 gfc_data_value;
1397
1398
1399 typedef struct gfc_data
1400 {
1401   gfc_data_variable *var;
1402   gfc_data_value *value;
1403   locus where;
1404
1405   struct gfc_data *next;
1406 }
1407 gfc_data;
1408
1409 #define gfc_get_data_variable() gfc_getmem(sizeof(gfc_data_variable))
1410 #define gfc_get_data_value() gfc_getmem(sizeof(gfc_data_value))
1411 #define gfc_get_data() gfc_getmem(sizeof(gfc_data))
1412
1413
1414 /* Structure for holding compile options */
1415 typedef struct
1416 {
1417   const char *source;
1418   char *module_dir;
1419   gfc_source_form source_form;
1420   int fixed_line_length;
1421   int max_identifier_length;
1422   int verbose;
1423
1424   int warn_aliasing;
1425   int warn_conversion;
1426   int warn_implicit_interface;
1427   int warn_line_truncation;
1428   int warn_underflow;
1429   int warn_surprising;
1430   int warn_unused_labels;
1431
1432   int flag_default_double;
1433   int flag_default_integer;
1434   int flag_default_real;
1435   int flag_dollar_ok;
1436   int flag_underscoring;
1437   int flag_second_underscore;
1438   int flag_implicit_none;
1439   int flag_max_stack_var_size;
1440   int flag_module_access_private;
1441   int flag_no_backend;
1442   int flag_pack_derived;
1443   int flag_repack_arrays;
1444   int flag_f2c;
1445   int flag_backslash;
1446
1447   int q_kind;
1448
1449   int warn_std;
1450   int allow_std;
1451   int warn_nonstd_intrinsics;
1452 }
1453 gfc_option_t;
1454
1455 extern gfc_option_t gfc_option;
1456
1457
1458 /* Constructor nodes for array and structure constructors.  */
1459 typedef struct gfc_constructor
1460 {
1461   gfc_expr *expr;
1462   gfc_iterator *iterator;
1463   locus where;
1464   struct gfc_constructor *next;
1465   struct
1466   {
1467     mpz_t offset; /* Record the offset of array element which appears in
1468                      data statement like "data a(5)/4/".  */
1469     gfc_component *component; /* Record the component being initialized.  */
1470   }
1471   n;
1472   mpz_t repeat; /* Record the repeat number of initial values in data
1473                  statement like "data a/5*10/".  */
1474 }
1475 gfc_constructor;
1476
1477
1478 typedef struct iterator_stack
1479 {
1480   gfc_symtree *variable;
1481   mpz_t value;
1482   struct iterator_stack *prev;
1483 }
1484 iterator_stack;
1485 extern iterator_stack *iter_stack;
1486
1487 /************************ Function prototypes *************************/
1488
1489 /* data.c  */
1490 void gfc_formalize_init_value (gfc_symbol *);
1491 void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
1492 void gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t);
1493 void gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t);
1494 void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
1495
1496 /* scanner.c */
1497 void gfc_scanner_done_1 (void);
1498 void gfc_scanner_init_1 (void);
1499
1500 void gfc_add_include_path (const char *);
1501 void gfc_release_include_path (void);
1502 FILE *gfc_open_included_file (const char *);
1503
1504 int gfc_at_end (void);
1505 int gfc_at_eof (void);
1506 int gfc_at_bol (void);
1507 int gfc_at_eol (void);
1508 void gfc_advance_line (void);
1509 int gfc_check_include (void);
1510
1511 void gfc_skip_comments (void);
1512 int gfc_next_char_literal (int);
1513 int gfc_next_char (void);
1514 int gfc_peek_char (void);
1515 void gfc_error_recovery (void);
1516 void gfc_gobble_whitespace (void);
1517 try gfc_new_file (const char *, gfc_source_form);
1518
1519 extern gfc_source_form gfc_current_form;
1520 extern char *gfc_source_file;
1521 extern locus gfc_current_locus;
1522
1523 /* misc.c */
1524 void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
1525 void gfc_free (void *);
1526 int gfc_terminal_width(void);
1527 void gfc_clear_ts (gfc_typespec *);
1528 FILE *gfc_open_file (const char *);
1529 const char *gfc_article (const char *);
1530 const char *gfc_basic_typename (bt);
1531 const char *gfc_typename (gfc_typespec *);
1532
1533 #define gfc_op2string(OP) (OP == INTRINSIC_ASSIGN ? \
1534                            "=" : gfc_code2string (intrinsic_operators, OP))
1535
1536 const char *gfc_code2string (const mstring *, int);
1537 int gfc_string2code (const mstring *, const char *);
1538 const char *gfc_intent_string (sym_intent);
1539
1540 void gfc_init_1 (void);
1541 void gfc_init_2 (void);
1542 void gfc_done_1 (void);
1543 void gfc_done_2 (void);
1544
1545 /* options.c */
1546 unsigned int gfc_init_options (unsigned int, const char **);
1547 int gfc_handle_option (size_t, const char *, int);
1548 bool gfc_post_options (const char **);
1549
1550 /* iresolve.c */
1551 const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
1552
1553 /* error.c */
1554
1555 typedef struct gfc_error_buf
1556 {
1557   int flag;
1558   size_t allocated, index;
1559   char *message;
1560 } gfc_error_buf;
1561
1562 void gfc_error_init_1 (void);
1563 void gfc_buffer_error (int);
1564
1565 void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1566 void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1567 void gfc_clear_warning (void);
1568 void gfc_warning_check (void);
1569
1570 void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1571 void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
1572 void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
1573 void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
1574 void gfc_clear_error (void);
1575 int gfc_error_check (void);
1576
1577 try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
1578
1579 /* A general purpose syntax error.  */
1580 #define gfc_syntax_error(ST)    \
1581   gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
1582
1583 void gfc_push_error (gfc_error_buf *);
1584 void gfc_pop_error (gfc_error_buf *);
1585 void gfc_free_error (gfc_error_buf *);
1586
1587 void gfc_status (const char *, ...) ATTRIBUTE_PRINTF_1;
1588 void gfc_status_char (char);
1589
1590 void gfc_get_errors (int *, int *);
1591
1592 /* arith.c */
1593 void gfc_arith_init_1 (void);
1594 void gfc_arith_done_1 (void);
1595
1596 /* trans-types.c */
1597 int gfc_validate_kind (bt, int, bool);
1598 extern int gfc_index_integer_kind;
1599 extern int gfc_default_integer_kind;
1600 extern int gfc_max_integer_kind;
1601 extern int gfc_default_real_kind;
1602 extern int gfc_default_double_kind;
1603 extern int gfc_default_character_kind;
1604 extern int gfc_default_logical_kind;
1605 extern int gfc_default_complex_kind;
1606 extern int gfc_c_int_kind;
1607
1608 /* symbol.c */
1609 void gfc_clear_new_implicit (void);
1610 try gfc_add_new_implicit_range (int, int);
1611 try gfc_merge_new_implicit (gfc_typespec *);
1612 void gfc_set_implicit_none (void);
1613
1614 gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
1615 try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
1616
1617 void gfc_set_component_attr (gfc_component *, symbol_attribute *);
1618 void gfc_get_component_attr (symbol_attribute *, gfc_component *);
1619
1620 void gfc_set_sym_referenced (gfc_symbol * sym);
1621
1622 try gfc_add_allocatable (symbol_attribute *, locus *);
1623 try gfc_add_dimension (symbol_attribute *, const char *, locus *);
1624 try gfc_add_external (symbol_attribute *, locus *);
1625 try gfc_add_intrinsic (symbol_attribute *, locus *);
1626 try gfc_add_optional (symbol_attribute *, locus *);
1627 try gfc_add_pointer (symbol_attribute *, locus *);
1628 try gfc_add_result (symbol_attribute *, const char *, locus *);
1629 try gfc_add_save (symbol_attribute *, const char *, locus *);
1630 try gfc_add_saved_common (symbol_attribute *, locus *);
1631 try gfc_add_target (symbol_attribute *, locus *);
1632 try gfc_add_dummy (symbol_attribute *, const char *, locus *);
1633 try gfc_add_generic (symbol_attribute *, const char *, locus *);
1634 try gfc_add_common (symbol_attribute *, locus *);
1635 try gfc_add_in_common (symbol_attribute *, const char *, locus *);
1636 try gfc_add_data (symbol_attribute *, const char *, locus *);
1637 try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
1638 try gfc_add_sequence (symbol_attribute *, const char *, locus *);
1639 try gfc_add_elemental (symbol_attribute *, locus *);
1640 try gfc_add_pure (symbol_attribute *, locus *);
1641 try gfc_add_recursive (symbol_attribute *, locus *);
1642 try gfc_add_function (symbol_attribute *, const char *, locus *);
1643 try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
1644
1645 try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
1646 try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
1647 try gfc_add_entry (symbol_attribute *, const char *, locus *);
1648 try gfc_add_procedure (symbol_attribute *, procedure_type,
1649                        const char *, locus *);
1650 try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
1651 try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
1652                                 gfc_formal_arglist *, locus *);
1653 try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
1654
1655 void gfc_clear_attr (symbol_attribute *);
1656 try gfc_missing_attr (symbol_attribute *, locus *);
1657 try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
1658
1659 try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
1660 gfc_symbol *gfc_use_derived (gfc_symbol *);
1661 gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
1662 gfc_component *gfc_find_component (gfc_symbol *, const char *);
1663
1664 gfc_st_label *gfc_get_st_label (int);
1665 void gfc_free_st_label (gfc_st_label *);
1666 void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
1667 try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
1668
1669 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
1670 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
1671 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
1672 gfc_user_op *gfc_get_uop (const char *);
1673 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
1674 void gfc_free_symbol (gfc_symbol *);
1675 gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
1676 int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
1677 int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
1678 int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
1679 int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **);
1680 int gfc_get_ha_symbol (const char *, gfc_symbol **);
1681 int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
1682
1683 int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
1684
1685 void gfc_undo_symbols (void);
1686 void gfc_commit_symbols (void);
1687 void gfc_free_namespace (gfc_namespace *);
1688
1689 void gfc_symbol_init_2 (void);
1690 void gfc_symbol_done_2 (void);
1691
1692 void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
1693 void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
1694 void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
1695 void gfc_save_all (gfc_namespace *);
1696
1697 void gfc_symbol_state (void);
1698
1699 gfc_gsymbol *gfc_get_gsymbol (const char *);
1700 gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
1701
1702 /* intrinsic.c */
1703 extern int gfc_init_expr;
1704
1705 /* Given a symbol that we have decided is intrinsic, mark it as such
1706    by placing it into a special module that is otherwise impossible to
1707    read or write.  */
1708
1709 #define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
1710
1711 void gfc_intrinsic_init_1 (void);
1712 void gfc_intrinsic_done_1 (void);
1713
1714 char gfc_type_letter (bt);
1715 gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
1716 try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
1717 try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
1718 int gfc_generic_intrinsic (const char *);
1719 int gfc_specific_intrinsic (const char *);
1720 int gfc_intrinsic_name (const char *, int);
1721 gfc_intrinsic_sym *gfc_find_function (const char *);
1722
1723 match gfc_intrinsic_func_interface (gfc_expr *, int);
1724 match gfc_intrinsic_sub_interface (gfc_code *, int);
1725
1726 /* simplify.c */
1727 void gfc_simplify_init_1 (void);
1728
1729 /* match.c -- FIXME */
1730 void gfc_free_iterator (gfc_iterator *, int);
1731 void gfc_free_forall_iterator (gfc_forall_iterator *);
1732 void gfc_free_alloc_list (gfc_alloc *);
1733 void gfc_free_namelist (gfc_namelist *);
1734 void gfc_free_equiv (gfc_equiv *);
1735 void gfc_free_data (gfc_data *);
1736 void gfc_free_case_list (gfc_case *);
1737
1738 /* expr.c */
1739 void gfc_free_actual_arglist (gfc_actual_arglist *);
1740 gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
1741 const char *gfc_extract_int (gfc_expr *, int *);
1742
1743 gfc_expr *gfc_build_conversion (gfc_expr *);
1744 void gfc_free_ref_list (gfc_ref *);
1745 void gfc_type_convert_binary (gfc_expr *);
1746 int gfc_is_constant_expr (gfc_expr *);
1747 try gfc_simplify_expr (gfc_expr *, int);
1748
1749 gfc_expr *gfc_get_expr (void);
1750 void gfc_free_expr (gfc_expr *);
1751 void gfc_replace_expr (gfc_expr *, gfc_expr *);
1752 gfc_expr *gfc_int_expr (int);
1753 gfc_expr *gfc_logical_expr (int, locus *);
1754 mpz_t *gfc_copy_shape (mpz_t *, int);
1755 mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
1756 gfc_expr *gfc_copy_expr (gfc_expr *);
1757
1758 try gfc_specification_expr (gfc_expr *);
1759
1760 int gfc_numeric_ts (gfc_typespec *);
1761 int gfc_kind_max (gfc_expr *, gfc_expr *);
1762
1763 try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *);
1764 try gfc_check_assign (gfc_expr *, gfc_expr *, int);
1765 try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
1766 try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
1767
1768 gfc_expr *gfc_default_initializer (gfc_typespec *);
1769 gfc_expr *gfc_get_variable_expr (gfc_symtree *);
1770
1771
1772 /* st.c */
1773 extern gfc_code new_st;
1774
1775 void gfc_clear_new_st (void);
1776 gfc_code *gfc_get_code (void);
1777 gfc_code *gfc_append_code (gfc_code *, gfc_code *);
1778 void gfc_free_statement (gfc_code *);
1779 void gfc_free_statements (gfc_code *);
1780
1781 /* resolve.c */
1782 try gfc_resolve_expr (gfc_expr *);
1783 void gfc_resolve (gfc_namespace *);
1784 int gfc_impure_variable (gfc_symbol *);
1785 int gfc_pure (gfc_symbol *);
1786 int gfc_elemental (gfc_symbol *);
1787 try gfc_resolve_iterator (gfc_iterator *, bool);
1788 try gfc_resolve_index (gfc_expr *, int);
1789 try gfc_resolve_dim_arg (gfc_expr *);
1790
1791 /* array.c */
1792 void gfc_free_array_spec (gfc_array_spec *);
1793 gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
1794
1795 try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
1796 gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
1797 try gfc_resolve_array_spec (gfc_array_spec *, int);
1798
1799 int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
1800
1801 gfc_expr *gfc_start_constructor (bt, int, locus *);
1802 void gfc_append_constructor (gfc_expr *, gfc_expr *);
1803 void gfc_free_constructor (gfc_constructor *);
1804 void gfc_simplify_iterator_var (gfc_expr *);
1805 try gfc_expand_constructor (gfc_expr *);
1806 int gfc_constant_ac (gfc_expr *);
1807 int gfc_expanded_ac (gfc_expr *);
1808 try gfc_resolve_array_constructor (gfc_expr *);
1809 try gfc_check_constructor_type (gfc_expr *);
1810 try gfc_check_iter_variable (gfc_expr *);
1811 try gfc_check_constructor (gfc_expr *, try (*)(gfc_expr *));
1812 gfc_constructor *gfc_copy_constructor (gfc_constructor * src);
1813 gfc_expr *gfc_get_array_element (gfc_expr *, int);
1814 try gfc_array_size (gfc_expr *, mpz_t *);
1815 try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
1816 try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
1817 gfc_array_ref *gfc_find_array_ref (gfc_expr *);
1818 void gfc_insert_constructor (gfc_expr *, gfc_constructor *);
1819 gfc_constructor *gfc_get_constructor (void);
1820 tree gfc_conv_array_initializer (tree type, gfc_expr * expr);
1821 try spec_size (gfc_array_spec *, mpz_t *);
1822 int gfc_is_compile_time_shape (gfc_array_spec *);
1823
1824 /* interface.c -- FIXME: some of these should be in symbol.c */
1825 void gfc_free_interface (gfc_interface *);
1826 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
1827 void gfc_check_interfaces (gfc_namespace *);
1828 void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
1829 gfc_symbol *gfc_search_interface (gfc_interface *, int,
1830                                   gfc_actual_arglist **);
1831 try gfc_extend_expr (gfc_expr *);
1832 void gfc_free_formal_arglist (gfc_formal_arglist *);
1833 try gfc_extend_assign (gfc_code *, gfc_namespace *);
1834 try gfc_add_interface (gfc_symbol * sym);
1835
1836 /* io.c */
1837 extern gfc_st_label format_asterisk;
1838
1839 void gfc_free_open (gfc_open *);
1840 try gfc_resolve_open (gfc_open *);
1841 void gfc_free_close (gfc_close *);
1842 try gfc_resolve_close (gfc_close *);
1843 void gfc_free_filepos (gfc_filepos *);
1844 try gfc_resolve_filepos (gfc_filepos *);
1845 void gfc_free_inquire (gfc_inquire *);
1846 try gfc_resolve_inquire (gfc_inquire *);
1847 void gfc_free_dt (gfc_dt *);
1848 try gfc_resolve_dt (gfc_dt *);
1849
1850 /* module.c */
1851 void gfc_module_init_2 (void);
1852 void gfc_module_done_2 (void);
1853 void gfc_dump_module (const char *, int);
1854 bool gfc_check_access (gfc_access, gfc_access);
1855
1856 /* primary.c */
1857 symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
1858 symbol_attribute gfc_expr_attr (gfc_expr *);
1859
1860 /* trans.c */
1861 void gfc_generate_code (gfc_namespace *);
1862 void gfc_generate_module_code (gfc_namespace *);
1863
1864 /* bbt.c */
1865 typedef int (*compare_fn) (void *, void *);
1866 void gfc_insert_bbt (void *, void *, compare_fn);
1867 void gfc_delete_bbt (void *, void *, compare_fn);
1868
1869 /* dump-parse-tree.c */
1870 void gfc_show_namespace (gfc_namespace *);
1871
1872 /* parse.c */
1873 try gfc_parse_file (void);
1874
1875 #endif /* GCC_GFORTRAN_H  */