gcc/fortran/gfortran.h

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