OSDN Git Service

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