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