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