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