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