1 /* 2 * Copyright (c) 1994-2019, NVIDIA CORPORATION. All rights reserved. 3 * 4 * Licensed under the Apache License, Version 2.0 (the "License"); 5 * you may not use this file except in compliance with the License. 6 * You may obtain a copy of the License at 7 * 8 * http://www.apache.org/licenses/LICENSE-2.0 9 * 10 * Unless required by applicable law or agreed to in writing, software 11 * distributed under the License is distributed on an "AS IS" BASIS, 12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 * See the License for the specific language governing permissions and 14 * limitations under the License. 15 * 16 */ 17 18 /** 19 \file 20 \brief Semantic analyzer data definitions. 21 */ 22 23 /* Semantic stack entry types (SST_ID) */ 24 #define S_NULL 0 /* empty/invalid */ 25 #define S_CONST 1 /* scalar constant */ 26 #define S_EXPR 2 /* expression */ 27 #define S_LVALUE 3 /* non-whole variable */ 28 #define S_LOGEXPR 4 /* (obsolete; was logical expression) */ 29 #define S_STAR 5 /* * */ 30 #define S_VAL 6 /* %VAL(expr) argument (VMS) */ 31 #define S_IDENT 7 /* identifier, possibly a whole variable */ 32 #define S_LABEL 8 /* label */ 33 #define S_STFUNC 9 /* statement function reference */ 34 #define S_REF 10 /* %REF(expr) argument (VMS)*/ 35 #define S_TRIPLE 11 /* j:k:m */ 36 #define S_KEYWORD 12 /* keyword, not an identifier */ 37 #define S_ACONST 13 /* array constant */ 38 #define S_SCONST 14 /* structure constant */ 39 #define S_DERIVED 15 /* derived type object */ 40 41 /* macros for checking to see if a derived type has a defined I/O 42 * routine associated with it. DT_HAS_IO_FREAD true if derived type 43 * has a formatted read associated with it. DT_HAS_IO_UREAD true 44 * if derived type has an unformatted read associated with it. 45 * DT_HAS_IO_FWRITE true if derived type has a formatted write 46 * associated with it. DT_HAS_IO_UWRITE true if derived type has an 47 * unformatted write associated with it. DT_HAS_IO true if there's any 48 * defined I/O subroutine associated with it. 49 */ 50 #define DT_IO_UNKNOWN 0x0 /* Not yet known if derived type has defined I/O */ 51 #define DT_IO_NONE 0x1 /* No defined I/O for derived type */ 52 #define DT_IO_FREAD 0x2 /* Defined READ(FORMATTED) */ 53 #define DT_IO_UREAD 0x4 /* Defined READ(UNFORMATTED) */ 54 #define DT_IO_FWRITE 0x8 /* Defined WRITE(FORMATTED) */ 55 #define DT_IO_UWRITE 0x10 /* Defined WRITE(UNFORMATTED) */ 56 57 #define DT_HAS_IO_FREAD(dt) (((UFIOG(DTY(dt + 3)) & DT_IO_FREAD))) 58 #define DT_HAS_IO_UREAD(dt) (((UFIOG(DTY(dt + 3)) & DT_IO_UREAD))) 59 #define DT_HAS_IO_FWRITE(dt) (((UFIOG(DTY(dt + 3)) & DT_IO_FWRITE))) 60 #define DT_HAS_IO_UWRITE(dt) (((UFIOG(DTY(dt + 3)) & DT_IO_UWRITE))) 61 #define DT_HAS_IO(dt) ((UFIOG(DTY(dt + 3)))) 62 63 #define NEW_INTRIN \ 64 65535 /* (newer) intrinsic with no predefined entry in the symtab */ 65 66 /* 67 * Generate lexical block debug information? Criteria: 68 * -debug 69 * not -Mvect (!flg.vect) 70 * not -Mconcur (!XBIT(34,0x200) 71 * lex block disabled (!XBIT(123,0x4000)) 72 */ 73 #define DBG_LEXBLK \ 74 flg.debug && !flg.vect && !XBIT(34, 0x200) && !XBIT(123, 0x400) 75 76 typedef struct type_list { 77 LOGICAL is_class; 78 int dtype; 79 int label; 80 struct type_list *next; 81 } TYPE_LIST; 82 83 typedef struct { 84 int first; 85 int last; 86 } FLITM; 87 88 typedef struct xyyz { 89 struct xyyz *next; 90 int ast; 91 union { 92 int sptr; 93 int ilm; 94 int cltype; 95 INT conval; 96 struct sst *stkp; 97 FLITM *flitmp; 98 } t; 99 } ITEM; 100 #define ITEM_END ((ITEM *)1) 101 102 typedef enum { 103 LP_PDO = 1, /* omp do */ 104 LP_PARDO, /* parallel do */ 105 LP_DISTRIBUTE, /* distribute loop: distribute construct */ 106 LP_DIST_TEAMS, /* distribute loop: teams distribute construct */ 107 LP_DIST_TARGTEAMS, /* distribute loop: target teams distribute construct */ 108 LP_DISTPARDO, /* distribute loop: distribute parallel do ... */ 109 LP_DISTPARDO_TEAMS, /* distribute loop: teams distribute parallel do ... */ 110 LP_DISTPARDO_TARGTEAMS, /* distribute loop: target teams dist... */ 111 LP_PARDO_OTHER, /* parallel do: created for any distribute parallel do 112 * construct. */ 113 } distlooptype; 114 115 typedef struct { 116 int index_var; /* do index variable */ 117 int init_expr; 118 int limit_expr; 119 int step_expr; 120 int count; /* loop count ast */ 121 int lastval_var; 122 int collapse; /* collapse level if applicable; 1 is innermost */ 123 char prev_dovar; /* DOVAR flag of index variable before it's entered */ 124 LOGICAL nodepchk; 125 distlooptype distloop; 126 } DOINFO; 127 128 typedef struct reduc_sym { 129 int shared; /* shared symbol */ 130 int Private; /* private copy */ 131 struct reduc_sym *next; 132 } REDUC_SYM; 133 134 typedef struct reduc_tag { /* reduction clause item */ 135 int opr; /* if != 0, OP_xxx value */ 136 int intrin; /* if != 0, sptr to intrinsic */ 137 REDUC_SYM *list; /* list of shared variables & private copies */ 138 struct reduc_tag *next; 139 } REDUC; 140 141 typedef struct noscope_sym { 142 int oldsptr; 143 int newsptr; 144 int lineno; 145 LOGICAL is_dovar; 146 } NOSCOPE_SYM; 147 148 typedef struct { /* DO-IF stack entries */ 149 int Id; 150 int lineno; /* beginning line# of control structure */ 151 BIGUINT nest; /* bit vector indicating the structures are present 152 * in the stack including the current structure 153 */ 154 int name; /* index into the symbol names area representing the 155 * name of the construct; 0 if construct is not named. 156 */ 157 int exit_label; /* For a DO loop, the label (target) of an EXIT 158 * stmt; 0 if the EXIT stmt is not present. 159 * For block-if construct, the label of the 160 * statement after the matching endif; created 161 * if else-if is present; 0 if else-if not present. 162 * For a case-construct, label of the statement after 163 * the case construct 164 */ 165 /* These four fields are OpenMP fields used in non-OpenMP slots. */ 166 NOSCOPE_SYM *no_scope_base; /* list of variables without scope */ 167 int no_scope_avail; 168 int no_scope_size; 169 int no_scope_forall; 170 union { 171 struct { 172 int do_label; /* label in the DO statement */ 173 int cycle_label; /* target label for CYCLE statement in do body */ 174 int top_label; /* label of the top of a DO while loop */ 175 int ast; /* DO ast */ 176 DOINFO *doinfo; /* 'do' info record for a DO statement */ 177 /* The remaining fields are for DO CONCURRENT loops. 178 * Some fields are only set on an innermost loop. */ 179 SPTR symavl; /* stb.stg_avail value at entry (sym "watermark") */ 180 int count; /* var=triplet control count -- outermost=1 */ 181 int kind; /* temp: 1) curr locality kind; 2) loop component kind */ 182 bool no_default; /* loop has a DEFAULT(NONE) locality spec? */ 183 int popindex; /* do pop the index symbol */ 184 int block_sym; /* loop body block sym */ 185 int syms; /* list of index, local, local_init, and shared syms */ 186 int last_sym; /* last sym in syms list */ 187 int label_syms; /* list of label syms */ 188 int error_syms; /* list of syms that have errors */ 189 int mask_std; /* mask std (may be null) */ 190 int body_std; /* first loop body std (may be null) */ 191 } u1; 192 struct { 193 int shapedim; /* number of dimensions in the WHERE construct */ 194 int masked; /* masked elsewhere */ 195 } u2; 196 struct { 197 int case_expr; /* SELECT CASE expression (an AST) */ 198 int dtype; /* data type of the SELECT CASE expression: 0 for 199 * an illegal expression. 200 */ 201 int beg_default; /* The pointer to the last STD generated when the 202 * 'CASE DEFAULT' is parsed (i.e., the STD which 203 * immediately precedes the first STD generated 204 * for the default block. If the CASE DEFAULT 205 * appears before a CASE, the STDs of the default 206 * block are 'saved' and this field locates the 207 * first STD of the default block. This field 208 * is initially 0. 209 */ 210 int end_default; /* If the default block is saved, this field is 211 * the pointer to the last STD of the default 212 * block. This field is initially 0. 213 * 214 * To determine: 215 * o if a CASEDEFAULT immediately precedes a 216 * CASE or ENDSELECT, beg_default is non-zero 217 * non-zero & end_default is 0. 218 * o if CASE DEFAULT has been saved (and it 219 * appears before a CASE), beg_default and 220 * end_default are non-zero. 221 * o if the default block is empty, beg_default 222 * is zero. 223 */ 224 int swel_hd; /* Relative pointer to the beginning of the SWEL 225 * list which represents the CASE values specified 226 * for the construct. 227 */ 228 int allo_chtmp; /* allocated char temp for case expr if necessary*/ 229 char default_seen; /* non-zero if CASEDEFAULT is present */ 230 char default_complete; /* non-zero if the end of the CASEDEFAULT has 231 * been handled 232 */ 233 char pending; /* non-zero if a CASE block is still open (its 234 * end hasn't been processed). 235 */ 236 } u3; 237 struct { /* OpenMP stuff */ 238 int bpar; /* ast of the A_MP_PARALLEL ast generated 239 * for a parallel region; filled in for the 240 * PARALLEL and 'combo' directives. 241 * sptr of the global semaphore variable 242 * created for CRITICAL <ident>. 243 */ 244 int beginp; /* beginning ast of the parallel construct. 245 * Both the bpar and beginp fields are 246 * filled in for the combo directives. 247 */ 248 int target; /* OpenMP use */ 249 int teams; /* OpenMP use */ 250 int distribute; /* OpenMP use */ 251 REDUC *reduc; /* reductions for parallel constructs */ 252 REDUC_SYM *lastprivate; /* lastprivate for parallel constructs */ 253 ITEM *allocated; /* list of allocated private variables */ 254 ITEM *region_vars; /* accelerator region copy/local/mirror vars */ 255 union { 256 struct { 257 /* DO */ 258 int sched_type; /* one of DI_SCHxxx if a parallel do */ 259 int chunk; /* sptr representing chunk size 260 * (0 if not present) 261 */ 262 LOGICAL is_ordered; /* loop has the ordered attribute */ 263 264 LOGICAL is_simd; /* if this loop can be simd loop */ 265 int dist_chunk; /* sptr representing distribute chunk size 266 * 0 is not present 267 */ 268 } v1; 269 struct { 270 /* SECTIONS */ 271 int sect_cnt; /* number of SECTION blocks */ 272 int sect_var; /* where to store section number */ 273 } v2; 274 } v; 275 } u4; 276 struct { /* SELECT TYPE */ 277 int selector; /* sptr of selector */ 278 LOGICAL is_whole; /* whether selector is a whole variable */ 279 int active_sptr; /* sptr of active temp pointer */ 280 int beg_std; /* std of select type stmt */ 281 int end_select_label; /* sptr of label for end select stmt */ 282 int class_default_label; /* sptr of label to class default */ 283 TYPE_LIST *types; /* list of types */ 284 } u5; 285 struct { /* forall stuff */ 286 int laststd; /* last gen'd std at start of forall processing */ 287 SPTR symavl; /* stb.stg_avail value at entry (sym "watermark") */ 288 DTYPE dtype; /* explicit index data type */ 289 int idxlist; /* list of index var sptrs */ 290 int forall_ast; 291 } u6; 292 struct { /* ASSOCIATE */ 293 ITEM *sptrs; /* sptrs of association names */ 294 } u7; 295 } u; 296 } DOIF; 297 298 #define DI_IF 0 299 #define DI_IFELSE 1 300 #define DI_DO 2 301 #define DI_DOWHILE 3 302 #define DI_WHERE 4 303 #define DI_ELSEWHERE 5 304 #define DI_FORALL 6 305 #define DI_CASE 7 306 #define DI_PAR 8 307 #define DI_PARDO 9 308 #define DI_PDO 10 309 #define DI_DOACROSS 11 310 #define DI_PARSECTS 12 311 #define DI_SECTS 13 312 #define DI_SINGLE 14 313 #define DI_CRITICAL 15 314 #define DI_MASTER 16 315 #define DI_ORDERED 17 316 #define DI_WORKSHARE 18 317 #define DI_PARWORKS 19 318 #define DI_TASK 20 319 #define DI_ACCREG 21 320 #define DI_ACCKERNELS 22 321 #define DI_ACCPARALLEL 23 322 #define DI_ACCDO 24 323 #define DI_ACCLOOP 25 324 #define DI_ACCREGDO 26 325 #define DI_ACCREGLOOP 27 326 #define DI_ACCKERNELSDO 28 327 #define DI_ACCKERNELSLOOP 29 328 #define DI_ACCPARALLELDO 30 329 #define DI_ACCPARALLELLOOP 31 330 #define DI_ACCKERNEL 32 331 #define DI_ACCDATAREG 33 332 #define DI_CUFKERNEL 34 333 #define DI_SELECT_TYPE 35 334 #define DI_ACCHOSTDATA 36 335 #define DI_ATOMIC_CAPTURE 37 336 #define DI_DOCONCURRENT 38 337 #define DI_SIMD 39 338 #define DI_TASKGROUP 40 339 #define DI_TASKLOOP 41 340 #define DI_TARGET 42 341 #define DI_TARGETENTERDATA 43 342 #define DI_TARGETEXITDATA 44 343 #define DI_TARGETDATA 45 344 #define DI_TARGETUPDATE 46 345 #define DI_DISTRIBUTE 47 346 #define DI_TEAMS 48 347 #define DI_DECLTARGET 49 348 #define DI_ASSOC 50 349 #define DI_DISTPARDO 51 350 #define DI_TARGPARDO 52 351 #define DI_TARGETSIMD 53 352 #define DI_TARGTEAMSDIST 54 353 #define DI_TEAMSDIST 55 354 #define DI_TARGTEAMSDISTPARDO 56 355 #define DI_TEAMSDISTPARDO 57 356 #define DI_ACCSERIAL 58 357 #define DI_ACCSERIALLOOP 59 358 #define DI_MAXID 60 /* always the last one */ 359 360 /* NOTE: the DI_ID value cannot be greater than 63 (SEE DI_NEST ...) **/ 361 362 #define DI_SCH_STATIC 0 363 #define DI_SCH_DYNAMIC 1 364 #define DI_SCH_GUIDED 2 365 #define DI_SCH_INTERLEAVE 3 366 #define DI_SCH_RUNTIME 4 367 #define DI_SCH_AUTO 5 368 #define DI_SCH_DIST_STATIC 6 369 #define DI_SCH_DIST_DYNAMIC 7 370 371 #define DI_ID(d) sem.doif_base[d].Id 372 #define DI_LINENO(d) sem.doif_base[d].lineno 373 #define DI_NEST(d) sem.doif_base[d].nest 374 #define DI_NAME(d) sem.doif_base[d].name 375 #define DI_EXIT_LABEL(d) sem.doif_base[d].exit_label 376 377 #define DI_DO_LABEL(d) sem.doif_base[d].u.u1.do_label 378 #define DI_CYCLE_LABEL(d) sem.doif_base[d].u.u1.cycle_label 379 #define DI_TOP_LABEL(d) sem.doif_base[d].u.u1.top_label 380 #define DI_DO_AST(d) sem.doif_base[d].u.u1.ast 381 #define DI_DOINFO(d) sem.doif_base[d].u.u1.doinfo 382 #define DI_DO_POPINDEX(d) sem.doif_base[d].u.u1.popindex 383 #define DI_CONC_SYMAVL(d) sem.doif_base[d].u.u1.symavl 384 #define DI_CONC_COUNT(d) sem.doif_base[d].u.u1.count 385 #define DI_CONC_KIND(d) sem.doif_base[d].u.u1.kind 386 #define DI_CONC_NO_DEFAULT(d) sem.doif_base[d].u.u1.no_default 387 #define DI_CONC_BLOCK_SYM(d) sem.doif_base[d].u.u1.block_sym 388 #define DI_CONC_SYMS(d) sem.doif_base[d].u.u1.syms 389 #define DI_CONC_LAST_SYM(d) sem.doif_base[d].u.u1.last_sym 390 #define DI_CONC_LABEL_SYMS(d) sem.doif_base[d].u.u1.label_syms 391 #define DI_CONC_ERROR_SYMS(d) sem.doif_base[d].u.u1.error_syms 392 #define DI_CONC_MASK_STD(d) sem.doif_base[d].u.u1.mask_std 393 #define DI_CONC_BODY_STD(d) sem.doif_base[d].u.u1.body_std 394 395 #define DI_SHAPEDIM(d) sem.doif_base[d].u.u2.shapedim 396 #define DI_MASKED(d) sem.doif_base[d].u.u2.masked 397 398 #define DI_CASE_EXPR(d) sem.doif_base[d].u.u3.case_expr 399 #define DI_DTYPE(d) sem.doif_base[d].u.u3.dtype 400 #define DI_BEG_DEFAULT(d) sem.doif_base[d].u.u3.beg_default 401 #define DI_END_DEFAULT(d) sem.doif_base[d].u.u3.end_default 402 #define DI_SWEL_HD(d) sem.doif_base[d].u.u3.swel_hd 403 #define DI_ALLO_CHTMP(d) sem.doif_base[d].u.u3.allo_chtmp 404 #define DI_DEFAULT_SEEN(d) sem.doif_base[d].u.u3.default_seen 405 #define DI_DEFAULT_COMPLETE(d) sem.doif_base[d].u.u3.default_complete 406 #define DI_PENDING(d) sem.doif_base[d].u.u3.pending 407 408 #define DI_BPAR(d) sem.doif_base[d].u.u4.bpar 409 #define DI_BTARGET(d) sem.doif_base[d].u.u4.target 410 #define DI_BTEAMS(d) sem.doif_base[d].u.u4.teams 411 #define DI_BDISTRIBUTE(d) sem.doif_base[d].u.u4.distribute 412 #define DI_CRITSYM(d) sem.doif_base[d].u.u4.bpar 413 #define DI_BEGINP(d) sem.doif_base[d].u.u4.beginp 414 #define DI_REDUC(d) sem.doif_base[d].u.u4.reduc 415 #define DI_LASTPRIVATE(d) sem.doif_base[d].u.u4.lastprivate 416 #define DI_ALLOCATED(d) sem.doif_base[d].u.u4.allocated 417 #define DI_REGIONVARS(d) sem.doif_base[d].u.u4.region_vars 418 #define DI_SCHED_TYPE(d) sem.doif_base[d].u.u4.v.v1.sched_type 419 #define DI_CHUNK(d) sem.doif_base[d].u.u4.v.v1.chunk 420 #define DI_DISTCHUNK(d) sem.doif_base[d].u.u4.v.v1.dist_chunk 421 #define DI_IS_ORDERED(d) sem.doif_base[d].u.u4.v.v1.is_ordered 422 #define DI_ISSIMD(d) sem.doif_base[d].u.u4.v.v1.is_simd 423 #define DI_SECT_CNT(d) sem.doif_base[d].u.u4.v.v2.sect_cnt 424 #define DI_SECT_VAR(d) sem.doif_base[d].u.u4.v.v2.sect_var 425 #define DI_NOSCOPE_BASE(d) sem.doif_base[d].no_scope_base 426 #define DI_NOSCOPE_SIZE(d) sem.doif_base[d].no_scope_size 427 #define DI_NOSCOPE_AVL(d) sem.doif_base[d].no_scope_avail 428 #define DI_NOSCOPE_FORALL(d) sem.doif_base[d].no_scope_forall 429 430 #define DI_SELECTOR(d) sem.doif_base[d].u.u5.selector 431 #define DI_IS_WHOLE(d) sem.doif_base[d].u.u5.is_whole 432 #define DI_ACTIVE_SPTR(d) sem.doif_base[d].u.u5.active_sptr 433 #define DI_END_SELECT_LABEL(d) sem.doif_base[d].u.u5.end_select_label 434 #define DI_TYPE_BEG(d) sem.doif_base[d].u.u5.beg_std 435 #define DI_CLASS_DEFAULT_LABEL(d) sem.doif_base[d].u.u5.class_default_label 436 #define DI_SELECT_TYPE_LIST(d) sem.doif_base[d].u.u5.types 437 438 #define DI_FORALL_LASTSTD(d) sem.doif_base[d].u.u6.laststd 439 #define DI_FORALL_SYMAVL(d) sem.doif_base[d].u.u6.symavl 440 #define DI_FORALL_DTYPE(d) sem.doif_base[d].u.u6.dtype 441 #define DI_IDXLIST(d) sem.doif_base[d].u.u6.idxlist 442 #define DI_FORALL_AST(d) sem.doif_base[d].u.u6.forall_ast 443 444 #define DI_ASSOCIATIONS(d) sem.doif_base[d].u.u7.sptrs 445 446 #define onel 1ULL 447 #define DI_B(t) (onel << (t)) 448 #define DI_IN_NEST(d, t) (d && d <= sem.doif_depth && (DI_NEST(d) & DI_B(t))) 449 450 #define NEED_DOIF(df, typ) \ 451 { \ 452 df = ++sem.doif_depth; \ 453 NEED(df + 1, sem.doif_base, DOIF, sem.doif_size, sem.doif_size + 8); \ 454 BZERO(sem.doif_base+df, DOIF, 1); \ 455 DI_LINENO(df) = gbl.lineno; \ 456 DI_ID(df) = typ; \ 457 DI_NEST(df) = DI_NEST(df - 1) | DI_B(typ); \ 458 } 459 460 /* Define Initializer Variable Tree */ 461 typedef struct var_init { /* used for elements of dinit variable list */ 462 short id; 463 #define Dostart 0 464 #define Doend 1 465 #define Varref 2 466 union { 467 struct { 468 int indvar; /* ast */ 469 int lowbd; /* ast */ 470 int upbd; /* ast */ 471 int step; /* ast */ 472 } dostart; 473 struct { 474 struct var_init *dostart; 475 } doend; 476 struct { 477 /* Semantic stack info for variable reference */ 478 int id; 479 int ptr; /* ast */ 480 int dtype; 481 int shape; 482 struct var_init *subt; /* for derived-type: points to 483 var list of mangled-name structure members */ 484 } varref; 485 } u; 486 struct var_init *next; 487 } VAR; 488 489 /* typedef and macros to access array constructor lists: */ 490 /* also used for structure constructors */ 491 /* NOW also used for initialization list of constants which 492 formerly used the CONST structure */ 493 494 /* NOTE: repeatc may not be needed if it can be recalculated from sptr 495 field. sptr field may be able to be relocated to u2. 496 */ 497 typedef struct _aexpr AEXPR; 498 typedef struct _acl { 499 char id; /* one of AC_... */ 500 unsigned is_const : 1, /* is it constant ? */ 501 ci_exprt : 1, /* 1==>component initialization has been exported */ 502 no_dinitp : 1; /* do not set DINIT flag */ 503 DTYPE dtype; /* used in init. Later if AC_ACONST or AC_SCONST */ 504 DTYPE ptrdtype; /* ptr type if pointer init */ 505 int repeatc; /* used in init. ast or ==0 for default of 1 */ 506 int sptr; /* used for DATA stmt, VMS struct inits, and F95 507 * derived type component initializers */ 508 int size; /* set by chk_constructor() - the ast of the size 509 * (upper bound) of the temporary (if AC_ACONST). 510 */ 511 INT conval; /* "constant" value when evaluating F95 512 * derived type component initializations 513 * for non-static variable */ 514 struct _acl *next; /* next in list */ 515 struct _acl *subc; /* down in tree. Valid for AC_ACONST, 516 AC_SCONST, AC_IDO, AC_REPEAT , 517 AC_VMSSTRUCT, AC_VMSUNION */ 518 union { 519 struct sst *stkp; /* if AC_EXPR */ 520 AEXPR *expr; /* if AC_AEXPR */ 521 int ast; /* if AC_AST, AC_CONST, AC_IDENT */ 522 int i; /* if AC_ICONST */ 523 INT count; /* if AC_REPEAT */ 524 DOINFO *doinfo; /* if AC_IDO */ 525 } u1; 526 union { 527 int array_i; /* if AC_EXPR, AC_AST */ 528 } u2; 529 } ACL; 530 531 struct _aexpr { 532 int op; 533 ACL *lop; 534 ACL *rop; 535 }; 536 537 #define AC_IDENT 1 538 #define AC_CONST 2 539 #define AC_EXPR 3 /* SST expr */ 540 #define AC_IEXPR 4 /* AC expression */ 541 #define AC_AST 5 542 #define AC_IDO 6 543 #define AC_REPEAT 7 544 #define AC_ACONST 8 545 #define AC_SCONST 9 546 #define AC_LIST 10 /* only used during DATA stmt processing */ 547 #define AC_VMSSTRUCT 11 548 #define AC_VMSUNION 12 549 #define AC_TYPEINIT 13 550 #define AC_ICONST 14 551 /* integer constant value, currently used to keep 552 * intrinsic routine selector 553 */ 554 #define AC_CONVAL 15 555 /* Type of ACL leaf item generated by calling 556 * eval_init_expr/eval_init_expr_item. The conval 557 * field contains the results of the evaluation. 558 * The type of the value is a literal constant if 559 * the type a TY_WORD. Otherwise, the value is the 560 * sptr of a constant. 561 */ 562 #define AC_ADD 1 563 #define AC_SUB 2 564 #define AC_MUL 3 565 #define AC_DIV 4 566 #define AC_EXP 5 567 #define AC_NEG 6 568 #define AC_INTR_CALL 7 569 #define AC_ARRAYREF 8 570 #define AC_MEMBR_SEL 9 571 #define AC_CONV 10 572 #define AC_CAT 11 573 #define AC_EXPK 12 574 #define AC_LEQV 13 575 #define AC_LNEQV 14 576 #define AC_LOR 15 577 #define AC_LAND 16 578 #define AC_EQ 17 579 #define AC_GE 18 580 #define AC_GT 19 581 #define AC_LE 20 582 #define AC_LT 21 583 #define AC_NE 22 584 #define AC_LNOT 23 585 #define AC_EXPX 24 586 #define AC_TRIPLE 25 587 588 typedef enum { 589 AC_I_NONE = 0, 590 AC_I_adjustl, 591 AC_I_adjustr, 592 AC_I_char, 593 AC_I_ichar, 594 AC_I_index, 595 AC_I_int, 596 AC_I_ishft, 597 AC_I_ishftc, 598 AC_I_kind, 599 AC_I_lbound, 600 AC_I_len, 601 AC_I_len_trim, 602 AC_I_nint, 603 AC_I_null, 604 AC_I_repeat, 605 AC_I_reshape, 606 AC_I_scan, 607 AC_I_selected_int_kind, 608 AC_I_selected_real_kind, 609 AC_I_size, 610 AC_I_transfer, 611 AC_I_trim, 612 AC_I_ubound, 613 AC_I_verify, 614 AC_I_shape, 615 AC_I_min, 616 AC_I_max, 617 AC_I_fltconvert, 618 AC_I_floor, 619 AC_I_ceiling, 620 AC_I_mod, 621 AC_I_sqrt, 622 AC_I_exp, 623 AC_I_log, 624 AC_I_log10, 625 AC_I_sin, 626 AC_I_cos, 627 AC_I_tan, 628 AC_I_asin, 629 AC_I_acos, 630 AC_I_atan, 631 AC_I_atan2, 632 AC_I_selected_char_kind, 633 AC_I_abs, 634 AC_I_iand, 635 AC_I_ior, 636 AC_I_ieor, 637 AC_I_merge, 638 AC_I_lshift, 639 AC_I_rshift, 640 AC_I_maxloc, 641 AC_I_maxval, 642 AC_I_minloc, 643 AC_I_minval, 644 AC_I_scale, 645 } AC_INTRINSIC; 646 647 #define BINOP(p) ((p)->op != AC_NEG && (p)->op != AC_CONV) 648 649 /* getitem() AREA's */ 650 #define ACL_AREA 0 651 #define ACL_SAVE_AREA 3 652 653 #define GET_ACL(a) get_acl(a) 654 655 typedef struct { /* STRUCTURE stack entries */ 656 char type; /* 's': STRUCTURE; 'u': UNION; 'm: MAP */ 657 char mem_access; /* 0 - public by default, 'v'=>access private */ 658 int sptr; /* Sym ptr to field name list having this structure */ 659 int dtype; /* Pointer to structure dtype */ 660 int last; /* last member; updated by link_members */ 661 ACL *ict_beg; /* Initializer Constant Tree begin */ 662 ACL *ict_end; /* Initializer Constant Tree end */ 663 } STSK; 664 /* access entries in STRUCTURE stack; 0 ==> top of stack, 1 ==> 1 back, etc. */ 665 #define STSK_ENT(i) sem.stsk_base[sem.stsk_depth - (i)-1] 666 667 typedef struct equiv_var { /* variable references in EQUIVALENCE statements */ 668 int sptr; 669 int lineno; 670 int ps; 671 int substring; /* ast of left substring index, 0=>none */ 672 int subscripts; 673 ISZ_T byte_offset; 674 /* the next field can be made smaller if more fields must be added */ 675 INT is_first; /* nonzero marks first in a group */ 676 int next; 677 } EQVV; 678 679 #define EQV(i) sem.eqv_base[i] 680 #define EQV_NUMSS(i) sem.eqv_ss_base[i] /* number of subscripts */ 681 #define EQV_SS(i, j) sem.eqv_ss_base[i + j + 1] /* j from 0 to EQV_NUMSS(i) */ 682 683 typedef struct _seql { /* variable references in [NO]SEQUENCE statements */ 684 char type; /* 's' - SEQUENCE; 'n' - NOSEQUENCE */ 685 int sptr; /* sym ptr of object in statement */ 686 struct _seql *next; /* next _seql item */ 687 } SEQL; 688 689 typedef struct _accl { /* variable references in ACCESS statements */ 690 char type; /* 'u' - PUBLIC; 'v' - PRIVATE */ 691 char oper; /* 'o' - operator; ' ' - not an operator */ 692 int sptr; /* sym ptr of object in statement */ 693 struct _accl *next; /* next _accl item */ 694 } ACCL; 695 696 /* 697 * For saving state when interface blocks are processed. 698 */ 699 typedef struct { 700 int currsub; /* previous subprogram */ 701 RU_TYPE rutype; /* type of previous subprogram */ 702 bool module_procedure; /* instantiated with MODULE PROCEDURE <id> */ 703 int pgphase; 704 int none_implicit; /* bit vector indicating presence of implicit 705 * none. A nonzero value indicates that all 706 * variables need to be declared. Bit values 707 * indicate placement of the implicit none: 708 * 709 * 0x00 - not present 710 * 0x01 - -dclchk specified on the command line 711 * 0x02 - present in the host 712 * 0x04 - present in a contained procedure 713 * 714 * NOTE: the latter two values correspond to the 715 * possible values of semant.c:host_present. 716 */ 717 LOGICAL seen_implicit; 718 LOGICAL seen_parameter; 719 int generic; /* if non-zero, sptr of ST_GENERIC */ 720 int operator; /* if non-zero, sptr of ST_OPERATOR */ 721 char gnr_rutype; /* routine type of the generic */ 722 char optype; /* 0x00 - defined operator 723 * 0x01 - unary intrinsic operator 724 * 0x02 - binary intrinsic operator 725 * 0x03 - unary and binary intrinsic operator 726 * 0x04 - assignment 727 */ 728 char abstract; /* if nonzero, ABSTRACT INTERFACE */ 729 char opval; /* OP_... value if intrinsic operator */ 730 int hpfdcl; /* available index for the hpf declarations whose 731 * semantic processing is deferred. For the interface, 732 * the hpf declarations are saved as indices 733 * [hpfdcl, sem.hpfdcl-1]. 734 */ 735 int nml; /* copy of sem.nml */ 736 } INTERF; 737 738 /* 739 * support for extracting positional or keyword arguments for an 740 * intrinsic: 741 * 1. for each intrinsic, the symbol table utility has created a string 742 * which defines the arguments and their positions in the argument 743 * list and keywords. 744 * 745 * Optional arguments are indicating by prefixing their keywords with 746 * '*'. 747 * 2. get_kwd_args() extracts the arguments from the semantic list 748 * and places them in the static array argpos[] in positional 749 * order. evl_kwd_args calls get_kwd_args() and evaluates each 750 * argument. 751 */ 752 753 typedef struct { 754 struct sst *stkp; /* semantic stack entry for argument, possibly NULL */ 755 int ast; /* its ast, possibly 0 */ 756 } argpos_t; 757 758 #define ARG_STK(i) sem.argpos[i].stkp 759 #define ARG_AST(i) sem.argpos[i].ast 760 #define XFR_ARGAST(i) ARG_AST(i) = SST_ASTG(ARG_STK(i)) 761 762 /* 763 * define stack entry for evaluating implied do's in dinits and array 764 * constructors. 765 */ 766 typedef struct { 767 int sptr; 768 INT currval; 769 INT upbd; 770 INT step; 771 } DOSTACK; 772 #define MAX_DOSTACK 8 773 774 /* 775 * define a stack for scope entries; 776 * a "scope" is opened for: 777 * a 'zero' level scope for global symbols 778 * an outermost subprogram 779 * an interface block 780 * a subprogram interface inside an interface block 781 * a 'used' module 782 * a contained subprogram. 783 * a scope is identified by a symbol, typically the subprogram name, 784 * or by an integer less than zero, for 'interface' scopes. 785 * some scopes are 'open', meaning names from outer scopes are also 786 * visible (used modules, contained subprograms); other scopes are 787 * 'closed', meaning outer scopes are not visible (subprogram interface 788 * within an interface block). 789 * the scope stack is indexed by sem.scope_level; 790 */ 791 792 /* for creating lists of symbols such as a list of symbols appearing in 793 * the SHARED clause of one of the parallel directives which defines a 794 * new scope. 795 */ 796 typedef struct scope_sym_tag { 797 int sptr; /* symbol appearing in the SHARED clause */ 798 int scope; /* its outer scope value */ 799 struct scope_sym_tag *next; 800 } SCOPE_SYM; 801 802 typedef enum SCOPEKIND { 803 SCOPE_OUTER, 804 SCOPE_NORMAL, 805 SCOPE_SUBPROGRAM, 806 SCOPE_MODULE, 807 SCOPE_INTERFACE, 808 SCOPE_USE, 809 SCOPE_PAR, 810 } SCOPEKIND; 811 812 typedef struct { 813 int sptr; /* identifier of this scope, usually a symbol */ 814 SCOPEKIND kind; /* defined below */ 815 LOGICAL open; /* is this open scope? */ 816 LOGICAL Private; /* symbols here are private */ 817 int symavl; /* stb.symavl when the scope was opened */ 818 int except; /* SYMI list of names not used */ 819 int only; /* in a private scope, SYMI list of public names */ 820 int import; /* SYMI list of names explictly imported from host */ 821 /***** fields used if within a parallel scope: *****/ 822 int rgn_scope; /* index of the scope entry of the containing 823 * parallel region. 824 */ 825 int par_scope; /* one of PAR_SCOPE_... - the DEFAULT scope */ 826 int end_prologue; /* end of prologue of parallel and task constructs. 827 * Code for initial assignments of 828 * "default(firstprivate)" variables is inserted here. 829 */ 830 int di_par; /* index of the DOIF structure corresponding to 831 * this scope. 832 */ 833 int sym; /* the ST_BLOCK defining this scope */ 834 int autobj; /* list of automatic data objects for this 835 * scope 836 */ 837 SC_KIND prev_sc; /* previous storage class */ 838 SCOPE_SYM *shared_list; /* List of symbols appearing in the SHARED 839 * clause for this scope when par_scope is 840 * 'shared'. 841 */ 842 int mpscope_sptr; /* scope ST_BLOCK of the next scope - it is the same as 843 * sym of next scope. 844 */ 845 int uplevel_sptr; /* uplevel ST_BLOCK of the next scope which keeps info for 846 * shared variables 847 * in current region. 848 */ 849 } SCOPESTACK; 850 851 /* default scope of new symbols within a parallel region */ 852 #define PAR_SCOPE_NONE 0 853 #define PAR_SCOPE_SHARED 1 854 #define PAR_SCOPE_PRIVATE 2 855 #define PAR_SCOPE_FIRSTPRIVATE 3 856 #define PAR_SCOPE_TASKNODEFAULT 4 857 858 #define BLK_SYM(i) sem.scope_stack[i].sym 859 #define BLK_AUTOBJ(i) sem.scope_stack[i].autobj 860 #define BLK_UPLEVEL_SPTR(i) sem.scope_stack[i].uplevel_sptr 861 #define BLK_SCOPE_SPTR(i) sem.scope_stack[i].mpscope_sptr 862 863 /* scopestack.c */ 864 void scopestack_init(void); 865 SCOPESTACK *curr_scope(void); 866 SCOPESTACK *get_scope(int index); 867 int get_scope_level(SCOPESTACK *scope); 868 SCOPESTACK *next_scope(SCOPESTACK *scope); 869 SCOPESTACK *next_scope_sptr(SCOPESTACK *scope, int sptr); 870 SCOPESTACK *next_scope_kind(SCOPESTACK *scope, SCOPEKIND kind); 871 SCOPESTACK *next_scope_kind_sptr(SCOPESTACK *scope, SCOPEKIND kind, int sptr); 872 SCOPESTACK *next_scope_kind_symname(SCOPESTACK *scope, SCOPEKIND kind, 873 const char *symname); 874 int have_use_scope(int sptr); 875 LOGICAL is_except_in_scope(SCOPESTACK *scope, int sptr); 876 LOGICAL is_private_in_scope(SCOPESTACK *scope, int sptr); 877 void push_scope_level(int sptr, SCOPEKIND kind); 878 void push_iface_scope_level(); 879 void pop_scope_level(SCOPEKIND kind); 880 void save_scope_level(void); 881 void restore_scope_level(void); 882 void par_push_scope(LOGICAL bind_to_outer); 883 void par_pop_scope(void); 884 #if DEBUG 885 void dumpscope(FILE *f); 886 void dump_one_scope(int sl, FILE *f); 887 #endif 888 889 /* module.c */ 890 void allocate_refsymbol(int); 891 void set_modusename(int, int); 892 void use_init(void); 893 void init_use_stmts(void); 894 void add_use_stmt(void); 895 void add_submodule_use(void); 896 SPTR add_use_rename(SPTR, SPTR, LOGICAL); 897 void apply_use_stmts(void); 898 void add_isoc_intrinsics(void); 899 void open_module(SPTR); 900 void close_module(void); 901 void mod_combined_name(char *); 902 void mod_combined_index(char *); 903 SPTR begin_module(SPTR); 904 SPTR begin_submodule(SPTR, SPTR, SPTR, SPTR *); 905 LOGICAL get_seen_contains(void); 906 void mod_implicit(int, int, int); 907 void begin_contains(void); 908 void end_module(void); 909 LOGICAL has_cuda_data(void); 910 void mod_fini(void); 911 void mod_init(void); 912 int mod_add_subprogram(int); 913 void mod_end_subprogram(void); 914 void mod_end_subprogram_two(void); 915 916 /* semantio.c */ 917 int get_nml_array(int); 918 919 #define MAXDIMS 7 920 typedef struct { 921 struct _sem_bounds { 922 int lowtype; 923 int uptype; 924 ISZ_T lowb; 925 ISZ_T upb; 926 int lwast; 927 int upast; 928 } bounds[MAXDIMS]; 929 struct _sem_arrdim { /* communicate info for <dim spec>s to mk_arrdsc() */ 930 int ndim; /* number of dimensions */ 931 int ndefer; /* number of deferred dimensions (:) */ 932 } arrdim; 933 } SEM_DIM_SPECS; 934 935 /* semutil2.c */ 936 ISZ_T size_of_array(DTYPE); 937 DTYPE chk_constructor(ACL *, DTYPE); 938 void chk_struct_constructor(ACL *); 939 void gen_type_initialize_for_sym(SPTR, int, int, DTYPE); 940 void clean_struct_default_init(int); 941 void restore_host_state(int); 942 void restore_internal_subprograms(void); 943 void dummy_program(void); 944 int have_module_state(void); 945 void fix_type_param_members(SPTR, DTYPE); 946 void add_type_param_initialize(int); 947 void add_p_dealloc_item(int sptr); 948 int gen_finalization_for_sym(int sptr, int std, int memAst); 949 void gen_alloc_mem_initialize_for_sym(int sptr, int std); 950 int add_parent_to_bounds(int parent, int ast); 951 int fix_mem_bounds2(int, int); 952 int fix_mem_bounds(int parent, int mem); 953 int init_sdsc(int, DTYPE, int, int); 954 void save_module_state1(void); 955 void save_module_state2(void); 956 void restore_module_state(void); 957 void reset_module_state(void); 958 LOGICAL is_alloc_ast(int); 959 LOGICAL is_alloc_std(int); 960 LOGICAL is_dealloc_ast(int); 961 LOGICAL is_dealloc_std(int); 962 SPTR get_dtype_init_template(DTYPE); 963 void module_must_hide_this_symbol(int sptr); 964 void reset_internal_subprograms(void); 965 int mp_create_bscope(int reuse); 966 void save_struct_init(ACL *); 967 void chk_adjarr(void); 968 int mp_create_escope(void); 969 void dup_struct_init(int, int); 970 void gen_derived_type_alloc_init(ITEM *); 971 void save_host_state(int); /* semtutil2.c */ 972 void add_auto_finalize(int); 973 int runtime_array(int); 974 DTYPE mk_arrdsc(void); 975 int gen_defer_shape(int, int, int); 976 ACL *eval_init_expr(ACL *e); 977 void gen_allocate_array(int); 978 void gen_deallocate_arrays(void); 979 void mk_defer_shape(SPTR); 980 void mk_assumed_shape(SPTR); 981 SPTR get_arr_const(DTYPE); 982 DTYPE select_kind(DTYPE, int, INT); 983 SPTR get_param_alias_var(SPTR, DTYPE); 984 void init_named_array_constant(int, int); 985 int init_sptr_w_acl(int, ACL *); 986 int init_derived_w_acl(int, ACL *); 987 ACL *mk_init_intrinsic(AC_INTRINSIC); 988 ACL *get_acl(int); 989 ACL *save_acl(ACL *); 990 ACL *construct_acl_from_ast(int, DTYPE, int); 991 ACL *rewrite_acl(ACL *, DTYPE, int); 992 ACL *all_default_init(DTYPE); 993 void dmp_acl(ACL *, int); 994 void mk_struct_constr(int, int); 995 void process_struct_components(int, void (*)(int)); 996 int get_struct_leafcnt(int); 997 int get_first_mangled(int); 998 void re_struct_constr(int, int); 999 void propagate_attr(int, int); 1000 ACL *dinit_struct_vals(ACL *, DTYPE, SPTR); 1001 SPTR get_temp(DTYPE); 1002 DTYPE get_temp_dtype(DTYPE, int); 1003 SPTR get_itemp(DTYPE); 1004 SPTR get_arr_temp(DTYPE, LOGICAL, LOGICAL, LOGICAL); 1005 SPTR get_adjlr_arr_temp(DTYPE); 1006 int get_shape_arr_temp(int); 1007 SPTR get_ch_temp(DTYPE); 1008 int need_alloc_ch_temp(DTYPE); 1009 int sem_strcmp(char *, char *); 1010 LOGICAL sem_eq_str(int, char *); 1011 void add_case_range(int, int, int); 1012 int _i4_cmp(int, int); 1013 int _i8_cmp(int, int); 1014 int _char_cmp(int, int); 1015 int _nchar_cmp(int, int); 1016 int gen_alloc_dealloc(int, int, ITEM *); 1017 void check_alloc_clauses(ITEM *, ITEM *, int *, int *); 1018 void check_dealloc_clauses(ITEM *, ITEM *); 1019 void gen_conditional_dealloc(int, int, int); 1020 int gen_conditional_alloc(int, int, int); 1021 void gen_conditional_dealloc_for_sym(int, int); 1022 int gen_dealloc_for_sym(int, int); 1023 void gen_automatic_reallocation(int, int, int); 1024 void gen_dealloc_etmps(void); 1025 void sem_set_storage_class(int); 1026 void check_and_add_auto_dealloc_from_ast(int); 1027 void check_and_add_auto_dealloc(int); 1028 void add_auto_dealloc(int); 1029 int enter_lexical_block(int); 1030 void exit_lexical_block(int); 1031 void dmp_doif(FILE *f); 1032 LOGICAL not_in_forall(char *); 1033 LOGICAL cuda_enabled(char *); 1034 LOGICAL in_device_code(int); 1035 void sem_err104(int, int, char *); 1036 void sem_err105(int); 1037 VAR *gen_varref_var(int, DTYPE); 1038 void sem_fini(void); 1039 int gen_set_type(int dest_ast, int src_ast, int std, LOGICAL insert_before, 1040 LOGICAL intrin_type); 1041 int mk_set_type_call(int arg0, int arg1, LOGICAL intrin_type); 1042 1043 /* semant.c */ 1044 void semant_init(int noparse); 1045 int getMscall(void); 1046 int getCref(void); 1047 void build_typedef_init_tree(int sptr, int dtype); 1048 int internal_proc_has_ident(int ident, int proc); 1049 void fixup_reqgs_ident(int sptr); 1050 int queue_type_param(int sptr, int dtype, int offset, int flag); 1051 int get_kind_parm_by_name(char *np, int dtype); 1052 int get_parm_by_number(int offset, int dtype); 1053 int get_parm_by_name(char *np, int dtype); 1054 int chk_kind_parm_expr(int ast, int dtype, int flag, int strict_flag); 1055 int chk_len_parm_expr(int ast, int dtype, int flag); 1056 int get_len_set_parm_by_name(char *np, int dtype, int *val); 1057 int cmp_len_parms(int ast1, int ast2); 1058 int defer_pt_decl(int dtype, int flag); 1059 void put_default_kind_type_param(int dtype, int flag, int flag2); 1060 void put_length_type_param(DTYPE dtype, int flag); 1061 int get_len_parm_by_number(int num, int dtype, int flag); 1062 int all_len_parms_assumed(int dtype); 1063 LOGICAL put_kind_type_param(DTYPE dtype, int offset, int value, int expr, 1064 int flag); 1065 void llvm_set_tbp_dtype(int dtype); 1066 int get_unl_poly_sym(int mem_dtype); 1067 int has_type_parameter(int dtype); 1068 int has_length_type_parameter_use(int dtype); 1069 DTYPE create_parameterized_dt(DTYPE dtype, LOGICAL force); 1070 DTYPE get_parameterized_dt(DTYPE dtype); 1071 int is_parameter_context(); 1072 bool in_intrinsic_decl(void); 1073 int get_entity_access(); 1074 1075 /** 1076 * \brief Deferred procedure interface. 1077 */ 1078 typedef struct { 1079 SPTR iface; /**< sptr of interface name */ 1080 DTYPE dtype; /**< dtype of TY_PROC data type record */ 1081 SPTR proc; /**< sptr of external/dummy procedure */ 1082 SPTR mem; /**< sptr of the procedure member/component */ 1083 int lineno; /**< line number of the statement */ 1084 char *iface_name; /**< iface name string */ 1085 int pass_class; /**< set if pass arg has class set */ 1086 char *tag_name; /**< name of pass arg dtype tag */ 1087 int sem_pass; /**< semantic pass that this symbol was set */ 1088 int stype; /**< STYPE of iface */ 1089 SPTR scope; /**< scope of the procedure pointer declaration */ 1090 SPTR proc_var; /**< the procedure variable */ 1091 int internal; /**< value of gbl.internal when processing proc or mem */ 1092 } IFACE; 1093 1094 typedef struct ident_proc_list { 1095 char *proc_name; /* internal procedure name */ 1096 int usecnt; /* # times ident for this proc seen in contains proc */ 1097 struct ident_proc_list *next; 1098 } IDENT_PROC_LIST; 1099 1100 typedef struct ident_list { 1101 char *ident; /* ident name seen in an internal procedure */ 1102 IDENT_PROC_LIST *proc_list; /* list of internal proc names that use ident */ 1103 struct ident_list *next; 1104 } IDENT_LIST; 1105 1106 #define _INF_CLEN 500 1107 1108 /* program statement phase types: 1109 * 1110 * INIT - nothing seen yet (initial value) 1111 * HEADER - SUBROUTINE, FUNCTION, BLOCKDATA, 1112 * PROGRAM, MODULE, SUBMODULE 1113 * USE - USE statements seen 1114 * IMPORT - IMPORT statements seen 1115 * IMPLICIT - IMPLICIT statements 1116 * PARAMETER may intersperse 1117 * SPEC - Specification statements or 1118 * statement function definitions 1119 * PARAMETER, DATA, NAMELIST may intersperse 1120 * EXEC - Executable statements 1121 * DATA, NAMELIST may intersperse 1122 * CONTAIN - CONTAINS statement 1123 * INTERNAL - Internal/module subprograms 1124 * END - END statement 1125 * END_MODULE - END statement for a module (actual value is negative and is 1126 * the minimum value) 1127 * 1128 * NOTES: 1129 * PARAMETER does not explicitly set 1130 * pgphase unless pgphase is < IMPLICIT in 1131 * which case it's set to IMPLICIT. 1132 * DATA, NAMELIST do not explicitly set 1133 * pgphase unless pgphase is < SPEC in which 1134 * case it's set to SPEC. 1135 */ 1136 typedef enum { 1137 PHASE_END_MODULE = -1, 1138 PHASE_INIT = 0, 1139 PHASE_HEADER = 1, 1140 PHASE_USE = 2, 1141 PHASE_IMPORT = 3, 1142 PHASE_IMPLICIT = 4, 1143 PHASE_SPEC = 5, 1144 PHASE_EXEC = 6, 1145 PHASE_CONTAIN = 7, 1146 PHASE_INTERNAL = 8, 1147 PHASE_END = 9 1148 } PHASE_TYPE; 1149 1150 /* declare global semant variables: */ 1151 1152 typedef struct { 1153 int end_host_labno; /* label number (not symbol table sptr) if the 1154 * END statement of the host subprogram which 1155 * contains internal subprogram is labeled. 1156 * This 'label' is found when the end statement 1157 * is processed during the first pass and is 1158 * emitted when the host's CONTAINS statement 1159 * is processed during the second pass. 1160 */ 1161 int doif_size; /* size in records of DOIF stack area. */ 1162 DOIF *doif_base; /* base pointer for DOIF stack area. */ 1163 int doif_depth; /* current DO-IF nesting level */ 1164 SPTR index_sym_to_pop; /* DO index symbol to pop off hash link at end of loop */ 1165 SPTR doconcurrent_symavl; /* stb.stg_avail value at start of do concurrent */ 1166 DTYPE doconcurrent_dtype; /* explicit do concurrent index data type */ 1167 int eqvlist; /* head of list of equivalences */ 1168 EQVV *eqv_base; /* list of equivalences */ 1169 int eqv_size; 1170 int eqv_avail; 1171 int *eqv_ss_base; /* subscripts for equivalences */ 1172 int eqv_ss_size; 1173 int eqv_ss_avail; 1174 int flabels; /* pointer to list of ftn ref'd labels */ 1175 int nml; /* pointer to list of namelist symbols */ 1176 int funcval; /* pointer to variable for function ret val */ 1177 PHASE_TYPE pgphase; /* statement type seen so far */ 1178 int gdtype; /* global data typ, a DT_ value */ 1179 int ogdtype; /* original global data type (i.e. before *n 1180 modification), a DT_ value */ 1181 int gty; /* global data type (i.e. before *n 1182 modification), a TY_ value. */ 1183 int gcvlen; /* global character type size */ 1184 int deferred_func_kind; /* AST of unresolved func retval KIND expr */ 1185 int deferred_func_len; /* AST of unresolved func retval LEN expr */ 1186 int deferred_dertype; /* sptr of unresolved derived type func return */ 1187 int deferred_kind_len_lineno; /* linenbr of unresolved func return type 1188 KIND/LEN */ 1189 int atemps; /* avail counter for array bounds temporaries */ 1190 int itemps; /* avail counter for temporaries named 'ixxx' */ 1191 int ptemps; /* avail counter for inliner ptr temporaries */ 1192 LOGICAL savall; /* SAVE statement w.o. symbols specified */ 1193 LOGICAL savloc; /* at least one local variable SAVE'd */ 1194 LOGICAL autoloc; /* at least one local AUTOMATIC variable */ 1195 int none_implicit; /* insure that variables are declared - set 1196 TRUE if IMPLICIT NONE seen */ 1197 STSK *stsk_base; /* base pointer for structure stack area */ 1198 int stsk_size; /* size in records of structure stack area */ 1199 int stsk_depth; /* current structure depth (i.e. stack top) */ 1200 int stag_dtype; /* structure tag dtype pointer */ 1201 int psfunc; /* next <var ref> may be lhs of statement func */ 1202 LOGICAL dinit_error; /* error flag during DATA stmt processing */ 1203 int dinit_count; /* # elements left in current dcl id to init */ 1204 LOGICAL dinit_data; /* TRUE if in DATA stmt, FALSE if type dcl or 1205 structure init stmt */ 1206 int dinit_nbr_inits; /* number of ICT/IVL initialization pairs written 1207 to the dinit file (astb.df) */ 1208 LOGICAL ignore_stmt; /* TRUE => parser is to ignore current stmt */ 1209 int switch_size; /* size of switch/CGOTO list area */ 1210 int switch_avl; /* next available word in switch list area */ 1211 LOGICAL temps_reset; /* TRUE if semant general temps can be resused */ 1212 LOGICAL in_stfunc; /* in statement function def */ 1213 int in_dim; /* in <dimension list> */ 1214 int in_struct_constr; /* 0 if false, else sptr of derived type tag */ 1215 SCOPESTACK *scope_stack; /* pushed and popped as scopes are entered/left*/ 1216 int scope_level; /* starts at zero */ 1217 int scope_size; /* size of scope stack */ 1218 int scope_extra; /* count of 'extra' scopes */ 1219 /* 1220 * the following two members (bounds, and arrdim) are filled in 1221 * when semantically processing <dim list> specifiers and processed by 1222 * mk_arrdsc() (semutil2.c) to create an array descriptor (TY_ARRAY data 1223 * type record). 1224 */ 1225 struct _sem_bounds bounds[MAXDIMS]; 1226 struct _sem_arrdim arrdim; 1227 int last_std; /* last std created */ 1228 int tkntyp; /* token effecting semant reduction */ 1229 SEQL seql; /* records [NO]SEQUENCE: 1230 * type: 1231 * 0 -- statement not seen 1232 * 's' -- SEQUENCE 1233 * 'n' -- NOSEQUENCE 1234 * next: list of SEQL items, one for each variable 1235 */ 1236 int dtemps; /* avail counter for 'd' temporaries */ 1237 int interface; /* depth of interface blocks (0 => no interface) */ 1238 INTERF *interf_base; 1239 int interf_size; 1240 argpos_t *argpos; /* keyword arguments in positional order */ 1241 DOSTACK dostack[MAX_DOSTACK]; /* stack for evaluating implied do's */ 1242 DOSTACK *top; /* next top of stack for evaluating implied do's */ 1243 ITEM *p_dealloc; /* pointer to list of dynamically allocated arrays, 1244 * allocatable derived types, and derived types with 1245 * allocatable components which must deallocated upon 1246 * end of statement */ 1247 ITEM *p_dealloc_delete; /* pointer to list of statements that 1248 * can be deleted if the associated dynamically- 1249 * allocated array isn't needed after all */ 1250 int mod_cnt; /* incremented if MODULE is seen */ 1251 SPTR mod_sym; /* ST_MODULE symbol for the MODULE subprogram */ 1252 SPTR submod_sym; /* original ST_MODULE symbol for SUBMODULE */ 1253 int mod_public_level; /* scope level of public USEs in module */ 1254 int use_seen; /* the current subprogram has a USE stmt */ 1255 ACCL accl; /* records PUBLIC/PRIVATE: 1256 * type: 1257 * 0 -- 'default' access statement not seen 1258 * 'u' -- 'default' is PUBLIC 1259 * 'v' -- 'default' is PRIVATE 1260 * next: list of ACCL items, one for each variable 1261 */ 1262 LOGICAL atomic[3]; /* atomic update: three element flag to record when the 1263 * directive is seen (atomic[1]), whether or not atomic 1264 * was the previous statement (atomic[0]), and whether 1265 * or not endatomic needs to be generated (atomic[2]) 1266 */ 1267 struct { /* master/endmaster */ 1268 int cnt; /* counter */ 1269 int lineno; /* line number of master */ 1270 int ast; /* ast of master */ 1271 } master; 1272 struct { /* critical/endcritical */ 1273 int cnt; /* counter */ 1274 int lineno; /* line number of critical */ 1275 int ast; /* ast of critical */ 1276 } critical; 1277 ITEM *intent_list; /* list of variables, not in an interface, for which 1278 * INTENT was specfied */ 1279 LOGICAL symmetric; /* SYMMETRIC statement w.o. symbols specified */ 1280 int which_pass; /* which semantic analyzer pass - 0 or 1 */ 1281 LOGICAL stfunc_error; /* error occurred when referencing a stmt function 1282 * while defining a statement function. 1283 */ 1284 LOGICAL mod_public_flag; /* when processing module contained routines, 1285 * is the default public or private? */ 1286 LOGICAL mod_dllexport; /* Win64 dllexport seen, module symbols must be 1287 * exported */ 1288 SC_KIND sc; /* SC_LOCAL or SC_PRIVATE for temporaries */ 1289 int orph; /* set wherever we see clause in orphan 1290 and clause take private, shared 1291 0 - not in 1292 >0 - in 1293 */ 1294 int parallel; /* parallel nesting level - PARALLEL, DOACROSS, 1295 * PARALLELDO, PARALLELSECTIONS: 1296 * 0 - not parallel 1297 * >0 - parallel nesting level (1 => outermost) 1298 */ 1299 LOGICAL expect_do; /* next statement after DOACROSS, PDO, or 1300 * PARALLELDO needs to be a DO. 1301 */ 1302 int expect_acc_do; /* next statement after ACC DO or ACC REGION DO 1303 * needs to be a DO. 1304 */ 1305 int collapsed_acc_do; /* value of collapse clause for acc loop */ 1306 int seq_acc_do; /* acc loop with 'seq' clause */ 1307 int expect_cuf_do; /* next statement after CUF KERNELS needs to be a DO. */ 1308 LOGICAL close_pdo; /* A DO loop for a PDO, PARALLELDO, or DOACROSS 1309 * has been processed and its removal from the 1310 * DOIF stack is delayed until the next 1311 * statement is processed. For PDO and 1312 * PARALLELDO, the next statement may be the 1313 * optional 'end' statement for the directive. 1314 * For PDO, the decision to emit a barrier 1315 * is also delayed since its ENDDO may specify 1316 * NOWAIT. For DOACROSS and PARALLELDO, the 1317 * the parallel region is closed when the 1318 * DO loop is closed. 1319 */ 1320 LOGICAL expect_simd_do; /* next statement after SIMD construct 1321 * to be a DO. 1322 */ 1323 LOGICAL expect_dist_do; /* next statement after SIMD construct 1324 * to be a DO. 1325 */ 1326 int target; /* use for OpenMP target */ 1327 int teams; /* use for OpenMP teams */ 1328 1329 struct { /* For atomic smp directive */ 1330 int is_acc; 1331 int lineno; /* line number of atomic */ 1332 LOGICAL seen; /* atomic directive just seen */ 1333 LOGICAL pending; /* atomic directive not yet applied */ 1334 LOGICAL apply; /* to be applied */ 1335 int accassignc; /* assigment statement count*/ 1336 int action_type; /* update|read|write|capture */ 1337 #define ATOMIC_UNDEF -1 1338 #define ATOMIC_UPDATE 1 1339 #define ATOMIC_READ 2 1340 #define ATOMIC_WRITE 3 1341 #define ATOMIC_CAPTURE 4 1342 int ast; /* ast of generated A_MP_CRITICAL, or 1343 genreated A_ACC_ATOMIC */ 1344 int rmw_op; /* AOP_ADD, AOP_SUB, etc */ 1345 int mem_order; /* AOP_UNDEF: if this isn't read-modify-write */ 1346 1347 } mpaccatomic; 1348 LOGICAL is_hpf; /* is this statement in !hpf$? */ 1349 int hpfdcl; /* available index for the hpf declarations 1350 * whose semantic processing is deferred 1351 * until the first executable is seen. The 1352 * the hpf declarations are saved as indices 1353 * [0, sem.hpfdcl-1]. 1354 */ 1355 int ssa_area; /* which getitem area to use for <ssa> */ 1356 LOGICAL use_etmps; /* flag to indicate that allocated temps created 1357 * for terms in an expression need to be saved 1358 * in the etmp list; they need to deallocated 1359 * after the computation of the expression. 1360 */ 1361 ITEM *etmp_list; /* list of the temps allocated for an 1362 * expression. 1363 */ 1364 ITEM *auto_dealloc; /* list of allocatable arrays that need to be 1365 * automatically deallocated (F95 feature). 1366 */ 1367 int blksymnum; 1368 LOGICAL ignore_default_none; /* don't perform the OMP DEFAULT(NONE) check */ 1369 int collapse; /* collapse value for the pardo or pdo */ 1370 int collapse_depth; /* depth of collapse loop; 1 => innermost */ 1371 int task; /* depth of task 1372 * 0 - not in task 1373 * >0 - task nesting level (1 => outermost) 1374 */ 1375 int alloc_std; /* std of ALLOCATE generated by 1376 * semutil2.c:gen_alloc_dealloc() 1377 */ 1378 struct { /* info of a call to an array function */ 1379 int try 1380 ; /* enable collection - when rhs of an assn */ 1381 int sptr; /* the function being called */ 1382 int return_value; /* the ast of the temp which is the return 1383 * value of the temp. 1384 */ 1385 int call_std; /* the std of the call to the function */ 1386 int alloc_std; /* the std of the allocate of the temp if 1387 * dynamic. 1388 */ 1389 } arrfn; 1390 LOGICAL in_enum; 1391 int *non_private_base; /* variables that cannot appear in a */ 1392 int non_private_size; /* private clause */ 1393 int non_private_avail; 1394 int *typroc_base; /* TY_PROC dtypes created */ 1395 int typroc_size; 1396 int typroc_avail; 1397 IFACE *iface_base; 1398 int iface_size; 1399 int iface_avail; 1400 LOGICAL class; /* true if processing poly variable */ 1401 int type_mode; /* mode of type declaration: 1402 * 0 - not within type 1403 * 1 - within type 1404 * 2 - within type and contains seen 1405 */ 1406 ITEM **tbp_arg; /* saved type bound procedure argument stack */ 1407 int tbp_arg_cnt; /* tbp_arg stack depth */ 1408 int tbp_access_stmt; /* used to note private stmt after a 1409 * contains statement within a type 1410 * declaration (i.e., type_mode == 2) 1411 * 0 - no stmt specified 1412 * 1 - private specified 1413 */ 1414 int tbp_interface; /* interface-name for deferred tbp processing*/ 1415 int generic_tbp; /* true if processing generic type bound proc */ 1416 ITEM *auto_finalize; /* list of objects that need to be finalized */ 1417 int select_type_seen; /* true if we just processed select type stmt */ 1418 int param_offset; /* counts # params for parameterized type */ 1419 int kind_type_param; /* currently processed kind type parameter */ 1420 int new_param_dt; /* currently processed param derived type */ 1421 ITEM *type_initialize; /* list of parameterized type objects for init*/ 1422 int extends; /* type extension tag during type processing */ 1423 int type_param_sptr; /* currently processed type param sptr */ 1424 int param_struct_constr; /* true when process param struct constructor */ 1425 int type_param_candidate; /* param offset for either len or kind */ 1426 ITEM *len_candidate; /* expression used for len */ 1427 ITEM *kind_candidate; /* expression used for kind */ 1428 int len_type_param; /* offset of param used for length */ 1429 int param_assume_sz; /* set when current type parameter is assume sz */ 1430 int param_defer_len; /* set when current type parameter is defer len */ 1431 int defined_io_type; /* set when we're processing defined IO stmts 1432 * 1 = read(formatted), 2 = read(unformatted) 1433 * 3 = write(formatted), 4 = write(unformatted) 1434 */ 1435 int defined_io_seen; /* set when processing defined I/O item */ 1436 struct { 1437 int allocs; 1438 int nodes; 1439 } stats; 1440 LOGICAL seen_import; /* import stmt in an interface seen */ 1441 void *save_aconst; /* saves SST of array constructor */ 1442 ITEM *alloc_mem_initialize; /* list of allocatable members to initialize */ 1443 LOGICAL ieee_features; /* USE ieee_features seen */ 1444 LOGICAL io_stmt; /* parsing an IO statement */ 1445 LOGICAL seen_end_module; /* seen end module statement */ 1446 LOGICAL contiguous; /* -Mcontiguous */ 1447 SPTR modhost_proc; /* ST_PROC of a module host routine containing an 1448 * internal procedure (set on demand) 1449 */ 1450 SPTR modhost_entry; /* ST_ENTRY of a module host routine containing an 1451 * internal procedure (set on demand) 1452 */ 1453 bool module_procedure; /* in instantiated MODULE PROCEDURE <id> def'n */ 1454 bool in_array_const; /* true when we are currently processing an 1455 * array constructor. 1456 */ 1457 bool parsing_operator; /* true when we are parsing an ST_OPERATOR */ 1458 } SEM; 1459 1460 extern SEM sem; 1461 1462 /* 1463 * NTYPE - number of basic types; this must include the NCHARACTER 1464 * type even though it may not be an available feature. 1465 */ 1466 #define NTYPE 23 1467 1468 extern INT cast_types[NTYPE][2][2]; 1469 1470 #define IS_INTRINSIC(st) (st == ST_INTRIN || st == ST_GENERIC || st == ST_PD) 1471 1472 #define INSIDE_STRUCT (sem.stsk_depth != 0) 1473 1474 void CheckDecl(int); 1475 #define DCLCHK(sptr) \ 1476 { \ 1477 if (sem.none_implicit) \ 1478 CheckDecl(sptr); \ 1479 } 1480 1481 #define DOCHK(sptr) \ 1482 if (DOVARG(sptr)) \ 1483 if (sem.doconcurrent_symavl) \ 1484 error(1053, ERR_Severe, gbl.lineno, "DO CONCURRENT", CNULL); \ 1485 else \ 1486 error(115, 2, gbl.lineno, SYMNAME(sptr), CNULL); 1487 1488 #define IN_MODULE (sem.mod_cnt && gbl.internal == 0) 1489 #define IN_MODULE_SPEC (sem.mod_cnt && gbl.currsub == 0) 1490 1491 /* declare external functions called only from within semant: */ 1492 1493 /* main.c */ 1494 void end_contained(void); 1495 1496 /* semsmp.c */ 1497 LOGICAL use_opt_atomic(int); 1498 int emit_epar(void); 1499 int emit_etarget(void); 1500 void is_dovar_sptr(int); 1501 void clear_no_scope_sptr(void); 1502 void add_no_scope_sptr(int, int, int); 1503 void pop_accel_vars(void); 1504 void handle_accdecl(int keyword); 1505 void check_no_scope_sptr(void); 1506 void parstuff_init(void); 1507 int emit_bcs_ecs(int); 1508 void end_parallel_clause(int); 1509 void end_teams(); 1510 void end_target(); 1511 void add_assign_firstprivate(int, int); 1512 void accel_end_dir(int, LOGICAL); 1513 void add_non_private(int); 1514 void mk_cuda_builtins(int *, int *, int); 1515 int mk_cuda_typedef(char *); 1516 int mk_mbr_ref(int, char *); 1517 void set_parref_flag(int, int, int); 1518 void set_parref_flag2(int, int, int); 1519 int is_sptr_in_shared_list(SPTR); 1520 void set_private_encl(int, int); 1521 void set_private_taskflag(int); 1522 int find_outer_sym(int); 1523 void par_add_stblk_shvar(void); 1524 int do_distbegin(DOINFO *, int, int); 1525 1526 /* semutil.c */ 1527 void check_derived_type_array_section(int); 1528 int gen_poly_element_arg(int ast, SPTR sptr, int std); 1529 int add_ptr_assign(int, int, int); 1530 void gen_contig_check(int dest, int src, SPTR sdsc, int lineno, bool cs, int std); 1531 int collapse_begin(DOINFO *); 1532 int collapse_add(DOINFO *); 1533 void link_parents(STSK *, int); 1534 void link_members(STSK *, int); 1535 int ref_object(int); 1536 int mk_component_ast(int, int, int); 1537 int chk_pointer_intent(int, int); 1538 int any_pointer_source(int); 1539 int chk_pointer_target(int, int); 1540 int mod_type(int, int, int, int, int, int); 1541 int getbase(int); 1542 int do_index_addr(int); 1543 int do_begin(DOINFO *); 1544 void do_lastval(DOINFO *); 1545 int do_parbegin(DOINFO *); 1546 void do_end(DOINFO *); 1547 int mkmember(int, int, int); 1548 LOGICAL legal_labelvar(int); 1549 void resolve_fwd_refs(void); 1550 DOINFO *get_doinfo(int); 1551 LOGICAL is_protected(int); 1552 void err_protected(int, char *); 1553 void set_assn(int); 1554 1555 /* semfin.c */ 1556 void semfin(void); 1557 void ipa_semfin(void); 1558 void semfin_free_memory(void); 1559 void fix_class_args(int sptr); 1560 void llvm_fix_args(int sptr, LOGICAL is_func); 1561 void do_equiv(void); 1562 void init_derived_type(SPTR, int, int); 1563 1564 /* semsym.c */ 1565 int sym_in_scope(int, OVCLASS, int *, int *, int); 1566 void sem_import_sym(int); 1567 int test_scope(int); 1568 int declref(int, SYMTYPE, int); 1569 void set_internref_stfunc(int); 1570 int declsym(int, SYMTYPE, LOGICAL); 1571 int refsym(int, OVCLASS); 1572 int refsym_inscope(int, OVCLASS); 1573 void enforce_denorm(void); 1574 int getocsym(int, OVCLASS, LOGICAL); 1575 int declobject(int, SYMTYPE); 1576 int newsym(int); 1577 int ref_ident(int); 1578 int ref_ident_inscope(int); 1579 int ref_storage(int); 1580 int ref_storage_inscope(int); 1581 int ref_int_scalar(int); 1582 int ref_based_object(int); 1583 int ref_based_object_sc(int, SC_KIND); 1584 int refocsym(int, OVCLASS); 1585 int sym_skip_construct(int); 1586 int declsym_newscope(int, SYMTYPE, int); 1587 int decl_private_sym(int); 1588 int sem_check_scope(int, int); 1589 1590 /* semfunc.c */ 1591 int get_static_type_descriptor(int sptr); 1592 int get_type_descr_arg(int func_sptr, int arg); 1593 int get_type_descr_arg2(int func_sptr, int arg); 1594 int sc_local_passbyvalue(int sptr, int func_sptr); 1595 LOGICAL allocatable_member(int sptr); 1596 LOGICAL in_kernel_region(void); 1597 int get_tbp_argno(int sptr, int dty2); 1598 int get_generic_member(int dtype, int sptr); 1599 int get_generic_member2(int dtype, int sptr, int argcnt, int *argno); 1600 int generic_tbp_has_pass_and_nopass(int dtype, int sptr); 1601 int get_generic_tbp_pass_or_nopass(int dtype, int sptr, int flag); 1602 int get_specific_member(int dtype, int sptr); 1603 int get_implementation(int dtype, int sptr, int flag, int *memout); 1604 int _selected_char_kind(int con); 1605 /* end semfunc.c */ 1606 1607 /* semfunc2.c */ 1608 void set_pass_objects(int, int); 1609 int intrinsic_as_arg(int); 1610 int ref_entry(int); 1611 int select_gsame(int); 1612 char *make_kwd_str(int); 1613 char *make_keyword_str(int, int); 1614 LOGICAL get_kwd_args(ITEM *, int, char *); 1615 LOGICAL evl_kwd_args(ITEM *, int, char *); 1616 LOGICAL sum_scatter_args(ITEM *, int); 1617 LOGICAL check_arguments(int, int, ITEM *, char *); 1618 LOGICAL chk_arguments(int, int, ITEM *, char *, int, int, int, int *); 1619 LOGICAL ignore_tkr(int, int); 1620 LOGICAL ignore_tkr_all(int); 1621 int iface_intrinsic(int); 1622 void defer_arg_chk(SPTR formal, SPTR actual, SPTR subprog, 1623 cmp_interface_flags, int lineno, bool performChk); 1624 /* end semfunc2.c */ 1625 1626 /* semgnr.c */ 1627 void check_generic(int); 1628 void init_intrinsic_opr(void); 1629 void bind_intrinsic_opr(int, int); 1630 int get_intrinsic_oprsym(int, int); 1631 int get_intrinsic_opr(int, int); 1632 int dtype_has_defined_io(int); 1633 void check_defined_io(void); 1634 void add_overload(int, int); 1635 void copy_specifics(int fromsptr, int tosptr); 1636 1637 /* semant2.c */ 1638 int test_private_dtype(int dtype); 1639 1640 /* semant3.c */ 1641 void check_doconcurrent(int doif); 1642 int has_poly_mbr(int sptr, int flag); 1643 void push_tbp_arg(ITEM *item); 1644 ITEM *pop_tbp_arg(void); 1645 1646 /* xref.c */ 1647 void xrefinit(void); 1648 void xrefput(int symptr, int usage); 1649 void xref(void); 1650 /* end xref.c */ 1651 1652 /** \brief Constants representing tasks for type bound procedure (tbp) 1653 * processing. 1654 * 1655 * These are used with the task argument in the queue_tbp() function. 1656 */ 1657 typedef enum tbpTasks { 1658 TBP_CLEAR_ERROR = -1, /**< Clear all entries in queue after an error */ 1659 TBP_CLEAR, /**< Clear all entries after normal processing */ 1660 TBP_CLEAR_STALE_RECORDS, /**< Clear tbp_queue entries with stale dtypes */ 1661 TBP_ADD_SIMPLE, /**< Add tbp after parsing simple tbp (e.g., procedure tbp;) 1662 */ 1663 TBP_ADD_TO_DTYPE, /**< Add tbps to derived type dtype records */ 1664 TBP_COMPLETE_ENDMODULE, /**< Complete tbp ST_MEMBERs in derived type after 1665 parsing ENDMODULE */ 1666 TBP_ADD_INTERFACE, /**< Add interface name to queue if user specified one */ 1667 TBP_ADD_IMPL, /**< Add binding name and implementation name to queue. 1668 Occurs when we parse something like 1669 procedure x => y (where x is the binding name and y is 1670 the implementation name). */ 1671 TBP_PASS, /**< Specify explicit pass argument for tbp */ 1672 TBP_COMPLETE_FIN, /**< Complete tbp ST_MEMBERS after processing module 1673 CONTAINS, etc. Called from semfin() */ 1674 TBP_INHERIT, /**< Copy inherited tbps from parent type to child type */ 1675 TBP_NOPASS, /**< Specify NOPASS attribute for tbp */ 1676 TBP_NONOVERRIDABLE, /**< Specify NON_OVERRIDABLE attribute for tbp */ 1677 TBP_PRIVATE, /**< Specify PRIVATE attribute for tbp */ 1678 TBP_PUBLIC, /**< Specify PUBLIC attribute for tbp */ 1679 TBP_STATUS, /**< Check to see if we have tbps to add to a derived type */ 1680 TBP_DEFERRED, /**< Specify DEFERRED attribute for tbp */ 1681 TBP_IFACE, /**< Specify an external routine via an explicit interface for 1682 the tbp's implementation */ 1683 TBP_COMPLETE_END, /**< Complete tbp ST_MEMBERs after parsing ENDFUNCTION, 1684 ENPROGRAM, ENSUBROUTINE outside the scope of a 1685 module. */ 1686 TBP_COMPLETE_ENDTYPE, /**< Complete tbp ST_MEMBERs after parsing ENDTYPE 1687 outside the scope of a module. */ 1688 TBP_CHECK_CHILD, /**< Check validity of child tbp with parent tbp */ 1689 TBP_CHECK_PRIVATE, /**< Check validity of private child tbp with parent tbp */ 1690 TBP_CHECK_PUBLIC, /**< Check validity of public child tbp with parent tbp */ 1691 TBP_COMPLETE_GENERIC, /**< Complete tbp ST_MEMBERs for generic tbps. This 1692 task is invoked in various places of generic and 1693 operator processing. */ 1694 TBP_ADD_FINAL, /**< Add final subroutine to queue */ 1695 TBP_FORCE_RESOLVE /**< Force resolution of tbps in tbpQueue */ 1696 1697 } tbpTask; 1698 1699 /* semtbp.c */ 1700 int queue_tbp(int sptr, int bind, int offset, int dtype, tbpTask task); 1701 void ensure_no_stale_tbp_queue_entries(void); 1702 1703 /** \brief These are constants used by SST_DIMFLAG and A_MASK to represent 1704 * empty subscripts (e.g., (:), (:,:), (:,:,:), etc. ) 1705 */ 1706 typedef enum dimMask { 1707 lboundMask = 0x1, /**< empty lower bound mask */ 1708 uboundMask = 0x2, /**< empty upper bound mask */ 1709 strideMask = 0x4 /**< empty stride mask */ 1710 } dimMask; 1711