gcc/fortran/gfortran.h

   1 /* gfortran header file
   2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
   3    2009, 2010
   4    Free Software Foundation, Inc.
   5    Contributed by Andy Vaught
   6
   7 This file is part of GCC.
   8
   9 GCC is free software; you can redistribute it and/or modify it under
  10 the terms of the GNU General Public License as published by the Free
  11 Software Foundation; either version 3, or (at your option) any later
  12 version.
  13
  14 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  15 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with GCC; see the file COPYING3.  If not see
  21 <http://www.gnu.org/licenses/>.  */
  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 /* Declarations common to the front-end and library are put in
  33    libgfortran/libgfortran_frontend.h  */
  34 #include "libgfortran.h"
  35
  36
  37 #include "intl.h"
  38 #include "coretypes.h"
  39 #include "input.h"
  40 #include "splay-tree.h"
  41 /* The following ifdefs are recommended by the autoconf documentation
  42    for any code using alloca.  */
  43
  44 /* AIX requires this to be the first thing in the file.  */
  45 #ifdef __GNUC__
  46 #else /* not __GNUC__ */
  47 #ifdef HAVE_ALLOCA_H
  48 #include <alloca.h>
  49 #else /* do not HAVE_ALLOCA_H */
  50 #ifdef _AIX
  51 #pragma alloca
  52 #else
  53 #ifndef alloca                  /* predefined by HP cc +Olibcalls */
  54 char *alloca ();
  55 #endif /* not predefined */
  56 #endif /* not _AIX */
  57 #endif /* do not HAVE_ALLOCA_H */
  58 #endif /* not __GNUC__ */
  59
  60 /* Major control parameters.  */
  61
  62 #define GFC_MAX_SYMBOL_LEN 63   /* Must be at least 63 for F2003.  */
  63 #define GFC_MAX_BINDING_LABEL_LEN 126 /* (2 * GFC_MAX_SYMBOL_LEN) */
  64 #define GFC_MAX_LINE 132        /* Characters beyond this are not seen.  */
  65 #define GFC_LETTERS 26          /* Number of letters in the alphabet.  */
  66
  67 #define MAX_SUBRECORD_LENGTH 2147483639   /* 2**31-9 */
  68
  69
  70 #define free(x) Use_gfc_free_instead_of_free()
  71 #define gfc_is_whitespace(c) ((c==' ') || (c=='\t'))
  72
  73 #ifndef NULL
  74 #define NULL ((void *) 0)
  75 #endif
  76
  77 /* Stringization.  */
  78 #define stringize(x) expand_macro(x)
  79 #define expand_macro(x) # x
  80
  81 /* For the runtime library, a standard prefix is a requirement to
  82    avoid cluttering the namespace with things nobody asked for.  It's
  83    ugly to look at and a pain to type when you add the prefix by hand,
  84    so we hide it behind a macro.  */
  85 #define PREFIX(x) "_gfortran_" x
  86 #define PREFIX_LEN 10
  87
  88 #define BLANK_COMMON_NAME "__BLNK__"
  89
  90 /* Macro to initialize an mstring structure.  */
  91 #define minit(s, t) { s, NULL, t }
  92
  93 /* Structure for storing strings to be matched by gfc_match_string.  */
  94 typedef struct
  95 {
  96   const char *string;
  97   const char *mp;
  98   int tag;
  99 }
 100 mstring;
 101
 102
 103
 104 /*************************** Enums *****************************/
 105
 106 /* Used when matching and resolving data I/O transfer statements.  */
 107
 108 typedef enum
 109 { M_READ, M_WRITE, M_PRINT, M_INQUIRE }
 110 io_kind;
 111
 112 /* The author remains confused to this day about the convention of
 113    returning '0' for 'SUCCESS'... or was it the other way around?  The
 114    following enum makes things much more readable.  We also start
 115    values off at one instead of zero.  */
 116
 117 typedef enum
 118 { SUCCESS = 1, FAILURE }
 119 gfc_try;
 120
 121 /* This is returned by gfc_notification_std to know if, given the flags
 122    that were given (-std=, -pedantic) we should issue an error, a warning
 123    or nothing.  */
 124
 125 typedef enum
 126 { SILENT, WARNING, ERROR }
 127 notification;
 128
 129 /* Matchers return one of these three values.  The difference between
 130    MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
 131    successful, but that something non-syntactic is wrong and an error
 132    has already been issued.  */
 133
 134 typedef enum
 135 { MATCH_NO = 1, MATCH_YES, MATCH_ERROR }
 136 match;
 137
 138 typedef enum
 139 { FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
 140 gfc_source_form;
 141
 142 /* Basic types.  BT_VOID is used by ISO C Binding so funcs like c_f_pointer
 143    can take any arg with the pointer attribute as a param.  */
 144 typedef enum
 145 { BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX, BT_LOGICAL, BT_CHARACTER,
 146   BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID
 147 }
 148 bt;
 149
 150 /* Expression node types.  */
 151 typedef enum
 152 { EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
 153   EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL, EXPR_PPC
 154 }
 155 expr_t;
 156
 157 /* Array types.  */
 158 typedef enum
 159 { AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
 160   AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_UNKNOWN
 161 }
 162 array_type;
 163
 164 typedef enum
 165 { AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN }
 166 ar_type;
 167
 168 /* Statement label types.  */
 169 typedef enum
 170 { ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET,
 171   ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
 172 }
 173 gfc_sl_type;
 174
 175 /* Intrinsic operators.  */
 176 typedef enum
 177 { GFC_INTRINSIC_BEGIN = 0,
 178   INTRINSIC_NONE = -1, INTRINSIC_UPLUS = GFC_INTRINSIC_BEGIN,
 179   INTRINSIC_UMINUS, INTRINSIC_PLUS, INTRINSIC_MINUS, INTRINSIC_TIMES,
 180   INTRINSIC_DIVIDE, INTRINSIC_POWER, INTRINSIC_CONCAT,
 181   INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV,
 182   /* ==, /=, >, >=, <, <=  */
 183   INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE,
 184   INTRINSIC_LT, INTRINSIC_LE,
 185   /* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style)  */
 186   INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
 187   INTRINSIC_LT_OS, INTRINSIC_LE_OS,
 188   INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN,
 189   INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */
 190 }
 191 gfc_intrinsic_op;
 192
 193
 194 /* This macro is the number of intrinsic operators that exist.
 195    Assumptions are made about the numbering of the interface_op enums.  */
 196 #define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
 197
 198 /* Arithmetic results.  */
 199 typedef enum
 200 { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
 201   ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT
 202 }
 203 arith;
 204
 205 /* Statements.  */
 206 typedef enum
 207 {
 208   ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_ASSOCIATE,
 209   ST_BACKSPACE, ST_BLOCK, ST_BLOCK_DATA,
 210   ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE,
 211   ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF,
 212   ST_ELSEWHERE, ST_END_ASSOCIATE, ST_END_BLOCK, ST_END_BLOCK_DATA,
 213   ST_ENDDO, ST_IMPLIED_ENDDO,
 214   ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
 215   ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
 216   ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
 217   ST_ERROR_STOP, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION,
 218   ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
 219   ST_INQUIRE, ST_INTERFACE, ST_SYNC_ALL, ST_SYNC_MEMORY, ST_SYNC_IMAGES,
 220   ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
 221   ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
 222   ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT,
 223   ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
 224   ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
 225   ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
 226   ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
 227   ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
 228   ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
 229   ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE,
 230   ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
 231   ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
 232   ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
 233   ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
 234   ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
 235   ST_GET_FCN_CHARACTERISTICS, ST_NONE
 236 }
 237 gfc_statement;
 238
 239
 240 /* Types of interfaces that we can have.  Assignment interfaces are
 241    considered to be intrinsic operators.  */
 242 typedef enum
 243 {
 244   INTERFACE_NAMELESS = 1, INTERFACE_GENERIC,
 245   INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT
 246 }
 247 interface_type;
 248
 249 /* Symbol flavors: these are all mutually exclusive.
 250    10 elements = 4 bits.  */
 251 typedef enum sym_flavor
 252 {
 253   FL_UNKNOWN = 0, FL_PROGRAM, FL_BLOCK_DATA, FL_MODULE, FL_VARIABLE,
 254   FL_PARAMETER, FL_LABEL, FL_PROCEDURE, FL_DERIVED, FL_NAMELIST,
 255   FL_VOID
 256 }
 257 sym_flavor;
 258
 259 /* Procedure types.  7 elements = 3 bits.  */
 260 typedef enum procedure_type
 261 { PROC_UNKNOWN, PROC_MODULE, PROC_INTERNAL, PROC_DUMMY,
 262   PROC_INTRINSIC, PROC_ST_FUNCTION, PROC_EXTERNAL
 263 }
 264 procedure_type;
 265
 266 /* Intent types.  */
 267 typedef enum sym_intent
 268 { INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT
 269 }
 270 sym_intent;
 271
 272 /* Access types.  */
 273 typedef enum gfc_access
 274 { ACCESS_UNKNOWN = 0, ACCESS_PUBLIC, ACCESS_PRIVATE
 275 }
 276 gfc_access;
 277
 278 /* Flags to keep track of where an interface came from.
 279    3 elements = 2 bits.  */
 280 typedef enum ifsrc
 281 { IFSRC_UNKNOWN = 0,    /* Interface unknown, only return type may be known.  */
 282   IFSRC_DECL,           /* FUNCTION or SUBROUTINE declaration.  */
 283   IFSRC_IFBODY          /* INTERFACE statement or PROCEDURE statement
 284                            with explicit interface.  */
 285 }
 286 ifsrc;
 287
 288 /* Whether a SAVE attribute was set explicitly or implicitly.  */
 289 typedef enum save_state
 290 { SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
 291 }
 292 save_state;
 293
 294 /* Strings for all symbol attributes.  We use these for dumping the
 295    parse tree, in error messages, and also when reading and writing
 296    modules.  In symbol.c.  */
 297 extern const mstring flavors[];
 298 extern const mstring procedures[];
 299 extern const mstring intents[];
 300 extern const mstring access_types[];
 301 extern const mstring ifsrc_types[];
 302 extern const mstring save_status[];
 303
 304 /* Enumeration of all the generic intrinsic functions.  Used by the
 305    backend for identification of a function.  */
 306
 307 enum gfc_isym_id
 308 {
 309   /* GFC_ISYM_NONE is used for intrinsics which will never be seen by
 310      the backend (e.g. KIND).  */
 311   GFC_ISYM_NONE = 0,
 312   GFC_ISYM_ABORT,
 313   GFC_ISYM_ABS,
 314   GFC_ISYM_ACCESS,
 315   GFC_ISYM_ACHAR,
 316   GFC_ISYM_ACOS,
 317   GFC_ISYM_ACOSH,
 318   GFC_ISYM_ADJUSTL,
 319   GFC_ISYM_ADJUSTR,
 320   GFC_ISYM_AIMAG,
 321   GFC_ISYM_AINT,
 322   GFC_ISYM_ALARM,
 323   GFC_ISYM_ALL,
 324   GFC_ISYM_ALLOCATED,
 325   GFC_ISYM_AND,
 326   GFC_ISYM_ANINT,
 327   GFC_ISYM_ANY,
 328   GFC_ISYM_ASIN,
 329   GFC_ISYM_ASINH,
 330   GFC_ISYM_ASSOCIATED,
 331   GFC_ISYM_ATAN,
 332   GFC_ISYM_ATAN2,
 333   GFC_ISYM_ATANH,
 334   GFC_ISYM_BIT_SIZE,
 335   GFC_ISYM_BTEST,
 336   GFC_ISYM_CEILING,
 337   GFC_ISYM_CHAR,
 338   GFC_ISYM_CHDIR,
 339   GFC_ISYM_CHMOD,
 340   GFC_ISYM_CMPLX,
 341   GFC_ISYM_COMMAND_ARGUMENT_COUNT,
 342   GFC_ISYM_COMPLEX,
 343   GFC_ISYM_CONJG,
 344   GFC_ISYM_CONVERSION,
 345   GFC_ISYM_COS,
 346   GFC_ISYM_COSH,
 347   GFC_ISYM_COUNT,
 348   GFC_ISYM_CPU_TIME,
 349   GFC_ISYM_CSHIFT,
 350   GFC_ISYM_CTIME,
 351   GFC_ISYM_C_SIZEOF,
 352   GFC_ISYM_DATE_AND_TIME,
 353   GFC_ISYM_DBLE,
 354   GFC_ISYM_DIGITS,
 355   GFC_ISYM_DIM,
 356   GFC_ISYM_DOT_PRODUCT,
 357   GFC_ISYM_DPROD,
 358   GFC_ISYM_DTIME,
 359   GFC_ISYM_EOSHIFT,
 360   GFC_ISYM_EPSILON,
 361   GFC_ISYM_ERF,
 362   GFC_ISYM_ERFC,
 363   GFC_ISYM_ERFC_SCALED,
 364   GFC_ISYM_ETIME,
 365   GFC_ISYM_EXIT,
 366   GFC_ISYM_EXP,
 367   GFC_ISYM_EXPONENT,
 368   GFC_ISYM_EXTENDS_TYPE_OF,
 369   GFC_ISYM_FDATE,
 370   GFC_ISYM_FGET,
 371   GFC_ISYM_FGETC,
 372   GFC_ISYM_FLOOR,
 373   GFC_ISYM_FLUSH,
 374   GFC_ISYM_FNUM,
 375   GFC_ISYM_FPUT,
 376   GFC_ISYM_FPUTC,
 377   GFC_ISYM_FRACTION,
 378   GFC_ISYM_FREE,
 379   GFC_ISYM_FSEEK,
 380   GFC_ISYM_FSTAT,
 381   GFC_ISYM_FTELL,
 382   GFC_ISYM_TGAMMA,
 383   GFC_ISYM_GERROR,
 384   GFC_ISYM_GETARG,
 385   GFC_ISYM_GET_COMMAND,
 386   GFC_ISYM_GET_COMMAND_ARGUMENT,
 387   GFC_ISYM_GETCWD,
 388   GFC_ISYM_GETENV,
 389   GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
 390   GFC_ISYM_GETGID,
 391   GFC_ISYM_GETLOG,
 392   GFC_ISYM_GETPID,
 393   GFC_ISYM_GETUID,
 394   GFC_ISYM_GMTIME,
 395   GFC_ISYM_HOSTNM,
 396   GFC_ISYM_HUGE,
 397   GFC_ISYM_HYPOT,
 398   GFC_ISYM_IACHAR,
 399   GFC_ISYM_IAND,
 400   GFC_ISYM_IARGC,
 401   GFC_ISYM_IBCLR,
 402   GFC_ISYM_IBITS,
 403   GFC_ISYM_IBSET,
 404   GFC_ISYM_ICHAR,
 405   GFC_ISYM_IDATE,
 406   GFC_ISYM_IEOR,
 407   GFC_ISYM_IERRNO,
 408   GFC_ISYM_IMAGE_INDEX,
 409   GFC_ISYM_INDEX,
 410   GFC_ISYM_INT,
 411   GFC_ISYM_INT2,
 412   GFC_ISYM_INT8,
 413   GFC_ISYM_IOR,
 414   GFC_ISYM_IRAND,
 415   GFC_ISYM_ISATTY,
 416   GFC_ISYM_IS_IOSTAT_END,
 417   GFC_ISYM_IS_IOSTAT_EOR,
 418   GFC_ISYM_ISNAN,
 419   GFC_ISYM_ISHFT,
 420   GFC_ISYM_ISHFTC,
 421   GFC_ISYM_ITIME,
 422   GFC_ISYM_J0,
 423   GFC_ISYM_J1,
 424   GFC_ISYM_JN,
 425   GFC_ISYM_JN2,
 426   GFC_ISYM_KILL,
 427   GFC_ISYM_KIND,
 428   GFC_ISYM_LBOUND,
 429   GFC_ISYM_LCOBOUND,
 430   GFC_ISYM_LEADZ,
 431   GFC_ISYM_LEN,
 432   GFC_ISYM_LEN_TRIM,
 433   GFC_ISYM_LGAMMA,
 434   GFC_ISYM_LGE,
 435   GFC_ISYM_LGT,
 436   GFC_ISYM_LINK,
 437   GFC_ISYM_LLE,
 438   GFC_ISYM_LLT,
 439   GFC_ISYM_LOC,
 440   GFC_ISYM_LOG,
 441   GFC_ISYM_LOG10,
 442   GFC_ISYM_LOGICAL,
 443   GFC_ISYM_LONG,
 444   GFC_ISYM_LSHIFT,
 445   GFC_ISYM_LSTAT,
 446   GFC_ISYM_LTIME,
 447   GFC_ISYM_MALLOC,
 448   GFC_ISYM_MATMUL,
 449   GFC_ISYM_MAX,
 450   GFC_ISYM_MAXEXPONENT,
 451   GFC_ISYM_MAXLOC,
 452   GFC_ISYM_MAXVAL,
 453   GFC_ISYM_MCLOCK,
 454   GFC_ISYM_MCLOCK8,
 455   GFC_ISYM_MERGE,
 456   GFC_ISYM_MIN,
 457   GFC_ISYM_MINEXPONENT,
 458   GFC_ISYM_MINLOC,
 459   GFC_ISYM_MINVAL,
 460   GFC_ISYM_MOD,
 461   GFC_ISYM_MODULO,
 462   GFC_ISYM_MOVE_ALLOC,
 463   GFC_ISYM_MVBITS,
 464   GFC_ISYM_NEAREST,
 465   GFC_ISYM_NEW_LINE,
 466   GFC_ISYM_NINT,
 467   GFC_ISYM_NORM2,
 468   GFC_ISYM_NOT,
 469   GFC_ISYM_NULL,
 470   GFC_ISYM_NUMIMAGES,
 471   GFC_ISYM_OR,
 472   GFC_ISYM_PACK,
 473   GFC_ISYM_PARITY,
 474   GFC_ISYM_PERROR,
 475   GFC_ISYM_POPCNT,
 476   GFC_ISYM_POPPAR,
 477   GFC_ISYM_PRECISION,
 478   GFC_ISYM_PRESENT,
 479   GFC_ISYM_PRODUCT,
 480   GFC_ISYM_RADIX,
 481   GFC_ISYM_RAND,
 482   GFC_ISYM_RANDOM_NUMBER,
 483   GFC_ISYM_RANDOM_SEED,
 484   GFC_ISYM_RANGE,
 485   GFC_ISYM_REAL,
 486   GFC_ISYM_RENAME,
 487   GFC_ISYM_REPEAT,
 488   GFC_ISYM_RESHAPE,
 489   GFC_ISYM_RRSPACING,
 490   GFC_ISYM_RSHIFT,
 491   GFC_ISYM_SAME_TYPE_AS,
 492   GFC_ISYM_SC_KIND,
 493   GFC_ISYM_SCALE,
 494   GFC_ISYM_SCAN,
 495   GFC_ISYM_SECNDS,
 496   GFC_ISYM_SECOND,
 497   GFC_ISYM_SET_EXPONENT,
 498   GFC_ISYM_SHAPE,
 499   GFC_ISYM_SIGN,
 500   GFC_ISYM_SIGNAL,
 501   GFC_ISYM_SI_KIND,
 502   GFC_ISYM_SIN,
 503   GFC_ISYM_SINH,
 504   GFC_ISYM_SIZE,
 505   GFC_ISYM_SLEEP,
 506   GFC_ISYM_SIZEOF,
 507   GFC_ISYM_SPACING,
 508   GFC_ISYM_SPREAD,
 509   GFC_ISYM_SQRT,
 510   GFC_ISYM_SRAND,
 511   GFC_ISYM_SR_KIND,
 512   GFC_ISYM_STAT,
 513   GFC_ISYM_STORAGE_SIZE,
 514   GFC_ISYM_SUM,
 515   GFC_ISYM_SYMLINK,
 516   GFC_ISYM_SYMLNK,
 517   GFC_ISYM_SYSTEM,
 518   GFC_ISYM_SYSTEM_CLOCK,
 519   GFC_ISYM_TAN,
 520   GFC_ISYM_TANH,
 521   GFC_ISYM_THIS_IMAGE,
 522   GFC_ISYM_TIME,
 523   GFC_ISYM_TIME8,
 524   GFC_ISYM_TINY,
 525   GFC_ISYM_TRAILZ,
 526   GFC_ISYM_TRANSFER,
 527   GFC_ISYM_TRANSPOSE,
 528   GFC_ISYM_TRIM,
 529   GFC_ISYM_TTYNAM,
 530   GFC_ISYM_UBOUND,
 531   GFC_ISYM_UCOBOUND,
 532   GFC_ISYM_UMASK,
 533   GFC_ISYM_UNLINK,
 534   GFC_ISYM_UNPACK,
 535   GFC_ISYM_VERIFY,
 536   GFC_ISYM_XOR,
 537   GFC_ISYM_Y0,
 538   GFC_ISYM_Y1,
 539   GFC_ISYM_YN,
 540   GFC_ISYM_YN2
 541 };
 542 typedef enum gfc_isym_id gfc_isym_id;
 543
 544
 545 typedef enum
 546 {
 547   GFC_INIT_REAL_OFF = 0,
 548   GFC_INIT_REAL_ZERO,
 549   GFC_INIT_REAL_NAN,
 550   GFC_INIT_REAL_SNAN,
 551   GFC_INIT_REAL_INF,
 552   GFC_INIT_REAL_NEG_INF
 553 }
 554 init_local_real;
 555
 556 typedef enum
 557 {
 558   GFC_INIT_LOGICAL_OFF = 0,
 559   GFC_INIT_LOGICAL_FALSE,
 560   GFC_INIT_LOGICAL_TRUE
 561 }
 562 init_local_logical;
 563
 564 typedef enum
 565 {
 566   GFC_INIT_CHARACTER_OFF = 0,
 567   GFC_INIT_CHARACTER_ON
 568 }
 569 init_local_character;
 570
 571 typedef enum
 572 {
 573   GFC_INIT_INTEGER_OFF = 0,
 574   GFC_INIT_INTEGER_ON
 575 }
 576 init_local_integer;
 577
 578 typedef enum
 579 {
 580   GFC_FCOARRAY_NONE = 0,
 581   GFC_FCOARRAY_SINGLE
 582 }
 583 gfc_fcoarray;
 584
 585 typedef enum
 586 {
 587   GFC_REVERSE_NOT_SET,
 588   GFC_REVERSE_SET,
 589   GFC_CAN_REVERSE,
 590   GFC_CANNOT_REVERSE
 591 }
 592 gfc_reverse;
 593
 594 /************************* Structures *****************************/
 595
 596 /* Used for keeping things in balanced binary trees.  */
 597 #define BBT_HEADER(self) int priority; struct self *left, *right
 598
 599 #define NAMED_INTCST(a,b,c,d) a,
 600 typedef enum
 601 {
 602   ISOFORTRANENV_INVALID = -1,
 603 #include "iso-fortran-env.def"
 604   ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
 605 }
 606 iso_fortran_env_symbol;
 607 #undef NAMED_INTCST
 608
 609 #define NAMED_INTCST(a,b,c,d) a,
 610 #define NAMED_REALCST(a,b,c) a,
 611 #define NAMED_CMPXCST(a,b,c) a,
 612 #define NAMED_LOGCST(a,b,c) a,
 613 #define NAMED_CHARKNDCST(a,b,c) a,
 614 #define NAMED_CHARCST(a,b,c) a,
 615 #define DERIVED_TYPE(a,b,c) a,
 616 #define PROCEDURE(a,b) a,
 617 typedef enum
 618 {
 619   ISOCBINDING_INVALID = -1,
 620 #include "iso-c-binding.def"
 621   ISOCBINDING_LAST,
 622   ISOCBINDING_NUMBER = ISOCBINDING_LAST
 623 }
 624 iso_c_binding_symbol;
 625 #undef NAMED_INTCST
 626 #undef NAMED_REALCST
 627 #undef NAMED_CMPXCST
 628 #undef NAMED_LOGCST
 629 #undef NAMED_CHARKNDCST
 630 #undef NAMED_CHARCST
 631 #undef DERIVED_TYPE
 632 #undef PROCEDURE
 633
 634 typedef enum
 635 {
 636   INTMOD_NONE = 0, INTMOD_ISO_FORTRAN_ENV, INTMOD_ISO_C_BINDING
 637 }
 638 intmod_id;
 639
 640 typedef struct
 641 {
 642   char name[GFC_MAX_SYMBOL_LEN + 1];
 643   int value;  /* Used for both integer and character values.  */
 644   bt f90_type;
 645 }
 646 CInteropKind_t;
 647
 648 /* Array of structs, where the structs represent the C interop kinds.
 649    The list will be implemented based on a hash of the kind name since
 650    these could be accessed multiple times.
 651    Declared in trans-types.c as a global, since it's in that file
 652    that the list is initialized.  */
 653 extern CInteropKind_t c_interop_kinds_table[];
 654
 655
 656 /* Structure and list of supported extension attributes.  */
 657 typedef enum
 658 {
 659   EXT_ATTR_DLLIMPORT = 0,
 660   EXT_ATTR_DLLEXPORT,
 661   EXT_ATTR_STDCALL,
 662   EXT_ATTR_CDECL,
 663   EXT_ATTR_FASTCALL,
 664   EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
 665 }
 666 ext_attr_id_t;
 667
 668 typedef struct
 669 {
 670   const char *name;
 671   unsigned id;
 672   const char *middle_end_name;
 673 }
 674 ext_attr_t;
 675
 676 extern const ext_attr_t ext_attr_list[];
 677
 678 /* Symbol attribute structure.  */
 679 typedef struct
 680 {
 681   /* Variable attributes.  */
 682   unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
 683     optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
 684     dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
 685     implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
 686     contiguous:1;
 687
 688   /* For CLASS containers, the pointer attribute is sometimes set internally
 689      even though it was not directly specified.  In this case, keep the
 690      "real" (original) value here.  */
 691   unsigned class_pointer:1;
 692
 693   ENUM_BITFIELD (save_state) save:2;
 694
 695   unsigned data:1,              /* Symbol is named in a DATA statement.  */
 696     is_protected:1,             /* Symbol has been marked as protected.  */
 697     use_assoc:1,                /* Symbol has been use-associated.  */
 698     use_only:1,                 /* Symbol has been use-associated, with ONLY.  */
 699     use_rename:1,               /* Symbol has been use-associated and renamed.  */
 700     imported:1,                 /* Symbol has been associated by IMPORT.  */
 701     host_assoc:1;               /* Symbol has been host associated.  */
 702
 703   unsigned in_namelist:1, in_common:1, in_equivalence:1;
 704   unsigned function:1, subroutine:1, procedure:1;
 705   unsigned generic:1, generic_copy:1;
 706   unsigned implicit_type:1;     /* Type defined via implicit rules.  */
 707   unsigned untyped:1;           /* No implicit type could be found.  */
 708
 709   unsigned is_bind_c:1;         /* say if is bound to C.  */
 710   unsigned extension:8;         /* extension level of a derived type.  */
 711   unsigned is_class:1;          /* is a CLASS container.  */
 712   unsigned class_ok:1;          /* is a CLASS object with correct attributes.  */
 713   unsigned vtab:1;              /* is a derived type vtab, pointed to by CLASS objects.  */
 714   unsigned vtype:1;             /* is a derived type of a vtab.  */
 715
 716   /* These flags are both in the typespec and attribute.  The attribute
 717      list is what gets read from/written to a module file.  The typespec
 718      is created from a decl being processed.  */
 719   unsigned is_c_interop:1;      /* It's c interoperable.  */
 720   unsigned is_iso_c:1;          /* Symbol is from iso_c_binding.  */
 721
 722   /* Function/subroutine attributes */
 723   unsigned sequence:1, elemental:1, pure:1, recursive:1;
 724   unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
 725
 726   /* This is set if the subroutine doesn't return.  Currently, this
 727      is only possible for intrinsic subroutines.  */
 728   unsigned noreturn:1;
 729
 730   /* Set if this procedure is an alternate entry point.  These procedures
 731      don't have any code associated, and the backend will turn them into
 732      thunks to the master function.  */
 733   unsigned entry:1;
 734
 735   /* Set if this is the master function for a procedure with multiple
 736      entry points.  */
 737   unsigned entry_master:1;
 738
 739   /* Set if this is the master function for a function with multiple
 740      entry points where characteristics of the entry points differ.  */
 741   unsigned mixed_entry_master:1;
 742
 743   /* Set if a function must always be referenced by an explicit interface.  */
 744   unsigned always_explicit:1;
 745
 746   /* Set if the symbol has been referenced in an expression.  No further
 747      modification of type or type parameters is permitted.  */
 748   unsigned referenced:1;
 749
 750   /* Set if this is the symbol for the main program.  */
 751   unsigned is_main_program:1;
 752
 753   /* Mutually exclusive multibit attributes.  */
 754   ENUM_BITFIELD (gfc_access) access:2;
 755   ENUM_BITFIELD (sym_intent) intent:2;
 756   ENUM_BITFIELD (sym_flavor) flavor:4;
 757   ENUM_BITFIELD (ifsrc) if_source:2;
 758
 759   ENUM_BITFIELD (procedure_type) proc:3;
 760
 761   /* Special attributes for Cray pointers, pointees.  */
 762   unsigned cray_pointer:1, cray_pointee:1;
 763
 764   /* The symbol is a derived type with allocatable components, pointer
 765      components or private components, procedure pointer components,
 766      possibly nested.  zero_comp is true if the derived type has no
 767      component at all.  */
 768   unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
 769            private_comp:1, zero_comp:1, coarray_comp:1;
 770
 771   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
 772   unsigned ext_attr:EXT_ATTR_NUM;
 773
 774   /* The namespace where the attribute has been set.  */
 775   struct gfc_namespace *volatile_ns, *asynchronous_ns;
 776 }
 777 symbol_attribute;
 778
 779
 780 /* We need to store source lines as sequences of multibyte source
 781    characters. We define here a type wide enough to hold any multibyte
 782    source character, just like libcpp does.  A 32-bit type is enough.  */
 783
 784 #if HOST_BITS_PER_INT >= 32
 785 typedef unsigned int gfc_char_t;
 786 #elif HOST_BITS_PER_LONG >= 32
 787 typedef unsigned long gfc_char_t;
 788 #elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
 789 typedef unsigned long long gfc_char_t;
 790 #else
 791 # error "Cannot find an integer type with at least 32 bits"
 792 #endif
 793
 794
 795 /* The following three structures are used to identify a location in
 796    the sources.
 797
 798    gfc_file is used to maintain a tree of the source files and how
 799    they include each other
 800
 801    gfc_linebuf holds a single line of source code and information
 802    which file it resides in
 803
 804    locus point to the sourceline and the character in the source
 805    line.
 806 */
 807
 808 typedef struct gfc_file
 809 {
 810   struct gfc_file *next, *up;
 811   int inclusion_line, line;
 812   char *filename;
 813 } gfc_file;
 814
 815 typedef struct gfc_linebuf
 816 {
 817   source_location location;
 818   struct gfc_file *file;
 819   struct gfc_linebuf *next;
 820
 821   int truncated;
 822   bool dbg_emitted;
 823
 824   gfc_char_t line[1];
 825 } gfc_linebuf;
 826
 827 #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
 828
 829 #define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
 830
 831 typedef struct
 832 {
 833   gfc_char_t *nextc;
 834   gfc_linebuf *lb;
 835 } locus;
 836
 837 /* In order for the "gfc" format checking to work correctly, you must
 838    have declared a typedef locus first.  */
 839 #if GCC_VERSION >= 4001
 840 #define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
 841 #else
 842 #define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
 843 #endif
 844
 845
 846 /* Suppress error messages or re-enable them.  */
 847
 848 void gfc_push_suppress_errors (void);
 849 void gfc_pop_suppress_errors (void);
 850
 851
 852 /* Character length structures hold the expression that gives the
 853    length of a character variable.  We avoid putting these into
 854    gfc_typespec because doing so prevents us from doing structure
 855    copies and forces us to deallocate any typespecs we create, as well
 856    as structures that contain typespecs.  They also can have multiple
 857    character typespecs pointing to them.
 858
 859    These structures form a singly linked list within the current
 860    namespace and are deallocated with the namespace.  It is possible to
 861    end up with gfc_charlen structures that have nothing pointing to them.  */
 862
 863 typedef struct gfc_charlen
 864 {
 865   struct gfc_expr *length;
 866   struct gfc_charlen *next;
 867   bool length_from_typespec; /* Length from explicit array ctor typespec?  */
 868   tree backend_decl;
 869   tree passed_length; /* Length argument explicitelly passed.  */
 870
 871   int resolved;
 872 }
 873 gfc_charlen;
 874
 875 #define gfc_get_charlen() XCNEW (gfc_charlen)
 876
 877 /* Type specification structure.  */
 878 typedef struct
 879 {
 880   bt type;
 881   int kind;
 882
 883   union
 884   {
 885     struct gfc_symbol *derived; /* For derived types only.  */
 886     gfc_charlen *cl;            /* For character types only.  */
 887     int pad;                    /* For hollerith types only.  */
 888   }
 889   u;
 890
 891   struct gfc_symbol *interface; /* For PROCEDURE declarations.  */
 892   int is_c_interop;
 893   int is_iso_c;
 894   bt f90_type;
 895 }
 896 gfc_typespec;
 897
 898 /* Array specification.  */
 899 typedef struct
 900 {
 901   int rank;     /* A rank of zero means that a variable is a scalar.  */
 902   int corank;
 903   array_type type, cotype;
 904   struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
 905
 906   /* These two fields are used with the Cray Pointer extension.  */
 907   bool cray_pointee; /* True iff this spec belongs to a cray pointee.  */
 908   bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to
 909                         AS_EXPLICIT, but we want to remember that we
 910                         did this.  */
 911
 912 }
 913 gfc_array_spec;
 914
 915 #define gfc_get_array_spec() XCNEW (gfc_array_spec)
 916
 917
 918 /* Components of derived types.  */
 919 typedef struct gfc_component
 920 {
 921   const char *name;
 922   gfc_typespec ts;
 923
 924   symbol_attribute attr;
 925   gfc_array_spec *as;
 926
 927   tree backend_decl;
 928   locus loc;
 929   struct gfc_expr *initializer;
 930   struct gfc_component *next;
 931
 932   /* Needed for procedure pointer components.  */
 933   struct gfc_formal_arglist *formal;
 934   struct gfc_namespace *formal_ns;
 935   struct gfc_typebound_proc *tb;
 936 }
 937 gfc_component;
 938
 939 #define gfc_get_component() XCNEW (gfc_component)
 940
 941 /* Formal argument lists are lists of symbols.  */
 942 typedef struct gfc_formal_arglist
 943 {
 944   /* Symbol representing the argument at this position in the arglist.  */
 945   struct gfc_symbol *sym;
 946   /* Points to the next formal argument.  */
 947   struct gfc_formal_arglist *next;
 948 }
 949 gfc_formal_arglist;
 950
 951 #define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
 952
 953
 954 /* The gfc_actual_arglist structure is for actual arguments.  */
 955 typedef struct gfc_actual_arglist
 956 {
 957   const char *name;
 958   /* Alternate return label when the expr member is null.  */
 959   struct gfc_st_label *label;
 960
 961   /* This is set to the type of an eventual omitted optional
 962      argument. This is used to determine if a hidden string length
 963      argument has to be added to a function call.  */
 964   bt missing_arg_type;
 965
 966   struct gfc_expr *expr;
 967   struct gfc_actual_arglist *next;
 968 }
 969 gfc_actual_arglist;
 970
 971 #define gfc_get_actual_arglist() XCNEW (gfc_actual_arglist)
 972
 973
 974 /* Because a symbol can belong to multiple namelists, they must be
 975    linked externally to the symbol itself.  */
 976 typedef struct gfc_namelist
 977 {
 978   struct gfc_symbol *sym;
 979   struct gfc_namelist *next;
 980 }
 981 gfc_namelist;
 982
 983 #define gfc_get_namelist() XCNEW (gfc_namelist)
 984
 985 enum
 986 {
 987   OMP_LIST_PRIVATE,
 988   OMP_LIST_FIRSTPRIVATE,
 989   OMP_LIST_LASTPRIVATE,
 990   OMP_LIST_COPYPRIVATE,
 991   OMP_LIST_SHARED,
 992   OMP_LIST_COPYIN,
 993   OMP_LIST_PLUS,
 994   OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
 995   OMP_LIST_MULT,
 996   OMP_LIST_SUB,
 997   OMP_LIST_AND,
 998   OMP_LIST_OR,
 999   OMP_LIST_EQV,
1000   OMP_LIST_NEQV,
1001   OMP_LIST_MAX,
1002   OMP_LIST_MIN,
1003   OMP_LIST_IAND,
1004   OMP_LIST_IOR,
1005   OMP_LIST_IEOR,
1006   OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR,
1007   OMP_LIST_NUM
1008 };
1009
1010 /* Because a symbol can belong to multiple namelists, they must be
1011    linked externally to the symbol itself.  */
1012
1013 enum gfc_omp_sched_kind
1014 {
1015   OMP_SCHED_NONE,
1016   OMP_SCHED_STATIC,
1017   OMP_SCHED_DYNAMIC,
1018   OMP_SCHED_GUIDED,
1019   OMP_SCHED_RUNTIME,
1020   OMP_SCHED_AUTO
1021 };
1022
1023 enum gfc_omp_default_sharing
1024 {
1025   OMP_DEFAULT_UNKNOWN,
1026   OMP_DEFAULT_NONE,
1027   OMP_DEFAULT_PRIVATE,
1028   OMP_DEFAULT_SHARED,
1029   OMP_DEFAULT_FIRSTPRIVATE
1030 };
1031
1032 typedef struct gfc_omp_clauses
1033 {
1034   struct gfc_expr *if_expr;
1035   struct gfc_expr *num_threads;
1036   gfc_namelist *lists[OMP_LIST_NUM];
1037   enum gfc_omp_sched_kind sched_kind;
1038   struct gfc_expr *chunk_size;
1039   enum gfc_omp_default_sharing default_sharing;
1040   int collapse;
1041   bool nowait, ordered, untied;
1042 }
1043 gfc_omp_clauses;
1044
1045 #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
1046
1047
1048 /* The gfc_st_label structure is a BBT attached to a namespace that
1049    records the usage of statement labels within that space.  */
1050
1051 typedef struct gfc_st_label
1052 {
1053   BBT_HEADER(gfc_st_label);
1054
1055   int value;
1056
1057   gfc_sl_type defined, referenced;
1058
1059   struct gfc_expr *format;
1060
1061   tree backend_decl;
1062
1063   locus where;
1064 }
1065 gfc_st_label;
1066
1067
1068 /* gfc_interface()-- Interfaces are lists of symbols strung together.  */
1069 typedef struct gfc_interface
1070 {
1071   struct gfc_symbol *sym;
1072   locus where;
1073   struct gfc_interface *next;
1074 }
1075 gfc_interface;
1076
1077 #define gfc_get_interface() XCNEW (gfc_interface)
1078
1079 /* User operator nodes.  These are like stripped down symbols.  */
1080 typedef struct
1081 {
1082   const char *name;
1083
1084   gfc_interface *op;
1085   struct gfc_namespace *ns;
1086   gfc_access access;
1087 }
1088 gfc_user_op;
1089
1090
1091 /* A list of specific bindings that are associated with a generic spec.  */
1092 typedef struct gfc_tbp_generic
1093 {
1094   /* The parser sets specific_st, upon resolution we look for the corresponding
1095      gfc_typebound_proc and set specific for further use.  */
1096   struct gfc_symtree* specific_st;
1097   struct gfc_typebound_proc* specific;
1098
1099   struct gfc_tbp_generic* next;
1100 }
1101 gfc_tbp_generic;
1102
1103 #define gfc_get_tbp_generic() XCNEW (gfc_tbp_generic)
1104
1105
1106 /* Data needed for type-bound procedures.  */
1107 typedef struct gfc_typebound_proc
1108 {
1109   locus where; /* Where the PROCEDURE/GENERIC definition was.  */
1110
1111   union
1112   {
1113     struct gfc_symtree* specific; /* The interface if DEFERRED.  */
1114     gfc_tbp_generic* generic;
1115   }
1116   u;
1117
1118   gfc_access access;
1119   const char* pass_arg; /* Argument-name for PASS.  NULL if not specified.  */
1120
1121   /* The overridden type-bound proc (or GENERIC with this name in the
1122      parent-type) or NULL if non.  */
1123   struct gfc_typebound_proc* overridden;
1124
1125   /* Once resolved, we use the position of pass_arg in the formal arglist of
1126      the binding-target procedure to identify it.  The first argument has
1127      number 1 here, the second 2, and so on.  */
1128   unsigned pass_arg_num;
1129
1130   unsigned nopass:1; /* Whether we have NOPASS (PASS otherwise).  */
1131   unsigned non_overridable:1;
1132   unsigned deferred:1;
1133   unsigned is_generic:1;
1134   unsigned function:1, subroutine:1;
1135   unsigned error:1; /* Ignore it, when an error occurred during resolution.  */
1136   unsigned ppc:1;
1137 }
1138 gfc_typebound_proc;
1139
1140
1141 /* Symbol nodes.  These are important things.  They are what the
1142    standard refers to as "entities".  The possibly multiple names that
1143    refer to the same entity are accomplished by a binary tree of
1144    symtree structures that is balanced by the red-black method-- more
1145    than one symtree node can point to any given symbol.  */
1146
1147 typedef struct gfc_symbol
1148 {
1149   const char *name;     /* Primary name, before renaming */
1150   const char *module;   /* Module this symbol came from */
1151   locus declared_at;
1152
1153   gfc_typespec ts;
1154   symbol_attribute attr;
1155
1156   /* The formal member points to the formal argument list if the
1157      symbol is a function or subroutine name.  If the symbol is a
1158      generic name, the generic member points to the list of
1159      interfaces.  */
1160
1161   gfc_interface *generic;
1162   gfc_access component_access;
1163
1164   gfc_formal_arglist *formal;
1165   struct gfc_namespace *formal_ns;
1166   struct gfc_namespace *f2k_derived;
1167
1168   struct gfc_expr *value;       /* Parameter/Initializer value */
1169   gfc_array_spec *as;
1170   struct gfc_symbol *result;    /* function result symbol */
1171   gfc_component *components;    /* Derived type components */
1172
1173   /* Defined only for Cray pointees; points to their pointer.  */
1174   struct gfc_symbol *cp_pointer;
1175
1176   int entry_id;                 /* Used in resolve.c for entries.  */
1177
1178   /* CLASS hashed name for declared and dynamic types in the class.  */
1179   int hash_value;
1180
1181   struct gfc_symbol *common_next;       /* Links for COMMON syms */
1182
1183   /* This is in fact a gfc_common_head but it is only used for pointer
1184      comparisons to check if symbols are in the same common block.  */
1185   struct gfc_common_head* common_head;
1186
1187   /* Make sure setup code for dummy arguments is generated in the correct
1188      order.  */
1189   int dummy_order;
1190
1191   gfc_namelist *namelist, *namelist_tail;
1192
1193   /* Change management fields.  Symbols that might be modified by the
1194      current statement have the mark member nonzero and are kept in a
1195      singly linked list through the tlink field.  Of these symbols,
1196      symbols with old_symbol equal to NULL are symbols created within
1197      the current statement.  Otherwise, old_symbol points to a copy of
1198      the old symbol.  */
1199
1200   struct gfc_symbol *old_symbol, *tlink;
1201   unsigned mark:1, gfc_new:1;
1202   /* Nonzero if all equivalences associated with this symbol have been
1203      processed.  */
1204   unsigned equiv_built:1;
1205   /* Set if this variable is used as an index name in a FORALL.  */
1206   unsigned forall_index:1;
1207   int refs;
1208   struct gfc_namespace *ns;     /* namespace containing this symbol */
1209
1210   tree backend_decl;
1211
1212   /* Identity of the intrinsic module the symbol comes from, or
1213      INTMOD_NONE if it's not imported from a intrinsic module.  */
1214   intmod_id from_intmod;
1215   /* Identity of the symbol from intrinsic modules, from enums maintained
1216      separately by each intrinsic module.  Used together with from_intmod,
1217      it uniquely identifies a symbol from an intrinsic module.  */
1218   int intmod_sym_id;
1219
1220   /* This may be repetitive, since the typespec now has a binding
1221      label field.  */
1222   char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
1223   /* Store a reference to the common_block, if this symbol is in one.  */
1224   struct gfc_common_head *common_block;
1225
1226   /* Link to corresponding association-list if this is an associate name.  */
1227   struct gfc_association_list *assoc;
1228 }
1229 gfc_symbol;
1230
1231
1232 /* This structure is used to keep track of symbols in common blocks.  */
1233 typedef struct gfc_common_head
1234 {
1235   locus where;
1236   char use_assoc, saved, threadprivate;
1237   char name[GFC_MAX_SYMBOL_LEN + 1];
1238   struct gfc_symbol *head;
1239   char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
1240   int is_bind_c;
1241 }
1242 gfc_common_head;
1243
1244 #define gfc_get_common_head() XCNEW (gfc_common_head)
1245
1246
1247 /* A list of all the alternate entry points for a procedure.  */
1248
1249 typedef struct gfc_entry_list
1250 {
1251   /* The symbol for this entry point.  */
1252   gfc_symbol *sym;
1253   /* The zero-based id of this entry point.  */
1254   int id;
1255   /* The LABEL_EXPR marking this entry point.  */
1256   tree label;
1257   /* The next item in the list.  */
1258   struct gfc_entry_list *next;
1259 }
1260 gfc_entry_list;
1261
1262 #define gfc_get_entry_list() \
1263   (gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))
1264
1265 /* Lists of rename info for the USE statement.  */
1266
1267 typedef struct gfc_use_rename
1268 {
1269   char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
1270   struct gfc_use_rename *next;
1271   int found;
1272   gfc_intrinsic_op op;
1273   locus where;
1274 }
1275 gfc_use_rename;
1276
1277 #define gfc_get_use_rename() XCNEW (gfc_use_rename);
1278
1279 /* A list of all USE statements in a namespace.  */
1280
1281 typedef struct gfc_use_list
1282 {
1283   const char *module_name;
1284   int only_flag;
1285   struct gfc_use_rename *rename;
1286   locus where;
1287   /* Next USE statement.  */
1288   struct gfc_use_list *next;
1289 }
1290 gfc_use_list;
1291
1292 #define gfc_get_use_list() \
1293   (gfc_use_list *) gfc_getmem(sizeof(gfc_use_list))
1294
1295 /* Within a namespace, symbols are pointed to by symtree nodes that
1296    are linked together in a balanced binary tree.  There can be
1297    several symtrees pointing to the same symbol node via USE
1298    statements.  */
1299
1300 typedef struct gfc_symtree
1301 {
1302   BBT_HEADER (gfc_symtree);
1303   const char *name;
1304   int ambiguous;
1305   union
1306   {
1307     gfc_symbol *sym;            /* Symbol associated with this node */
1308     gfc_user_op *uop;
1309     gfc_common_head *common;
1310     gfc_typebound_proc *tb;
1311   }
1312   n;
1313 }
1314 gfc_symtree;
1315
1316 /* A linked list of derived types in the namespace.  */
1317 typedef struct gfc_dt_list
1318 {
1319   struct gfc_symbol *derived;
1320   struct gfc_dt_list *next;
1321 }
1322 gfc_dt_list;
1323
1324 #define gfc_get_dt_list() XCNEW (gfc_dt_list)
1325
1326   /* A list of all derived types.  */
1327   extern gfc_dt_list *gfc_derived_types;
1328
1329 /* A namespace describes the contents of procedure, module, interface block
1330    or BLOCK construct.  */
1331 /* ??? Anything else use these?  */
1332
1333 typedef struct gfc_namespace
1334 {
1335   /* Tree containing all the symbols in this namespace.  */
1336   gfc_symtree *sym_root;
1337   /* Tree containing all the user-defined operators in the namespace.  */
1338   gfc_symtree *uop_root;
1339   /* Tree containing all the common blocks.  */
1340   gfc_symtree *common_root;
1341
1342   /* Tree containing type-bound procedures.  */
1343   gfc_symtree *tb_sym_root;
1344   /* Type-bound user operators.  */
1345   gfc_symtree *tb_uop_root;
1346   /* For derived-types, store type-bound intrinsic operators here.  */
1347   gfc_typebound_proc *tb_op[GFC_INTRINSIC_OPS];
1348   /* Linked list of finalizer procedures.  */
1349   struct gfc_finalizer *finalizers;
1350
1351   /* If set_flag[letter] is set, an implicit type has been set for letter.  */
1352   int set_flag[GFC_LETTERS];
1353   /* Keeps track of the implicit types associated with the letters.  */
1354   gfc_typespec default_type[GFC_LETTERS];
1355   /* Store the positions of IMPLICIT statements.  */
1356   locus implicit_loc[GFC_LETTERS];
1357
1358   /* If this is a namespace of a procedure, this points to the procedure.  */
1359   struct gfc_symbol *proc_name;
1360   /* If this is the namespace of a unit which contains executable
1361      code, this points to it.  */
1362   struct gfc_code *code;
1363
1364   /* Points to the equivalences set up in this namespace.  */
1365   struct gfc_equiv *equiv, *old_equiv;
1366
1367   /* Points to the equivalence groups produced by trans_common.  */
1368   struct gfc_equiv_list *equiv_lists;
1369
1370   gfc_interface *op[GFC_INTRINSIC_OPS];
1371
1372   /* Points to the parent namespace, i.e. the namespace of a module or
1373      procedure in which the procedure belonging to this namespace is
1374      contained. The parent namespace points to this namespace either
1375      directly via CONTAINED, or indirectly via the chain built by
1376      SIBLING.  */
1377   struct gfc_namespace *parent;
1378   /* CONTAINED points to the first contained namespace. Sibling
1379      namespaces are chained via SIBLING.  */
1380   struct gfc_namespace  *contained, *sibling;
1381
1382   gfc_common_head blank_common;
1383   gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];
1384
1385   gfc_st_label *st_labels;
1386   /* This list holds information about all the data initializers in
1387      this namespace.  */
1388   struct gfc_data *data;
1389
1390   gfc_charlen *cl_list, *old_cl_list;
1391
1392   gfc_dt_list *derived_types;
1393
1394   int save_all, seen_save, seen_implicit_none;
1395
1396   /* Normally we don't need to refcount namespaces.  However when we read
1397      a module containing a function with multiple entry points, this
1398      will appear as several functions with the same formal namespace.  */
1399   int refs;
1400
1401   /* A list of all alternate entry points to this procedure (or NULL).  */
1402   gfc_entry_list *entries;
1403
1404   /* A list of USE statements in this namespace.  */
1405   gfc_use_list *use_stmts;
1406
1407   /* Set to 1 if namespace is a BLOCK DATA program unit.  */
1408   unsigned is_block_data:1;
1409
1410   /* Set to 1 if namespace is an interface body with "IMPORT" used.  */
1411   unsigned has_import_set:1;
1412
1413   /* Set to 1 if resolved has been called for this namespace.
1414      Holds -1 during resolution.  */
1415   signed resolved:2;
1416
1417   /* Set to 1 if code has been generated for this namespace.  */
1418   unsigned translated:1;
1419
1420   /* Set to 1 if symbols in this namespace should be 'construct entities',
1421      i.e. for BLOCK local variables.  */
1422   unsigned construct_entities:1;
1423 }
1424 gfc_namespace;
1425
1426 extern gfc_namespace *gfc_current_ns;
1427 extern gfc_namespace *gfc_global_ns_list;
1428
1429 /* Global symbols are symbols of global scope. Currently we only use
1430    this to detect collisions already when parsing.
1431    TODO: Extend to verify procedure calls.  */
1432
1433 enum gfc_symbol_type
1434 {
1435   GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
1436   GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA
1437 };
1438
1439 typedef struct gfc_gsymbol
1440 {
1441   BBT_HEADER(gfc_gsymbol);
1442
1443   const char *name;
1444   const char *sym_name;
1445   const char *mod_name;
1446   const char *binding_label;
1447   enum gfc_symbol_type type;
1448
1449   int defined, used;
1450   locus where;
1451   gfc_namespace *ns;
1452 }
1453 gfc_gsymbol;
1454
1455 extern gfc_gsymbol *gfc_gsym_root;
1456
1457 /* Information on interfaces being built.  */
1458 typedef struct
1459 {
1460   interface_type type;
1461   gfc_symbol *sym;
1462   gfc_namespace *ns;
1463   gfc_user_op *uop;
1464   gfc_intrinsic_op op;
1465 }
1466 gfc_interface_info;
1467
1468 extern gfc_interface_info current_interface;
1469
1470
1471 /* Array reference.  */
1472
1473 enum gfc_array_ref_dimen_type
1474 {
1475   DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_STAR, DIMEN_UNKNOWN
1476 };
1477
1478 typedef struct gfc_array_ref
1479 {
1480   ar_type type;
1481   int dimen;                    /* # of components in the reference */
1482   int codimen;
1483   bool in_allocate;             /* For coarray checks. */
1484   locus where;
1485   gfc_array_spec *as;
1486
1487   locus c_where[GFC_MAX_DIMENSIONS];    /* All expressions can be NULL */
1488   struct gfc_expr *start[GFC_MAX_DIMENSIONS], *end[GFC_MAX_DIMENSIONS],
1489     *stride[GFC_MAX_DIMENSIONS];
1490
1491   enum gfc_array_ref_dimen_type dimen_type[GFC_MAX_DIMENSIONS];
1492
1493   struct gfc_expr *offset;
1494 }
1495 gfc_array_ref;
1496
1497 #define gfc_get_array_ref() XCNEW (gfc_array_ref)
1498
1499
1500 /* Component reference nodes.  A variable is stored as an expression
1501    node that points to the base symbol.  After that, a singly linked
1502    list of component reference nodes gives the variable's complete
1503    resolution.  The array_ref component may be present and comes
1504    before the component component.  */
1505
1506 typedef enum
1507   { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING }
1508 ref_type;
1509
1510 typedef struct gfc_ref
1511 {
1512   ref_type type;
1513
1514   union
1515   {
1516     struct gfc_array_ref ar;
1517
1518     struct
1519     {
1520       gfc_component *component;
1521       gfc_symbol *sym;
1522     }
1523     c;
1524
1525     struct
1526     {
1527       struct gfc_expr *start, *end;     /* Substring */
1528       gfc_charlen *length;
1529     }
1530     ss;
1531
1532   }
1533   u;
1534
1535   struct gfc_ref *next;
1536 }
1537 gfc_ref;
1538
1539 #define gfc_get_ref() XCNEW (gfc_ref)
1540
1541
1542 /* Structures representing intrinsic symbols and their arguments lists.  */
1543 typedef struct gfc_intrinsic_arg
1544 {
1545   char name[GFC_MAX_SYMBOL_LEN + 1];
1546
1547   gfc_typespec ts;
1548   unsigned optional:1, value:1;
1549   ENUM_BITFIELD (sym_intent) intent:2;
1550   gfc_actual_arglist *actual;
1551
1552   struct gfc_intrinsic_arg *next;
1553
1554 }
1555 gfc_intrinsic_arg;
1556
1557
1558 /* Specifies the various kinds of check functions used to verify the
1559    argument lists of intrinsic functions. fX with X an integer refer
1560    to check functions of intrinsics with X arguments. f1m is used for
1561    the MAX and MIN intrinsics which can have an arbitrary number of
1562    arguments, f3ml is used for the MINLOC and MAXLOC intrinsics as
1563    these have special semantics.  */
1564
1565 typedef union
1566 {
1567   gfc_try (*f0)(void);
1568   gfc_try (*f1)(struct gfc_expr *);
1569   gfc_try (*f1m)(gfc_actual_arglist *);
1570   gfc_try (*f2)(struct gfc_expr *, struct gfc_expr *);
1571   gfc_try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1572   gfc_try (*f3ml)(gfc_actual_arglist *);
1573   gfc_try (*f3red)(gfc_actual_arglist *);
1574   gfc_try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1575             struct gfc_expr *);
1576   gfc_try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1577             struct gfc_expr *, struct gfc_expr *);
1578 }
1579 gfc_check_f;
1580
1581 /* Like gfc_check_f, these specify the type of the simplification
1582    function associated with an intrinsic. The fX are just like in
1583    gfc_check_f. cc is used for type conversion functions.  */
1584
1585 typedef union
1586 {
1587   struct gfc_expr *(*f0)(void);
1588   struct gfc_expr *(*f1)(struct gfc_expr *);
1589   struct gfc_expr *(*f2)(struct gfc_expr *, struct gfc_expr *);
1590   struct gfc_expr *(*f3)(struct gfc_expr *, struct gfc_expr *,
1591                          struct gfc_expr *);
1592   struct gfc_expr *(*f4)(struct gfc_expr *, struct gfc_expr *,
1593                          struct gfc_expr *, struct gfc_expr *);
1594   struct gfc_expr *(*f5)(struct gfc_expr *, struct gfc_expr *,
1595                          struct gfc_expr *, struct gfc_expr *,
1596                          struct gfc_expr *);
1597   struct gfc_expr *(*cc)(struct gfc_expr *, bt, int);
1598 }
1599 gfc_simplify_f;
1600
1601 /* Again like gfc_check_f, these specify the type of the resolution
1602    function associated with an intrinsic. The fX are just like in
1603    gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort().  */
1604
1605 typedef union
1606 {
1607   void (*f0)(struct gfc_expr *);
1608   void (*f1)(struct gfc_expr *, struct gfc_expr *);
1609   void (*f1m)(struct gfc_expr *, struct gfc_actual_arglist *);
1610   void (*f2)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1611   void (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1612              struct gfc_expr *);
1613   void (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1614              struct gfc_expr *, struct gfc_expr *);
1615   void (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1616              struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1617   void (*s1)(struct gfc_code *);
1618 }
1619 gfc_resolve_f;
1620
1621
1622 typedef struct gfc_intrinsic_sym
1623 {
1624   const char *name, *lib_name;
1625   gfc_intrinsic_arg *formal;
1626   gfc_typespec ts;
1627   unsigned elemental:1, inquiry:1, transformational:1, pure:1,
1628     generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1;
1629
1630   int standard;
1631
1632   gfc_simplify_f simplify;
1633   gfc_check_f check;
1634   gfc_resolve_f resolve;
1635   struct gfc_intrinsic_sym *specific_head, *next;
1636   gfc_isym_id id;
1637
1638 }
1639 gfc_intrinsic_sym;
1640
1641
1642 /* Expression nodes.  The expression node types deserve explanations,
1643    since the last couple can be easily misconstrued:
1644
1645    EXPR_OP         Operator node pointing to one or two other nodes
1646    EXPR_FUNCTION   Function call, symbol points to function's name
1647    EXPR_CONSTANT   A scalar constant: Logical, String, Real, Int or Complex
1648    EXPR_VARIABLE   An Lvalue with a root symbol and possible reference list
1649                    which expresses structure, array and substring refs.
1650    EXPR_NULL       The NULL pointer value (which also has a basic type).
1651    EXPR_SUBSTRING  A substring of a constant string
1652    EXPR_STRUCTURE  A structure constructor
1653    EXPR_ARRAY      An array constructor.
1654    EXPR_COMPCALL   Function (or subroutine) call of a procedure pointer
1655                    component or type-bound procedure.  */
1656
1657 #include <gmp.h>
1658 #include <mpfr.h>
1659 #include <mpc.h>
1660 #define GFC_RND_MODE GMP_RNDN
1661 #define GFC_MPC_RND_MODE MPC_RNDNN
1662
1663 typedef splay_tree gfc_constructor_base;
1664
1665 typedef struct gfc_expr
1666 {
1667   expr_t expr_type;
1668
1669   gfc_typespec ts;      /* These two refer to the overall expression */
1670
1671   int rank;
1672   mpz_t *shape;         /* Can be NULL if shape is unknown at compile time */
1673
1674   /* Nonnull for functions and structure constructors, may also used to hold the
1675      base-object for component calls.  */
1676   gfc_symtree *symtree;
1677
1678   gfc_ref *ref;
1679
1680   locus where;
1681
1682   /* True if the expression is a call to a function that returns an array,
1683      and if we have decided not to allocate temporary data for that array.
1684      is_boz is true if the integer is regarded as BOZ bitpatten and is_snan
1685      denotes a signalling not-a-number.  */
1686   unsigned int inline_noncopying_intrinsic : 1, is_boz : 1, is_snan : 1;
1687
1688   /* Sometimes, when an error has been emitted, it is necessary to prevent
1689       it from recurring.  */
1690   unsigned int error : 1;
1691
1692   /* Mark an expression where a user operator has been substituted by
1693      a function call in interface.c(gfc_extend_expr).  */
1694   unsigned int user_operator : 1;
1695
1696   /* Mark an expression as being a MOLD argument of ALLOCATE.  */
1697   unsigned int mold : 1;
1698
1699   /* If an expression comes from a Hollerith constant or compile-time
1700      evaluation of a transfer statement, it may have a prescribed target-
1701      memory representation, and these cannot always be backformed from
1702      the value.  */
1703   struct
1704   {
1705     int length;
1706     char *string;
1707   }
1708   representation;
1709
1710   union
1711   {
1712     int logical;
1713
1714     io_kind iokind;
1715
1716     mpz_t integer;
1717
1718     mpfr_t real;
1719
1720     mpc_t complex;
1721
1722     struct
1723     {
1724       gfc_intrinsic_op op;
1725       gfc_user_op *uop;
1726       struct gfc_expr *op1, *op2;
1727     }
1728     op;
1729
1730     struct
1731     {
1732       gfc_actual_arglist *actual;
1733       const char *name; /* Points to the ultimate name of the function */
1734       gfc_intrinsic_sym *isym;
1735       gfc_symbol *esym;
1736     }
1737     function;
1738
1739     struct
1740     {
1741       gfc_actual_arglist* actual;
1742       const char* name;
1743       /* Base-object, whose component was called.  NULL means that it should
1744          be taken from symtree/ref.  */
1745       struct gfc_expr* base_object;
1746       gfc_typebound_proc* tbp; /* Should overlap with esym.  */
1747
1748       /* For type-bound operators, we want to call PASS procedures but already
1749          have the full arglist; mark this, so that it is not extended by the
1750          PASS argument.  */
1751       unsigned ignore_pass:1;
1752
1753       /* Do assign-calls rather than calls, that is appropriate dependency
1754          checking.  */
1755       unsigned assign:1;
1756     }
1757     compcall;
1758
1759     struct
1760     {
1761       int length;
1762       gfc_char_t *string;
1763     }
1764     character;
1765
1766     gfc_constructor_base constructor;
1767   }
1768   value;
1769
1770 }
1771 gfc_expr;
1772
1773
1774 #define gfc_get_shape(rank) ((mpz_t *) gfc_getmem((rank)*sizeof(mpz_t)))
1775
1776 /* Structures for information associated with different kinds of
1777    numbers.  The first set of integer parameters define all there is
1778    to know about a particular kind.  The rest of the elements are
1779    computed from the first elements.  */
1780
1781 typedef struct
1782 {
1783   /* Values really representable by the target.  */
1784   mpz_t huge, pedantic_min_int, min_int;
1785
1786   int kind, radix, digits, bit_size, range;
1787
1788   /* True if the C type of the given name maps to this precision.
1789      Note that more than one bit can be set.  */
1790   unsigned int c_char : 1;
1791   unsigned int c_short : 1;
1792   unsigned int c_int : 1;
1793   unsigned int c_long : 1;
1794   unsigned int c_long_long : 1;
1795 }
1796 gfc_integer_info;
1797
1798 extern gfc_integer_info gfc_integer_kinds[];
1799
1800
1801 typedef struct
1802 {
1803   int kind, bit_size;
1804
1805   /* True if the C++ type bool, C99 type _Bool, maps to this precision.  */
1806   unsigned int c_bool : 1;
1807 }
1808 gfc_logical_info;
1809
1810 extern gfc_logical_info gfc_logical_kinds[];
1811
1812
1813 typedef struct
1814 {
1815   mpfr_t epsilon, huge, tiny, subnormal;
1816   int kind, radix, digits, min_exponent, max_exponent;
1817   int range, precision;
1818
1819   /* The precision of the type as reported by GET_MODE_PRECISION.  */
1820   int mode_precision;
1821
1822   /* True if the C type of the given name maps to this precision.
1823      Note that more than one bit can be set.  */
1824   unsigned int c_float : 1;
1825   unsigned int c_double : 1;
1826   unsigned int c_long_double : 1;
1827   unsigned int c_float128 : 1;
1828 }
1829 gfc_real_info;
1830
1831 extern gfc_real_info gfc_real_kinds[];
1832
1833 typedef struct
1834 {
1835   int kind, bit_size;
1836   const char *name;
1837 }
1838 gfc_character_info;
1839
1840 extern gfc_character_info gfc_character_kinds[];
1841
1842
1843 /* Equivalence structures.  Equivalent lvalues are linked along the
1844    *eq pointer, equivalence sets are strung along the *next node.  */
1845 typedef struct gfc_equiv
1846 {
1847   struct gfc_equiv *next, *eq;
1848   gfc_expr *expr;
1849   const char *module;
1850   int used;
1851 }
1852 gfc_equiv;
1853
1854 #define gfc_get_equiv() XCNEW (gfc_equiv)
1855
1856 /* Holds a single equivalence member after processing.  */
1857 typedef struct gfc_equiv_info
1858 {
1859   gfc_symbol *sym;
1860   HOST_WIDE_INT offset;
1861   HOST_WIDE_INT length;
1862   struct gfc_equiv_info *next;
1863 } gfc_equiv_info;
1864
1865 /* Holds equivalence groups, after they have been processed.  */
1866 typedef struct gfc_equiv_list
1867 {
1868   gfc_equiv_info *equiv;
1869   struct gfc_equiv_list *next;
1870 } gfc_equiv_list;
1871
1872 /* gfc_case stores the selector list of a case statement.  The *low
1873    and *high pointers can point to the same expression in the case of
1874    a single value.  If *high is NULL, the selection is from *low
1875    upwards, if *low is NULL the selection is *high downwards.
1876
1877    This structure has separate fields to allow single and double linked
1878    lists of CASEs at the same time.  The singe linked list along the NEXT
1879    field is a list of cases for a single CASE label.  The double linked
1880    list along the LEFT/RIGHT fields is used to detect overlap and to
1881    build a table of the cases for SELECT constructs with a CHARACTER
1882    case expression.  */
1883
1884 typedef struct gfc_case
1885 {
1886   /* Where we saw this case.  */
1887   locus where;
1888   int n;
1889
1890   /* Case range values.  If (low == high), it's a single value.  If one of
1891      the labels is NULL, it's an unbounded case.  If both are NULL, this
1892      represents the default case.  */
1893   gfc_expr *low, *high;
1894
1895   /* Only used for SELECT TYPE.  */
1896   gfc_typespec ts;
1897
1898   /* Next case label in the list of cases for a single CASE label.  */
1899   struct gfc_case *next;
1900
1901   /* Used for detecting overlap, and for code generation.  */
1902   struct gfc_case *left, *right;
1903
1904   /* True if this case label can never be matched.  */
1905   int unreachable;
1906 }
1907 gfc_case;
1908
1909 #define gfc_get_case() XCNEW (gfc_case)
1910
1911
1912 typedef struct
1913 {
1914   gfc_expr *var, *start, *end, *step;
1915 }
1916 gfc_iterator;
1917
1918 #define gfc_get_iterator() XCNEW (gfc_iterator)
1919
1920
1921 /* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements.  */
1922
1923 typedef struct gfc_alloc
1924 {
1925   gfc_expr *expr;
1926   struct gfc_alloc *next;
1927 }
1928 gfc_alloc;
1929
1930 #define gfc_get_alloc() XCNEW (gfc_alloc)
1931
1932
1933 typedef struct
1934 {
1935   gfc_expr *unit, *file, *status, *access, *form, *recl,
1936     *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
1937     *decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit;
1938   gfc_st_label *err;
1939 }
1940 gfc_open;
1941
1942
1943 typedef struct
1944 {
1945   gfc_expr *unit, *status, *iostat, *iomsg;
1946   gfc_st_label *err;
1947 }
1948 gfc_close;
1949
1950
1951 typedef struct
1952 {
1953   gfc_expr *unit, *iostat, *iomsg;
1954   gfc_st_label *err;
1955 }
1956 gfc_filepos;
1957
1958
1959 typedef struct
1960 {
1961   gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
1962     *name, *access, *sequential, *direct, *form, *formatted,
1963     *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
1964     *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
1965     *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id;
1966
1967   gfc_st_label *err;
1968
1969 }
1970 gfc_inquire;
1971
1972
1973 typedef struct
1974 {
1975   gfc_expr *unit, *iostat, *iomsg, *id;
1976   gfc_st_label *err, *end, *eor;
1977 }
1978 gfc_wait;
1979
1980
1981 typedef struct
1982 {
1983   gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
1984            *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
1985            *sign, *extra_comma;
1986
1987   gfc_symbol *namelist;
1988   /* A format_label of `format_asterisk' indicates the "*" format */
1989   gfc_st_label *format_label;
1990   gfc_st_label *err, *end, *eor;
1991
1992   locus eor_where, end_where, err_where;
1993 }
1994 gfc_dt;
1995
1996
1997 typedef struct gfc_forall_iterator
1998 {
1999   gfc_expr *var, *start, *end, *stride;
2000   struct gfc_forall_iterator *next;
2001 }
2002 gfc_forall_iterator;
2003
2004
2005 /* Linked list to store associations in an ASSOCIATE statement.  */
2006
2007 typedef struct gfc_association_list
2008 {
2009   struct gfc_association_list *next;
2010
2011   /* Whether this is association to a variable that can be changed; otherwise,
2012      it's association to an expression and the name may not be used as
2013      lvalue.  */
2014   unsigned variable:1;
2015
2016   /* True if this struct is currently only linked to from a gfc_symbol rather
2017      than as part of a real list in gfc_code->ext.block.assoc.  This may
2018      happen for SELECT TYPE temporaries and must be considered
2019      for memory handling.  */
2020   unsigned dangling:1;
2021
2022   char name[GFC_MAX_SYMBOL_LEN + 1];
2023   gfc_symtree *st; /* Symtree corresponding to name.  */
2024   locus where;
2025
2026   gfc_expr *target;
2027 }
2028 gfc_association_list;
2029 #define gfc_get_association_list() XCNEW (gfc_association_list)
2030
2031
2032 /* Executable statements that fill gfc_code structures.  */
2033 typedef enum
2034 {
2035   EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN,
2036   EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP,
2037   EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN,
2038   EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
2039   EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_BLOCK,
2040   EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC,
2041   EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE, EXEC_SELECT_TYPE,
2042   EXEC_SYNC_ALL, EXEC_SYNC_MEMORY, EXEC_SYNC_IMAGES,
2043   EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
2044   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
2045   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
2046   EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
2047   EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
2048   EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
2049   EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
2050   EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
2051   EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT
2052 }
2053 gfc_exec_op;
2054
2055 typedef struct gfc_code
2056 {
2057   gfc_exec_op op;
2058
2059   struct gfc_code *block, *next;
2060   locus loc;
2061
2062   gfc_st_label *here, *label1, *label2, *label3;
2063   gfc_symtree *symtree;
2064   gfc_expr *expr1, *expr2, *expr3;
2065   /* A name isn't sufficient to identify a subroutine, we need the actual
2066      symbol for the interface definition.
2067   const char *sub_name;  */
2068   gfc_symbol *resolved_sym;
2069   gfc_intrinsic_sym *resolved_isym;
2070
2071   union
2072   {
2073     gfc_actual_arglist *actual;
2074     gfc_case *case_list;
2075     gfc_iterator *iterator;
2076
2077     struct
2078     {
2079       gfc_typespec ts;
2080       gfc_alloc *list;
2081     }
2082     alloc;
2083
2084     struct
2085     {
2086       gfc_namespace *ns;
2087       gfc_association_list *assoc;
2088     }
2089     block;
2090
2091     gfc_open *open;
2092     gfc_close *close;
2093     gfc_filepos *filepos;
2094     gfc_inquire *inquire;
2095     gfc_wait *wait;
2096     gfc_dt *dt;
2097     gfc_forall_iterator *forall_iterator;
2098     struct gfc_code *whichloop;
2099     int stop_code;
2100     gfc_entry_list *entry;
2101     gfc_omp_clauses *omp_clauses;
2102     const char *omp_name;
2103     gfc_namelist *omp_namelist;
2104     bool omp_bool;
2105   }
2106   ext;          /* Points to additional structures required by statement */
2107
2108   /* Cycle and break labels in do loops.  */
2109   tree cycle_label;
2110   tree exit_label;
2111 }
2112 gfc_code;
2113
2114
2115 /* Storage for DATA statements.  */
2116 typedef struct gfc_data_variable
2117 {
2118   gfc_expr *expr;
2119   gfc_iterator iter;
2120   struct gfc_data_variable *list, *next;
2121 }
2122 gfc_data_variable;
2123
2124
2125 typedef struct gfc_data_value
2126 {
2127   mpz_t repeat;
2128   gfc_expr *expr;
2129   struct gfc_data_value *next;
2130 }
2131 gfc_data_value;
2132
2133
2134 typedef struct gfc_data
2135 {
2136   gfc_data_variable *var;
2137   gfc_data_value *value;
2138   locus where;
2139
2140   struct gfc_data *next;
2141 }
2142 gfc_data;
2143
2144
2145 /* Structure for holding compile options */
2146 typedef struct
2147 {
2148   char *module_dir;
2149   gfc_source_form source_form;
2150   /* Maximum line lengths in fixed- and free-form source, respectively.
2151      When fixed_line_length or free_line_length are 0, the whole line is used,
2152      regardless of length.
2153
2154      If the user requests a fixed_line_length <7 then gfc_init_options()
2155      emits a fatal error.  */
2156   int fixed_line_length;
2157   int free_line_length;
2158   /* Maximum number of continuation lines in fixed- and free-form source,
2159      respectively.  */
2160   int max_continue_fixed;
2161   int max_continue_free;
2162   int max_identifier_length;
2163   int dump_parse_tree;
2164
2165   int warn_aliasing;
2166   int warn_ampersand;
2167   int warn_conversion;
2168   int warn_conversion_extra;
2169   int warn_implicit_interface;
2170   int warn_implicit_procedure;
2171   int warn_line_truncation;
2172   int warn_surprising;
2173   int warn_tabs;
2174   int warn_underflow;
2175   int warn_intrinsic_shadow;
2176   int warn_intrinsics_std;
2177   int warn_character_truncation;
2178   int warn_array_temp;
2179   int warn_align_commons;
2180   int warn_unused_dummy_argument;
2181   int max_errors;
2182
2183   int flag_all_intrinsics;
2184   int flag_default_double;
2185   int flag_default_integer;
2186   int flag_default_real;
2187   int flag_dollar_ok;
2188   int flag_underscoring;
2189   int flag_second_underscore;
2190   int flag_implicit_none;
2191   int flag_max_stack_var_size;
2192   int flag_max_array_constructor;
2193   int flag_range_check;
2194   int flag_pack_derived;
2195   int flag_repack_arrays;
2196   int flag_preprocessed;
2197   int flag_f2c;
2198   int flag_automatic;
2199   int flag_backslash;
2200   int flag_backtrace;
2201   int flag_allow_leading_underscore;
2202   int flag_dump_core;
2203   int flag_external_blas;
2204   int blas_matmul_limit;
2205   int flag_cray_pointer;
2206   int flag_d_lines;
2207   int flag_openmp;
2208   int flag_sign_zero;
2209   int flag_module_private;
2210   int flag_recursive;
2211   int flag_init_local_zero;
2212   int flag_init_integer;
2213   int flag_init_integer_value;
2214   int flag_init_real;
2215   int flag_init_logical;
2216   int flag_init_character;
2217   char flag_init_character_value;
2218   int flag_align_commons;
2219   int flag_whole_file;
2220   int flag_protect_parens;
2221
2222   int fpe;
2223   int rtcheck;
2224   gfc_fcoarray coarray;
2225
2226   int warn_std;
2227   int allow_std;
2228   int convert;
2229   int record_marker;
2230   int max_subrecord_length;
2231 }
2232 gfc_option_t;
2233
2234 extern gfc_option_t gfc_option;
2235
2236 /* Constructor nodes for array and structure constructors.  */
2237 typedef struct gfc_constructor
2238 {
2239   gfc_constructor_base base;
2240   mpz_t offset;               /* Offset within a constructor, used as
2241                                  key within base. */
2242
2243   gfc_expr *expr;
2244   gfc_iterator *iterator;
2245   locus where;
2246
2247   union
2248   {
2249      gfc_component *component; /* Record the component being initialized.  */
2250   }
2251   n;
2252 }
2253 gfc_constructor;
2254
2255
2256 typedef struct iterator_stack
2257 {
2258   gfc_symtree *variable;
2259   mpz_t value;
2260   struct iterator_stack *prev;
2261 }
2262 iterator_stack;
2263 extern iterator_stack *iter_stack;
2264
2265
2266 /* Used for (possibly nested) SELECT TYPE statements.  */
2267 typedef struct gfc_select_type_stack
2268 {
2269   gfc_symbol *selector;                 /* Current selector variable.  */
2270   gfc_symtree *tmp;                     /* Current temporary variable.  */
2271   struct gfc_select_type_stack *prev;   /* Previous element on stack.  */
2272 }
2273 gfc_select_type_stack;
2274 extern gfc_select_type_stack *select_type_stack;
2275 #define gfc_get_select_type_stack() XCNEW (gfc_select_type_stack)
2276
2277
2278 /* Node in the linked list used for storing finalizer procedures.  */
2279
2280 typedef struct gfc_finalizer
2281 {
2282   struct gfc_finalizer* next;
2283   locus where; /* Where the FINAL declaration occurred.  */
2284
2285   /* Up to resolution, we want the gfc_symbol, there we lookup the corresponding
2286      symtree and later need only that.  This way, we can access and call the
2287      finalizers from every context as they should be "always accessible".  I
2288      don't make this a union because we need the information whether proc_sym is
2289      still referenced or not for dereferencing it on deleting a gfc_finalizer
2290      structure.  */
2291   gfc_symbol*  proc_sym;
2292   gfc_symtree* proc_tree;
2293 }
2294 gfc_finalizer;
2295 #define gfc_get_finalizer() XCNEW (gfc_finalizer)
2296
2297
2298 /************************ Function prototypes *************************/
2299
2300 /* decl.c */
2301 bool gfc_in_match_data (void);
2302 match gfc_match_char_spec (gfc_typespec *);
2303
2304 /* scanner.c */
2305 void gfc_scanner_done_1 (void);
2306 void gfc_scanner_init_1 (void);
2307
2308 void gfc_add_include_path (const char *, bool, bool);
2309 void gfc_add_intrinsic_modules_path (const char *);
2310 void gfc_release_include_path (void);
2311 FILE *gfc_open_included_file (const char *, bool, bool);
2312 FILE *gfc_open_intrinsic_module (const char *);
2313
2314 int gfc_at_end (void);
2315 int gfc_at_eof (void);
2316 int gfc_at_bol (void);
2317 int gfc_at_eol (void);
2318 void gfc_advance_line (void);
2319 int gfc_check_include (void);
2320 int gfc_define_undef_line (void);
2321
2322 int gfc_wide_is_printable (gfc_char_t);
2323 int gfc_wide_is_digit (gfc_char_t);
2324 int gfc_wide_fits_in_byte (gfc_char_t);
2325 gfc_char_t gfc_wide_tolower (gfc_char_t);
2326 gfc_char_t gfc_wide_toupper (gfc_char_t);
2327 size_t gfc_wide_strlen (const gfc_char_t *);
2328 int gfc_wide_strncasecmp (const gfc_char_t *, const char *, size_t);
2329 gfc_char_t *gfc_wide_memset (gfc_char_t *, gfc_char_t, size_t);
2330 char *gfc_widechar_to_char (const gfc_char_t *, int);
2331 gfc_char_t *gfc_char_to_widechar (const char *);
2332
2333 #define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
2334
2335 void gfc_skip_comments (void);
2336 gfc_char_t gfc_next_char_literal (int);
2337 gfc_char_t gfc_next_char (void);
2338 char gfc_next_ascii_char (void);
2339 gfc_char_t gfc_peek_char (void);
2340 char gfc_peek_ascii_char (void);
2341 void gfc_error_recovery (void);
2342 void gfc_gobble_whitespace (void);
2343 gfc_try gfc_new_file (void);
2344 const char * gfc_read_orig_filename (const char *, const char **);
2345
2346 extern gfc_source_form gfc_current_form;
2347 extern const char *gfc_source_file;
2348 extern locus gfc_current_locus;
2349
2350 void gfc_start_source_files (void);
2351 void gfc_end_source_files (void);
2352
2353 /* misc.c */
2354 void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
2355 void gfc_free (void *);
2356 int gfc_terminal_width (void);
2357 void gfc_clear_ts (gfc_typespec *);
2358 FILE *gfc_open_file (const char *);
2359 const char *gfc_basic_typename (bt);
2360 const char *gfc_typename (gfc_typespec *);
2361 const char *gfc_op2string (gfc_intrinsic_op);
2362 const char *gfc_code2string (const mstring *, int);
2363 int gfc_string2code (const mstring *, const char *);
2364 const char *gfc_intent_string (sym_intent);
2365
2366 void gfc_init_1 (void);
2367 void gfc_init_2 (void);
2368 void gfc_done_1 (void);
2369 void gfc_done_2 (void);
2370
2371 int get_c_kind (const char *, CInteropKind_t *);
2372
2373 /* options.c */
2374 unsigned int gfc_option_lang_mask (void);
2375 void gfc_init_options (unsigned int,
2376                        struct cl_decoded_option *);
2377 bool gfc_handle_option (size_t, const char *, int, int,
2378                         const struct cl_option_handlers *);
2379 bool gfc_post_options (const char **);
2380
2381 /* f95-lang.c */
2382 void gfc_maybe_initialize_eh (void);
2383
2384 /* iresolve.c */
2385 const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
2386 bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
2387
2388 /* error.c */
2389
2390 typedef struct gfc_error_buf
2391 {
2392   int flag;
2393   size_t allocated, index;
2394   char *message;
2395 } gfc_error_buf;
2396
2397 void gfc_error_init_1 (void);
2398 void gfc_buffer_error (int);
2399
2400 const char *gfc_print_wide_char (gfc_char_t);
2401
2402 void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
2403 void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
2404 void gfc_clear_warning (void);
2405 void gfc_warning_check (void);
2406
2407 void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
2408 void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
2409 void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
2410 void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
2411 void gfc_clear_error (void);
2412 int gfc_error_check (void);
2413 int gfc_error_flag_test (void);
2414
2415 notification gfc_notification_std (int);
2416 gfc_try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
2417
2418 /* A general purpose syntax error.  */
2419 #define gfc_syntax_error(ST)    \
2420   gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
2421
2422 void gfc_push_error (gfc_error_buf *);
2423 void gfc_pop_error (gfc_error_buf *);
2424 void gfc_free_error (gfc_error_buf *);
2425
2426 void gfc_get_errors (int *, int *);
2427 void gfc_errors_to_warnings (int);
2428
2429 /* arith.c */
2430 void gfc_arith_init_1 (void);
2431 void gfc_arith_done_1 (void);
2432 arith gfc_check_integer_range (mpz_t p, int kind);
2433 bool gfc_check_character_range (gfc_char_t, int);
2434
2435 /* trans-types.c */
2436 gfc_try gfc_check_any_c_kind (gfc_typespec *);
2437 int gfc_validate_kind (bt, int, bool);
2438 int gfc_get_int_kind_from_width_isofortranenv (int size);
2439 int gfc_get_real_kind_from_width_isofortranenv (int size);
2440 tree gfc_get_derived_type (gfc_symbol * derived);
2441 extern int gfc_index_integer_kind;
2442 extern int gfc_default_integer_kind;
2443 extern int gfc_max_integer_kind;
2444 extern int gfc_default_real_kind;
2445 extern int gfc_default_double_kind;
2446 extern int gfc_default_character_kind;
2447 extern int gfc_default_logical_kind;
2448 extern int gfc_default_complex_kind;
2449 extern int gfc_c_int_kind;
2450 extern int gfc_intio_kind;
2451 extern int gfc_charlen_int_kind;
2452 extern int gfc_numeric_storage_size;
2453 extern int gfc_character_storage_size;
2454
2455 /* symbol.c */
2456 void gfc_clear_new_implicit (void);
2457 gfc_try gfc_add_new_implicit_range (int, int);
2458 gfc_try gfc_merge_new_implicit (gfc_typespec *);
2459 void gfc_set_implicit_none (void);
2460 void gfc_check_function_type (gfc_namespace *);
2461 bool gfc_is_intrinsic_typename (const char *);
2462
2463 gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
2464 gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
2465
2466 void gfc_set_sym_referenced (gfc_symbol *);
2467
2468 gfc_try gfc_add_attribute (symbol_attribute *, locus *);
2469 gfc_try gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
2470 gfc_try gfc_add_allocatable (symbol_attribute *, locus *);
2471 gfc_try gfc_add_codimension (symbol_attribute *, const char *, locus *);
2472 gfc_try gfc_add_contiguous (symbol_attribute *, const char *, locus *);
2473 gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *);
2474 gfc_try gfc_add_external (symbol_attribute *, locus *);
2475 gfc_try gfc_add_intrinsic (symbol_attribute *, locus *);
2476 gfc_try gfc_add_optional (symbol_attribute *, locus *);
2477 gfc_try gfc_add_pointer (symbol_attribute *, locus *);
2478 gfc_try gfc_add_cray_pointer (symbol_attribute *, locus *);
2479 gfc_try gfc_add_cray_pointee (symbol_attribute *, locus *);
2480 match gfc_mod_pointee_as (gfc_array_spec *);
2481 gfc_try gfc_add_protected (symbol_attribute *, const char *, locus *);
2482 gfc_try gfc_add_result (symbol_attribute *, const char *, locus *);
2483 gfc_try gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
2484 gfc_try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
2485 gfc_try gfc_add_saved_common (symbol_attribute *, locus *);
2486 gfc_try gfc_add_target (symbol_attribute *, locus *);
2487 gfc_try gfc_add_dummy (symbol_attribute *, const char *, locus *);
2488 gfc_try gfc_add_generic (symbol_attribute *, const char *, locus *);
2489 gfc_try gfc_add_common (symbol_attribute *, locus *);
2490 gfc_try gfc_add_in_common (symbol_attribute *, const char *, locus *);
2491 gfc_try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
2492 gfc_try gfc_add_data (symbol_attribute *, const char *, locus *);
2493 gfc_try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
2494 gfc_try gfc_add_sequence (symbol_attribute *, const char *, locus *);
2495 gfc_try gfc_add_elemental (symbol_attribute *, locus *);
2496 gfc_try gfc_add_pure (symbol_attribute *, locus *);
2497 gfc_try gfc_add_recursive (symbol_attribute *, locus *);
2498 gfc_try gfc_add_function (symbol_attribute *, const char *, locus *);
2499 gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
2500 gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
2501 gfc_try gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
2502 gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
2503 gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);
2504
2505 gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
2506 gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
2507 gfc_try gfc_add_extension (symbol_attribute *, locus *);
2508 gfc_try gfc_add_value (symbol_attribute *, const char *, locus *);
2509 gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
2510 gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *);
2511 gfc_try gfc_add_procedure (symbol_attribute *, procedure_type,
2512                        const char *, locus *);
2513 gfc_try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
2514 gfc_try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
2515                                 gfc_formal_arglist *, locus *);
2516 gfc_try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
2517
2518 void gfc_clear_attr (symbol_attribute *);
2519 gfc_try gfc_missing_attr (symbol_attribute *, locus *);
2520 gfc_try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
2521
2522 gfc_try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
2523 gfc_symbol *gfc_use_derived (gfc_symbol *);
2524 gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
2525 gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool);
2526
2527 gfc_st_label *gfc_get_st_label (int);
2528 void gfc_free_st_label (gfc_st_label *);
2529 void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
2530 gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
2531
2532 gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
2533
2534 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
2535 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
2536 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
2537 void gfc_delete_symtree (gfc_symtree **, const char *);
2538 gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
2539 gfc_user_op *gfc_get_uop (const char *);
2540 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
2541 void gfc_free_symbol (gfc_symbol *);
2542 void gfc_release_symbol (gfc_symbol *);
2543 gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
2544 gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
2545 int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
2546 int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
2547 int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
2548 gfc_try verify_c_interop (gfc_typespec *);
2549 gfc_try verify_c_interop_param (gfc_symbol *);
2550 gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
2551 gfc_try verify_bind_c_derived_type (gfc_symbol *);
2552 gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
2553 void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *);
2554 gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int);
2555 int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
2556 int gfc_get_ha_symbol (const char *, gfc_symbol **);
2557 int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
2558
2559 int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
2560
2561 void gfc_undo_symbols (void);
2562 void gfc_commit_symbols (void);
2563 void gfc_commit_symbol (gfc_symbol *);
2564 gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
2565 void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
2566 void gfc_free_namespace (gfc_namespace *);
2567
2568 void gfc_symbol_init_2 (void);
2569 void gfc_symbol_done_2 (void);
2570
2571 void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
2572 void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
2573 void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
2574 void gfc_save_all (gfc_namespace *);
2575
2576 void gfc_enforce_clean_symbol_state (void);
2577 void gfc_free_dt_list (void);
2578
2579
2580 gfc_gsymbol *gfc_get_gsymbol (const char *);
2581 gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
2582
2583 gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
2584 gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
2585 gfc_symbol* gfc_get_ultimate_derived_super_type (gfc_symbol*);
2586 bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
2587 bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
2588
2589 void gfc_copy_formal_args (gfc_symbol *, gfc_symbol *);
2590 void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
2591 void gfc_copy_formal_args_ppc (gfc_component *, gfc_symbol *);
2592
2593 void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too  */
2594
2595 gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
2596 gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
2597
2598 bool gfc_is_associate_pointer (gfc_symbol*);
2599
2600 /* intrinsic.c -- true if working in an init-expr, false otherwise.  */
2601 extern bool gfc_init_expr_flag;
2602
2603 /* Given a symbol that we have decided is intrinsic, mark it as such
2604    by placing it into a special module that is otherwise impossible to
2605    read or write.  */
2606
2607 #define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
2608
2609 void gfc_intrinsic_init_1 (void);
2610 void gfc_intrinsic_done_1 (void);
2611
2612 char gfc_type_letter (bt);
2613 gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
2614 gfc_try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
2615 gfc_try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
2616 gfc_try gfc_convert_chartype (gfc_expr *, gfc_typespec *);
2617 int gfc_generic_intrinsic (const char *);
2618 int gfc_specific_intrinsic (const char *);
2619 bool gfc_is_intrinsic (gfc_symbol*, int, locus);
2620 int gfc_intrinsic_actual_ok (const char *, const bool);
2621 gfc_intrinsic_sym *gfc_find_function (const char *);
2622 gfc_intrinsic_sym *gfc_find_subroutine (const char *);
2623
2624 match gfc_intrinsic_func_interface (gfc_expr *, int);
2625 match gfc_intrinsic_sub_interface (gfc_code *, int);
2626
2627 void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
2628 gfc_try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
2629                                       bool, locus);
2630
2631 /* match.c -- FIXME */
2632 void gfc_free_iterator (gfc_iterator *, int);
2633 void gfc_free_forall_iterator (gfc_forall_iterator *);
2634 void gfc_free_alloc_list (gfc_alloc *);
2635 void gfc_free_namelist (gfc_namelist *);
2636 void gfc_free_equiv (gfc_equiv *);
2637 void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
2638 void gfc_free_data (gfc_data *);
2639 void gfc_free_case_list (gfc_case *);
2640
2641 /* matchexp.c -- FIXME too?  */
2642 gfc_expr *gfc_get_parentheses (gfc_expr *);
2643
2644 /* openmp.c */
2645 void gfc_free_omp_clauses (gfc_omp_clauses *);
2646 void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
2647 void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *);
2648 void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
2649 void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
2650
2651 /* expr.c */
2652 void gfc_free_actual_arglist (gfc_actual_arglist *);
2653 gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
2654 const char *gfc_extract_int (gfc_expr *, int *);
2655 bool is_subref_array (gfc_expr *);
2656 bool gfc_is_simply_contiguous (gfc_expr *, bool);
2657
2658 gfc_expr *gfc_build_conversion (gfc_expr *);
2659 void gfc_free_ref_list (gfc_ref *);
2660 void gfc_type_convert_binary (gfc_expr *, int);
2661 int gfc_is_constant_expr (gfc_expr *);
2662 gfc_try gfc_simplify_expr (gfc_expr *, int);
2663 int gfc_has_vector_index (gfc_expr *);
2664
2665 gfc_expr *gfc_get_expr (void);
2666 gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
2667 gfc_expr *gfc_get_null_expr (locus *);
2668 gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *, gfc_expr *);
2669 gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *);
2670 gfc_expr *gfc_get_constant_expr (bt, int, locus *);
2671 gfc_expr *gfc_get_character_expr (int, locus *, const char *, int len);
2672 gfc_expr *gfc_get_int_expr (int, locus *, int);
2673 gfc_expr *gfc_get_logical_expr (int, locus *, bool);
2674 gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
2675
2676 void gfc_free_expr (gfc_expr *);
2677 void gfc_replace_expr (gfc_expr *, gfc_expr *);
2678 mpz_t *gfc_copy_shape (mpz_t *, int);
2679 mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
2680 gfc_expr *gfc_copy_expr (gfc_expr *);
2681 gfc_ref* gfc_copy_ref (gfc_ref*);
2682
2683 gfc_try gfc_specification_expr (gfc_expr *);
2684
2685 int gfc_numeric_ts (gfc_typespec *);
2686 int gfc_kind_max (gfc_expr *, gfc_expr *);
2687
2688 gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
2689 gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int);
2690 gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
2691 gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
2692
2693 bool gfc_has_default_initializer (gfc_symbol *);
2694 gfc_expr *gfc_default_initializer (gfc_typespec *);
2695 gfc_expr *gfc_get_variable_expr (gfc_symtree *);
2696
2697 gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
2698
2699 bool gfc_traverse_expr (gfc_expr *, gfc_symbol *,
2700                         bool (*)(gfc_expr *, gfc_symbol *, int*),
2701                         int);
2702 void gfc_expr_set_symbols_referenced (gfc_expr *);
2703 gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
2704 void gfc_expr_replace_symbols (gfc_expr *, gfc_symbol *);
2705 void gfc_expr_replace_comp (gfc_expr *, gfc_component *);
2706
2707 bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
2708
2709 bool gfc_is_coindexed (gfc_expr *);
2710 bool gfc_get_corank (gfc_expr *);
2711 bool gfc_has_ultimate_allocatable (gfc_expr *);
2712 bool gfc_has_ultimate_pointer (gfc_expr *);
2713
2714 gfc_expr* gfc_build_intrinsic_call (const char*, locus, unsigned, ...);
2715
2716
2717 /* st.c */
2718 extern gfc_code new_st;
2719
2720 void gfc_clear_new_st (void);
2721 gfc_code *gfc_get_code (void);
2722 gfc_code *gfc_append_code (gfc_code *, gfc_code *);
2723 void gfc_free_statement (gfc_code *);
2724 void gfc_free_statements (gfc_code *);
2725 void gfc_free_association_list (gfc_association_list *);
2726
2727 /* resolve.c */
2728 gfc_try gfc_resolve_expr (gfc_expr *);
2729 void gfc_resolve (gfc_namespace *);
2730 void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
2731 int gfc_impure_variable (gfc_symbol *);
2732 int gfc_pure (gfc_symbol *);
2733 int gfc_elemental (gfc_symbol *);
2734 gfc_try gfc_resolve_iterator (gfc_iterator *, bool);
2735 gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int);
2736 gfc_try gfc_resolve_index (gfc_expr *, int);
2737 gfc_try gfc_resolve_dim_arg (gfc_expr *);
2738 int gfc_is_formal_arg (void);
2739 void gfc_resolve_substring_charlen (gfc_expr *);
2740 match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
2741 gfc_expr *gfc_expr_to_initialize (gfc_expr *);
2742 bool gfc_type_is_extensible (gfc_symbol *sym);
2743
2744
2745 /* array.c */
2746 gfc_iterator *gfc_copy_iterator (gfc_iterator *);
2747
2748 void gfc_free_array_spec (gfc_array_spec *);
2749 gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
2750
2751 gfc_try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
2752 gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
2753 gfc_try gfc_resolve_array_spec (gfc_array_spec *, int);
2754
2755 int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
2756
2757 void gfc_simplify_iterator_var (gfc_expr *);
2758 gfc_try gfc_expand_constructor (gfc_expr *, bool);
2759 int gfc_constant_ac (gfc_expr *);
2760 int gfc_expanded_ac (gfc_expr *);
2761 gfc_try gfc_resolve_character_array_constructor (gfc_expr *);
2762 gfc_try gfc_resolve_array_constructor (gfc_expr *);
2763 gfc_try gfc_check_constructor_type (gfc_expr *);
2764 gfc_try gfc_check_iter_variable (gfc_expr *);
2765 gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *));
2766 gfc_try gfc_array_size (gfc_expr *, mpz_t *);
2767 gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
2768 gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
2769 gfc_array_ref *gfc_find_array_ref (gfc_expr *);
2770 tree gfc_conv_array_initializer (tree type, gfc_expr *);
2771 gfc_try spec_size (gfc_array_spec *, mpz_t *);
2772 gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
2773 int gfc_is_compile_time_shape (gfc_array_spec *);
2774
2775 gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
2776
2777
2778 /* interface.c -- FIXME: some of these should be in symbol.c */
2779 void gfc_free_interface (gfc_interface *);
2780 int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
2781 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
2782 int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
2783                             char *, int);
2784 void gfc_check_interfaces (gfc_namespace *);
2785 void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
2786 void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
2787 gfc_symbol *gfc_search_interface (gfc_interface *, int,
2788                                   gfc_actual_arglist **);
2789 gfc_try gfc_extend_expr (gfc_expr *, bool *);
2790 void gfc_free_formal_arglist (gfc_formal_arglist *);
2791 gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
2792 gfc_try gfc_add_interface (gfc_symbol *);
2793 gfc_interface *gfc_current_interface_head (void);
2794 void gfc_set_current_interface_head (gfc_interface *);
2795 gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
2796 bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
2797 bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
2798 int gfc_has_vector_subscript (gfc_expr*);
2799
2800 /* io.c */
2801 extern gfc_st_label format_asterisk;
2802
2803 void gfc_free_open (gfc_open *);
2804 gfc_try gfc_resolve_open (gfc_open *);
2805 void gfc_free_close (gfc_close *);
2806 gfc_try gfc_resolve_close (gfc_close *);
2807 void gfc_free_filepos (gfc_filepos *);
2808 gfc_try gfc_resolve_filepos (gfc_filepos *);
2809 void gfc_free_inquire (gfc_inquire *);
2810 gfc_try gfc_resolve_inquire (gfc_inquire *);
2811 void gfc_free_dt (gfc_dt *);
2812 gfc_try gfc_resolve_dt (gfc_dt *, locus *);
2813 void gfc_free_wait (gfc_wait *);
2814 gfc_try gfc_resolve_wait (gfc_wait *);
2815
2816 /* module.c */
2817 void gfc_module_init_2 (void);
2818 void gfc_module_done_2 (void);
2819 void gfc_dump_module (const char *, int);
2820 bool gfc_check_access (gfc_access, gfc_access);
2821 void gfc_free_use_stmts (gfc_use_list *);
2822
2823 /* primary.c */
2824 symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
2825 symbol_attribute gfc_expr_attr (gfc_expr *);
2826 match gfc_match_rvalue (gfc_expr **);
2827 match gfc_match_varspec (gfc_expr*, int, bool, bool);
2828 int gfc_check_digit (char, int);
2829 bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
2830
2831 /* trans.c */
2832 void gfc_generate_code (gfc_namespace *);
2833 void gfc_generate_module_code (gfc_namespace *);
2834
2835 /* bbt.c */
2836 typedef int (*compare_fn) (void *, void *);
2837 void gfc_insert_bbt (void *, void *, compare_fn);
2838 void gfc_delete_bbt (void *, void *, compare_fn);
2839
2840 /* dump-parse-tree.c */
2841 void gfc_dump_parse_tree (gfc_namespace *, FILE *);
2842
2843 /* parse.c */
2844 gfc_try gfc_parse_file (void);
2845 void gfc_global_used (gfc_gsymbol *, locus *);
2846 gfc_namespace* gfc_build_block_ns (gfc_namespace *);
2847
2848 /* dependency.c */
2849 int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
2850
2851 /* check.c */
2852 gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
2853
2854 /* class.c */
2855 void gfc_add_component_ref (gfc_expr *, const char *);
2856 gfc_expr *gfc_class_null_initializer (gfc_typespec *);
2857 gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
2858                                 gfc_array_spec **, bool);
2859 gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
2860 gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
2861                                       const char*, bool, locus*);
2862 gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
2863                                          const char*, bool, locus*);
2864 gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
2865                                                      gfc_intrinsic_op, bool,
2866                                                      locus*);
2867 gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
2868
2869 #define CLASS_DATA(sym) sym->ts.u.derived->components
2870
2871 /* frontend-passes.c */
2872
2873 void gfc_run_passes (gfc_namespace *);
2874
2875 #endif /* GCC_GFORTRAN_H  */