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