|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2 of the GNU General Public License as 00007 published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU General Public License along 00021 with this program; if not, write the Free Software Foundation, Inc., 59 00022 Temple Place - Suite 330, Boston MA 02111-1307, USA. 00023 00024 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00025 Mountain View, CA 94043, or: 00026 00027 http://www.sgi.com 00028 00029 For further information regarding this notice, see: 00030 00031 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00032 00033 */ 00034 00035 00036 00037 static char USMID[] = "\n@(#)5.0_pl/sources/s_directiv.c 5.12 10/28/99 10:03:56\n"; 00038 00039 # include "defines.h" /* Machine dependent ifdefs */ 00040 00041 # include "host.m" /* Host machine dependent macros.*/ 00042 # include "host.h" /* Host machine dependent header.*/ 00043 # include "target.m" /* Target machine dependent macros.*/ 00044 # include "target.h" /* Target machine dependent header.*/ 00045 00046 # include "globals.m" 00047 # include "tokens.m" 00048 # include "sytb.m" 00049 # include "s_globals.m" 00050 # include "debug.m" 00051 00052 # include "globals.h" 00053 # include "tokens.h" 00054 # include "sytb.h" 00055 # include "s_globals.h" 00056 00057 00058 /*****************************************************************\ 00059 |* function prototypes of static functions declared in this file *| 00060 \*****************************************************************/ 00061 00062 static void add_common_blk_objects_to_list(int, int); 00063 static boolean assert_semantics(void); 00064 static boolean attr_is_in_list(int, int); 00065 static void doall_cmic_semantics(void); 00066 static void doparallel_cmic_semantics(void); 00067 static void end_blk_mp_semantics(boolean); 00068 static void set_mp_task_flags(int, boolean); 00069 static void endparallel_cmic_semantics(void); 00070 static boolean has_been_reprivatized(int); 00071 static void mp_directive_semantics(mp_directive_type); 00072 static boolean multiple_clause_err(int, int); 00073 static void open_mp_directive_semantics(open_mp_directive_type); 00074 static void parallel_cmic_semantics(void); 00075 static int pop_task_blk(void); 00076 static boolean power_o_two(int); 00077 static void prefetch_ref_semantics(void); 00078 static void push_task_blk(int); 00079 static void set_open_mp_task_flags(int, boolean); 00080 static void wait_send_semantics(void); 00081 00082 /******************************************************************************\ 00083 |* *| 00084 |* Description: *| 00085 |* Pass 2 processing for some directive stmts. *| 00086 |* *| 00087 |* Input parameters: *| 00088 |* NONE *| 00089 |* *| 00090 |* Output parameters: *| 00091 |* NONE *| 00092 |* *| 00093 |* Returns: *| 00094 |* NOTHING *| 00095 |* *| 00096 \******************************************************************************/ 00097 00098 void directive_stmt_semantics(void) 00099 00100 { 00101 int attr_idx; 00102 int column; 00103 expr_arg_type exp_desc; 00104 int host_attr_idx; 00105 int idx; 00106 int il_idx; 00107 int ir_idx; 00108 opnd_type l_opnd; 00109 int line; 00110 int list_idx; 00111 int name_idx; 00112 int new_il_idx; 00113 boolean null_point; 00114 long64 num_cpus; 00115 long num_cpu_value; 00116 boolean ok = TRUE; 00117 int old_ir_idx; 00118 opnd_type opnd; 00119 int prev_idx; 00120 expr_mode_type save_expr_mode; 00121 int sn_idx; 00122 00123 00124 TRACE (Func_Entry, "directive_stmt_semantics", NULL); 00125 00126 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 00127 00128 switch(IR_OPR(ir_idx)) { 00129 00130 case Aggressiveinnerloopfission_Opr: 00131 cdir_switches.aggressiveinnerloopfission = TRUE; 00132 break; 00133 00134 case Align_Cdir_Opr: 00135 cdir_switches.align = TRUE; 00136 break; 00137 00138 00139 case Bl_Cdir_Opr: 00140 cdir_switches.bl = TRUE; 00141 break; 00142 00143 00144 case Blockable_Dir_Opr: 00145 cdir_switches.blockable_sh_idx = curr_stmt_sh_idx; 00146 cdir_switches.blockable_group++; 00147 cdir_switches.blockable_count = 00148 IR_LIST_CNT_L(SH_IR_IDX(curr_stmt_sh_idx)); 00149 break; 00150 00151 00152 case Bounds_Cdir_Opr: 00153 case Nobounds_Cdir_Opr: 00154 00155 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) { 00156 list_idx = IR_IDX_L(ir_idx); 00157 00158 while (list_idx) { 00159 00160 /* set in_call_list to TRUE so we don't get msg about */ 00161 /* assumed size array use. */ 00162 00163 in_call_list = TRUE; 00164 00165 COPY_OPND(opnd, IL_OPND(list_idx)); 00166 xref_state = CIF_Symbol_Reference; 00167 exp_desc.rank = 0; 00168 ok &= expr_semantics(&opnd, &exp_desc); 00169 in_call_list = FALSE; 00170 00171 attr_idx = find_left_attr(&opnd); 00172 00173 find_opnd_line_and_column(&opnd, &line, &column); 00174 00175 if (attr_idx == NULL_IDX || 00176 AT_OBJ_CLASS(attr_idx) != Data_Obj) { 00177 00178 PRINTMSG(line, 1141, Error, column, 00179 (IR_OPR(ir_idx) == Bounds_Cdir_Opr ? 00180 "BOUNDS" : "NOBOUNDS")); 00181 } 00182 00183 IL_FLD(list_idx) = AT_Tbl_Idx; 00184 IL_IDX(list_idx) = attr_idx; 00185 IL_LINE_NUM(list_idx) = line; 00186 IL_COL_NUM(list_idx) = column; 00187 00188 list_idx = IL_NEXT_LIST_IDX(list_idx); 00189 } 00190 } 00191 00192 bounds_cdir_handler(ir_idx); 00193 00194 break; 00195 00196 00197 case Cachealign_Cdir_Opr : 00198 00199 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx && 00200 IR_LIST_CNT_L(ir_idx) > 0) { 00201 00202 list_idx = IR_IDX_L(ir_idx); 00203 00204 while (list_idx) { 00205 00206 /* set in_call_list to TRUE so we don't get msg about */ 00207 /* assumed size array use. */ 00208 00209 in_call_list = TRUE; 00210 00211 COPY_OPND(opnd, IL_OPND(list_idx)); 00212 exp_desc.rank = 0; 00213 xref_state = CIF_Symbol_Reference; 00214 ok = expr_semantics(&opnd, &exp_desc); 00215 00216 attr_idx = find_left_attr(&opnd); 00217 00218 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 00219 ATD_CLASS(attr_idx) != Variable || 00220 ATD_IN_COMMON(attr_idx)) { 00221 00222 find_opnd_line_and_column(&opnd, &line, &column); 00223 PRINTMSG(line, 1067, Error, column); 00224 } 00225 else if (ATD_CACHE_ALIGN(attr_idx)) { 00226 find_opnd_line_and_column(&opnd, &line, &column); 00227 PRINTMSG(line, 1065, Error, column); 00228 } 00229 else { 00230 ATD_CACHE_ALIGN(attr_idx) = TRUE; 00231 } 00232 00233 list_idx = IL_NEXT_LIST_IDX(list_idx); 00234 } 00235 00236 in_call_list = FALSE; 00237 } 00238 00239 break; 00240 00241 case Cache_Bypass_Cdir_Opr: 00242 00243 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) { /* Should contain an IL list */ 00244 cdir_switches.cache_bypass_ir_idx = ir_idx; 00245 00246 if (IR_LIST_CNT_L(ir_idx) > 0) { 00247 list_idx = IR_IDX_L(ir_idx); 00248 00249 while (list_idx) { 00250 00251 /* set in_call_list to TRUE so we don't get msg about */ 00252 /* assumed size array use. */ 00253 00254 in_call_list = TRUE; 00255 00256 COPY_OPND(opnd, IL_OPND(list_idx)); 00257 exp_desc.rank = 0; 00258 xref_state = CIF_Symbol_Reference; 00259 ok = expr_semantics(&opnd, &exp_desc); 00260 00261 attr_idx = find_left_attr(&opnd); 00262 00263 if (AT_OBJ_CLASS(attr_idx) == Interface && 00264 ATI_PROC_IDX(attr_idx) != NULL_IDX) { 00265 attr_idx = ATI_PROC_IDX(attr_idx); 00266 } 00267 00268 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 00269 ATP_PGM_UNIT(attr_idx) == Function && 00270 !ATP_RSLT_NAME(attr_idx)) { 00271 attr_idx = ATP_RSLT_IDX(attr_idx); 00272 } 00273 00274 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 00275 ATD_ARRAY_IDX(attr_idx) == NULL_IDX) { 00276 find_opnd_line_and_column(&opnd, &line, &column); 00277 PRINTMSG(line, 1318, Error, column, 00278 AT_OBJ_NAME_PTR(attr_idx)); 00279 } 00280 else if (TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) != Integer_8 && 00281 TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) != Real_8 && 00282 TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) != Logical_8 && 00283 TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) != Complex_8) { 00284 find_opnd_line_and_column(&opnd, &line, &column); 00285 PRINTMSG(line, 1320, Error, column, 00286 AT_OBJ_NAME_PTR(attr_idx)); 00287 } 00288 else { 00289 ATD_CACHE_BYPASS_ARRAY(attr_idx) = TRUE; 00290 } 00291 list_idx = IL_NEXT_LIST_IDX(list_idx); 00292 } 00293 } 00294 in_call_list = FALSE; 00295 } 00296 break; 00297 00298 case Cncall_Cmic_Opr: 00299 cdir_switches.cncall = TRUE; 00300 break; 00301 00302 case Concurrentize_Star_Opr: 00303 break; 00304 00305 case Noconcurrentize_Star_Opr: 00306 break; 00307 00308 case Fissionable_Star_Opr: 00309 cdir_switches.fissionable = TRUE; 00310 break; 00311 00312 case Flush_Star_Opr: 00313 list_idx = IR_IDX_L(ir_idx); 00314 00315 while (list_idx != NULL_IDX) { 00316 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 00317 attr_idx = IL_IDX(list_idx); 00318 AT_LOCKED_IN(attr_idx) = TRUE; 00319 00320 while (AT_ATTR_LINK(attr_idx)) { 00321 attr_idx = AT_ATTR_LINK(attr_idx); 00322 AT_LOCKED_IN(attr_idx) = TRUE; 00323 } 00324 00325 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 00326 PRINTMSG(IL_LINE_NUM(list_idx), 1480, Error, 00327 IL_COL_NUM(list_idx)); 00328 } 00329 00330 IL_IDX(list_idx) = attr_idx; 00331 } 00332 00333 list_idx = IL_NEXT_LIST_IDX(list_idx); 00334 } 00335 break; 00336 00337 case Fusable_Star_Opr: 00338 cdir_switches.fusable = TRUE; 00339 break; 00340 00341 case Inline_Cdir_Opr: 00342 cdir_switches.do_inline = TRUE; 00343 break; 00344 00345 case Interchange_Dir_Opr: 00346 cdir_switches.interchange_sh_idx = curr_stmt_sh_idx;; 00347 cdir_switches.interchange_group++; 00348 cdir_switches.interchange_count = 00349 IR_LIST_CNT_L(SH_IR_IDX(curr_stmt_sh_idx)); 00350 break; 00351 00352 case Ivdep_Cdir_Opr: 00353 cdir_switches.ivdep = TRUE; 00354 00355 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 00356 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 00357 exp_desc.rank = 0; 00358 xref_state = CIF_Symbol_Reference; 00359 ok = expr_semantics(&opnd, &exp_desc); 00360 00361 if (OPND_FLD(opnd) != CN_Tbl_Idx || 00362 exp_desc.rank != 0 || 00363 exp_desc.type != Integer) { 00364 find_opnd_line_and_column(&opnd, &line, &column); 00365 PRINTMSG(line, 796, Error, column); 00366 } 00367 else if (compare_cn_and_value(OPND_IDX(opnd), 1, Lt_Opr) || 00368 compare_cn_and_value(OPND_IDX(opnd), 1024, Gt_Opr)) { 00369 find_opnd_line_and_column(&opnd, &line, &column); 00370 PRINTMSG(line, 796, Error, column); 00371 } 00372 else { 00373 cdir_switches.safevl_idx = OPND_IDX(opnd); 00374 } 00375 } 00376 else { 00377 cdir_switches.safevl_idx = const_safevl_idx; 00378 } 00379 00380 break; 00381 00382 00383 case Concurrent_Cdir_Opr: 00384 00385 cdir_switches.concurrent = TRUE; 00386 00387 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 00388 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 00389 exp_desc.rank = 0; 00390 xref_state = CIF_Symbol_Reference; 00391 ok = expr_semantics(&opnd, &exp_desc); 00392 00393 if (OPND_FLD(opnd) != CN_Tbl_Idx || 00394 exp_desc.rank != 0 || 00395 exp_desc.type != Integer) { 00396 find_opnd_line_and_column(&opnd, &line, &column); 00397 PRINTMSG(line, 1422, Error, column); 00398 } 00399 else if (fold_relationals(OPND_IDX(opnd), 00400 CN_INTEGER_ONE_IDX, 00401 Lt_Opr)) { 00402 00403 /* Value must be >= 1 */ 00404 00405 find_opnd_line_and_column(&opnd, &line, &column); 00406 PRINTMSG(line, 1422, Error, column); 00407 } 00408 else { 00409 cdir_switches.concurrent_idx = OPND_IDX(opnd); 00410 } 00411 } 00412 break; 00413 00414 case Mark_Cdir_Opr: 00415 cdir_switches.mark = TRUE; 00416 00417 if (IR_FLD_L(ir_idx) == CN_Tbl_Idx) { 00418 cdir_switches.mark_dir_idx = IR_IDX_L(ir_idx); 00419 } 00420 break; 00421 00422 case Nextscalar_Cdir_Opr: 00423 cdir_switches.nextscalar = TRUE; 00424 break; 00425 00426 case Noblocking_Dir_Opr: 00427 cdir_switches.noblocking = TRUE; 00428 break; 00429 00430 case Nofission_Star_Opr: 00431 cdir_switches.nofission = TRUE; 00432 break; 00433 00434 case Nofusion_Star_Opr: 00435 cdir_switches.nofusion = TRUE; 00436 break; 00437 00438 case Nointerchange_Dir_Opr: 00439 cdir_switches.nointerchange = TRUE; 00440 break; 00441 00442 case Nomark_Cdir_Opr: 00443 cdir_switches.mark = FALSE; 00444 cdir_switches.mark_dir_idx = NULL_IDX; 00445 break; 00446 00447 00448 case Nobl_Cdir_Opr: 00449 cdir_switches.bl = FALSE; 00450 break; 00451 00452 case Noinline_Cdir_Opr: 00453 cdir_switches.do_inline = FALSE; 00454 break; 00455 00456 case Nopattern_Cdir_Opr: 00457 cdir_switches.pattern = FALSE; 00458 break; 00459 00460 00461 case Norecurrence_Cdir_Opr: 00462 cdir_switches.recurrence = FALSE; 00463 break; 00464 00465 00466 case Nosplit_Cdir_Opr: 00467 cdir_switches.split = FALSE; 00468 break; 00469 00470 00471 case Nostream_Dir_Opr: 00472 cdir_switches.stream = FALSE; 00473 break; 00474 00475 00476 case Notask_Cdir_Opr: 00477 cdir_switches.task = FALSE; 00478 cdir_switches.notask_region = TRUE; 00479 break; 00480 00481 00482 case Nounroll_Cdir_Opr: 00483 00484 /* 1 means NO unrolling */ 00485 00486 cdir_switches.unroll_count_idx = CN_INTEGER_ONE_IDX; 00487 cdir_switches.unroll_dir = TRUE; 00488 break; 00489 00490 00491 case Novector_Cdir_Opr: 00492 cdir_switches.vector = FALSE; 00493 break; 00494 00495 00496 case Novsearch_Cdir_Opr: 00497 cdir_switches.vsearch = FALSE; 00498 break; 00499 00500 case Opaque_Star_Opr: 00501 cdir_switches.opaque = TRUE; 00502 break; 00503 00504 00505 case Pattern_Cdir_Opr: 00506 cdir_switches.pattern = TRUE; 00507 break; 00508 00509 00510 case Permutation_Cmic_Opr: 00511 cdir_switches.permutation = TRUE; 00512 break; 00513 00514 00515 case Preferstream_Nocinv_Dir_Opr: 00516 cdir_switches.preferstream_nocinv = TRUE; 00517 00518 /* Intentional fall through */ 00519 00520 case Preferstream_Dir_Opr: 00521 cdir_switches.preferstream = TRUE; 00522 break; 00523 00524 00525 case Prefertask_Cdir_Opr: 00526 cdir_switches.prefertask = TRUE; 00527 break; 00528 00529 00530 case Prefervector_Cdir_Opr: 00531 cdir_switches.prefervector = TRUE; 00532 break; 00533 00534 case Purpleconditional_Star_Opr: 00535 cdir_switches.purpleconditional = TRUE; 00536 00537 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 00538 exp_desc.rank = 0; 00539 xref_state = CIF_Symbol_Reference; 00540 ok = expr_semantics(&opnd, &exp_desc); 00541 00542 find_opnd_line_and_column(&opnd, &line, &column); 00543 if (exp_desc.type != Logical || 00544 exp_desc.rank != 0) { 00545 PRINTMSG(line, 803, Error, column); 00546 } 00547 00548 idx = create_tmp_asg(&opnd, 00549 &exp_desc, 00550 &l_opnd, 00551 Intent_In, 00552 FALSE, 00553 FALSE); 00554 IR_FLD_L(ir_idx) = AT_Tbl_Idx; 00555 IR_IDX_L(ir_idx) = idx; 00556 IR_LINE_NUM_L(ir_idx) = line; 00557 IR_COL_NUM_L(ir_idx) = column; 00558 break; 00559 00560 case Purpleunconditional_Star_Opr: 00561 cdir_switches.purpleunconditional = TRUE; 00562 break; 00563 00564 case Recurrence_Cdir_Opr: 00565 cdir_switches.recurrence = TRUE; 00566 break; 00567 00568 00569 case Shortloop_Cdir_Opr: 00570 cdir_switches.shortloop = TRUE; 00571 00572 if (cdir_switches.shortloop128) { 00573 cdir_switches.shortloop128 = FALSE; 00574 } 00575 00576 break; 00577 00578 00579 case Split_Cdir_Opr: 00580 cdir_switches.split = TRUE; 00581 break; 00582 00583 00584 case Shortloop128_Cdir_Opr: 00585 cdir_switches.shortloop128 = TRUE; 00586 00587 if (cdir_switches.shortloop) { 00588 cdir_switches.shortloop = FALSE; 00589 } 00590 00591 break; 00592 00593 00594 case Stream_Dir_Opr: 00595 cdir_switches.stream = TRUE; 00596 break; 00597 00598 00599 case Suppress_Opr: 00600 list_idx = IR_IDX_L(ir_idx); 00601 00602 while (list_idx) { 00603 /* set in_call_list to TRUE so we don't get msg about */ 00604 /* assumed size array use. */ 00605 00606 in_call_list = TRUE; 00607 00608 COPY_OPND(opnd, IL_OPND(list_idx)); 00609 exp_desc.rank = 0; 00610 xref_state = CIF_Symbol_Reference; 00611 ok = expr_semantics(&opnd, &exp_desc); 00612 00613 while (OPND_FLD(opnd) == IR_Tbl_Idx && 00614 (IR_OPR(OPND_IDX(opnd)) == Whole_Substring_Opr || 00615 IR_OPR(OPND_IDX(opnd)) == Whole_Subscript_Opr || 00616 (IR_OPR(OPND_IDX(opnd)) == Subscript_Opr && 00617 IR_FLD_R(OPND_IDX(opnd)) == IL_Tbl_Idx && 00618 IL_PE_SUBSCRIPT(IR_IDX_R(OPND_IDX(opnd)))) || 00619 IR_OPR(OPND_IDX(opnd)) == Dv_Deref_Opr)) { 00620 00621 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd))); 00622 } 00623 00624 if (OPND_FLD(opnd) != AT_Tbl_Idx) { 00625 find_opnd_line_and_column(&opnd, &line, &column); 00626 PRINTMSG(line, 1487, Error, column, "SUPPRESS"); 00627 } 00628 00629 COPY_OPND(IL_OPND(list_idx), opnd); 00630 00631 list_idx = IL_NEXT_LIST_IDX(list_idx); 00632 } 00633 00634 in_call_list = FALSE; 00635 break; 00636 00637 00638 case Task_Cdir_Opr: 00639 cdir_switches.task = TRUE; 00640 cdir_switches.notask_region = FALSE; 00641 break; 00642 00643 00644 case Unroll_Cdir_Opr: 00645 00646 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 00647 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 00648 save_expr_mode = expr_mode; 00649 exp_desc.rank = 0; 00650 xref_state = CIF_Symbol_Reference; 00651 expr_mode = Initialization_Expr; 00652 ok = expr_semantics(&opnd, &exp_desc); 00653 COPY_OPND(IR_OPND_L(ir_idx), opnd); 00654 00655 if (OPND_FLD(opnd) != CN_Tbl_Idx || 00656 exp_desc.rank != 0 || 00657 exp_desc.type != Integer) { 00658 find_opnd_line_and_column(&opnd, &line, &column); 00659 PRINTMSG(line, 1105, Error, column); 00660 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 00661 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 00662 } 00663 else if (fold_relationals(OPND_IDX(opnd), 00664 CN_INTEGER_ZERO_IDX, 00665 Eq_Opr)) { 00666 00667 /* Directive is "UNROLL 0". Force it to no unrolling, */ 00668 /* so send an unroll count of 1 to pdgcs!! */ 00669 00670 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 00671 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 00672 } 00673 else if (compare_cn_and_value(OPND_IDX(opnd), 0, Lt_Opr) || 00674 compare_cn_and_value(OPND_IDX(opnd), 1024, Gt_Opr)) { 00675 find_opnd_line_and_column(&opnd, &line, &column); 00676 PRINTMSG(line, 1105, Error, column); 00677 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 00678 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 00679 } 00680 00681 cdir_switches.unroll_count_idx = IR_IDX_L(ir_idx); 00682 cdir_switches.unroll_dir = TRUE; 00683 expr_mode = save_expr_mode; 00684 } 00685 else { 00686 cdir_switches.unroll_count_idx = CN_INTEGER_ZERO_IDX; 00687 cdir_switches.unroll_dir = TRUE; 00688 } 00689 break; 00690 00691 00692 case Vector_Cdir_Opr: 00693 cdir_switches.vector = TRUE; 00694 break; 00695 00696 00697 case Vsearch_Cdir_Opr: 00698 cdir_switches.vsearch = TRUE; 00699 break; 00700 00701 00702 /* -------------------------------------------------------------------- */ 00703 /* */ 00704 /* CMIC$'s */ 00705 /* */ 00706 /* -------------------------------------------------------------------- */ 00707 00708 /* -------------------------------------------------------------------- */ 00709 /* DOALL */ 00710 /* -------------------------------------------------------------------- */ 00711 00712 case Doall_Cmic_Opr: 00713 00714 doall_cmic_semantics(); 00715 break; 00716 00717 00718 /* -------------------------------------------------------------------- */ 00719 /* DOPARALLEL */ 00720 /* -------------------------------------------------------------------- */ 00721 00722 case Doparallel_Cmic_Opr: 00723 00724 doparallel_cmic_semantics(); 00725 break; 00726 00727 case Enddo_Cmic_Opr: 00728 if (IR_OPR(SH_IR_IDX(SH_NEXT_IDX(curr_stmt_sh_idx))) == 00729 Endparallel_Cmic_Opr) { 00730 /* use a const 1 as a flag to prevent the extra barrier on irix */ 00731 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 00732 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 00733 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx); 00734 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx); 00735 } 00736 00737 wait_send_semantics(); 00738 break; 00739 00740 00741 /* -------------------------------------------------------------------- */ 00742 /* GUARD END GUARD */ 00743 /* -------------------------------------------------------------------- */ 00744 00745 case Guard_Cmic_Opr: 00746 case Endguard_Cmic_Opr: 00747 00748 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 00749 00750 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 00751 exp_desc.rank = 0; 00752 xref_state = CIF_Symbol_Reference; 00753 ok = expr_semantics(&opnd, &exp_desc); 00754 IR_FLD_L(ir_idx) = AT_Tbl_Idx; 00755 idx = create_tmp_asg(&opnd, 00756 &exp_desc, 00757 &l_opnd, 00758 Intent_In, 00759 FALSE, 00760 FALSE); 00761 IR_IDX_L(ir_idx) = idx; 00762 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx); 00763 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx); 00764 } 00765 00766 break; 00767 00768 00769 /* -------------------------------------------------------------------- */ 00770 /* END PARALLEL */ 00771 /* -------------------------------------------------------------------- */ 00772 00773 case Endparallel_Cmic_Opr: 00774 00775 endparallel_cmic_semantics(); 00776 break; 00777 00778 00779 /* -------------------------------------------------------------------- */ 00780 /* NUMCPUS */ 00781 /* -------------------------------------------------------------------- */ 00782 00783 case Numcpus_Cmic_Opr: 00784 00785 if (cdir_switches.parallel_region) { 00786 00787 /* Numcpus is illegal within a parallel region */ 00788 00789 PRINTMSG(stmt_start_line, 1121, Error, stmt_start_col); 00790 } 00791 00792 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 00793 exp_desc.rank = 0; 00794 xref_state = CIF_Symbol_Reference; 00795 ok = expr_semantics(&opnd, &exp_desc); 00796 COPY_OPND(IR_OPND_L(ir_idx), opnd); 00797 num_cpus = CN_INT_TO_C(IR_IDX_L(ir_idx)); 00798 00799 if (IR_FLD_L(ir_idx) == CN_Tbl_Idx && (num_cpus < 1 || num_cpus > 64)){ 00800 00801 if (num_cpus < 1) { 00802 num_cpu_value = 1; 00803 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 00804 } 00805 else { 00806 num_cpu_value = 64; 00807 IR_IDX_L(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 00808 num_cpu_value); 00809 } 00810 00811 PRINTMSG(stmt_start_line, 1122, Warning, 00812 stmt_start_col, 00813 (long) num_cpus, 00814 num_cpu_value); 00815 } 00816 00817 break; 00818 00819 00820 /* -------------------------------------------------------------------- */ 00821 /* PARALLEL */ 00822 /* -------------------------------------------------------------------- */ 00823 00824 case Parallel_Cmic_Opr: 00825 00826 parallel_cmic_semantics(); 00827 break; 00828 00829 /* -------------------------------------------------------------------- */ 00830 /* SEND */ 00831 /* -------------------------------------------------------------------- */ 00832 00833 case Send_Cmic_Opr: 00834 00835 NTR_IR_LIST_TBL(new_il_idx); 00836 00837 IL_FLD(new_il_idx) = IR_Tbl_Idx; 00838 IL_IDX(new_il_idx) = ir_idx; 00839 IL_LINE_NUM(new_il_idx) = IR_LINE_NUM(ir_idx); 00840 IL_COL_NUM(new_il_idx) = IR_COL_NUM(ir_idx); 00841 00842 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { /* POINT */ 00843 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 00844 exp_desc.rank = 0; 00845 xref_state = CIF_Symbol_Reference; 00846 ok = expr_semantics(&opnd, &exp_desc); 00847 00848 if (exp_desc.type != Integer || exp_desc.rank != 0) { 00849 find_opnd_line_and_column(&opnd, &line, &column); 00850 PRINTMSG(line, 1431, Error, column, "POINT", "SEND"); 00851 } 00852 00853 COPY_OPND(IR_OPND_L(ir_idx), opnd); 00854 } 00855 00856 if (IR_FLD_R(ir_idx) != NO_Tbl_Idx) { /* IF */ 00857 COPY_OPND(opnd, IR_OPND_R(ir_idx)); 00858 exp_desc.rank = 0; 00859 xref_state = CIF_Symbol_Reference; 00860 ok = expr_semantics(&opnd, &exp_desc); 00861 find_opnd_line_and_column(&opnd, &line, &column); 00862 00863 if (ok && (exp_desc.type != Logical || exp_desc.rank != 0)) { 00864 PRINTMSG(line, 1433, Error, column, "IF", "SEND"); 00865 } 00866 COPY_OPND(IR_OPND_R(ir_idx), opnd); 00867 00868 IR_FLD_R(ir_idx) = AT_Tbl_Idx; 00869 idx = create_tmp_asg(&opnd, 00870 &exp_desc, 00871 &l_opnd, 00872 Intent_In, 00873 FALSE, 00874 FALSE); 00875 IR_IDX_R(ir_idx) = idx; 00876 IR_LINE_NUM_R(ir_idx) = line; 00877 IR_COL_NUM_R(ir_idx) = column; 00878 } 00879 00880 if (cdir_switches.send_list_idx == NULL_IDX) { 00881 cdir_switches.send_list_idx = new_il_idx; 00882 } 00883 else { 00884 il_idx = cdir_switches.send_list_idx; 00885 00886 while (il_idx != NULL_IDX) { 00887 prev_idx = il_idx; 00888 il_idx = IL_NEXT_LIST_IDX(il_idx); 00889 } 00890 00891 IL_NEXT_LIST_IDX(prev_idx) = new_il_idx; 00892 } 00893 break; 00894 00895 /* -------------------------------------------------------------------- */ 00896 /* WAIT */ 00897 /* -------------------------------------------------------------------- */ 00898 00899 case Wait_Cmic_Opr: 00900 00901 /* Create a list of all the wait cmics for semantic checking. */ 00902 00903 NTR_IR_LIST_TBL(new_il_idx); 00904 00905 IL_FLD(new_il_idx) = IR_Tbl_Idx; 00906 IL_IDX(new_il_idx) = ir_idx; 00907 IL_LINE_NUM(new_il_idx) = IR_LINE_NUM(ir_idx); 00908 IL_COL_NUM(new_il_idx) = IR_COL_NUM(ir_idx); 00909 00910 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { /* POINT */ 00911 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 00912 exp_desc.rank = 0; 00913 xref_state = CIF_Symbol_Reference; 00914 ok = expr_semantics(&opnd, &exp_desc); 00915 00916 if (exp_desc.type != Integer || exp_desc.rank != 0) { 00917 find_opnd_line_and_column(&opnd, &line, &column); 00918 PRINTMSG(line, 1431, Error, column, "POINT", "WAIT"); 00919 } 00920 00921 COPY_OPND(IR_OPND_L(ir_idx), opnd); 00922 null_point = FALSE; 00923 } 00924 else { 00925 null_point = TRUE; 00926 } 00927 00928 COPY_OPND(opnd, IR_OPND_R(ir_idx)); 00929 exp_desc.rank = 0; 00930 xref_state = CIF_Symbol_Reference; 00931 ok = expr_semantics(&opnd, &exp_desc); 00932 00933 if (exp_desc.type != Integer || exp_desc.rank != 0 || 00934 OPND_FLD(opnd) != CN_Tbl_Idx) { 00935 find_opnd_line_and_column(&opnd, &line, &column); 00936 PRINTMSG(line, 1532, Error, column); 00937 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 00938 IR_IDX_R(ir_idx) = CN_INTEGER_ONE_IDX; 00939 } 00940 else { 00941 COPY_OPND(IR_OPND_R(ir_idx), opnd); 00942 } 00943 00944 if (cdir_switches.wait_list_idx == NULL_IDX) { 00945 00946 /* This is the first WAIT - no checking necessary */ 00947 00948 cdir_switches.wait_list_idx = new_il_idx; 00949 } 00950 else { 00951 00952 /* Check each point to make sure it is unique as we add to list */ 00953 00954 il_idx = cdir_switches.wait_list_idx; 00955 00956 while (il_idx != NULL_IDX) { 00957 prev_idx = il_idx; 00958 old_ir_idx = IL_IDX(il_idx); 00959 00960 if (IR_FLD_L(old_ir_idx) == NO_Tbl_Idx) { 00961 00962 if (null_point) { /* They both are POINTless. */ 00963 PRINTMSG(IR_LINE_NUM(ir_idx), 1521, Error, 00964 IR_COL_NUM(ir_idx)); 00965 ok = FALSE; 00966 break; 00967 } 00968 } 00969 else if (IR_FLD_L(ir_idx) == CN_Tbl_Idx && 00970 IR_FLD_L(old_ir_idx) == CN_Tbl_Idx && 00971 fold_relationals(IR_IDX_L(ir_idx), 00972 IR_IDX_L(old_ir_idx), 00973 Eq_Opr)) { 00974 00975 /* Issue message. Same POINT value is not allowed. */ 00976 00977 find_opnd_line_and_column(&(IR_OPND_L(ir_idx)), 00978 &line, &column); 00979 PRINTMSG(line, 1521, Error, column); 00980 ok = FALSE; 00981 break; 00982 } 00983 il_idx = IL_NEXT_LIST_IDX(il_idx); 00984 } 00985 00986 if (ok) { 00987 IL_NEXT_LIST_IDX(prev_idx) = new_il_idx; 00988 } 00989 } 00990 break; 00991 00992 00993 00994 /* -------------------------------------------------------------------- */ 00995 /* */ 00996 /* C$'s */ 00997 /* */ 00998 /* -------------------------------------------------------------------- */ 00999 01000 /* -------------------------------------------------------------------- */ 01001 /* DOACROSS */ 01002 /* -------------------------------------------------------------------- */ 01003 01004 case Doacross_Dollar_Opr: 01005 mp_directive_semantics(Doacross); 01006 break; 01007 01008 /* -------------------------------------------------------------------- */ 01009 /* COPYIN */ 01010 /* -------------------------------------------------------------------- */ 01011 01012 case Copyin_Dollar_Opr: 01013 01014 if (cdir_switches.doall_sh_idx != NULL_IDX || 01015 cdir_switches.doacross_sh_idx != NULL_IDX || 01016 cdir_switches.parallel_region || 01017 cdir_switches.guard_in_par_reg) { 01018 01019 PRINTMSG(IR_LINE_NUM(ir_idx), 1395, Error, IR_COL_NUM(ir_idx)); 01020 } 01021 01022 list_idx = IR_IDX_L(ir_idx); 01023 01024 while (list_idx) { 01025 if (IL_FLD(list_idx) != SB_Tbl_Idx && 01026 IL_FLD(list_idx) != NO_Tbl_Idx) { 01027 COPY_OPND(opnd, IL_OPND(list_idx)); 01028 xref_state = CIF_Symbol_Reference; 01029 exp_desc.rank = 0; 01030 ok &= expr_semantics(&opnd, &exp_desc); 01031 COPY_OPND(IL_OPND(list_idx), opnd); 01032 01033 find_opnd_line_and_column(&opnd, &line, &column); 01034 attr_idx = find_left_attr(&opnd); 01035 01036 if (! exp_desc.reference || 01037 AT_OBJ_CLASS(attr_idx) != Data_Obj || 01038 ! ATD_IN_COMMON(attr_idx) || 01039 ATD_STOR_BLK_IDX(attr_idx) == NULL_IDX || 01040 SB_BLANK_COMMON(ATD_STOR_BLK_IDX(attr_idx))) { 01041 /* error */ 01042 01043 PRINTMSG(line, 1394, Error, column); 01044 } 01045 } 01046 else { 01047 /* common block */ 01048 } 01049 list_idx = IL_NEXT_LIST_IDX(list_idx); 01050 } 01051 break; 01052 01053 01054 /* -------------------------------------------------------------------- */ 01055 /* DYNAMIC */ 01056 /* -------------------------------------------------------------------- */ 01057 01058 case Dynamic_Dollar_Opr: 01059 01060 list_idx = IR_IDX_L(ir_idx); 01061 01062 while (list_idx) { 01063 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01064 attr_idx = IL_IDX(list_idx); 01065 AT_LOCKED_IN(attr_idx) = TRUE; 01066 01067 while (AT_ATTR_LINK(attr_idx)) { 01068 attr_idx = AT_ATTR_LINK(attr_idx); 01069 AT_LOCKED_IN(attr_idx) = TRUE; 01070 } 01071 01072 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 01073 ATD_ARRAY_IDX(attr_idx) == NULL_IDX) { 01074 01075 find_opnd_line_and_column(&IL_OPND(list_idx), &line, &column); 01076 PRINTMSG(line, 1396, Error, column, "C$DYNAMIC"); 01077 } 01078 01079 IL_IDX(list_idx) = attr_idx; 01080 } 01081 list_idx = IL_NEXT_LIST_IDX(list_idx); 01082 } 01083 break; 01084 01085 /* -------------------------------------------------------------------- */ 01086 /* PAGE_PLACE */ 01087 /* -------------------------------------------------------------------- */ 01088 01089 case Page_Place_Dollar_Opr: 01090 list_idx = IR_IDX_L(ir_idx); 01091 01092 COPY_OPND(opnd, IL_OPND(list_idx)); 01093 xref_state = CIF_Symbol_Reference; 01094 exp_desc.rank = 0; 01095 ok &= expr_semantics(&opnd, &exp_desc); 01096 COPY_OPND(IL_OPND(list_idx), opnd); 01097 01098 /* must be a reference */ 01099 01100 list_idx = IL_NEXT_LIST_IDX(list_idx); 01101 01102 COPY_OPND(opnd, IL_OPND(list_idx)); 01103 xref_state = CIF_Symbol_Reference; 01104 exp_desc.rank = 0; 01105 ok &= expr_semantics(&opnd, &exp_desc); 01106 COPY_OPND(IL_OPND(list_idx), opnd); 01107 01108 if (exp_desc.type != Integer || 01109 exp_desc.rank != 0) { 01110 01111 find_opnd_line_and_column(&opnd, &line, &column); 01112 PRINTMSG(line, 1397, Error, column); 01113 } 01114 01115 list_idx = IL_NEXT_LIST_IDX(list_idx); 01116 01117 COPY_OPND(opnd, IL_OPND(list_idx)); 01118 xref_state = CIF_Symbol_Reference; 01119 exp_desc.rank = 0; 01120 ok &= expr_semantics(&opnd, &exp_desc); 01121 COPY_OPND(IL_OPND(list_idx), opnd); 01122 01123 if (exp_desc.type != Integer || 01124 exp_desc.rank != 0) { 01125 01126 find_opnd_line_and_column(&opnd, &line, &column); 01127 PRINTMSG(line, 1397, Error, column); 01128 } 01129 01130 break; 01131 01132 /* -------------------------------------------------------------------- */ 01133 /* REDISTRIBUTE */ 01134 /* -------------------------------------------------------------------- */ 01135 01136 case Redistribute_Dollar_Opr: 01137 attr_idx = IR_IDX_L(ir_idx); 01138 AT_LOCKED_IN(attr_idx) = TRUE; 01139 01140 while (AT_ATTR_LINK(attr_idx)) { 01141 attr_idx = AT_ATTR_LINK(attr_idx); 01142 AT_LOCKED_IN(attr_idx) = TRUE; 01143 } 01144 01145 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 01146 ATD_ARRAY_IDX(attr_idx) == NULL_IDX) { 01147 01148 find_opnd_line_and_column(&IR_OPND_L(ir_idx), &line, &column); 01149 PRINTMSG(line, 1396, Error, column, "C$REDISTRIBUTE"); 01150 } 01151 01152 IR_IDX_L(ir_idx) = attr_idx; 01153 01154 list_idx = IL_IDX(IR_IDX_R(ir_idx)); 01155 01156 while (list_idx) { 01157 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 01158 COPY_OPND(opnd, IL_OPND(list_idx)); 01159 xref_state = CIF_Symbol_Reference; 01160 exp_desc.rank = 0; 01161 ok &= expr_semantics(&opnd, &exp_desc); 01162 COPY_OPND(IL_OPND(list_idx), opnd); 01163 01164 if (exp_desc.type != Integer || 01165 exp_desc.rank != 0) { 01166 01167 find_opnd_line_and_column(&opnd, &line, &column); 01168 PRINTMSG(line, 1397, Error, column); 01169 } 01170 } 01171 list_idx = IL_NEXT_LIST_IDX(list_idx); 01172 } 01173 01174 list_idx = IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)); 01175 01176 if (list_idx) { 01177 list_idx = IL_IDX(list_idx); 01178 01179 while(list_idx) { 01180 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 01181 COPY_OPND(opnd, IL_OPND(list_idx)); 01182 xref_state = CIF_Symbol_Reference; 01183 exp_desc.rank = 0; 01184 ok &= expr_semantics(&opnd, &exp_desc); 01185 COPY_OPND(IL_OPND(list_idx), opnd); 01186 01187 find_opnd_line_and_column(&opnd, &line, &column); 01188 01189 if (OPND_FLD(opnd) != CN_Tbl_Idx || 01190 exp_desc.type != Integer) { 01191 /* error, must be a constant */ 01192 PRINTMSG(line, 1368, Error, column); 01193 } 01194 else if (compare_cn_and_value(OPND_IDX(opnd), 01195 0, 01196 Lt_Opr)) { 01197 01198 /* error, must be greater than zero */ 01199 PRINTMSG(line, 1368, Error, column); 01200 } 01201 } 01202 01203 list_idx = IL_NEXT_LIST_IDX(list_idx); 01204 } 01205 } 01206 01207 break; 01208 01209 /* -------------------------------------------------------------------- */ 01210 /* PDO */ 01211 /* -------------------------------------------------------------------- */ 01212 01213 case Pdo_Par_Opr: 01214 mp_directive_semantics(Pdo); 01215 break; 01216 01217 /* -------------------------------------------------------------------- */ 01218 /* PARALLEL DO */ 01219 /* -------------------------------------------------------------------- */ 01220 01221 case Parallel_Do_Par_Opr: 01222 mp_directive_semantics(Parallel_Do); 01223 break; 01224 01225 /* -------------------------------------------------------------------- */ 01226 /* PARALLEL */ 01227 /* -------------------------------------------------------------------- */ 01228 01229 case Parallel_Par_Opr: 01230 mp_directive_semantics(Parallel); 01231 break; 01232 01233 /* -------------------------------------------------------------------- */ 01234 /* PSECTION */ 01235 /* -------------------------------------------------------------------- */ 01236 01237 case Psection_Par_Opr: 01238 mp_directive_semantics(Psection); 01239 break; 01240 01241 /* -------------------------------------------------------------------- */ 01242 /* SINGLEPROCESS */ 01243 /* -------------------------------------------------------------------- */ 01244 01245 case Singleprocess_Par_Opr: 01246 mp_directive_semantics(Singleprocess); 01247 break; 01248 01249 case Section_Par_Opr: 01250 break; 01251 01252 case End_Pdo_Par_Opr: 01253 end_blk_mp_semantics(FALSE); 01254 break; 01255 01256 case End_Parallel_Par_Opr: 01257 end_blk_mp_semantics(FALSE); 01258 break; 01259 01260 case Barrier_Par_Opr: 01261 break; 01262 01263 case Critical_Section_Par_Opr: 01264 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 01265 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 01266 xref_state = CIF_Symbol_Reference; 01267 exp_desc.rank = 0; 01268 ok &= expr_semantics(&opnd, &exp_desc); 01269 COPY_OPND(IR_OPND_L(ir_idx), opnd); 01270 } 01271 break; 01272 01273 case End_Critical_Section_Par_Opr: 01274 break; 01275 01276 case End_Psection_Par_Opr: 01277 end_blk_mp_semantics(FALSE); 01278 break; 01279 01280 case End_Singleprocess_Par_Opr: 01281 end_blk_mp_semantics(FALSE); 01282 break; 01283 01284 /* -------------------------------------------------------------------- */ 01285 /* */ 01286 /* C*$*'s */ 01287 /* */ 01288 /* -------------------------------------------------------------------- */ 01289 01290 01291 case Blockingsize_Dir_Opr: 01292 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 01293 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 01294 xref_state = CIF_Symbol_Reference; 01295 exp_desc.rank = 0; 01296 ok &= expr_semantics(&opnd, &exp_desc); 01297 01298 # if 0 01299 if (OPND_FLD(opnd) == CN_Tbl_Idx && 01300 exp_desc.rank == 0 && 01301 exp_desc.type == Integer) { 01302 01303 if (compare_cn_and_value(OPND_IDX(opnd), 0, Lt_Opr) { 01304 find_opnd_line_and_column(&opnd, &line, &column); 01305 PRINTMSG(line, 796, Error, column); 01306 } 01307 } 01308 # endif 01309 01310 COPY_OPND(IR_OPND_L(ir_idx), opnd); 01311 01312 01313 } 01314 01315 if (IR_FLD_R(ir_idx) != NO_Tbl_Idx) { 01316 COPY_OPND(opnd, IR_OPND_R(ir_idx)); 01317 xref_state = CIF_Symbol_Reference; 01318 exp_desc.rank = 0; 01319 ok &= expr_semantics(&opnd, &exp_desc); 01320 COPY_OPND(IR_OPND_R(ir_idx), opnd); 01321 } 01322 break; 01323 01324 case Assert_Star_Opr: 01325 ok = assert_semantics(); 01326 break; 01327 01328 case Fission_Star_Opr: 01329 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 01330 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 01331 xref_state = CIF_Symbol_Reference; 01332 exp_desc.rank = 0; 01333 ok &= expr_semantics(&opnd, &exp_desc); 01334 COPY_OPND(IR_OPND_L(ir_idx), opnd); 01335 } 01336 break; 01337 01338 case Fuse_Star_Opr: 01339 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 01340 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 01341 xref_state = CIF_Symbol_Reference; 01342 exp_desc.rank = 0; 01343 ok &= expr_semantics(&opnd, &exp_desc); 01344 COPY_OPND(IR_OPND_L(ir_idx), opnd); 01345 } 01346 break; 01347 01348 case Regionbegin_Star_Opr: 01349 break; 01350 01351 case Regionend_Star_Opr: 01352 break; 01353 01354 case Section_Nongp_Star_Opr: 01355 case Section_Gp_Star_Opr: 01356 list_idx = IR_IDX_L(ir_idx); 01357 01358 while (list_idx != NULL_IDX) { 01359 01360 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01361 01362 if (ATD_IN_COMMON(IL_IDX(list_idx))) { 01363 PRINTMSG(IL_LINE_NUM(list_idx), 1440, Error, 01364 IL_COL_NUM(list_idx), 01365 SB_BLANK_COMMON(ATD_STOR_BLK_IDX(IL_IDX(list_idx))) ? 01366 "" : SB_NAME_PTR(ATD_STOR_BLK_IDX(IL_IDX(list_idx))), 01367 AT_OBJ_NAME_PTR(IL_IDX(list_idx)), 01368 (IR_OPR(ir_idx) == Section_Gp_Star_Opr) ? 01369 "SECTION_GP": "SECTION_NON_GP"); 01370 } 01371 else if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) { 01372 PRINTMSG(IL_LINE_NUM(list_idx), 1547, Error, 01373 IL_COL_NUM(list_idx), 01374 AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx)), 01375 AT_OBJ_NAME_PTR(IL_IDX(list_idx)), 01376 (IR_OPR(ir_idx) == Section_Gp_Star_Opr) ? 01377 "SECTION_GP": "SECTION_NON_GP"); 01378 } 01379 else if (ATD_STOR_BLK_IDX(IL_IDX(list_idx)) == NULL_IDX || 01380 (SB_BLK_TYPE(ATD_STOR_BLK_IDX(IL_IDX(list_idx))) != Static && 01381 SB_BLK_TYPE(ATD_STOR_BLK_IDX(IL_IDX(list_idx))) != 01382 Static_Local && 01383 SB_BLK_TYPE(ATD_STOR_BLK_IDX(IL_IDX(list_idx))) != 01384 Static_Named)) { 01385 01386 if (!AT_DCL_ERR(IL_IDX(list_idx))) { 01387 PRINTMSG(IL_LINE_NUM(list_idx), 1497, Error, 01388 IL_COL_NUM(list_idx), 01389 AT_OBJ_NAME_PTR(IL_IDX(list_idx)), 01390 (IR_OPR(ir_idx) == Section_Gp_Star_Opr) ? 01391 "SECTION_GP": "SECTION_NON_GP"); 01392 } 01393 } 01394 } 01395 else if (IL_FLD(list_idx) == SB_Tbl_Idx) { 01396 /* may need to do something with the storage block idx */ 01397 01398 if (IR_OPR(ir_idx) == Section_Gp_Star_Opr && 01399 SB_BLK_TYPE(IL_IDX(list_idx)) == Threadprivate) { 01400 PRINTMSG(IL_LINE_NUM(list_idx), 1645, Error, 01401 IL_COL_NUM(list_idx), 01402 SB_NAME_PTR(IL_IDX(list_idx))); 01403 } 01404 } 01405 01406 list_idx = IL_NEXT_LIST_IDX(list_idx); 01407 } 01408 break; 01409 01410 case Unroll_Star_Opr: 01411 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) { 01412 COPY_OPND(opnd, IR_OPND_L(ir_idx)); 01413 xref_state = CIF_Symbol_Reference; 01414 exp_desc.rank = 0; 01415 ok &= expr_semantics(&opnd, &exp_desc); 01416 COPY_OPND(IR_OPND_L(ir_idx), opnd); 01417 } 01418 break; 01419 01420 case Prefetch_Manual_Star_Opr: 01421 if (IR_FLD_L(ir_idx) != CN_Tbl_Idx || 01422 (compare_cn_and_value(IR_IDX_L(ir_idx), 01423 0, 01424 Ne_Opr) && 01425 compare_cn_and_value(IR_IDX_L(ir_idx), 01426 1, 01427 Ne_Opr))) { 01428 01429 find_opnd_line_and_column(&IR_OPND_L(ir_idx), &line, &column); 01430 PRINTMSG(line, 1378, Error, column, "PREFETCH_MANUAL"); 01431 } 01432 break; 01433 01434 case Prefetch_Ref_Star_Opr: 01435 prefetch_ref_semantics(); 01436 break; 01437 01438 case Prefetch_Star_Opr: 01439 if (IR_FLD_L(ir_idx) != CN_Tbl_Idx || 01440 (compare_cn_and_value(IR_IDX_L(ir_idx), 01441 0, 01442 Ne_Opr) && 01443 compare_cn_and_value(IR_IDX_L(ir_idx), 01444 1, 01445 Ne_Opr) && 01446 compare_cn_and_value(IR_IDX_L(ir_idx), 01447 2, 01448 Ne_Opr))) { 01449 01450 find_opnd_line_and_column(&IR_OPND_L(ir_idx), &line, &column); 01451 PRINTMSG(line, 1378, Error, column, "PREFETCH"); 01452 } 01453 01454 if (IR_FLD_R(ir_idx) != NO_Tbl_Idx) { 01455 if (IR_FLD_R(ir_idx) != CN_Tbl_Idx || 01456 (compare_cn_and_value(IR_IDX_R(ir_idx), 01457 0, 01458 Ne_Opr) && 01459 compare_cn_and_value(IR_IDX_R(ir_idx), 01460 1, 01461 Ne_Opr) && 01462 compare_cn_and_value(IR_IDX_R(ir_idx), 01463 2, 01464 Ne_Opr))) { 01465 01466 find_opnd_line_and_column(&IR_OPND_R(ir_idx), &line, &column); 01467 PRINTMSG(line, 1378, Error, column, "PREFETCH"); 01468 } 01469 } 01470 else { 01471 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 01472 IR_IDX_R(ir_idx) = CN_INTEGER_NEG_ONE_IDX; 01473 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx); 01474 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);; 01475 } 01476 01477 break; 01478 01479 case Prefetch_Ref_Disable_Star_Opr: 01480 # ifdef _DEBUG 01481 if (IR_FLD_L(ir_idx) != AT_Tbl_Idx) { 01482 PRINTMSG(IR_LINE_NUM(ir_idx), 626, Internal, IR_COL_NUM(ir_idx), 01483 "AT_Tbl_Idx", "directive_stmt_semantics"); 01484 } 01485 # endif 01486 attr_idx = IR_IDX_L(ir_idx); 01487 AT_LOCKED_IN(attr_idx) = TRUE; 01488 01489 while (AT_ATTR_LINK(attr_idx)) { 01490 attr_idx = AT_ATTR_LINK(attr_idx); 01491 AT_LOCKED_IN(attr_idx) = TRUE; 01492 } 01493 01494 IR_IDX_L(ir_idx) = attr_idx; 01495 01496 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 01497 ATD_ARRAY_IDX(attr_idx) == NULL_IDX) { 01498 01499 find_opnd_line_and_column(&IR_OPND_L(ir_idx), &line, &column); 01500 PRINTMSG(line, 1382, Error, column); 01501 } 01502 01503 if (IR_FLD_R(ir_idx) != NO_Tbl_Idx) { 01504 COPY_OPND(opnd, IR_OPND_R(ir_idx)); 01505 xref_state = CIF_Symbol_Reference; 01506 exp_desc.rank = 0; 01507 ok &= expr_semantics(&opnd, &exp_desc); 01508 COPY_OPND(IR_OPND_R(ir_idx), opnd); 01509 01510 if (OPND_FLD(opnd) != CN_Tbl_Idx) { 01511 find_opnd_line_and_column(&IR_OPND_R(ir_idx), &line, &column); 01512 PRINTMSG(line, 1383, Error, column, "PREFETCH_REF_DISABLE"); 01513 } 01514 } 01515 break; 01516 01517 case Align_Symbol_Star_Opr: 01518 case Fill_Symbol_Star_Opr: 01519 01520 # ifdef _DEBUG 01521 if (IR_FLD_L(ir_idx) != AT_Tbl_Idx && IR_FLD_L(ir_idx) != SB_Tbl_Idx) { 01522 PRINTMSG(IR_LINE_NUM(ir_idx), 626, Internal, IR_COL_NUM(ir_idx), 01523 "AT_Tbl_Idx or SB_Tbl_Idx", "directive_stmt_semantics"); 01524 } 01525 # endif 01526 01527 COPY_OPND(opnd, IR_OPND_R(ir_idx)); 01528 01529 xref_state = CIF_Symbol_Reference; 01530 exp_desc.rank = 0; 01531 ok &= expr_semantics(&opnd, &exp_desc); 01532 01533 COPY_OPND(IR_OPND_R(ir_idx), opnd); 01534 01535 if (OPND_FLD(opnd) != CN_Tbl_Idx || 01536 TYP_TYPE(CN_TYPE_IDX(OPND_IDX(opnd))) != Integer || 01537 (compare_cn_and_value(OPND_IDX(opnd), 01538 -1, 01539 Ne_Opr) && 01540 compare_cn_and_value(OPND_IDX(opnd), 01541 -2, 01542 Ne_Opr) && 01543 compare_cn_and_value(OPND_IDX(opnd), 01544 -3, 01545 Ne_Opr) && 01546 ! power_o_two(OPND_IDX(opnd)))) { 01547 01548 find_opnd_line_and_column(&opnd, &line, &column); 01549 PRINTMSG(line, 1386, Error, column, 01550 (IR_OPR(ir_idx) == Align_Symbol_Star_Opr ? 01551 "ALIGN_SYMBOL" : "FILL_SYMBOL")); 01552 } 01553 01554 break; 01555 01556 case Inline_Here_Star_Opr: 01557 01558 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) { 01559 cdir_switches.inline_here_sgi = TRUE; 01560 cdir_switches.noinline_here_sgi = FALSE; 01561 01562 if (cdir_switches.noinline_here_list_idx != NULL_IDX) { 01563 list_idx = cdir_switches.noinline_here_list_idx; 01564 cdir_switches.noinline_here_list_idx = NULL_IDX; 01565 01566 while (list_idx) { 01567 01568 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01569 01570 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) { 01571 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = FALSE; 01572 } 01573 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) { 01574 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx)); 01575 01576 while (sn_idx != NULL_IDX) { 01577 01578 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01579 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx))=FALSE; 01580 } 01581 sn_idx = SN_SIBLING_LINK(sn_idx); 01582 } 01583 } 01584 } 01585 list_idx = IL_NEXT_LIST_IDX(list_idx); 01586 } 01587 } 01588 01589 if (cdir_switches.inline_here_list_idx != NULL_IDX) { 01590 list_idx = cdir_switches.inline_here_list_idx; 01591 cdir_switches.inline_here_list_idx = NULL_IDX; 01592 01593 while (list_idx) { 01594 01595 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01596 01597 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) { 01598 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = FALSE; 01599 } 01600 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) { 01601 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx)); 01602 01603 while (sn_idx != NULL_IDX) { 01604 01605 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01606 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE; 01607 } 01608 sn_idx = SN_SIBLING_LINK(sn_idx); 01609 } 01610 } 01611 } 01612 list_idx = IL_NEXT_LIST_IDX(list_idx); 01613 } 01614 } 01615 } 01616 else { 01617 cdir_switches.inline_here_list_idx = IR_IDX_L(ir_idx); 01618 list_idx = IR_IDX_L(ir_idx); 01619 01620 while (list_idx) { 01621 01622 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01623 01624 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) { 01625 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = TRUE; 01626 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = FALSE; 01627 } 01628 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) { 01629 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx)); 01630 01631 while (sn_idx != NULL_IDX) { 01632 01633 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01634 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = TRUE; 01635 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx)) = FALSE; 01636 } 01637 sn_idx = SN_SIBLING_LINK(sn_idx); 01638 } 01639 } 01640 } 01641 list_idx = IL_NEXT_LIST_IDX(list_idx); 01642 } 01643 } 01644 break; 01645 01646 case Noinline_Here_Star_Opr: 01647 01648 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) { 01649 cdir_switches.noinline_here_sgi = TRUE; 01650 cdir_switches.inline_here_sgi = FALSE; 01651 01652 if (cdir_switches.noinline_here_list_idx != NULL_IDX) { 01653 list_idx = cdir_switches.noinline_here_list_idx; 01654 cdir_switches.noinline_here_list_idx = NULL_IDX; 01655 01656 while (list_idx) { 01657 01658 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01659 01660 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) { 01661 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = FALSE; 01662 } 01663 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) { 01664 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx)); 01665 01666 while (sn_idx != NULL_IDX) { 01667 01668 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01669 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx))=FALSE; 01670 } 01671 sn_idx = SN_SIBLING_LINK(sn_idx); 01672 } 01673 } 01674 } 01675 list_idx = IL_NEXT_LIST_IDX(list_idx); 01676 } 01677 } 01678 01679 if (cdir_switches.inline_here_list_idx != NULL_IDX) { 01680 list_idx = cdir_switches.inline_here_list_idx; 01681 cdir_switches.inline_here_list_idx = NULL_IDX; 01682 01683 while (list_idx) { 01684 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01685 01686 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) { 01687 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = FALSE; 01688 } 01689 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) { 01690 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx)); 01691 01692 while (sn_idx != NULL_IDX) { 01693 01694 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01695 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE; 01696 } 01697 sn_idx = SN_SIBLING_LINK(sn_idx); 01698 } 01699 } 01700 } 01701 list_idx = IL_NEXT_LIST_IDX(list_idx); 01702 } 01703 } 01704 } 01705 else { 01706 cdir_switches.noinline_here_list_idx = IR_IDX_L(ir_idx); 01707 list_idx = IR_IDX_L(ir_idx); 01708 01709 while (list_idx) { 01710 01711 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01712 01713 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) { 01714 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = TRUE; 01715 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = FALSE; 01716 } 01717 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) { 01718 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx)); 01719 01720 while (sn_idx != NULL_IDX) { 01721 01722 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01723 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx)) = TRUE; 01724 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE; 01725 } 01726 sn_idx = SN_SIBLING_LINK(sn_idx); 01727 } 01728 } 01729 } 01730 list_idx = IL_NEXT_LIST_IDX(list_idx); 01731 } 01732 } 01733 break; 01734 01735 case End_Inline_Here_Star_Opr: 01736 01737 cdir_switches.noinline_here_sgi = FALSE; 01738 cdir_switches.inline_here_sgi = FALSE; 01739 01740 if (cdir_switches.noinline_here_list_idx != NULL_IDX) { 01741 list_idx = cdir_switches.noinline_here_list_idx; 01742 cdir_switches.noinline_here_list_idx = NULL_IDX; 01743 01744 while (list_idx) { 01745 01746 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01747 01748 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) { 01749 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = FALSE; 01750 } 01751 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) { 01752 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx)); 01753 01754 while (sn_idx != NULL_IDX) { 01755 01756 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01757 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx)) = FALSE; 01758 } 01759 sn_idx = SN_SIBLING_LINK(sn_idx); 01760 } 01761 } 01762 } 01763 list_idx = IL_NEXT_LIST_IDX(list_idx); 01764 } 01765 } 01766 01767 if (cdir_switches.inline_here_list_idx != NULL_IDX) { 01768 list_idx = cdir_switches.inline_here_list_idx; 01769 cdir_switches.inline_here_list_idx = NULL_IDX; 01770 01771 while (list_idx) { 01772 01773 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 01774 01775 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) { 01776 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = FALSE; 01777 } 01778 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) { 01779 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx)); 01780 01781 while (sn_idx != NULL_IDX) { 01782 01783 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01784 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE; 01785 } 01786 sn_idx = SN_SIBLING_LINK(sn_idx); 01787 } 01788 } 01789 } 01790 list_idx = IL_NEXT_LIST_IDX(list_idx); 01791 } 01792 } 01793 break; 01794 01795 01796 case Inline_Routine_Star_Opr: 01797 01798 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) { 01799 SCP_INLINE_SGI(curr_scp_idx) = TRUE; 01800 SCP_NOINLINE_SGI(curr_scp_idx) = FALSE; 01801 } 01802 else { 01803 list_idx = IR_IDX_L(ir_idx); 01804 01805 while (list_idx) { 01806 attr_idx = IL_IDX(list_idx); 01807 01808 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) { 01809 ATP_SGI_ROUTINE_INLINE(attr_idx) = TRUE; 01810 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE; 01811 } 01812 else if (AT_OBJ_CLASS(attr_idx) == Interface) { 01813 sn_idx = ATI_FIRST_SPECIFIC_IDX(attr_idx); 01814 01815 while (sn_idx != NULL_IDX) { 01816 01817 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01818 ATP_SGI_ROUTINE_INLINE(SN_ATTR_IDX(sn_idx)) = TRUE; 01819 ATP_SGI_ROUTINE_NOINLINE(SN_ATTR_IDX(sn_idx)) = FALSE; 01820 } 01821 sn_idx = SN_SIBLING_LINK(sn_idx); 01822 } 01823 } 01824 list_idx = IL_NEXT_LIST_IDX(list_idx); 01825 } 01826 } 01827 break; 01828 01829 case Noinline_Routine_Star_Opr: 01830 01831 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) { 01832 SCP_NOINLINE_SGI(curr_scp_idx) = TRUE; 01833 SCP_INLINE_SGI(curr_scp_idx) = FALSE; 01834 } 01835 else { 01836 list_idx = IR_IDX_L(ir_idx); 01837 01838 while (list_idx) { 01839 attr_idx = IL_IDX(list_idx); 01840 01841 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) { 01842 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = TRUE; 01843 ATP_SGI_ROUTINE_INLINE(attr_idx) = FALSE; 01844 } 01845 else if (AT_OBJ_CLASS(attr_idx) == Interface) { 01846 sn_idx = ATI_FIRST_SPECIFIC_IDX(attr_idx); 01847 01848 while (sn_idx != NULL_IDX) { 01849 01850 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) { 01851 ATP_SGI_ROUTINE_NOINLINE(SN_ATTR_IDX(sn_idx)) = TRUE; 01852 ATP_SGI_ROUTINE_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE; 01853 } 01854 sn_idx = SN_SIBLING_LINK(sn_idx); 01855 } 01856 } 01857 01858 list_idx = IL_NEXT_LIST_IDX(list_idx); 01859 } 01860 } 01861 break; 01862 01863 case Inline_Global_Star_Opr: 01864 01865 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) { 01866 inline_global_sgi = TRUE; 01867 noinline_global_sgi = FALSE; 01868 } 01869 else { 01870 list_idx = IR_IDX_L(ir_idx); 01871 while (list_idx) { 01872 attr_idx = IL_IDX(list_idx); 01873 01874 if (srch_global_name_tbl(AT_OBJ_NAME_PTR(attr_idx), 01875 AT_NAME_LEN(attr_idx), 01876 &name_idx)) { 01877 01878 } 01879 else { 01880 ntr_global_name_tbl(attr_idx, NULL_IDX, name_idx); 01881 GA_OBJ_CLASS(GN_ATTR_IDX(name_idx)) = Pgm_Unit; 01882 GAP_GLOBAL_DIR(GN_ATTR_IDX(name_idx)) = TRUE; 01883 } 01884 01885 GAP_INLINE_STATE(GN_ATTR_IDX(name_idx)) = Inline_Sgi; 01886 01887 /* clear any routine dirs we've seen so far */ 01888 01889 ATP_SGI_ROUTINE_INLINE(attr_idx) = FALSE; 01890 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE; 01891 01892 ATP_SGI_GLOBAL_INLINE(attr_idx) = TRUE; 01893 ATP_SGI_GLOBAL_NOINLINE(attr_idx) = FALSE; 01894 01895 host_attr_idx = AT_ATTR_LINK(attr_idx); 01896 01897 while (host_attr_idx) { 01898 ATP_SGI_GLOBAL_INLINE(host_attr_idx) = 01899 ATP_SGI_GLOBAL_INLINE(attr_idx); 01900 ATP_SGI_GLOBAL_NOINLINE(host_attr_idx) = 01901 ATP_SGI_GLOBAL_NOINLINE(attr_idx); 01902 01903 ATP_SGI_ROUTINE_INLINE(host_attr_idx) = FALSE; 01904 ATP_SGI_ROUTINE_NOINLINE(host_attr_idx) = FALSE; 01905 01906 host_attr_idx = AT_ATTR_LINK(host_attr_idx); 01907 } 01908 01909 list_idx = IL_NEXT_LIST_IDX(list_idx); 01910 } 01911 } 01912 01913 if (! SH_COMPILER_GEN(curr_stmt_sh_idx)) { 01914 gen_gl_sh(After, Directive_Stmt, line, column, 01915 FALSE, FALSE, TRUE); 01916 GL_SH_IR_IDX(curr_gl_stmt_sh_idx) = copy_to_gl_subtree(ir_idx, 01917 IR_Tbl_Idx); 01918 } 01919 break; 01920 01921 case Noinline_Global_Star_Opr: 01922 01923 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) { 01924 noinline_global_sgi = TRUE; 01925 inline_global_sgi = FALSE; 01926 } 01927 else { 01928 list_idx = IR_IDX_L(ir_idx); 01929 while (list_idx) { 01930 attr_idx = IL_IDX(list_idx); 01931 01932 if (srch_global_name_tbl(AT_OBJ_NAME_PTR(attr_idx), 01933 AT_NAME_LEN(attr_idx), 01934 &name_idx)) { 01935 01936 } 01937 else { 01938 ntr_global_name_tbl(attr_idx, NULL_IDX, name_idx); 01939 GAP_GLOBAL_DIR(GN_ATTR_IDX(name_idx)) = TRUE; 01940 } 01941 01942 GAP_INLINE_STATE(GN_ATTR_IDX(name_idx)) = Noinline_Sgi; 01943 01944 /* clear any routine dirs we've seen so far */ 01945 01946 ATP_SGI_ROUTINE_INLINE(attr_idx) = FALSE; 01947 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE; 01948 01949 ATP_SGI_GLOBAL_NOINLINE(attr_idx) = TRUE; 01950 ATP_SGI_GLOBAL_INLINE(attr_idx) = FALSE; 01951 01952 host_attr_idx = AT_ATTR_LINK(attr_idx); 01953 01954 while (host_attr_idx) { 01955 ATP_SGI_GLOBAL_INLINE(host_attr_idx) = 01956 ATP_SGI_GLOBAL_INLINE(attr_idx); 01957 ATP_SGI_GLOBAL_NOINLINE(host_attr_idx) = 01958 ATP_SGI_GLOBAL_NOINLINE(attr_idx); 01959 01960 ATP_SGI_ROUTINE_INLINE(host_attr_idx) = FALSE; 01961 ATP_SGI_ROUTINE_NOINLINE(host_attr_idx) = FALSE; 01962 01963 host_attr_idx = AT_ATTR_LINK(host_attr_idx); 01964 } 01965 01966 list_idx = IL_NEXT_LIST_IDX(list_idx); 01967 } 01968 } 01969 01970 if (! SH_COMPILER_GEN(curr_stmt_sh_idx)) { 01971 gen_gl_sh(After, Directive_Stmt, line, column, 01972 FALSE, FALSE, TRUE); 01973 GL_SH_IR_IDX(curr_gl_stmt_sh_idx) = copy_to_gl_subtree(ir_idx, 01974 IR_Tbl_Idx); 01975 } 01976 break; 01977 01978 01979 case Atomic_Open_Mp_Opr: 01980 break; 01981 01982 case Barrier_Open_Mp_Opr: 01983 break; 01984 01985 case Critical_Open_Mp_Opr: 01986 break; 01987 01988 case Do_Open_Mp_Opr: 01989 open_mp_directive_semantics(Do_Omp); 01990 break; 01991 01992 case Endcritical_Open_Mp_Opr: 01993 break; 01994 01995 case Enddo_Open_Mp_Opr: 01996 end_blk_mp_semantics(TRUE); 01997 break; 01998 01999 case Endparallel_Open_Mp_Opr: 02000 end_blk_mp_semantics(TRUE); 02001 break; 02002 02003 case Endparalleldo_Open_Mp_Opr: 02004 end_blk_mp_semantics(TRUE); 02005 break; 02006 02007 case Endparallelsections_Open_Mp_Opr: 02008 end_blk_mp_semantics(TRUE); 02009 break; 02010 02011 case Endparallelworkshare_Open_Mp_Opr: 02012 end_blk_mp_semantics(TRUE); 02013 break; 02014 02015 case Endworkshare_Open_Mp_Opr: 02016 break; 02017 02018 case Endmaster_Open_Mp_Opr: 02019 break; 02020 02021 case Endordered_Open_Mp_Opr: 02022 break; 02023 02024 case Endsections_Open_Mp_Opr: 02025 end_blk_mp_semantics(TRUE); 02026 break; 02027 02028 case Endsingle_Open_Mp_Opr: 02029 end_blk_mp_semantics(TRUE); 02030 break; 02031 02032 case Flush_Open_Mp_Opr: 02033 list_idx = IR_IDX_L(ir_idx); 02034 02035 while (list_idx != NULL_IDX) { 02036 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 02037 attr_idx = IL_IDX(list_idx); 02038 AT_LOCKED_IN(attr_idx) = TRUE; 02039 02040 while (AT_ATTR_LINK(attr_idx)) { 02041 attr_idx = AT_ATTR_LINK(attr_idx); 02042 AT_LOCKED_IN(attr_idx) = TRUE; 02043 } 02044 02045 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 02046 PRINTMSG(IL_LINE_NUM(list_idx), 1480, Error, 02047 IL_COL_NUM(list_idx)); 02048 } 02049 02050 IL_IDX(list_idx) = attr_idx; 02051 } 02052 02053 list_idx = IL_NEXT_LIST_IDX(list_idx); 02054 } 02055 break; 02056 02057 case Master_Open_Mp_Opr: 02058 break; 02059 02060 case Ordered_Open_Mp_Opr: 02061 break; 02062 02063 case Parallel_Open_Mp_Opr: 02064 open_mp_directive_semantics(Parallel_Omp); 02065 break; 02066 02067 case Paralleldo_Open_Mp_Opr: 02068 open_mp_directive_semantics(Parallel_Do_Omp); 02069 break; 02070 02071 case Parallelsections_Open_Mp_Opr: 02072 open_mp_directive_semantics(Parallel_Sections_Omp); 02073 break; 02074 02075 case Parallelworkshare_Open_Mp_Opr: 02076 open_mp_directive_semantics(Parallel_Workshare_Omp); 02077 break; 02078 02079 case Section_Open_Mp_Opr: 02080 break; 02081 02082 case Sections_Open_Mp_Opr: 02083 open_mp_directive_semantics(Sections_Omp); 02084 break; 02085 02086 case Single_Open_Mp_Opr: 02087 open_mp_directive_semantics(Single_Omp); 02088 break; 02089 02090 case Workshare_Open_Mp_Opr: 02091 break; 02092 02093 /* eraxxon: OpenAD directive (skip semantic checking) */ 02094 case XXX_OpenAD_Opr: 02095 case Dependent_OpenAD_Opr: 02096 case Independent_OpenAD_Opr: 02097 case Simple_OpenAD_Opr: 02098 case EndSimple_OpenAD_Opr: 02099 break; 02100 02101 } 02102 02103 TRACE (Func_Exit, "directive_stmt_semantics", NULL); 02104 02105 return; 02106 02107 } /* directive_stmt_semantics */ 02108 02109 /******************************************************************************\ 02110 |* *| 02111 |* Description: *| 02112 |* <description> *| 02113 |* *| 02114 |* Input parameters: *| 02115 |* NONE *| 02116 |* *| 02117 |* Output parameters: *| 02118 |* NONE *| 02119 |* *| 02120 |* Returns: *| 02121 |* NOTHING *| 02122 |* *| 02123 \******************************************************************************/ 02124 02125 static void doall_cmic_semantics(void) 02126 02127 { 02128 int attr_idx; 02129 int column; 02130 expr_arg_type exp_desc; 02131 int getfirst_list_idx; 02132 int idx; 02133 int ir_idx; 02134 int line; 02135 int list_idx; 02136 int list2_idx; 02137 int list3_idx; 02138 opnd_type l_opnd; 02139 opnd_type opnd; 02140 int private_list_idx; 02141 int save_curr_stmt_sh_idx; 02142 int shared_list_idx; 02143 long64 value; 02144 02145 # if defined(GENERATE_WHIRL) 02146 int max_idx; 02147 opnd_type opnd2; 02148 char string[13]; 02149 # endif 02150 02151 02152 TRACE (Func_Entry, "doall_cmic_semantics", NULL); 02153 02154 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 02155 02156 if (cdir_switches.doall_sh_idx != NULL_IDX || 02157 cdir_switches.doacross_sh_idx != NULL_IDX || 02158 cdir_switches.parallel_region || 02159 cdir_switches.guard_in_par_reg) { 02160 02161 /* error .. already in a parallel_region */ 02162 PRINTMSG(IR_LINE_NUM(ir_idx), 814, Error, IR_COL_NUM(ir_idx)); 02163 } 02164 02165 cdir_switches.doall_sh_idx = curr_stmt_sh_idx; 02166 02167 /* pull stmt header out of list */ 02168 remove_sh(curr_stmt_sh_idx); 02169 save_curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx); 02170 02171 SH_PREV_IDX(cdir_switches.doall_sh_idx) = NULL_IDX; 02172 SH_NEXT_IDX(cdir_switches.doall_sh_idx) = NULL_IDX; 02173 02174 list_idx = IR_IDX_L(ir_idx); 02175 02176 /* process if condition */ 02177 02178 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 02179 COPY_OPND(opnd, IL_OPND(list_idx)); 02180 exp_desc.rank = 0; 02181 xref_state = CIF_Symbol_Reference; 02182 expr_semantics(&opnd, &exp_desc); 02183 02184 find_opnd_line_and_column(&opnd, &line, &column); 02185 if (exp_desc.type != Logical || 02186 exp_desc.rank != 0) { 02187 PRINTMSG(line, 803, Error, column); 02188 } 02189 02190 IL_FLD(list_idx) = AT_Tbl_Idx; 02191 idx = create_tmp_asg(&opnd, 02192 &exp_desc, 02193 &l_opnd, 02194 Intent_In, 02195 FALSE, 02196 FALSE); 02197 IL_IDX(list_idx) = idx; 02198 IL_LINE_NUM(list_idx) = line; 02199 IL_COL_NUM(list_idx) = column; 02200 } 02201 02202 /* process SHARED var list */ 02203 02204 list_idx = IL_NEXT_LIST_IDX(list_idx); 02205 cdir_switches.shared_list_idx = list_idx; 02206 02207 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 02208 02209 list2_idx = IL_IDX(list_idx); 02210 02211 while (list2_idx) { 02212 02213 attr_idx = IL_IDX(list2_idx); 02214 AT_LOCKED_IN(attr_idx) = TRUE; 02215 02216 while (AT_ATTR_LINK(attr_idx)) { 02217 attr_idx = AT_ATTR_LINK(attr_idx); 02218 AT_LOCKED_IN(attr_idx) = TRUE; 02219 } 02220 02221 IL_IDX(list2_idx) = attr_idx; 02222 02223 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 02224 ATP_PROC(attr_idx) == Dummy_Proc) { 02225 ATP_TASK_SHARED(attr_idx) = TRUE; 02226 } 02227 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 02228 ATD_CLASS(attr_idx) == Constant) { 02229 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 02230 IL_COL_NUM(list2_idx), 02231 AT_OBJ_NAME_PTR(attr_idx), 02232 "SHARED", "DO ALL"); 02233 02234 /* remove the attr from the list */ 02235 02236 if (list2_idx == IL_IDX(cdir_switches.shared_list_idx)) { 02237 02238 /* head of the list */ 02239 02240 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02241 IL_IDX(cdir_switches.shared_list_idx) = list2_idx; 02242 IL_IDX(list_idx) = list2_idx; 02243 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 02244 IL_LIST_CNT(list_idx)--; 02245 continue; 02246 } 02247 else { 02248 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 02249 IL_NEXT_LIST_IDX(list2_idx); 02250 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 02251 IL_PREV_LIST_IDX(list2_idx); 02252 02253 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02254 IL_LIST_CNT(list_idx)--; 02255 continue; 02256 } 02257 } 02258 else { 02259 ATD_TASK_SHARED(attr_idx) = TRUE; 02260 ATD_WAS_SCOPED(attr_idx) = TRUE; 02261 } 02262 02263 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx); 02264 02265 while (shared_list_idx != list2_idx && 02266 shared_list_idx != NULL_IDX) { 02267 02268 if (attr_idx == IL_IDX(shared_list_idx)) { 02269 02270 /* take this out of the list */ 02271 02272 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 02273 IL_NEXT_LIST_IDX(list2_idx); 02274 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 02275 IL_PREV_LIST_IDX(list2_idx); 02276 02277 list2_idx = IL_PREV_LIST_IDX(list2_idx); 02278 IL_LIST_CNT(list_idx)--; 02279 break; 02280 } 02281 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx); 02282 } 02283 02284 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02285 } 02286 } 02287 02288 /* process PRIVATE var list */ 02289 02290 list_idx = IL_NEXT_LIST_IDX(list_idx); 02291 cdir_switches.private_list_idx = list_idx; 02292 02293 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 02294 02295 list2_idx = IL_IDX(list_idx); 02296 02297 while (list2_idx) { 02298 02299 attr_idx = IL_IDX(list2_idx); 02300 AT_LOCKED_IN(attr_idx) = TRUE; 02301 02302 while (AT_ATTR_LINK(attr_idx)) { 02303 attr_idx = AT_ATTR_LINK(attr_idx); 02304 AT_LOCKED_IN(attr_idx) = TRUE; 02305 } 02306 02307 IL_IDX(list2_idx) = attr_idx; 02308 02309 # if defined(GENERATE_WHIRL) 02310 if (AT_OBJ_CLASS(attr_idx) == Data_Obj && 02311 (ATD_ALLOCATABLE(attr_idx) || 02312 ATD_CLASS(attr_idx) == CRI__Pointee || 02313 ATD_POINTER(attr_idx))) { 02314 02315 if (ATD_ALLOCATABLE(attr_idx)) { 02316 strcpy(string, "ALLOCATABLE"); 02317 } 02318 else if (ATD_POINTER(attr_idx)) { 02319 strcpy(string, "POINTER"); 02320 } 02321 else { 02322 strcpy(string, "Cray Pointee"); 02323 } 02324 02325 PRINTMSG(IL_LINE_NUM(list2_idx), 1446, Error, 02326 IL_COL_NUM(list2_idx), 02327 string, 02328 AT_OBJ_NAME_PTR(attr_idx), 02329 "DOALL"); 02330 02331 } 02332 else 02333 # endif 02334 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 02335 ATD_CLASS(attr_idx) == Constant) { 02336 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 02337 IL_COL_NUM(list2_idx), 02338 AT_OBJ_NAME_PTR(attr_idx), 02339 "PRIVATE", "DO ALL"); 02340 02341 /* remove the attr from the list */ 02342 02343 if (list2_idx == IL_IDX(cdir_switches.private_list_idx)) { 02344 02345 /* head of the list */ 02346 02347 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02348 IL_IDX(cdir_switches.private_list_idx) = list2_idx; 02349 IL_IDX(list_idx) = list2_idx; 02350 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 02351 IL_LIST_CNT(list_idx)--; 02352 continue; 02353 } 02354 else { 02355 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 02356 IL_NEXT_LIST_IDX(list2_idx); 02357 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 02358 IL_PREV_LIST_IDX(list2_idx); 02359 02360 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02361 IL_LIST_CNT(list_idx)--; 02362 continue; 02363 } 02364 } 02365 else { 02366 ATD_TASK_PRIVATE(attr_idx) = TRUE; 02367 ATD_WAS_SCOPED(attr_idx) = TRUE; 02368 02369 if (ATD_CLASS(attr_idx) == Variable && 02370 ATD_AUTOMATIC(attr_idx) && 02371 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 02372 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 02373 02374 ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 02375 02376 NTR_IR_LIST_TBL(list3_idx); 02377 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 02378 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 02379 IL_IDX(list_idx) = list3_idx; 02380 IL_LIST_CNT(list_idx)++; 02381 02382 IL_FLD(list3_idx) = AT_Tbl_Idx; 02383 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 02384 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 02385 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 02386 } 02387 } 02388 02389 private_list_idx = IL_IDX(cdir_switches.private_list_idx); 02390 02391 while (private_list_idx != list2_idx && 02392 private_list_idx != NULL_IDX) { 02393 02394 if (attr_idx == IL_IDX(private_list_idx)) { 02395 02396 /* take this out of the list */ 02397 02398 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 02399 IL_NEXT_LIST_IDX(list2_idx); 02400 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 02401 IL_PREV_LIST_IDX(list2_idx); 02402 02403 list2_idx = IL_PREV_LIST_IDX(list2_idx); 02404 IL_LIST_CNT(list_idx)--; 02405 goto CONTINUE; 02406 } 02407 private_list_idx = IL_NEXT_LIST_IDX(private_list_idx); 02408 } 02409 02410 02411 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx); 02412 02413 while (shared_list_idx) { 02414 02415 if (attr_idx == IL_IDX(shared_list_idx)) { 02416 02417 /* error, cannot have var in shared and private */ 02418 02419 PRINTMSG(IL_LINE_NUM(list2_idx), 805, Error, 02420 IL_COL_NUM(list2_idx), 02421 AT_OBJ_NAME_PTR(attr_idx)); 02422 break; 02423 } 02424 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx); 02425 } 02426 02427 CONTINUE: 02428 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02429 } 02430 } 02431 02432 /* process GETFIRST var list */ 02433 02434 list_idx = IL_NEXT_LIST_IDX(list_idx); 02435 cdir_switches.getfirst_list_idx = list_idx; 02436 02437 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 02438 02439 list2_idx = IL_IDX(list_idx); 02440 02441 while (list2_idx) { 02442 02443 attr_idx = IL_IDX(list2_idx); 02444 AT_LOCKED_IN(attr_idx) = TRUE; 02445 02446 while (AT_ATTR_LINK(attr_idx)) { 02447 attr_idx = AT_ATTR_LINK(attr_idx); 02448 AT_LOCKED_IN(attr_idx) = TRUE; 02449 } 02450 02451 IL_IDX(list2_idx) = attr_idx; 02452 02453 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 02454 ATD_CLASS(attr_idx) == Constant) { 02455 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 02456 IL_COL_NUM(list2_idx), 02457 AT_OBJ_NAME_PTR(attr_idx), 02458 "GETFIRST", "DO ALL"); 02459 02460 /* remove the attr from the list */ 02461 02462 if (list2_idx == IL_IDX(cdir_switches.getfirst_list_idx)) { 02463 02464 /* head of the list */ 02465 02466 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02467 IL_IDX(cdir_switches.getfirst_list_idx) = list2_idx; 02468 IL_IDX(list_idx) = list2_idx; 02469 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 02470 IL_LIST_CNT(list_idx)--; 02471 continue; 02472 } 02473 else { 02474 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 02475 IL_NEXT_LIST_IDX(list2_idx); 02476 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 02477 IL_PREV_LIST_IDX(list2_idx); 02478 02479 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02480 IL_LIST_CNT(list_idx)--; 02481 continue; 02482 } 02483 } 02484 else { 02485 ATD_TASK_GETFIRST(attr_idx) = TRUE; 02486 02487 if (ATD_CLASS(attr_idx) == Variable && 02488 ATD_AUTOMATIC(attr_idx) && 02489 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 02490 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 02491 02492 ATD_TASK_GETFIRST(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 02493 02494 NTR_IR_LIST_TBL(list3_idx); 02495 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 02496 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 02497 IL_IDX(list_idx) = list3_idx; 02498 IL_LIST_CNT(list_idx)++; 02499 02500 IL_FLD(list3_idx) = AT_Tbl_Idx; 02501 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 02502 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 02503 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 02504 } 02505 } 02506 02507 getfirst_list_idx = IL_IDX(cdir_switches.getfirst_list_idx); 02508 02509 while (getfirst_list_idx != list2_idx && 02510 getfirst_list_idx != NULL_IDX) { 02511 02512 if (attr_idx == IL_IDX(getfirst_list_idx)) { 02513 02514 /* take this out of the list */ 02515 02516 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 02517 IL_NEXT_LIST_IDX(list2_idx); 02518 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 02519 IL_PREV_LIST_IDX(list2_idx); 02520 02521 list2_idx = IL_PREV_LIST_IDX(list2_idx); 02522 IL_LIST_CNT(list_idx)--; 02523 goto CONTINUE2; 02524 } 02525 getfirst_list_idx = IL_NEXT_LIST_IDX(getfirst_list_idx); 02526 } 02527 02528 02529 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx); 02530 02531 while (shared_list_idx) { 02532 02533 if (attr_idx == IL_IDX(shared_list_idx)) { 02534 02535 /* error, cannot have var in shared and getfirst */ 02536 02537 PRINTMSG(IL_LINE_NUM(list2_idx), 1314, Error, 02538 IL_COL_NUM(list2_idx), 02539 AT_OBJ_NAME_PTR(attr_idx), 02540 "SHARED", "GETFIRST"); 02541 break; 02542 } 02543 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx); 02544 } 02545 02546 private_list_idx = IL_IDX(cdir_switches.private_list_idx); 02547 02548 while (private_list_idx) { 02549 02550 if (attr_idx == IL_IDX(private_list_idx)) { 02551 02552 /* error, cannot have var in private and getfirst */ 02553 02554 PRINTMSG(IL_LINE_NUM(list2_idx), 1314, Error, 02555 IL_COL_NUM(list2_idx), 02556 AT_OBJ_NAME_PTR(attr_idx), 02557 "PRIVATE", "GETFIRST"); 02558 break; 02559 } 02560 private_list_idx = IL_NEXT_LIST_IDX(private_list_idx); 02561 } 02562 02563 02564 CONTINUE2: 02565 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02566 } 02567 } 02568 02569 02570 /* AUTOSCOPE */ 02571 02572 list_idx = IL_NEXT_LIST_IDX(list_idx); 02573 02574 if (IL_FLD(list_idx) == CN_Tbl_Idx) { 02575 cdir_switches.autoscope = TRUE; 02576 } 02577 02578 /* process CONTROL var list */ 02579 02580 list_idx = IL_NEXT_LIST_IDX(list_idx); 02581 02582 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 02583 02584 list2_idx = IL_IDX(list_idx); 02585 02586 while (list2_idx) { 02587 02588 attr_idx = IL_IDX(list2_idx); 02589 AT_LOCKED_IN(attr_idx) = TRUE; 02590 02591 while (AT_ATTR_LINK(attr_idx)) { 02592 attr_idx = AT_ATTR_LINK(attr_idx); 02593 AT_LOCKED_IN(attr_idx) = TRUE; 02594 } 02595 02596 IL_IDX(list2_idx) = attr_idx; 02597 02598 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 02599 ATD_CLASS(attr_idx) == Constant) { 02600 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 02601 IL_COL_NUM(list2_idx), 02602 AT_OBJ_NAME_PTR(attr_idx), 02603 "CONTROL", "DO ALL"); 02604 02605 /* remove the attr from the list */ 02606 if (list2_idx == IL_IDX(list_idx)) { 02607 /* head of the list */ 02608 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02609 IL_IDX(list_idx) = list2_idx; 02610 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 02611 IL_LIST_CNT(list_idx)--; 02612 continue; 02613 } 02614 else { 02615 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 02616 IL_NEXT_LIST_IDX(list2_idx); 02617 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 02618 IL_PREV_LIST_IDX(list2_idx); 02619 02620 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02621 IL_LIST_CNT(list_idx)--; 02622 continue; 02623 } 02624 } 02625 02626 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02627 } 02628 } 02629 02630 /* skip SAVELAST */ 02631 02632 list_idx = IL_NEXT_LIST_IDX(list_idx); 02633 02634 /* process MAXCPUS value */ 02635 02636 list_idx = IL_NEXT_LIST_IDX(list_idx); 02637 02638 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 02639 COPY_OPND(opnd, IL_OPND(list_idx)); 02640 exp_desc.rank = 0; 02641 xref_state = CIF_Symbol_Reference; 02642 expr_semantics(&opnd, &exp_desc); 02643 02644 find_opnd_line_and_column(&opnd, &line, &column); 02645 02646 if (exp_desc.type != Integer || 02647 exp_desc.rank != 0) { 02648 PRINTMSG(line, 806, Error, column); 02649 } 02650 02651 IL_FLD(list_idx) = AT_Tbl_Idx; 02652 idx = create_tmp_asg(&opnd, 02653 &exp_desc, 02654 &l_opnd, 02655 Intent_In, 02656 FALSE, 02657 FALSE); 02658 IL_IDX(list_idx) = idx; 02659 IL_LINE_NUM(list_idx) = line; 02660 IL_COL_NUM(list_idx) = column; 02661 } 02662 else if (cdir_switches.maxcpus) { 02663 COPY_OPND(IL_OPND(list_idx), cdir_switches.maxcpus_opnd); 02664 cdir_switches.maxcpus = FALSE; 02665 } 02666 02667 /* skip WORK DISTRIBUTION */ 02668 02669 list_idx = IL_NEXT_LIST_IDX(list_idx); 02670 02671 /* process work distribution expression */ 02672 02673 list_idx = IL_NEXT_LIST_IDX(list_idx); 02674 02675 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 02676 COPY_OPND(opnd, IL_OPND(list_idx)); 02677 exp_desc.rank = 0; 02678 xref_state = CIF_Symbol_Reference; 02679 expr_semantics(&opnd, &exp_desc); 02680 02681 find_opnd_line_and_column(&opnd, &line, &column); 02682 02683 value = (IL_FLD(IL_PREV_LIST_IDX(list_idx)) != CN_Tbl_Idx) ? 0 : 02684 CN_INT_TO_C(IL_IDX(IL_PREV_LIST_IDX(list_idx))); 02685 02686 if (exp_desc.type != Integer || exp_desc.rank != 0) { 02687 PRINTMSG(line, 806, Error, column); 02688 } 02689 else if (OPND_FLD(opnd) == CN_Tbl_Idx && 02690 IL_FLD(IL_PREV_LIST_IDX(list_idx)) == CN_Tbl_Idx && 02691 compare_cn_and_value(OPND_IDX(opnd), 02692 0, 02693 Le_Opr)) { 02694 02695 if (value == CMIC_WORK_DIST_CHUNKSIZE) { 02696 PRINTMSG(line, 1499, Error, column, "CHUNKSIZE"); 02697 } 02698 else if (value == CMIC_WORK_DIST_NUMCHUNKS) { 02699 PRINTMSG(line, 1499, Error, column, "NUMCHUNKS"); 02700 } 02701 } 02702 # if defined(GENERATE_WHIRL) 02703 else if (OPND_FLD(opnd) != CN_Tbl_Idx && OPND_FLD(opnd) != NO_Tbl_Idx && 02704 (value == CMIC_WORK_DIST_CHUNKSIZE || 02705 value == CMIC_WORK_DIST_NUMCHUNKS)) { 02706 02707 /* generate max(1,value) */ 02708 02709 NTR_IR_TBL(max_idx); 02710 IR_OPR(max_idx) = Max_Opr; 02711 IR_TYPE_IDX(max_idx) = exp_desc.type_idx; 02712 IR_LINE_NUM(ir_idx) = line; 02713 IR_COL_NUM(ir_idx) = column; 02714 02715 OPND_FLD(opnd2) = CN_Tbl_Idx; 02716 OPND_IDX(opnd2) = CN_INTEGER_ONE_IDX; 02717 OPND_LINE_NUM(opnd2) = line; 02718 OPND_COL_NUM(opnd2) = column; 02719 02720 cast_opnd_to_type_idx(&opnd2, exp_desc.type_idx); 02721 02722 NTR_IR_LIST_TBL(list2_idx); 02723 IR_FLD_L(max_idx) = IL_Tbl_Idx; 02724 IR_LIST_CNT_L(max_idx) = 2; 02725 IR_IDX_L(max_idx) = list2_idx; 02726 02727 COPY_OPND(IL_OPND(list2_idx), opnd); 02728 02729 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx)); 02730 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx; 02731 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02732 02733 COPY_OPND(IL_OPND(list2_idx), opnd2); 02734 02735 OPND_FLD(opnd) = IR_Tbl_Idx; 02736 OPND_IDX(opnd) = max_idx; 02737 } 02738 # endif 02739 02740 IL_FLD(list_idx) = AT_Tbl_Idx; 02741 idx = create_tmp_asg(&opnd, 02742 &exp_desc, 02743 &l_opnd, 02744 Intent_In, 02745 FALSE, 02746 FALSE); 02747 IL_IDX(list_idx) = idx; 02748 IL_LINE_NUM(list_idx) = line; 02749 IL_COL_NUM(list_idx) = column; 02750 } 02751 02752 curr_stmt_sh_idx = save_curr_stmt_sh_idx; 02753 02754 02755 TRACE (Func_Exit, "doall_cmic_semantics", NULL); 02756 02757 return; 02758 02759 } /* doall_cmic_semantics */ 02760 02761 /******************************************************************************\ 02762 |* *| 02763 |* Description: *| 02764 |* <description> *| 02765 |* *| 02766 |* Input parameters: *| 02767 |* NONE *| 02768 |* *| 02769 |* Output parameters: *| 02770 |* NONE *| 02771 |* *| 02772 |* Returns: *| 02773 |* NOTHING *| 02774 |* *| 02775 \******************************************************************************/ 02776 02777 static void doparallel_cmic_semantics(void) 02778 02779 { 02780 int column; 02781 expr_arg_type exp_desc; 02782 int idx; 02783 int ir_idx; 02784 int line; 02785 int list_idx; 02786 opnd_type l_opnd; 02787 opnd_type opnd; 02788 int save_curr_stmt_sh_idx; 02789 long64 value; 02790 02791 # if defined(GENERATE_WHIRL) 02792 int list2_idx; 02793 int max_idx; 02794 opnd_type opnd2; 02795 # endif 02796 02797 02798 TRACE (Func_Entry, "doparallel_cmic_semantics", NULL); 02799 02800 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 02801 02802 cdir_switches.dopar_sh_idx = curr_stmt_sh_idx; 02803 02804 /* pull stmt header out of list */ 02805 remove_sh(curr_stmt_sh_idx); 02806 save_curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx); 02807 02808 SH_PREV_IDX(cdir_switches.dopar_sh_idx) = NULL_IDX; 02809 SH_NEXT_IDX(cdir_switches.dopar_sh_idx) = NULL_IDX; 02810 02811 list_idx = IR_IDX_L(ir_idx); 02812 02813 /* skip WORK DISTRIBUTION */ 02814 02815 /* process work distribution expression */ 02816 02817 list_idx = IL_NEXT_LIST_IDX(list_idx); 02818 02819 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 02820 COPY_OPND(opnd, IL_OPND(list_idx)); 02821 exp_desc.rank = 0; 02822 xref_state = CIF_Symbol_Reference; 02823 expr_semantics(&opnd, &exp_desc); 02824 02825 find_opnd_line_and_column(&opnd, &line, &column); 02826 02827 value = (IL_FLD(IL_PREV_LIST_IDX(list_idx)) != CN_Tbl_Idx) ? 0 : 02828 CN_INT_TO_C(IL_IDX(IL_PREV_LIST_IDX(list_idx))); 02829 02830 if (exp_desc.type != Integer || 02831 exp_desc.rank != 0) { 02832 PRINTMSG(line, 806, Error, column); 02833 } 02834 else if (OPND_FLD(opnd) == CN_Tbl_Idx && 02835 IL_FLD(IL_PREV_LIST_IDX(list_idx)) == CN_Tbl_Idx && 02836 compare_cn_and_value(OPND_IDX(opnd), 02837 0, 02838 Le_Opr)) { 02839 02840 if (value == CMIC_WORK_DIST_CHUNKSIZE) { 02841 PRINTMSG(line, 1499, Error, column, "CHUNKSIZE"); 02842 } 02843 else if (value == CMIC_WORK_DIST_NUMCHUNKS) { 02844 PRINTMSG(line, 1499, Error, column, "NUMCHUNKS"); 02845 } 02846 } 02847 # if defined(GENERATE_WHIRL) 02848 else if (OPND_FLD(opnd) != CN_Tbl_Idx && OPND_FLD(opnd) != NO_Tbl_Idx && 02849 (value == CMIC_WORK_DIST_CHUNKSIZE || 02850 value == CMIC_WORK_DIST_NUMCHUNKS)) { 02851 02852 /* generate max(1,value) */ 02853 02854 NTR_IR_TBL(max_idx); 02855 IR_OPR(max_idx) = Max_Opr; 02856 IR_TYPE_IDX(max_idx) = exp_desc.type_idx; 02857 IR_LINE_NUM(ir_idx) = line; 02858 IR_COL_NUM(ir_idx) = column; 02859 02860 OPND_FLD(opnd2) = CN_Tbl_Idx; 02861 OPND_IDX(opnd2) = CN_INTEGER_ONE_IDX; 02862 OPND_LINE_NUM(opnd2) = line; 02863 OPND_COL_NUM(opnd2) = column; 02864 02865 cast_opnd_to_type_idx(&opnd2, exp_desc.type_idx); 02866 02867 NTR_IR_LIST_TBL(list2_idx); 02868 IR_FLD_L(max_idx) = IL_Tbl_Idx; 02869 IR_LIST_CNT_L(max_idx) = 2; 02870 IR_IDX_L(max_idx) = list2_idx; 02871 02872 COPY_OPND(IL_OPND(list2_idx), opnd); 02873 02874 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx)); 02875 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx; 02876 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 02877 02878 COPY_OPND(IL_OPND(list2_idx), opnd2); 02879 02880 OPND_FLD(opnd) = IR_Tbl_Idx; 02881 OPND_IDX(opnd) = max_idx; 02882 } 02883 # endif 02884 02885 02886 IL_FLD(list_idx) = AT_Tbl_Idx; 02887 idx = create_tmp_asg(&opnd, 02888 &exp_desc, 02889 &l_opnd, 02890 Intent_In, 02891 FALSE, 02892 FALSE); 02893 IL_IDX(list_idx) = idx; 02894 IL_LINE_NUM(list_idx) = line; 02895 IL_COL_NUM(list_idx) = column; 02896 } 02897 02898 curr_stmt_sh_idx = save_curr_stmt_sh_idx; 02899 02900 TRACE (Func_Exit, "doparallel_cmic_semantics", NULL); 02901 02902 return; 02903 02904 } /* doparallel_cmic_semantics */ 02905 02906 /******************************************************************************\ 02907 |* *| 02908 |* Description: *| 02909 |* <description> *| 02910 |* *| 02911 |* Input parameters: *| 02912 |* NONE *| 02913 |* *| 02914 |* Output parameters: *| 02915 |* NONE *| 02916 |* *| 02917 |* Returns: *| 02918 |* NOTHING *| 02919 |* *| 02920 \******************************************************************************/ 02921 02922 static void endparallel_cmic_semantics(void) 02923 02924 { 02925 int list_idx; 02926 02927 TRACE (Func_Entry, "endparallel_cmic_semantics", NULL); 02928 02929 cdir_switches.no_internal_calls = FALSE; 02930 cdir_switches.parallel_region = FALSE; 02931 cdir_switches.autoscope = FALSE; 02932 02933 if (cdir_switches.private_list_idx && 02934 IL_FLD(cdir_switches.private_list_idx) != NO_Tbl_Idx) { 02935 02936 list_idx = IL_IDX(cdir_switches.private_list_idx); 02937 02938 while (list_idx) { 02939 if (IL_FLD(list_idx) == AT_Tbl_Idx && 02940 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) { 02941 02942 ATD_TASK_PRIVATE(IL_IDX(list_idx)) = FALSE; 02943 } 02944 list_idx = IL_NEXT_LIST_IDX(list_idx); 02945 } 02946 } 02947 02948 if (cdir_switches.getfirst_list_idx && 02949 IL_FLD(cdir_switches.getfirst_list_idx) != NO_Tbl_Idx) { 02950 02951 list_idx = IL_IDX(cdir_switches.getfirst_list_idx); 02952 02953 while (list_idx) { 02954 if (IL_FLD(list_idx) == AT_Tbl_Idx && 02955 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) { 02956 02957 ATD_TASK_GETFIRST(IL_IDX(list_idx)) = FALSE; 02958 } 02959 list_idx = IL_NEXT_LIST_IDX(list_idx); 02960 } 02961 } 02962 02963 02964 if (cdir_switches.shared_list_idx && 02965 IL_FLD(cdir_switches.shared_list_idx) != NO_Tbl_Idx) { 02966 02967 list_idx = IL_IDX(cdir_switches.shared_list_idx); 02968 02969 while (list_idx) { 02970 if (IL_FLD(list_idx) == AT_Tbl_Idx && 02971 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) { 02972 02973 ATD_TASK_SHARED(IL_IDX(list_idx)) = FALSE; 02974 } 02975 else if (IL_FLD(list_idx) == AT_Tbl_Idx && 02976 AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit && 02977 ATP_PROC(IL_IDX(list_idx)) == Dummy_Proc) { 02978 02979 ATP_TASK_SHARED(IL_IDX(list_idx)) = FALSE; 02980 } 02981 list_idx = IL_NEXT_LIST_IDX(list_idx); 02982 } 02983 } 02984 02985 cdir_switches.getfirst_list_idx = NULL_IDX; 02986 cdir_switches.private_list_idx = NULL_IDX; 02987 cdir_switches.shared_list_idx = NULL_IDX; 02988 02989 TRACE (Func_Exit, "endparallel_cmic_semantics", NULL); 02990 02991 return; 02992 02993 } /* endparallel_cmic_semantics */ 02994 02995 /******************************************************************************\ 02996 |* *| 02997 |* Description: *| 02998 |* <description> *| 02999 |* *| 03000 |* Input parameters: *| 03001 |* NONE *| 03002 |* *| 03003 |* Output parameters: *| 03004 |* NONE *| 03005 |* *| 03006 |* Returns: *| 03007 |* NOTHING *| 03008 |* *| 03009 \******************************************************************************/ 03010 03011 static void parallel_cmic_semantics(void) 03012 03013 { 03014 int attr_idx; 03015 int column; 03016 expr_arg_type exp_desc; 03017 int getfirst_list_idx; 03018 int idx; 03019 int ir_idx; 03020 int line; 03021 int list_idx; 03022 int list2_idx; 03023 int list3_idx; 03024 opnd_type l_opnd; 03025 opnd_type opnd; 03026 int private_list_idx; 03027 int shared_list_idx; 03028 03029 # if defined(GENERATE_WHIRL) 03030 char string[13]; 03031 # endif 03032 03033 03034 TRACE (Func_Entry, "parallel_cmic_semantics", NULL); 03035 03036 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 03037 03038 if (cdir_switches.doall_sh_idx != NULL_IDX || 03039 cdir_switches.doacross_sh_idx != NULL_IDX || 03040 cdir_switches.parallel_region || 03041 cdir_switches.guard_in_par_reg) { 03042 03043 /* error .. already in a parallel_region */ 03044 PRINTMSG(IR_LINE_NUM(ir_idx), 818, Error, IR_COL_NUM(ir_idx)); 03045 } 03046 03047 list_idx = IR_IDX_L(ir_idx); 03048 03049 /* process if condition */ 03050 03051 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03052 COPY_OPND(opnd, IL_OPND(list_idx)); 03053 exp_desc.rank = 0; 03054 xref_state = CIF_Symbol_Reference; 03055 expr_semantics(&opnd, &exp_desc); 03056 03057 find_opnd_line_and_column(&opnd, &line, &column); 03058 03059 if (exp_desc.type != Logical || 03060 exp_desc.rank != 0) { 03061 PRINTMSG(line, 803, Error, column); 03062 } 03063 03064 IL_FLD(list_idx) = AT_Tbl_Idx; 03065 idx = create_tmp_asg(&opnd, 03066 &exp_desc, 03067 &l_opnd, 03068 Intent_In, 03069 FALSE, 03070 FALSE); 03071 IL_IDX(list_idx) = idx; 03072 03073 IL_LINE_NUM(list_idx) = line; 03074 IL_COL_NUM(list_idx) = column; 03075 } 03076 03077 /* process SHARED var list */ 03078 03079 list_idx = IL_NEXT_LIST_IDX(list_idx); 03080 cdir_switches.shared_list_idx = list_idx; 03081 03082 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03083 03084 list2_idx = IL_IDX(list_idx); 03085 03086 while (list2_idx) { 03087 03088 attr_idx = IL_IDX(list2_idx); 03089 AT_LOCKED_IN(attr_idx) = TRUE; 03090 03091 while (AT_ATTR_LINK(attr_idx)) { 03092 attr_idx = AT_ATTR_LINK(attr_idx); 03093 AT_LOCKED_IN(attr_idx) = TRUE; 03094 } 03095 03096 IL_IDX(list2_idx) = attr_idx; 03097 03098 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 03099 ATP_PROC(attr_idx) == Dummy_Proc) { 03100 ATP_TASK_SHARED(attr_idx) = TRUE; 03101 } 03102 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 03103 ATD_CLASS(attr_idx) == Constant) { 03104 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 03105 IL_COL_NUM(list2_idx), 03106 AT_OBJ_NAME_PTR(attr_idx), 03107 "SHARED", "PARALLEL"); 03108 03109 /* remove the attr from the list */ 03110 if (list2_idx == IL_IDX(cdir_switches.shared_list_idx)) { 03111 /* head of the list */ 03112 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03113 IL_IDX(cdir_switches.shared_list_idx) = list2_idx; 03114 IL_IDX(list_idx) = list2_idx; 03115 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 03116 IL_LIST_CNT(list_idx)--; 03117 continue; 03118 } 03119 else { 03120 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03121 IL_NEXT_LIST_IDX(list2_idx); 03122 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03123 IL_PREV_LIST_IDX(list2_idx); 03124 03125 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03126 IL_LIST_CNT(list_idx)--; 03127 continue; 03128 } 03129 } 03130 else { 03131 ATD_TASK_SHARED(attr_idx) = TRUE; 03132 ATD_WAS_SCOPED(attr_idx) = TRUE; 03133 } 03134 03135 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx); 03136 03137 while (shared_list_idx != list2_idx && 03138 shared_list_idx != NULL_IDX) { 03139 03140 if (attr_idx == IL_IDX(shared_list_idx)) { 03141 /* take this out of the list */ 03142 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03143 IL_NEXT_LIST_IDX(list2_idx); 03144 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03145 IL_PREV_LIST_IDX(list2_idx); 03146 03147 list2_idx = IL_PREV_LIST_IDX(list2_idx); 03148 IL_LIST_CNT(list_idx)--; 03149 break; 03150 } 03151 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx); 03152 } 03153 03154 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03155 } 03156 } 03157 03158 /* process PRIVATE var list */ 03159 03160 list_idx = IL_NEXT_LIST_IDX(list_idx); 03161 cdir_switches.private_list_idx = list_idx; 03162 03163 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03164 03165 list2_idx = IL_IDX(list_idx); 03166 03167 while (list2_idx) { 03168 03169 attr_idx = IL_IDX(list2_idx); 03170 AT_LOCKED_IN(attr_idx) = TRUE; 03171 03172 while (AT_ATTR_LINK(attr_idx)) { 03173 attr_idx = AT_ATTR_LINK(attr_idx); 03174 AT_LOCKED_IN(attr_idx) = TRUE; 03175 } 03176 03177 IL_IDX(list2_idx) = attr_idx; 03178 03179 # if defined(GENERATE_WHIRL) 03180 if (AT_OBJ_CLASS(attr_idx) == Data_Obj && 03181 (ATD_ALLOCATABLE(attr_idx) || 03182 ATD_CLASS(attr_idx) == CRI__Pointee || 03183 ATD_POINTER(attr_idx))) { 03184 03185 if (ATD_ALLOCATABLE(attr_idx)) { 03186 strcpy(string, "ALLOCATABLE"); 03187 } 03188 else if (ATD_POINTER(attr_idx)) { 03189 strcpy(string, "POINTER"); 03190 } 03191 else { 03192 strcpy(string, "Cray Pointee"); 03193 } 03194 03195 PRINTMSG(IL_LINE_NUM(list2_idx), 1446, Error, 03196 IL_COL_NUM(list2_idx), 03197 string, 03198 "PARALLEL"); 03199 03200 } 03201 else 03202 # endif 03203 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 03204 ATD_CLASS(attr_idx) == Constant) { 03205 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 03206 IL_COL_NUM(list2_idx), 03207 AT_OBJ_NAME_PTR(attr_idx), 03208 "PRIVATE", "PARALLEL"); 03209 03210 /* remove the attr from the list */ 03211 if (list2_idx == IL_IDX(cdir_switches.private_list_idx)) { 03212 /* head of the list */ 03213 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03214 IL_IDX(cdir_switches.private_list_idx) = list2_idx; 03215 IL_IDX(list_idx) = list2_idx; 03216 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 03217 IL_LIST_CNT(list_idx)--; 03218 continue; 03219 } 03220 else { 03221 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03222 IL_NEXT_LIST_IDX(list2_idx); 03223 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03224 IL_PREV_LIST_IDX(list2_idx); 03225 03226 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03227 IL_LIST_CNT(list_idx)--; 03228 continue; 03229 } 03230 } 03231 else { 03232 ATD_TASK_PRIVATE(attr_idx) = TRUE; 03233 ATD_WAS_SCOPED(attr_idx) = TRUE; 03234 03235 if (ATD_CLASS(attr_idx) == Variable && 03236 ATD_AUTOMATIC(attr_idx) && 03237 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 03238 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 03239 03240 ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 03241 03242 NTR_IR_LIST_TBL(list3_idx); 03243 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 03244 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 03245 IL_IDX(list_idx) = list3_idx; 03246 IL_LIST_CNT(list_idx)++; 03247 03248 IL_FLD(list3_idx) = AT_Tbl_Idx; 03249 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 03250 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 03251 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 03252 } 03253 } 03254 03255 private_list_idx = IL_IDX(cdir_switches.private_list_idx); 03256 03257 while (private_list_idx != list2_idx && 03258 private_list_idx != NULL_IDX) { 03259 03260 if (attr_idx == IL_IDX(private_list_idx)) { 03261 /* take this out of the list */ 03262 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03263 IL_NEXT_LIST_IDX(list2_idx); 03264 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03265 IL_PREV_LIST_IDX(list2_idx); 03266 03267 list2_idx = IL_PREV_LIST_IDX(list2_idx); 03268 IL_LIST_CNT(list_idx)--; 03269 goto CONTINUE3; 03270 } 03271 private_list_idx = IL_NEXT_LIST_IDX(private_list_idx); 03272 } 03273 03274 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx); 03275 03276 while (shared_list_idx) { 03277 03278 if (attr_idx == IL_IDX(shared_list_idx)) { 03279 /* error, cannot have var in shared and private */ 03280 PRINTMSG(IL_LINE_NUM(list2_idx), 805, Error, 03281 IL_COL_NUM(list2_idx), 03282 AT_OBJ_NAME_PTR(attr_idx)); 03283 break; 03284 } 03285 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx); 03286 } 03287 03288 CONTINUE3: 03289 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03290 } 03291 } 03292 03293 /* process GETFIRST var list */ 03294 03295 list_idx = IL_NEXT_LIST_IDX(list_idx); 03296 cdir_switches.getfirst_list_idx = list_idx; 03297 03298 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03299 03300 list2_idx = IL_IDX(list_idx); 03301 03302 while (list2_idx) { 03303 03304 attr_idx = IL_IDX(list2_idx); 03305 AT_LOCKED_IN(attr_idx) = TRUE; 03306 03307 while (AT_ATTR_LINK(attr_idx)) { 03308 attr_idx = AT_ATTR_LINK(attr_idx); 03309 AT_LOCKED_IN(attr_idx) = TRUE; 03310 } 03311 03312 IL_IDX(list2_idx) = attr_idx; 03313 03314 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 03315 ATD_CLASS(attr_idx) == Constant) { 03316 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 03317 IL_COL_NUM(list2_idx), 03318 AT_OBJ_NAME_PTR(attr_idx), 03319 "GETFIRST", "PARALLEL"); 03320 03321 /* remove the attr from the list */ 03322 03323 if (list2_idx == IL_IDX(cdir_switches.getfirst_list_idx)) { 03324 03325 /* head of the list */ 03326 03327 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03328 IL_IDX(cdir_switches.getfirst_list_idx) = list2_idx; 03329 IL_IDX(list_idx) = list2_idx; 03330 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 03331 IL_LIST_CNT(list_idx)--; 03332 continue; 03333 } 03334 else { 03335 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03336 IL_NEXT_LIST_IDX(list2_idx); 03337 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03338 IL_PREV_LIST_IDX(list2_idx); 03339 03340 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03341 IL_LIST_CNT(list_idx)--; 03342 continue; 03343 } 03344 } 03345 else { 03346 ATD_TASK_GETFIRST(attr_idx) = TRUE; 03347 03348 if (ATD_CLASS(attr_idx) == Variable && 03349 ATD_AUTOMATIC(attr_idx) && 03350 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 03351 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 03352 03353 ATD_TASK_GETFIRST(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 03354 03355 NTR_IR_LIST_TBL(list3_idx); 03356 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 03357 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 03358 IL_IDX(list_idx) = list3_idx; 03359 IL_LIST_CNT(list_idx)++; 03360 03361 IL_FLD(list3_idx) = AT_Tbl_Idx; 03362 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 03363 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 03364 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 03365 } 03366 } 03367 03368 getfirst_list_idx = IL_IDX(cdir_switches.getfirst_list_idx); 03369 03370 while (getfirst_list_idx != list2_idx && 03371 getfirst_list_idx != NULL_IDX) { 03372 03373 if (attr_idx == IL_IDX(getfirst_list_idx)) { 03374 03375 /* take this out of the list */ 03376 03377 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03378 IL_NEXT_LIST_IDX(list2_idx); 03379 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03380 IL_PREV_LIST_IDX(list2_idx); 03381 03382 list2_idx = IL_PREV_LIST_IDX(list2_idx); 03383 IL_LIST_CNT(list_idx)--; 03384 goto CONTINUE4; 03385 } 03386 getfirst_list_idx = IL_NEXT_LIST_IDX(getfirst_list_idx); 03387 } 03388 03389 03390 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx); 03391 03392 while (shared_list_idx) { 03393 03394 if (attr_idx == IL_IDX(shared_list_idx)) { 03395 03396 /* error, cannot have var in shared and getfirst */ 03397 03398 PRINTMSG(IL_LINE_NUM(list2_idx), 1314, Error, 03399 IL_COL_NUM(list2_idx), 03400 AT_OBJ_NAME_PTR(attr_idx), 03401 "SHARED", "GETFIRST"); 03402 break; 03403 } 03404 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx); 03405 } 03406 03407 private_list_idx = IL_IDX(cdir_switches.private_list_idx); 03408 03409 while (private_list_idx) { 03410 03411 if (attr_idx == IL_IDX(private_list_idx)) { 03412 03413 /* error, cannot have var in private and getfirst */ 03414 03415 PRINTMSG(IL_LINE_NUM(list2_idx), 1314, Error, 03416 IL_COL_NUM(list2_idx), 03417 AT_OBJ_NAME_PTR(attr_idx), 03418 "PRIVATE", "GETFIRST"); 03419 break; 03420 } 03421 private_list_idx = IL_NEXT_LIST_IDX(private_list_idx); 03422 } 03423 03424 03425 CONTINUE4: 03426 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03427 } 03428 } 03429 03430 03431 /* AUTOSCOPE */ 03432 03433 list_idx = IL_NEXT_LIST_IDX(list_idx); 03434 03435 if (IL_FLD(list_idx) == CN_Tbl_Idx) { 03436 cdir_switches.autoscope = TRUE; 03437 } 03438 03439 /* process CONTROL var list */ 03440 03441 list_idx = IL_NEXT_LIST_IDX(list_idx); 03442 03443 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03444 03445 list2_idx = IL_IDX(list_idx); 03446 03447 while (list2_idx) { 03448 03449 attr_idx = IL_IDX(list2_idx); 03450 AT_LOCKED_IN(attr_idx) = TRUE; 03451 03452 while (AT_ATTR_LINK(attr_idx)) { 03453 attr_idx = AT_ATTR_LINK(attr_idx); 03454 AT_LOCKED_IN(attr_idx) = TRUE; 03455 } 03456 03457 IL_IDX(list2_idx) = attr_idx; 03458 03459 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 03460 ATD_CLASS(attr_idx) == Constant) { 03461 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 03462 IL_COL_NUM(list2_idx), 03463 AT_OBJ_NAME_PTR(attr_idx), 03464 "CONTROL", "PARALLEL"); 03465 03466 /* remove the attr from the list */ 03467 if (list2_idx == IL_IDX(list_idx)) { 03468 /* head of the list */ 03469 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03470 IL_IDX(list_idx) = list2_idx; 03471 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 03472 IL_LIST_CNT(list_idx)--; 03473 continue; 03474 } 03475 else { 03476 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03477 IL_NEXT_LIST_IDX(list2_idx); 03478 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03479 IL_PREV_LIST_IDX(list2_idx); 03480 03481 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03482 IL_LIST_CNT(list_idx)--; 03483 continue; 03484 } 03485 } 03486 03487 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03488 } 03489 } 03490 03491 /* process MAXCPUS value */ 03492 03493 list_idx = IL_NEXT_LIST_IDX(list_idx); 03494 03495 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03496 COPY_OPND(opnd, IL_OPND(list_idx)); 03497 exp_desc.rank = 0; 03498 xref_state = CIF_Symbol_Reference; 03499 expr_semantics(&opnd, &exp_desc); 03500 03501 find_opnd_line_and_column(&opnd, &line, &column); 03502 if (exp_desc.type != Integer || 03503 exp_desc.rank != 0) { 03504 PRINTMSG(line, 806, Error, column); 03505 } 03506 03507 IL_FLD(list_idx) = AT_Tbl_Idx; 03508 idx = create_tmp_asg(&opnd, 03509 &exp_desc, 03510 &l_opnd, 03511 Intent_In, 03512 FALSE, 03513 FALSE); 03514 IL_IDX(list_idx) = idx; 03515 IL_LINE_NUM(list_idx) = line; 03516 IL_COL_NUM(list_idx) = column; 03517 } 03518 else if (cdir_switches.maxcpus) { 03519 COPY_OPND(IL_OPND(list_idx), cdir_switches.maxcpus_opnd); 03520 cdir_switches.maxcpus = FALSE; 03521 } 03522 03523 cdir_switches.no_internal_calls = TRUE; 03524 cdir_switches.parallel_region = TRUE; 03525 TRACE (Func_Exit, "parallel_cmic_semantics", NULL); 03526 03527 return; 03528 03529 } /* parallel_cmic_semantics */ 03530 03531 /******************************************************************************\ 03532 |* *| 03533 |* Description: *| 03534 |* The ir looks like this coming in ... *| 03535 |* *| 03536 |* (mp_directive_opr) *| 03537 |* / *| 03538 |* |- IF condition *| 03539 |* |- SHARE | SHARED var list *| 03540 |* |- LASTLOCAL var list *| 03541 |* |- REDUCTION var list *| 03542 |* |- MP_SCHEDTYPE value (in const table) *| 03543 |* |- CHUNK expression (also BLOCKED) *| 03544 |* |- AFFINITY index_var list *| 03545 |* |- IS THREAD constant (THREAD == 1, DATA == 0) *| 03546 |* |- THREAD/DATA list *| 03547 |* |- LOCAL | PRIVATE var list *| 03548 |* |- ONTO list *| 03549 |* |- NEST list *| 03550 |* |- LASTTHREAD opnd *| 03551 |* |- ORDERED constant (ORDERED == 1, else NO_Tbl_Idx) *| 03552 |* *| 03553 |* Not all clauses are valid for all directives. *| 03554 |* *| 03555 |* Input parameters: *| 03556 |* NONE *| 03557 |* *| 03558 |* Output parameters: *| 03559 |* NONE *| 03560 |* *| 03561 |* Returns: *| 03562 |* NOTHING *| 03563 |* *| 03564 \******************************************************************************/ 03565 03566 static void mp_directive_semantics(mp_directive_type directive) 03567 03568 { 03569 int attr_idx; 03570 int column; 03571 expr_arg_type exp_desc; 03572 int i; 03573 int idx; 03574 int ir_idx; 03575 int line; 03576 int list_array[MP_DIR_LIST_CNT]; 03577 int list_idx; 03578 int list2_idx; 03579 int list3_idx; 03580 opnd_type l_opnd; 03581 opnd_type opnd; 03582 int orig_sh_idx; 03583 int save_curr_stmt_sh_idx; 03584 boolean save_error_flag; 03585 char string[13]; 03586 03587 03588 TRACE (Func_Entry, "mp_directive_semantics", NULL); 03589 03590 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 03591 save_curr_stmt_sh_idx = curr_stmt_sh_idx; 03592 orig_sh_idx = curr_stmt_sh_idx; 03593 save_error_flag = SH_ERR_FLG(curr_stmt_sh_idx); 03594 03595 list_idx = IR_IDX_L(ir_idx); 03596 03597 for (i = 0; i < MP_DIR_LIST_CNT; i++) { 03598 list_array[i] = list_idx; 03599 list_idx = IL_NEXT_LIST_IDX(list_idx); 03600 } 03601 03602 if (directive == Doacross || 03603 directive == Parallel_Do || 03604 directive == Pdo) { 03605 03606 /* pull stmt header out of list */ 03607 remove_sh(curr_stmt_sh_idx); 03608 save_curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx); 03609 03610 switch (directive) { 03611 case Doacross: 03612 cdir_switches.doacross_sh_idx = curr_stmt_sh_idx; 03613 SH_PREV_IDX(cdir_switches.doacross_sh_idx) = NULL_IDX; 03614 SH_NEXT_IDX(cdir_switches.doacross_sh_idx) = NULL_IDX; 03615 break; 03616 03617 case Parallel_Do: 03618 cdir_switches.paralleldo_sh_idx = curr_stmt_sh_idx; 03619 SH_PREV_IDX(cdir_switches.paralleldo_sh_idx) = NULL_IDX; 03620 SH_NEXT_IDX(cdir_switches.paralleldo_sh_idx) = NULL_IDX; 03621 break; 03622 03623 case Pdo: 03624 cdir_switches.pdo_sh_idx = curr_stmt_sh_idx; 03625 SH_PREV_IDX(cdir_switches.pdo_sh_idx) = NULL_IDX; 03626 SH_NEXT_IDX(cdir_switches.pdo_sh_idx) = NULL_IDX; 03627 break; 03628 } 03629 } 03630 else { 03631 cdir_switches.parallel_region = TRUE; 03632 } 03633 03634 if (clause_allowed[directive][If_Clause]) { 03635 list_idx = list_array[MP_DIR_IF_IDX]; 03636 03637 /* process IF condition */ 03638 03639 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03640 COPY_OPND(opnd, IL_OPND(list_idx)); 03641 exp_desc.rank = 0; 03642 xref_state = CIF_Symbol_Reference; 03643 expr_semantics(&opnd, &exp_desc); 03644 03645 find_opnd_line_and_column(&opnd, &line, &column); 03646 if (exp_desc.type != Logical || 03647 exp_desc.rank != 0) { 03648 PRINTMSG(line, 803, Error, column); 03649 } 03650 03651 IL_FLD(list_idx) = AT_Tbl_Idx; 03652 idx = create_tmp_asg(&opnd, 03653 &exp_desc, 03654 &l_opnd, 03655 Intent_In, 03656 FALSE, 03657 FALSE); 03658 IL_IDX(list_idx) = idx; 03659 IL_LINE_NUM(list_idx) = line; 03660 IL_COL_NUM(list_idx) = column; 03661 } 03662 } 03663 03664 if (clause_allowed[directive][Chunk_Clause]) { 03665 /* process CHUNK expression */ 03666 03667 list_idx = list_array[MP_DIR_CHUNK_IDX]; 03668 03669 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03670 COPY_OPND(opnd, IL_OPND(list_idx)); 03671 exp_desc.rank = 0; 03672 xref_state = CIF_Symbol_Reference; 03673 expr_semantics(&opnd, &exp_desc); 03674 03675 find_opnd_line_and_column(&opnd, &line, &column); 03676 03677 if (exp_desc.type != Integer || 03678 exp_desc.rank != 0) { 03679 PRINTMSG(line, 1364, Error, column); 03680 } 03681 03682 IL_FLD(list_idx) = AT_Tbl_Idx; 03683 idx = create_tmp_asg(&opnd, 03684 &exp_desc, 03685 &l_opnd, 03686 Intent_In, 03687 FALSE, 03688 FALSE); 03689 IL_IDX(list_idx) = idx; 03690 IL_LINE_NUM(list_idx) = line; 03691 IL_COL_NUM(list_idx) = column; 03692 } 03693 } 03694 03695 if (directive != Doacross && 03696 directive != Parallel_Do) { 03697 03698 push_task_blk(curr_stmt_sh_idx); 03699 } 03700 03701 cdir_switches.lastlocal_list_idx = list_array[MP_DIR_LASTLOCAL_IDX]; 03702 cdir_switches.private_list_idx = list_array[MP_DIR_LOCAL_IDX]; 03703 cdir_switches.shared_list_idx = list_array[MP_DIR_SHARE_IDX]; 03704 cdir_switches.reduction_list_idx = list_array[MP_DIR_REDUCTION_IDX]; 03705 cdir_switches.lastthread_list_idx = list_array[MP_DIR_LASTTHREAD_IDX]; 03706 03707 if (clause_allowed[directive][Share_Clause]) { 03708 /* process SHARED var list */ 03709 03710 list_idx = list_array[MP_DIR_SHARE_IDX]; 03711 03712 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03713 03714 list2_idx = IL_IDX(list_idx); 03715 03716 while (list2_idx) { 03717 03718 attr_idx = IL_IDX(list2_idx); 03719 AT_LOCKED_IN(attr_idx) = TRUE; 03720 03721 while (AT_ATTR_LINK(attr_idx)) { 03722 attr_idx = AT_ATTR_LINK(attr_idx); 03723 AT_LOCKED_IN(attr_idx) = TRUE; 03724 } 03725 03726 IL_IDX(list2_idx) = attr_idx; 03727 03728 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 03729 ATP_PROC(attr_idx) == Dummy_Proc) { 03730 ATP_TASK_SHARED(attr_idx) = TRUE; 03731 } 03732 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 03733 ATD_CLASS(attr_idx) == Constant) { 03734 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 03735 IL_COL_NUM(list2_idx), 03736 AT_OBJ_NAME_PTR(attr_idx), 03737 "SHARE", mp_dir_str[directive]); 03738 03739 /* remove the attr from the list */ 03740 03741 if (list2_idx == IL_IDX(cdir_switches.shared_list_idx)) { 03742 03743 /* head of the list */ 03744 03745 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03746 IL_IDX(cdir_switches.shared_list_idx) = list2_idx; 03747 IL_IDX(list_idx) = list2_idx; 03748 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 03749 IL_LIST_CNT(list_idx)--; 03750 continue; 03751 } 03752 else { 03753 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03754 IL_NEXT_LIST_IDX(list2_idx); 03755 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03756 IL_PREV_LIST_IDX(list2_idx); 03757 03758 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03759 IL_LIST_CNT(list_idx)--; 03760 continue; 03761 } 03762 } 03763 else if (! ATD_TASK_PRIVATE(attr_idx) && 03764 ! ATD_TASK_LASTTHREAD(attr_idx) && 03765 ! ATD_TASK_LASTLOCAL(attr_idx)) { 03766 03767 /* ATD_TASK_REDUCTION is allowed for SHARED */ 03768 03769 ATD_TASK_SHARED(attr_idx) = TRUE; 03770 ATD_WAS_SCOPED(attr_idx) = TRUE; 03771 03772 if (ATD_CLASS(attr_idx) == Variable && 03773 ATD_AUTOMATIC(attr_idx) && 03774 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 03775 ! ATD_TASK_SHARED(ATD_AUTO_BASE_IDX(attr_idx))) { 03776 03777 ATD_TASK_SHARED(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 03778 03779 NTR_IR_LIST_TBL(list3_idx); 03780 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 03781 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 03782 IL_IDX(list_idx) = list3_idx; 03783 IL_LIST_CNT(list_idx)++; 03784 03785 IL_FLD(list3_idx) = AT_Tbl_Idx; 03786 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 03787 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 03788 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 03789 } 03790 } 03791 else { 03792 PRINTMSG(IL_LINE_NUM(list2_idx), 1362, Error, 03793 IL_COL_NUM(list2_idx), 03794 AT_OBJ_NAME_PTR(attr_idx)); 03795 } 03796 03797 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03798 } 03799 } 03800 } 03801 03802 if (clause_allowed[directive][Lastlocal_Clause]) { 03803 /* process LASTLOCAL var list */ 03804 03805 list_idx = list_array[MP_DIR_LASTLOCAL_IDX]; 03806 03807 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03808 03809 list2_idx = IL_IDX(list_idx); 03810 03811 while (list2_idx) { 03812 03813 attr_idx = IL_IDX(list2_idx); 03814 AT_LOCKED_IN(attr_idx) = TRUE; 03815 03816 while (AT_ATTR_LINK(attr_idx)) { 03817 attr_idx = AT_ATTR_LINK(attr_idx); 03818 AT_LOCKED_IN(attr_idx) = TRUE; 03819 } 03820 03821 IL_IDX(list2_idx) = attr_idx; 03822 03823 if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 03824 ATD_CLASS(attr_idx) == Constant) { 03825 03826 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 03827 IL_COL_NUM(list2_idx), 03828 AT_OBJ_NAME_PTR(attr_idx), 03829 "LASTLOCAL", mp_dir_str[directive]); 03830 03831 /* remove the attr from the list */ 03832 03833 if (list2_idx == IL_IDX(cdir_switches.lastlocal_list_idx)) { 03834 03835 /* head of the list */ 03836 03837 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03838 IL_IDX(cdir_switches.lastlocal_list_idx) = list2_idx; 03839 IL_IDX(list_idx) = list2_idx; 03840 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 03841 IL_LIST_CNT(list_idx)--; 03842 continue; 03843 } 03844 else { 03845 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03846 IL_NEXT_LIST_IDX(list2_idx); 03847 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03848 IL_PREV_LIST_IDX(list2_idx); 03849 03850 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03851 IL_LIST_CNT(list_idx)--; 03852 continue; 03853 } 03854 } 03855 else if (! ATD_TASK_PRIVATE(attr_idx) && 03856 ! ATD_TASK_LASTTHREAD(attr_idx) && 03857 ! ATD_TASK_SHARED(attr_idx) && 03858 ! ATD_TASK_REDUCTION(attr_idx)) { 03859 03860 ATD_TASK_LASTLOCAL(attr_idx) = TRUE; 03861 03862 if (ATD_CLASS(attr_idx) == Variable && 03863 ATD_AUTOMATIC(attr_idx) && 03864 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 03865 ! ATD_TASK_LASTLOCAL(ATD_AUTO_BASE_IDX(attr_idx))) { 03866 03867 ATD_TASK_LASTLOCAL(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 03868 03869 NTR_IR_LIST_TBL(list3_idx); 03870 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 03871 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 03872 IL_IDX(list_idx) = list3_idx; 03873 IL_LIST_CNT(list_idx)++; 03874 03875 IL_FLD(list3_idx) = AT_Tbl_Idx; 03876 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 03877 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 03878 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 03879 } 03880 } 03881 else { 03882 PRINTMSG(IL_LINE_NUM(list2_idx), 1362, Error, 03883 IL_COL_NUM(list2_idx), 03884 AT_OBJ_NAME_PTR(attr_idx)); 03885 } 03886 03887 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03888 } 03889 } 03890 } 03891 03892 if (clause_allowed[directive][Local_Clause]) { 03893 /* process LOCAL var list */ 03894 03895 list_idx = list_array[MP_DIR_LOCAL_IDX]; 03896 03897 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 03898 03899 list2_idx = IL_IDX(list_idx); 03900 03901 while (list2_idx) { 03902 03903 attr_idx = IL_IDX(list2_idx); 03904 AT_LOCKED_IN(attr_idx) = TRUE; 03905 03906 while (AT_ATTR_LINK(attr_idx)) { 03907 attr_idx = AT_ATTR_LINK(attr_idx); 03908 AT_LOCKED_IN(attr_idx) = TRUE; 03909 } 03910 03911 IL_IDX(list2_idx) = attr_idx; 03912 03913 if (AT_OBJ_CLASS(attr_idx) == Data_Obj && 03914 (ATD_ALLOCATABLE(attr_idx) || 03915 ATD_CLASS(attr_idx) == CRI__Pointee || 03916 ATD_POINTER(attr_idx))) { 03917 03918 if (ATD_ALLOCATABLE(attr_idx)) { 03919 strcpy(string, "ALLOCATABLE"); 03920 } 03921 else if (ATD_POINTER(attr_idx)) { 03922 strcpy(string, "POINTER"); 03923 } 03924 else { 03925 strcpy(string, "Cray Pointee"); 03926 } 03927 03928 PRINTMSG(IL_LINE_NUM(list2_idx), 1430, Error, 03929 IL_COL_NUM(list2_idx), 03930 string, 03931 AT_OBJ_NAME_PTR(attr_idx), 03932 mp_dir_str[directive]); 03933 03934 } 03935 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 03936 ATD_CLASS(attr_idx) == Constant) { 03937 03938 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution, 03939 IL_COL_NUM(list2_idx), 03940 AT_OBJ_NAME_PTR(attr_idx), 03941 "LOCAL", mp_dir_str[directive]); 03942 03943 /* remove the attr from the list */ 03944 03945 if (list2_idx == IL_IDX(cdir_switches.private_list_idx)) { 03946 03947 /* head of the list */ 03948 03949 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03950 IL_IDX(cdir_switches.private_list_idx) = list2_idx; 03951 IL_IDX(list_idx) = list2_idx; 03952 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 03953 IL_LIST_CNT(list_idx)--; 03954 continue; 03955 } 03956 else { 03957 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 03958 IL_NEXT_LIST_IDX(list2_idx); 03959 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 03960 IL_PREV_LIST_IDX(list2_idx); 03961 03962 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 03963 IL_LIST_CNT(list_idx)--; 03964 continue; 03965 } 03966 } 03967 else if (! ATD_TASK_SHARED(attr_idx) && 03968 ! ATD_TASK_LASTLOCAL(attr_idx) && 03969 ! ATD_TASK_LASTTHREAD(attr_idx) && 03970 ! ATD_TASK_REDUCTION(attr_idx)) { 03971 03972 ATD_TASK_PRIVATE(attr_idx) = TRUE; 03973 ATD_WAS_SCOPED(attr_idx) = TRUE; 03974 03975 if (ATD_CLASS(attr_idx) == Variable && 03976 ATD_AUTOMATIC(attr_idx) && 03977 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 03978 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 03979 03980 ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 03981 03982 NTR_IR_LIST_TBL(list3_idx); 03983 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 03984 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 03985 IL_IDX(list_idx) = list3_idx; 03986 IL_LIST_CNT(list_idx)++; 03987 03988 IL_FLD(list3_idx) = AT_Tbl_Idx; 03989 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 03990 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 03991 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 03992 } 03993 } 03994 else { 03995 PRINTMSG(IL_LINE_NUM(list2_idx), 1362, Error, 03996 IL_COL_NUM(list2_idx), 03997 AT_OBJ_NAME_PTR(attr_idx)); 03998 } 03999 04000 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04001 } 04002 } 04003 } 04004 04005 if (clause_allowed[directive][Lastthread_Clause]) { 04006 list_idx = list_array[MP_DIR_LASTTHREAD_IDX]; 04007 04008 if (IL_FLD(list_idx) == AT_Tbl_Idx) { 04009 04010 attr_idx = IL_IDX(list_idx); 04011 AT_LOCKED_IN(attr_idx) = TRUE; 04012 04013 while (AT_ATTR_LINK(attr_idx)) { 04014 attr_idx = AT_ATTR_LINK(attr_idx); 04015 AT_LOCKED_IN(attr_idx) = TRUE; 04016 } 04017 04018 IL_IDX(list_idx) = attr_idx; 04019 04020 if (! ATD_TASK_PRIVATE(attr_idx) && 04021 ! ATD_TASK_LASTLOCAL(attr_idx) && 04022 ! ATD_TASK_SHARED(attr_idx) && 04023 ! ATD_TASK_REDUCTION(attr_idx)) { 04024 04025 ATD_TASK_LASTTHREAD(attr_idx) = TRUE; 04026 } 04027 else { 04028 PRINTMSG(IL_LINE_NUM(list_idx), 1362, Error, 04029 IL_COL_NUM(list_idx), 04030 AT_OBJ_NAME_PTR(attr_idx)); 04031 } 04032 } 04033 } 04034 04035 /* no calls to expr_semantics can be made before the NEST processing */ 04036 04037 if (clause_allowed[directive][Nest_Clause]) { 04038 /* process NEST var list */ 04039 04040 list_idx = list_array[MP_DIR_NEST_IDX]; 04041 04042 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 04043 04044 list2_idx = IL_IDX(list_idx); 04045 04046 while (list2_idx) { 04047 04048 attr_idx = IL_IDX(list2_idx); 04049 AT_LOCKED_IN(attr_idx) = TRUE; 04050 04051 while (AT_ATTR_LINK(attr_idx)) { 04052 attr_idx = AT_ATTR_LINK(attr_idx); 04053 AT_LOCKED_IN(attr_idx) = TRUE; 04054 } 04055 04056 if (! ATD_TASK_PRIVATE(attr_idx) && 04057 ! ATD_TASK_LASTLOCAL(attr_idx)) { 04058 04059 NTR_IR_LIST_TBL(list3_idx); 04060 IL_NEXT_LIST_IDX(list3_idx) = 04061 IL_IDX(cdir_switches.lastlocal_list_idx); 04062 if (IL_IDX(cdir_switches.lastlocal_list_idx) != NULL_IDX) { 04063 IL_PREV_LIST_IDX(IL_IDX(cdir_switches.lastlocal_list_idx)) = 04064 list3_idx; 04065 } 04066 IL_IDX(cdir_switches.lastlocal_list_idx) = list3_idx; 04067 IL_FLD(cdir_switches.lastlocal_list_idx) = IL_Tbl_Idx; 04068 IL_LIST_CNT(cdir_switches.lastlocal_list_idx)++; 04069 IL_FLD(list3_idx) = AT_Tbl_Idx; 04070 IL_IDX(list3_idx) = attr_idx; 04071 ATD_TASK_LASTLOCAL(attr_idx) = TRUE; 04072 } 04073 04074 IL_IDX(list2_idx) = attr_idx; 04075 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04076 } 04077 } 04078 } 04079 04080 if (clause_allowed[directive][Reduction_Clause]) { 04081 /* process REDUCTION var list */ 04082 04083 list_idx = list_array[MP_DIR_REDUCTION_IDX]; 04084 04085 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 04086 04087 list2_idx = IL_IDX(list_idx); 04088 04089 while (list2_idx) { 04090 04091 COPY_OPND(opnd, IL_OPND(list2_idx)); 04092 xref_state = CIF_Symbol_Reference; 04093 exp_desc.rank = 0; 04094 expr_semantics(&opnd, &exp_desc); 04095 04096 find_opnd_line_and_column(&opnd, &line, &column); 04097 attr_idx = find_left_attr(&opnd); 04098 04099 if (exp_desc.rank != 0) { 04100 PRINTMSG(line, 1363, Error, column); 04101 } 04102 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj || 04103 ATD_CLASS(attr_idx) == Constant) { 04104 04105 PRINTMSG(line, 804, Caution, column, 04106 AT_OBJ_NAME_PTR(attr_idx), 04107 "REDUCTION", mp_dir_str[directive]); 04108 04109 /* remove the attr from the list */ 04110 04111 if (list2_idx == IL_IDX(cdir_switches.reduction_list_idx)) { 04112 04113 /* head of the list */ 04114 04115 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04116 IL_IDX(cdir_switches.reduction_list_idx) = list2_idx; 04117 IL_IDX(list_idx) = list2_idx; 04118 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX; 04119 IL_LIST_CNT(list_idx)--; 04120 continue; 04121 } 04122 else { 04123 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) = 04124 IL_NEXT_LIST_IDX(list2_idx); 04125 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = 04126 IL_PREV_LIST_IDX(list2_idx); 04127 04128 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04129 IL_LIST_CNT(list_idx)--; 04130 continue; 04131 } 04132 } 04133 else if (! ATD_TASK_PRIVATE(attr_idx) && 04134 ! ATD_TASK_LASTTHREAD(attr_idx) && 04135 ! ATD_TASK_LASTLOCAL(attr_idx)) { 04136 04137 /* ATD_TASK_REDUCTION is allowed for SHARED */ 04138 04139 ATD_TASK_REDUCTION(attr_idx) = TRUE; 04140 } 04141 else { 04142 PRINTMSG(line, 1362, Error, column, 04143 AT_OBJ_NAME_PTR(attr_idx)); 04144 } 04145 04146 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04147 } 04148 } 04149 } 04150 04151 if (clause_allowed[directive][Affinity_Clause]) { 04152 /* process AFFINITY var list */ 04153 04154 list_idx = list_array[MP_DIR_AFFINITY_IDX]; 04155 04156 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 04157 04158 list2_idx = IL_IDX(list_idx); 04159 list3_idx = list_array[MP_DIR_NEST_IDX]; 04160 list3_idx = IL_IDX(list3_idx); 04161 04162 while (list2_idx) { 04163 04164 attr_idx = IL_IDX(list2_idx); 04165 AT_LOCKED_IN(attr_idx) = TRUE; 04166 04167 while (AT_ATTR_LINK(attr_idx)) { 04168 attr_idx = AT_ATTR_LINK(attr_idx); 04169 AT_LOCKED_IN(attr_idx) = TRUE; 04170 } 04171 04172 IL_IDX(list2_idx) = attr_idx; 04173 04174 if (list3_idx == NULL_IDX || 04175 IL_IDX(list3_idx) != attr_idx) { 04176 find_opnd_line_and_column(&IL_OPND(list2_idx), &line, &column); 04177 04178 PRINTMSG(line, 1417, Error, column); 04179 break; 04180 } 04181 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04182 list3_idx = IL_NEXT_LIST_IDX(list3_idx); 04183 } 04184 04185 04186 list_idx = list_array[MP_DIR_THREAD_DATA_IDX]; 04187 04188 # ifdef _DEBUG 04189 if (IL_FLD(list_idx) == NO_Tbl_Idx || 04190 IL_FLD(list_array[MP_DIR_IS_THREAD_IDX]) != CN_Tbl_Idx) { 04191 04192 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col, 04193 "THREAD/DATA list item", "mp_directive_semantics"); 04194 } 04195 # endif 04196 04197 if (compare_cn_and_value(IL_IDX(list_array[MP_DIR_IS_THREAD_IDX]), 04198 0, 04199 Eq_Opr)) { 04200 /* DATA */ 04201 COPY_OPND(opnd, IL_OPND(list_idx)); 04202 exp_desc.rank = 0; 04203 xref_state = CIF_Symbol_Reference; 04204 expr_semantics(&opnd, &exp_desc); 04205 COPY_OPND(IL_OPND(list_idx), opnd); 04206 04207 if (! exp_desc.array_elt) { 04208 /* error, must be array element */ 04209 find_opnd_line_and_column(&opnd, &line, &column); 04210 04211 PRINTMSG(line, 1372, Error, column); 04212 } 04213 04214 list2_idx = list_array[MP_DIR_ONTO_IDX]; 04215 if (IL_FLD(list2_idx) != NO_Tbl_Idx) { 04216 /* can't have ONTO with DATA affinity. */ 04217 find_opnd_line_and_column(&IL_OPND(list2_idx), &line, &column); 04218 04219 PRINTMSG(line, 1418, Error, column); 04220 } 04221 } 04222 else { 04223 /* THREAD */ 04224 COPY_OPND(opnd, IL_OPND(list_idx)); 04225 exp_desc.rank = 0; 04226 xref_state = CIF_Symbol_Reference; 04227 expr_semantics(&opnd, &exp_desc); 04228 COPY_OPND(IL_OPND(list_idx), opnd); 04229 04230 if (exp_desc.type != Integer || 04231 exp_desc.rank != 0) { 04232 /* error, must be array element */ 04233 find_opnd_line_and_column(&opnd, &line, &column); 04234 04235 PRINTMSG(line, 1371, Error, column); 04236 } 04237 } 04238 } 04239 } 04240 04241 if (clause_allowed[directive][Onto_Clause]) { 04242 /* process ONTO var list */ 04243 04244 list_idx = list_array[MP_DIR_ONTO_IDX]; 04245 04246 if (IL_FLD(list_idx) == IL_Tbl_Idx) { 04247 list_idx = IL_IDX(list_idx); 04248 04249 while (list_idx != NULL_IDX) { 04250 04251 COPY_OPND(opnd, IL_OPND(list_idx)); 04252 exp_desc.rank = 0; 04253 xref_state = CIF_Symbol_Reference; 04254 expr_semantics(&opnd, &exp_desc); 04255 COPY_OPND(IL_OPND(list_idx), opnd); 04256 04257 find_opnd_line_and_column(&opnd, &line, &column); 04258 04259 if (OPND_FLD(opnd) != CN_Tbl_Idx || 04260 exp_desc.type != Integer) { 04261 /* error, must be a constant */ 04262 PRINTMSG(line, 1368, Error, column); 04263 } 04264 else if (compare_cn_and_value(OPND_IDX(opnd), 04265 0, 04266 Lt_Opr)) { 04267 04268 /* error, must be greater than zero */ 04269 PRINTMSG(line, 1368, Error, column); 04270 } 04271 04272 list_idx = IL_NEXT_LIST_IDX(list_idx); 04273 } 04274 } 04275 } 04276 04277 04278 curr_stmt_sh_idx = save_curr_stmt_sh_idx; 04279 04280 /* restore error flag on curr_stmt_sh_idx. */ 04281 SH_ERR_FLG(orig_sh_idx) = save_error_flag; 04282 04283 04284 TRACE (Func_Exit, "mp_directive_semantics", NULL); 04285 04286 return; 04287 04288 } /* mp_directive_semantics */ 04289 04290 /******************************************************************************\ 04291 |* *| 04292 |* Description: *| 04293 |* The ir looks like this coming in ... *| 04294 |* *| 04295 |* (mp_directive_opr) *| 04296 |* / *| 04297 |* |- IF condition *| 04298 |* |- SHARE | SHARED var list *| 04299 |* |- LASTLOCAL var list *| 04300 |* |- REDUCTION var list *| 04301 |* |- MP_SCHEDTYPE value (in const table) *| 04302 |* |- CHUNK expression (also BLOCKED) *| 04303 |* |- AFFINITY index_var list *| 04304 |* |- IS THREAD constant (THREAD == 1, DATA == 0) *| 04305 |* |- THREAD/DATA list *| 04306 |* |- LOCAL | PRIVATE var list *| 04307 |* |- ONTO list *| 04308 |* |- NEST list *| 04309 |* |- LASTTHREAD opnd *| 04310 |* |- ORDERED constant (ORDERED == 1, else NO_Tbl_Idx) *| 04311 |* *| 04312 |* Not all clauses are valid for all directives. *| 04313 |* *| 04314 |* Input parameters: *| 04315 |* NONE *| 04316 |* *| 04317 |* Output parameters: *| 04318 |* NONE *| 04319 |* *| 04320 |* Returns: *| 04321 |* NOTHING *| 04322 |* *| 04323 \******************************************************************************/ 04324 04325 static void set_mp_task_flags(int ir_idx, 04326 boolean flag) 04327 04328 { 04329 int attr_idx; 04330 mp_directive_type directive; 04331 int i; 04332 int list_array[MP_DIR_LIST_CNT]; 04333 int list_idx; 04334 int list2_idx; 04335 04336 04337 TRACE (Func_Entry, "set_mp_task_flags", NULL); 04338 04339 list_idx = IR_IDX_L(ir_idx); 04340 04341 for (i = 0; i < MP_DIR_LIST_CNT; i++) { 04342 list_array[i] = list_idx; 04343 list_idx = IL_NEXT_LIST_IDX(list_idx); 04344 } 04345 04346 switch (IR_OPR(ir_idx)) { 04347 case Pdo_Par_Opr: 04348 directive = Pdo; 04349 break; 04350 04351 case Parallel_Par_Opr: 04352 directive = Parallel; 04353 break; 04354 04355 case Psection_Par_Opr: 04356 directive = Psection; 04357 break; 04358 04359 case Singleprocess_Par_Opr: 04360 directive = Singleprocess; 04361 break; 04362 04363 default: 04364 # ifdef _DEBUG 04365 PRINTMSG(IR_LINE_NUM(ir_idx), 626, Internal, IR_COL_NUM(ir_idx), 04366 "valid parallel region operator", "set_mp_task_flags"); 04367 # endif 04368 break; 04369 } 04370 04371 04372 if (clause_allowed[directive][Share_Clause]) { 04373 /* process SHARED var list */ 04374 04375 list_idx = list_array[MP_DIR_SHARE_IDX]; 04376 04377 cdir_switches.shared_list_idx = (flag ? list_idx : NULL_IDX) ; 04378 04379 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 04380 04381 list2_idx = IL_IDX(list_idx); 04382 04383 while (list2_idx) { 04384 04385 if (IL_FLD(list2_idx) == AT_Tbl_Idx && 04386 AT_OBJ_CLASS(IL_IDX(list2_idx)) == Data_Obj) { 04387 04388 ATD_TASK_SHARED(IL_IDX(list2_idx)) = flag; 04389 } 04390 04391 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04392 } 04393 } 04394 } 04395 04396 04397 if (clause_allowed[directive][Lastlocal_Clause]) { 04398 /* process LASTLOCAL var list */ 04399 04400 list_idx = list_array[MP_DIR_LASTLOCAL_IDX]; 04401 04402 cdir_switches.lastlocal_list_idx = (flag ? list_idx : NULL_IDX) ; 04403 04404 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 04405 04406 list2_idx = IL_IDX(list_idx); 04407 04408 while (list2_idx) { 04409 04410 if (IL_FLD(list2_idx) == AT_Tbl_Idx && 04411 AT_OBJ_CLASS(IL_IDX(list2_idx)) == Data_Obj) { 04412 04413 ATD_TASK_LASTLOCAL(IL_IDX(list2_idx)) = flag; 04414 } 04415 04416 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04417 } 04418 } 04419 } 04420 04421 if (clause_allowed[directive][Local_Clause]) { 04422 /* process LOCAL var list */ 04423 04424 list_idx = list_array[MP_DIR_LOCAL_IDX]; 04425 04426 cdir_switches.private_list_idx = (flag ? list_idx : NULL_IDX) ; 04427 04428 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 04429 04430 list2_idx = IL_IDX(list_idx); 04431 04432 while (list2_idx) { 04433 04434 if (IL_FLD(list2_idx) == AT_Tbl_Idx && 04435 AT_OBJ_CLASS(IL_IDX(list2_idx)) == Data_Obj) { 04436 04437 ATD_TASK_PRIVATE(IL_IDX(list2_idx)) = flag; 04438 } 04439 04440 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04441 } 04442 } 04443 } 04444 04445 if (clause_allowed[directive][Lastthread_Clause]) { 04446 /* process LASTTHREAD var list */ 04447 04448 list_idx = list_array[MP_DIR_LASTTHREAD_IDX]; 04449 04450 cdir_switches.lastthread_list_idx = (flag ? list_idx : NULL_IDX) ; 04451 04452 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 04453 04454 list2_idx = IL_IDX(list_idx); 04455 04456 while (list2_idx) { 04457 04458 if (IL_FLD(list2_idx) == AT_Tbl_Idx && 04459 AT_OBJ_CLASS(IL_IDX(list2_idx)) == Data_Obj) { 04460 04461 ATD_TASK_LASTTHREAD(IL_IDX(list2_idx)) = flag; 04462 } 04463 04464 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04465 } 04466 } 04467 } 04468 04469 if (clause_allowed[directive][Reduction_Clause]) { 04470 /* process REDUCTION var list */ 04471 04472 list_idx = list_array[MP_DIR_REDUCTION_IDX]; 04473 04474 cdir_switches.reduction_list_idx = (flag ? list_idx : NULL_IDX) ; 04475 04476 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 04477 04478 list2_idx = IL_IDX(list_idx); 04479 04480 while (list2_idx) { 04481 04482 attr_idx = find_left_attr(&IL_OPND(list2_idx)); 04483 ATD_TASK_REDUCTION(attr_idx) = flag; 04484 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 04485 } 04486 } 04487 } 04488 04489 cdir_switches.parallel_region = flag; 04490 04491 TRACE (Func_Exit, "set_mp_task_flags", NULL); 04492 04493 return; 04494 04495 } /* set_mp_task_flags */ 04496 04497 /******************************************************************************\ 04498 |* *| 04499 |* Description: *| 04500 |* This routine handles semantics for the PREFETCH_REF directive. *| 04501 |* The incoming ir looks like ... *| 04502 |* *| 04503 |* (Prefetch_Ref_Star_Opr) *| 04504 |* / *| 04505 |* |- array ref *| 04506 |* |- stride list (2) *| 04507 |* |- level list (2) *| 04508 |* |- kind *| 04509 |* |- size *| 04510 |* *| 04511 |* Input parameters: *| 04512 |* NONE *| 04513 |* *| 04514 |* Output parameters: *| 04515 |* NONE *| 04516 |* *| 04517 |* Returns: *| 04518 |* NOTHING *| 04519 |* *| 04520 \******************************************************************************/ 04521 04522 static void prefetch_ref_semantics(void) 04523 04524 { 04525 int column; 04526 expr_arg_type exp_desc; 04527 int i; 04528 int ir_idx; 04529 int line; 04530 int list_array[5]; 04531 int list_idx; 04532 opnd_type opnd; 04533 04534 04535 TRACE (Func_Entry, "prefetch_ref_semantics", NULL); 04536 04537 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 04538 04539 list_idx = IR_IDX_L(ir_idx); 04540 04541 for (i = 0; i < 5; i++) { 04542 list_array[i] = list_idx; 04543 list_idx = IL_NEXT_LIST_IDX(list_idx); 04544 } 04545 04546 /* array ref */ 04547 04548 if (IL_FLD(list_array[0]) != NO_Tbl_Idx) { 04549 COPY_OPND(opnd, IL_OPND(list_array[0])); 04550 xref_state = CIF_Symbol_Reference; 04551 exp_desc.rank = 0; 04552 expr_semantics(&opnd, &exp_desc); 04553 COPY_OPND(IL_OPND(list_array[0]), opnd); 04554 } 04555 04556 /* stride (optional) */ 04557 04558 if (IL_FLD(list_array[1]) == IL_Tbl_Idx) { 04559 list_idx = IL_IDX(list_array[1]); 04560 04561 while (list_idx != NULL_IDX) { 04562 COPY_OPND(opnd, IL_OPND(list_idx)); 04563 xref_state = CIF_Symbol_Reference; 04564 exp_desc.rank = 0; 04565 expr_semantics(&opnd, &exp_desc); 04566 COPY_OPND(IL_OPND(list_idx), opnd); 04567 04568 list_idx = IL_NEXT_LIST_IDX(list_idx); 04569 } 04570 } 04571 else { 04572 /* default = 1 */ 04573 NTR_IR_LIST_TBL(list_idx); 04574 IL_FLD(list_idx) = CN_Tbl_Idx; 04575 IL_IDX(list_idx) = CN_INTEGER_ONE_IDX; 04576 IL_LINE_NUM(list_idx) = stmt_start_line; 04577 IL_COL_NUM(list_idx) = stmt_start_col; 04578 04579 IL_FLD(list_array[1]) = IL_Tbl_Idx; 04580 IL_IDX(list_array[1]) = list_idx; 04581 IL_LIST_CNT(list_array[1]) = 1; 04582 } 04583 04584 /* level (optional) */ 04585 04586 if (IL_FLD(list_array[2]) == IL_Tbl_Idx) { 04587 list_idx = IL_IDX(list_array[2]); 04588 04589 while (list_idx != NULL_IDX) { 04590 COPY_OPND(opnd, IL_OPND(list_idx)); 04591 xref_state = CIF_Symbol_Reference; 04592 exp_desc.rank = 0; 04593 expr_semantics(&opnd, &exp_desc); 04594 COPY_OPND(IL_OPND(list_idx), opnd); 04595 04596 if (OPND_FLD(opnd) != CN_Tbl_Idx || 04597 (compare_cn_and_value(OPND_IDX(opnd), 04598 1, 04599 Ne_Opr) && 04600 compare_cn_and_value(OPND_IDX(opnd), 04601 2, 04602 Ne_Opr))) { 04603 04604 find_opnd_line_and_column(&IL_OPND(list_idx), &line, &column); 04605 PRINTMSG(line, 1384, Error, column); 04606 } 04607 04608 list_idx = IL_NEXT_LIST_IDX(list_idx); 04609 } 04610 } 04611 else { 04612 /* default = 2 */ 04613 NTR_IR_LIST_TBL(list_idx); 04614 IL_FLD(list_idx) = CN_Tbl_Idx; 04615 IL_IDX(list_idx) = CN_INTEGER_TWO_IDX; 04616 IL_LINE_NUM(list_idx) = stmt_start_line; 04617 IL_COL_NUM(list_idx) = stmt_start_col; 04618 04619 IL_FLD(list_array[2]) = IL_Tbl_Idx; 04620 IL_IDX(list_array[2]) = list_idx; 04621 IL_LIST_CNT(list_array[2]) = 1; 04622 } 04623 04624 /* don't need to look at KIND */ 04625 04626 /* size (optional) */ 04627 04628 if (IL_FLD(list_array[4]) != NO_Tbl_Idx) { 04629 COPY_OPND(opnd, IL_OPND(list_array[4])); 04630 xref_state = CIF_Symbol_Reference; 04631 exp_desc.rank = 0; 04632 expr_semantics(&opnd, &exp_desc); 04633 COPY_OPND(IL_OPND(list_array[4]), opnd); 04634 04635 if (OPND_FLD(opnd) != CN_Tbl_Idx) { 04636 find_opnd_line_and_column(&opnd, &line, &column); 04637 PRINTMSG(line, 1383, Error, column, "PREFETCH_REF"); 04638 } 04639 } 04640 04641 04642 TRACE (Func_Exit, "prefetch_ref_semantics", NULL); 04643 04644 return; 04645 04646 } /* prefetch_ref_semantics */ 04647 04648 /******************************************************************************\ 04649 |* *| 04650 |* Description: *| 04651 |* <description> *| 04652 |* *| 04653 |* Input parameters: *| 04654 |* NONE *| 04655 |* *| 04656 |* Output parameters: *| 04657 |* NONE *| 04658 |* *| 04659 |* Returns: *| 04660 |* NOTHING *| 04661 |* *| 04662 \******************************************************************************/ 04663 04664 void doall_end_semantics(void) 04665 04666 { 04667 int attr_idx; 04668 int list_idx; 04669 opnd_type opnd; 04670 04671 TRACE (Func_Entry, "doall_end_semantics", NULL); 04672 04673 cdir_switches.no_internal_calls = FALSE; 04674 cdir_switches.parallel_region = FALSE; 04675 cdir_switches.autoscope = FALSE; 04676 04677 if (cdir_switches.private_list_idx && 04678 IL_FLD(cdir_switches.private_list_idx) != NO_Tbl_Idx) { 04679 04680 list_idx = IL_IDX(cdir_switches.private_list_idx); 04681 04682 while (list_idx) { 04683 if (IL_FLD(list_idx) == AT_Tbl_Idx && 04684 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) { 04685 04686 ATD_TASK_PRIVATE(IL_IDX(list_idx)) = FALSE; 04687 } 04688 list_idx = IL_NEXT_LIST_IDX(list_idx); 04689 } 04690 } 04691 04692 if (cdir_switches.shared_list_idx && 04693 IL_FLD(cdir_switches.shared_list_idx) != NO_Tbl_Idx) { 04694 04695 list_idx = IL_IDX(cdir_switches.shared_list_idx); 04696 04697 while (list_idx) { 04698 if (IL_FLD(list_idx) == AT_Tbl_Idx && 04699 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) { 04700 04701 ATD_TASK_SHARED(IL_IDX(list_idx)) = FALSE; 04702 } 04703 else if (IL_FLD(list_idx) == AT_Tbl_Idx && 04704 AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit && 04705 ATP_PROC(IL_IDX(list_idx)) == Dummy_Proc) { 04706 04707 ATP_TASK_SHARED(IL_IDX(list_idx)) = FALSE; 04708 } 04709 list_idx = IL_NEXT_LIST_IDX(list_idx); 04710 } 04711 } 04712 04713 if (cdir_switches.getfirst_list_idx && 04714 IL_FLD(cdir_switches.getfirst_list_idx) != NO_Tbl_Idx) { 04715 04716 list_idx = IL_IDX(cdir_switches.getfirst_list_idx); 04717 04718 while (list_idx) { 04719 if (IL_FLD(list_idx) == AT_Tbl_Idx && 04720 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) { 04721 04722 ATD_TASK_GETFIRST(IL_IDX(list_idx)) = FALSE; 04723 } 04724 list_idx = IL_NEXT_LIST_IDX(list_idx); 04725 } 04726 } 04727 04728 if (cdir_switches.lastlocal_list_idx && 04729 IL_FLD(cdir_switches.lastlocal_list_idx) != NO_Tbl_Idx) { 04730 04731 list_idx = IL_IDX(cdir_switches.lastlocal_list_idx); 04732 04733 while (list_idx) { 04734 if (IL_FLD(list_idx) == AT_Tbl_Idx && 04735 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) { 04736 04737 ATD_TASK_LASTLOCAL(IL_IDX(list_idx)) = FALSE; 04738 } 04739 list_idx = IL_NEXT_LIST_IDX(list_idx); 04740 } 04741 } 04742 04743 if (cdir_switches.reduction_list_idx && 04744 IL_FLD(cdir_switches.reduction_list_idx) != NO_Tbl_Idx) { 04745 04746 list_idx = IL_IDX(cdir_switches.reduction_list_idx); 04747 04748 while (list_idx) { 04749 if (IL_FLD(list_idx) == AT_Tbl_Idx && 04750 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) { 04751 04752 ATD_TASK_REDUCTION(IL_IDX(list_idx)) = FALSE; 04753 } 04754 list_idx = IL_NEXT_LIST_IDX(list_idx); 04755 } 04756 } 04757 04758 if (cdir_switches.lastthread_list_idx && 04759 IL_FLD(cdir_switches.lastthread_list_idx) != NO_Tbl_Idx) { 04760 04761 COPY_OPND(opnd, IL_OPND(cdir_switches.lastthread_list_idx)); 04762 attr_idx = find_left_attr(&opnd); 04763 ATD_TASK_REDUCTION(attr_idx) = FALSE; 04764 } 04765 04766 cdir_switches.getfirst_list_idx = NULL_IDX; 04767 cdir_switches.private_list_idx = NULL_IDX; 04768 cdir_switches.shared_list_idx = NULL_IDX; 04769 cdir_switches.lastlocal_list_idx = NULL_IDX; 04770 cdir_switches.reduction_list_idx = NULL_IDX; 04771 cdir_switches.lastthread_list_idx = NULL_IDX; 04772 04773 wait_send_semantics(); 04774 04775 TRACE (Func_Exit, "doall_end_semantics", NULL); 04776 04777 return; 04778 04779 } /* doall_end_semantics */ 04780 04781 /******************************************************************************\ 04782 |* *| 04783 |* Description: *| 04784 |* <description> *| 04785 |* *| 04786 |* Input parameters: *| 04787 |* NONE *| 04788 |* *| 04789 |* Output parameters: *| 04790 |* NONE *| 04791 |* *| 04792 |* Returns: *| 04793 |* NOTHING *| 04794 |* *| 04795 \******************************************************************************/ 04796 04797 static boolean power_o_two(int idx) 04798 04799 { 04800 int i; 04801 int k; 04802 int cnt = 0; 04803 long_type the_constant; 04804 int words; 04805 04806 04807 TRACE (Func_Entry, "power_o_two", NULL); 04808 04809 # ifdef _DEBUG 04810 if (TYP_TYPE(CN_TYPE_IDX(idx)) != Integer) { 04811 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col, 04812 "Integer constant", "power_o_two"); 04813 } 04814 # endif 04815 04816 04817 /* BRIANJ KAYKAY */ 04818 words = num_host_wds[TYP_LINEAR(CN_TYPE_IDX(idx))]; 04819 04820 for (k = 0; k < words; k++) { 04821 the_constant = CP_CONSTANT(CN_POOL_IDX(idx) + k); 04822 04823 for (i = 0; i < TARGET_BITS_PER_WORD; i++) { 04824 if (((the_constant >> i) & 1) != 0) { 04825 cnt++; 04826 } 04827 } 04828 } 04829 04830 TRACE (Func_Exit, "power_o_two", NULL); 04831 04832 return(cnt == 1); 04833 04834 } /* power_o_two */ 04835 04836 /******************************************************************************\ 04837 |* *| 04838 |* Description: *| 04839 |* <description> *| 04840 |* *| 04841 |* Input parameters: *| 04842 |* NONE *| 04843 |* *| 04844 |* Output parameters: *| 04845 |* NONE *| 04846 |* *| 04847 |* Returns: *| 04848 |* NOTHING *| 04849 |* *| 04850 \******************************************************************************/ 04851 04852 static boolean assert_semantics(void) 04853 04854 { 04855 int attr_idx; 04856 int ir_idx; 04857 int list_idx; 04858 boolean ok = TRUE; 04859 04860 04861 TRACE (Func_Entry, "assert_semantics", NULL); 04862 04863 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 04864 04865 switch (CN_INT_TO_C(IR_IDX_L(ir_idx))) { 04866 case ASSERT_NORECURRENCE: 04867 list_idx = IR_IDX_R(ir_idx); 04868 while (list_idx) { 04869 attr_idx = IL_IDX(list_idx); 04870 AT_LOCKED_IN(attr_idx) = TRUE; 04871 04872 while (AT_ATTR_LINK(attr_idx)) { 04873 attr_idx = AT_ATTR_LINK(attr_idx); 04874 AT_LOCKED_IN(attr_idx) = TRUE; 04875 } 04876 04877 IL_IDX(list_idx) = attr_idx; 04878 04879 list_idx = IL_NEXT_LIST_IDX(list_idx); 04880 } 04881 break; 04882 04883 case ASSERT_DOPREFER: 04884 case ASSERT_DO: 04885 break; 04886 04887 case ASSERT_PERMUTATION: 04888 attr_idx = IR_IDX_R(ir_idx); 04889 while (AT_ATTR_LINK(attr_idx)) { 04890 attr_idx = AT_ATTR_LINK(attr_idx); 04891 AT_LOCKED_IN(attr_idx) = TRUE; 04892 } 04893 04894 IR_IDX_R(ir_idx) = attr_idx; 04895 break; 04896 04897 case ASSERT_ARGUMENTALIASING: 04898 case ASSERT_NOARGUMENTALIASING: 04899 case ASSERT_BOUNDSVIOLATIONS: 04900 case ASSERT_NOBOUNDSVIOLATIONS: 04901 case ASSERT_CONCURRENTCALL: 04902 case ASSERT_NOCONCURRENTCALL: 04903 case ASSERT_EQUIVALENCEHAZARD: 04904 case ASSERT_NOEQUIVALENCEHAZARD: 04905 case ASSERT_LASTVALUENEEDED: 04906 case ASSERT_LASTVALUESNEEDED: 04907 case ASSERT_NOLASTVALUENEEDED: 04908 case ASSERT_NOLASTVALUESNEEDED: 04909 case ASSERT_RELATION: 04910 case ASSERT_NOSYNC: 04911 case ASSERT_TEMPORARIESFORCONSTANTARGUMENTS: 04912 case ASSERT_NOTEMPORARIESFORCONSTANTARGUMENTS: 04913 case ASSERT_BENIGN: 04914 case ASSERT_DEPENDENCE: 04915 case ASSERT_FREQUENCY: 04916 case ASSERT_IGNOREANYDEPENDENCES: 04917 case ASSERT_IGNOREANYDEPENDENCE: 04918 case ASSERT_IGNOREASSUMEDDEPENDENCES: 04919 case ASSERT_IGNOREASSUMEDDEPENDENCE: 04920 case ASSERT_NOINTERCHANGE: 04921 case ASSERT_USECOMPRESS: 04922 case ASSERT_USEEXPAND: 04923 case ASSERT_USECONTROLLEDSTORE: 04924 case ASSERT_USEGATHER: 04925 case ASSERT_USESCATTER: 04926 /* intentionally blank */ 04927 break; 04928 } 04929 04930 TRACE (Func_Exit, "assert_semantics", NULL); 04931 04932 return(ok); 04933 04934 } /* assert_semantics */ 04935 04936 /******************************************************************************\ 04937 |* *| 04938 |* Description: *| 04939 |* The ir looks like this coming in ... *| 04940 |* *| 04941 |* (open mp directive operator) *| 04942 |* / *| 04943 |* |- IF condition *| 04944 |* |- PRIVATE var list *| 04945 |* |- SHARED var list *| 04946 |* |- FIRSTPRIVATE var list *| 04947 |* |- DEFAULT scope value (CN_Tbl_Idx) *| 04948 |* |- COPYIN var list *| 04949 |* |- REDUCTION opr | intrinsic list *| 04950 |* |- REDUCTION var list list *| 04951 |* |- LASTPRIVATE var list *| 04952 |* |- ORDERED constant (ORDERED == 1, else NO_Tbl_Idx) *| 04953 |* |- SCHEDULE type (CN_Tbl_Idx) *| 04954 |* |- SCHEDULE chunk (CN_Tbl_Idx) *| 04955 |* |- COPYPRIVATE var list *| 04956 |* |- AFFINITY index_var list *| 04957 |* |- IS THREAD constant (THREAD == 1, DATA == 0) *| 04958 |* |- THREAD/DATA list *| 04959 |* |- ONTO list *| 04960 |* |- NEST list *| 04961 |* |- FLUSH var list *| 04962 |* *| 04963 |* Not all clauses are valid for all directives. *| 04964 |* *| 04965 |* Input parameters: *| 04966 |* NONE *| 04967 |* *| 04968 |* Output parameters: *| 04969 |* NONE *| 04970 |* *| 04971 |* Returns: *| 04972 |* NOTHING *| 04973 |* *| 04974 \******************************************************************************/ 04975 04976 static void open_mp_directive_semantics(open_mp_directive_type directive) 04977 04978 { 04979 int attr_idx; 04980 int column; 04981 expr_arg_type exp_desc; 04982 int i; 04983 int idx; 04984 int ir_idx; 04985 int line; 04986 int list_array[OPEN_MP_LIST_CNT]; 04987 int list_idx; 04988 int list2_idx; 04989 int list3_idx; 04990 opnd_type l_opnd; 04991 boolean ok; 04992 opnd_type opnd; 04993 int orig_sh_idx; 04994 int save_curr_stmt_sh_idx; 04995 boolean save_error_flag; 04996 boolean work_sharing_dir = FALSE; 04997 long64 value; 04998 04999 05000 TRACE (Func_Entry, "open_mp_directive_semantics", NULL); 05001 05002 05003 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 05004 save_curr_stmt_sh_idx = curr_stmt_sh_idx; 05005 orig_sh_idx = curr_stmt_sh_idx; 05006 save_error_flag = SH_ERR_FLG(curr_stmt_sh_idx); 05007 05008 list_idx = IR_IDX_L(ir_idx); 05009 05010 for (i = 0; i < OPEN_MP_LIST_CNT; i++) { 05011 list_array[i] = list_idx; 05012 list_idx = IL_NEXT_LIST_IDX(list_idx); 05013 } 05014 05015 if (directive == Do_Omp || 05016 directive == Sections_Omp || 05017 directive == Single_Omp) { 05018 05019 work_sharing_dir = TRUE; 05020 } 05021 05022 if (directive == Do_Omp || 05023 directive == Parallel_Do_Omp) { 05024 05025 /* pull stmt header out of list */ 05026 remove_sh(curr_stmt_sh_idx); 05027 save_curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx); 05028 05029 switch (directive) { 05030 case Do_Omp: 05031 cdir_switches.do_omp_sh_idx = curr_stmt_sh_idx; 05032 SH_PREV_IDX(cdir_switches.do_omp_sh_idx) = NULL_IDX; 05033 SH_NEXT_IDX(cdir_switches.do_omp_sh_idx) = NULL_IDX; 05034 break; 05035 05036 case Parallel_Do_Omp: 05037 cdir_switches.paralleldo_omp_sh_idx = curr_stmt_sh_idx; 05038 SH_PREV_IDX(cdir_switches.paralleldo_omp_sh_idx) = NULL_IDX; 05039 SH_NEXT_IDX(cdir_switches.paralleldo_omp_sh_idx) = NULL_IDX; 05040 break; 05041 } 05042 } 05043 05044 /* process the clauses that capture an expression with create_tmp_asg */ 05045 /* first (before push_task_blk) so that any temps get placed on the */ 05046 /* private (or shared) lists of containing parallel blocks. */ 05047 05048 if (open_mp_clause_allowed[directive][If_Omp_Clause]) { 05049 list_idx = list_array[OPEN_MP_IF_IDX]; 05050 05051 /* process IF condition */ 05052 05053 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05054 COPY_OPND(opnd, IL_OPND(list_idx)); 05055 exp_desc.rank = 0; 05056 xref_state = CIF_Symbol_Reference; 05057 expr_semantics(&opnd, &exp_desc); 05058 05059 find_opnd_line_and_column(&opnd, &line, &column); 05060 if (exp_desc.type != Logical || 05061 exp_desc.rank != 0) { 05062 PRINTMSG(line, 1511, Error, column); 05063 } 05064 05065 IL_FLD(list_idx) = AT_Tbl_Idx; 05066 idx = create_tmp_asg(&opnd, 05067 &exp_desc, 05068 &l_opnd, 05069 Intent_In, 05070 FALSE, 05071 FALSE); 05072 IL_IDX(list_idx) = idx; 05073 IL_LINE_NUM(list_idx) = line; 05074 IL_COL_NUM(list_idx) = column; 05075 } 05076 } 05077 05078 if (open_mp_clause_allowed[directive][Schedule_Omp_Clause]) { 05079 /* process SCHEDULE CHUNK expression */ 05080 05081 list_idx = list_array[OPEN_MP_SCHEDULE_CHUNK_IDX]; 05082 list2_idx = list_array[OPEN_MP_SCHEDULE_TYPE_IDX]; 05083 05084 if (IL_FLD(list2_idx) != NO_Tbl_Idx) { 05085 value = CN_INT_TO_C(IL_IDX(list2_idx)); 05086 05087 switch (value) { 05088 case OPEN_MP_SCHEDULE_STATIC: 05089 break; 05090 05091 case OPEN_MP_SCHEDULE_DYNAMIC: 05092 if (IL_FLD(list_idx) == NO_Tbl_Idx) { 05093 IL_FLD(list_idx) = CN_Tbl_Idx; 05094 IL_IDX(list_idx) = CN_INTEGER_ONE_IDX; 05095 IL_LINE_NUM(list_idx) = IL_LINE_NUM(list2_idx); 05096 IL_COL_NUM(list_idx) = IL_COL_NUM(list2_idx); 05097 } 05098 break; 05099 05100 case OPEN_MP_SCHEDULE_GUIDED: 05101 if (IL_FLD(list_idx) == NO_Tbl_Idx) { 05102 IL_FLD(list_idx) = CN_Tbl_Idx; 05103 IL_IDX(list_idx) = CN_INTEGER_ONE_IDX; 05104 IL_LINE_NUM(list_idx) = IL_LINE_NUM(list2_idx); 05105 IL_COL_NUM(list_idx) = IL_COL_NUM(list2_idx); 05106 } 05107 break; 05108 05109 case OPEN_MP_SCHEDULE_RUNTIME: 05110 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05111 find_opnd_line_and_column(&IL_OPND(list_idx), &line, &column); 05112 PRINTMSG(line, 1475, Error, column); 05113 } 05114 break; 05115 05116 } 05117 05118 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05119 COPY_OPND(opnd, IL_OPND(list_idx)); 05120 exp_desc.rank = 0; 05121 xref_state = CIF_Symbol_Reference; 05122 ok = expr_semantics(&opnd, &exp_desc); 05123 05124 find_opnd_line_and_column(&opnd, &line, &column); 05125 05126 if (exp_desc.type != Integer || 05127 exp_desc.rank != 0) { 05128 PRINTMSG(line, 1364, Error, column); 05129 } 05130 else if (OPND_FLD(opnd) == CN_Tbl_Idx && 05131 compare_cn_and_value(OPND_IDX(opnd), 05132 0, 05133 Le_Opr)) { 05134 05135 PRINTMSG(line, 1560, Error, column); 05136 } 05137 05138 IL_FLD(list_idx) = AT_Tbl_Idx; 05139 idx = create_tmp_asg(&opnd, 05140 &exp_desc, 05141 &l_opnd, 05142 Intent_In, 05143 FALSE, 05144 FALSE); 05145 IL_IDX(list_idx) = idx; 05146 IL_LINE_NUM(list_idx) = line; 05147 IL_COL_NUM(list_idx) = column; 05148 } 05149 } 05150 } 05151 05152 if (directive != Do_Omp && 05153 directive != Parallel_Do_Omp) { 05154 cdir_switches.parallel_region = TRUE; 05155 } 05156 05157 push_task_blk(curr_stmt_sh_idx); 05158 05159 if (open_mp_clause_allowed[directive][Shared_Omp_Clause]) { 05160 /* process SHARED var list */ 05161 05162 list_idx = list_array[OPEN_MP_SHARED_IDX]; 05163 cdir_switches.shared_list_idx = list_idx; 05164 05165 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05166 05167 list2_idx = IL_IDX(list_idx); 05168 05169 while (list2_idx) { 05170 05171 attr_idx = IL_IDX(list2_idx); 05172 AT_LOCKED_IN(attr_idx) = TRUE; 05173 05174 while (AT_ATTR_LINK(attr_idx)) { 05175 attr_idx = AT_ATTR_LINK(attr_idx); 05176 AT_LOCKED_IN(attr_idx) = TRUE; 05177 } 05178 05179 IL_IDX(list2_idx) = attr_idx; 05180 05181 05182 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 05183 ATP_PROC(attr_idx) == Dummy_Proc) { 05184 ATP_TASK_SHARED(attr_idx) = TRUE; 05185 } 05186 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 05187 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05188 IL_COL_NUM(list2_idx), 05189 AT_OBJ_NAME_PTR(attr_idx), 05190 "SHARED", open_mp_dir_str[directive]); 05191 } 05192 else if (ATD_CLASS(attr_idx) == Constant) { 05193 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05194 IL_COL_NUM(list2_idx), 05195 AT_OBJ_NAME_PTR(attr_idx), 05196 "SHARED", open_mp_dir_str[directive]); 05197 } 05198 else if (AT_OBJ_CLASS(attr_idx) == Data_Obj && 05199 ATD_CLASS(attr_idx) == CRI__Pointee) { 05200 PRINTMSG(IL_LINE_NUM(list2_idx), 1477, Error, 05201 IL_COL_NUM(list2_idx), 05202 AT_OBJ_NAME_PTR(attr_idx)); 05203 } 05204 else if (multiple_clause_err(attr_idx, OPEN_MP_SHARED_IDX)) { 05205 PRINTMSG(IL_LINE_NUM(list2_idx), 1476, Error, 05206 IL_COL_NUM(list2_idx), 05207 AT_OBJ_NAME_PTR(attr_idx)); 05208 } 05209 else { 05210 ATD_TASK_SHARED(attr_idx) = TRUE; 05211 ATD_WAS_SCOPED(attr_idx) = TRUE; 05212 05213 if (ATD_CLASS(attr_idx) == Variable && 05214 ATD_AUTOMATIC(attr_idx) && 05215 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 05216 ! ATD_TASK_SHARED(ATD_AUTO_BASE_IDX(attr_idx))) { 05217 05218 ATD_TASK_SHARED(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 05219 05220 NTR_IR_LIST_TBL(list3_idx); 05221 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 05222 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 05223 IL_IDX(list_idx) = list3_idx; 05224 IL_LIST_CNT(list_idx)++; 05225 05226 IL_FLD(list3_idx) = AT_Tbl_Idx; 05227 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 05228 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 05229 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 05230 } 05231 } 05232 05233 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 05234 } 05235 } 05236 } 05237 05238 if (open_mp_clause_allowed[directive][Private_Omp_Clause]) { 05239 /* process PRIVATE var list */ 05240 05241 list_idx = list_array[OPEN_MP_PRIVATE_IDX]; 05242 cdir_switches.private_list_idx = list_idx; 05243 05244 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05245 05246 list2_idx = IL_IDX(list_idx); 05247 05248 while (list2_idx) { 05249 05250 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 05251 attr_idx = IL_IDX(list2_idx); 05252 AT_LOCKED_IN(attr_idx) = TRUE; 05253 05254 while (AT_ATTR_LINK(attr_idx)) { 05255 attr_idx = AT_ATTR_LINK(attr_idx); 05256 AT_LOCKED_IN(attr_idx) = TRUE; 05257 } 05258 05259 IL_IDX(list2_idx) = attr_idx; 05260 05261 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 05262 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05263 IL_COL_NUM(list2_idx), 05264 AT_OBJ_NAME_PTR(attr_idx), 05265 "PRIVATE", open_mp_dir_str[directive]); 05266 } 05267 else if (ATD_CLASS(attr_idx) == Constant) { 05268 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05269 IL_COL_NUM(list2_idx), 05270 AT_OBJ_NAME_PTR(attr_idx), 05271 "PRIVATE", open_mp_dir_str[directive]); 05272 } 05273 else if (ATD_CLASS(attr_idx) == CRI__Pointee) { 05274 PRINTMSG(IL_LINE_NUM(list2_idx), 1477, Error, 05275 IL_COL_NUM(list2_idx), 05276 AT_OBJ_NAME_PTR(attr_idx)); 05277 } 05278 else if (ATD_ARRAY_IDX(attr_idx) != NULL_IDX && 05279 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05280 Assumed_Size || 05281 BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05282 Assumed_Shape)) { 05283 05284 PRINTMSG(IL_LINE_NUM(list2_idx), 1482, Error, 05285 IL_COL_NUM(list2_idx), 05286 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05287 Assumed_Size ? "Assumed size" : "Assumed shape"), 05288 AT_OBJ_NAME_PTR(attr_idx)); 05289 } 05290 else if (multiple_clause_err(attr_idx, OPEN_MP_PRIVATE_IDX)) { 05291 PRINTMSG(IL_LINE_NUM(list2_idx), 1476, Error, 05292 IL_COL_NUM(list2_idx), 05293 AT_OBJ_NAME_PTR(attr_idx)); 05294 } 05295 else if (work_sharing_dir && 05296 has_been_reprivatized(attr_idx)) { 05297 PRINTMSG(IL_LINE_NUM(list2_idx), 1651, Error, 05298 IL_COL_NUM(list2_idx), 05299 "Privatized", 05300 AT_OBJ_NAME_PTR(attr_idx)); 05301 } 05302 else if (ATD_CLASS(attr_idx) == Dummy_Argument && 05303 ATD_INTENT(attr_idx) == Intent_In) { 05304 PRINTMSG(IL_LINE_NUM(list2_idx), 1492, Error, 05305 IL_COL_NUM(list2_idx), 05306 AT_OBJ_NAME_PTR(attr_idx), 05307 "PRIVATE"); 05308 } 05309 else if (ATD_PURE(attr_idx)) { 05310 PRINTMSG(IL_LINE_NUM(list2_idx), 1493, Error, 05311 IL_COL_NUM(list2_idx), 05312 AT_OBJ_NAME_PTR(attr_idx), 05313 "PRIVATE"); 05314 } 05315 else { 05316 ATD_TASK_PRIVATE(attr_idx) = TRUE; 05317 ATD_WAS_SCOPED(attr_idx) = TRUE; 05318 05319 if (ATD_CLASS(attr_idx) == Variable && 05320 ATD_AUTOMATIC(attr_idx) && 05321 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 05322 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 05323 05324 ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 05325 05326 NTR_IR_LIST_TBL(list3_idx); 05327 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 05328 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 05329 IL_IDX(list_idx) = list3_idx; 05330 IL_LIST_CNT(list_idx)++; 05331 05332 IL_FLD(list3_idx) = AT_Tbl_Idx; 05333 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 05334 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 05335 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 05336 } 05337 } 05338 } 05339 else { 05340 /* SB_Tbl_Idx here */ 05341 add_common_blk_objects_to_list(list2_idx, list_idx); 05342 } 05343 05344 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 05345 } 05346 } 05347 } 05348 05349 if (open_mp_clause_allowed[directive][Firstprivate_Omp_Clause]) { 05350 /* process FIRSTPRIVATE var list */ 05351 05352 list_idx = list_array[OPEN_MP_FIRSTPRIVATE_IDX]; 05353 cdir_switches.firstprivate_list_idx = list_idx; 05354 05355 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05356 05357 list2_idx = IL_IDX(list_idx); 05358 05359 while (list2_idx) { 05360 05361 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 05362 attr_idx = IL_IDX(list2_idx); 05363 AT_LOCKED_IN(attr_idx) = TRUE; 05364 05365 while (AT_ATTR_LINK(attr_idx)) { 05366 attr_idx = AT_ATTR_LINK(attr_idx); 05367 AT_LOCKED_IN(attr_idx) = TRUE; 05368 } 05369 05370 IL_IDX(list2_idx) = attr_idx; 05371 05372 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 05373 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05374 IL_COL_NUM(list2_idx), 05375 AT_OBJ_NAME_PTR(attr_idx), 05376 "FIRSTPRIVATE", open_mp_dir_str[directive]); 05377 } 05378 else if (ATD_CLASS(attr_idx) == Constant) { 05379 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05380 IL_COL_NUM(list2_idx), 05381 AT_OBJ_NAME_PTR(attr_idx), 05382 "FIRSTPRIVATE", open_mp_dir_str[directive]); 05383 } 05384 else if (ATD_CLASS(attr_idx) == CRI__Pointee) { 05385 PRINTMSG(IL_LINE_NUM(list2_idx), 1477, Error, 05386 IL_COL_NUM(list2_idx), 05387 AT_OBJ_NAME_PTR(attr_idx)); 05388 } 05389 else if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ptr || 05390 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ch_Ptr) { 05391 05392 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05393 IL_COL_NUM(list2_idx), 05394 "Cray pointer", 05395 AT_OBJ_NAME_PTR(attr_idx)); 05396 } 05397 else if (ATD_POINTER(attr_idx)) { 05398 05399 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05400 IL_COL_NUM(list2_idx), 05401 "Pointer", 05402 AT_OBJ_NAME_PTR(attr_idx)); 05403 } 05404 else if (ATD_ALLOCATABLE(attr_idx)) { 05405 05406 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05407 IL_COL_NUM(list2_idx), 05408 "Allocatable array", 05409 AT_OBJ_NAME_PTR(attr_idx)); 05410 } 05411 else if (ATD_ARRAY_IDX(attr_idx) != NULL_IDX && 05412 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05413 Assumed_Size || 05414 BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05415 Assumed_Shape)) { 05416 05417 PRINTMSG(IL_LINE_NUM(list2_idx), 1482, Error, 05418 IL_COL_NUM(list2_idx), 05419 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05420 Assumed_Size ? 05421 "Assumed size" : "Assumed shape"), 05422 AT_OBJ_NAME_PTR(attr_idx)); 05423 } 05424 else if (multiple_clause_err(attr_idx, 05425 OPEN_MP_FIRSTPRIVATE_IDX)) { 05426 PRINTMSG(IL_LINE_NUM(list2_idx), 1476, Error, 05427 IL_COL_NUM(list2_idx), 05428 AT_OBJ_NAME_PTR(attr_idx)); 05429 } 05430 else if (work_sharing_dir && 05431 has_been_reprivatized(attr_idx)) { 05432 PRINTMSG(IL_LINE_NUM(list2_idx), 1651, Error, 05433 IL_COL_NUM(list2_idx), 05434 "Privatized", 05435 AT_OBJ_NAME_PTR(attr_idx)); 05436 } 05437 else if (ATD_CLASS(attr_idx) == Dummy_Argument && 05438 ATD_INTENT(attr_idx) == Intent_In) { 05439 PRINTMSG(IL_LINE_NUM(list2_idx), 1492, Error, 05440 IL_COL_NUM(list2_idx), 05441 AT_OBJ_NAME_PTR(attr_idx), 05442 "FIRSTPRIVATE"); 05443 } 05444 else if (ATD_PURE(attr_idx)) { 05445 PRINTMSG(IL_LINE_NUM(list2_idx), 1493, Error, 05446 IL_COL_NUM(list2_idx), 05447 AT_OBJ_NAME_PTR(attr_idx), 05448 "FIRSTPRIVATE"); 05449 } 05450 else { 05451 ATD_TASK_FIRSTPRIVATE(attr_idx) = TRUE; 05452 05453 if (ATD_CLASS(attr_idx) == Variable && 05454 ATD_AUTOMATIC(attr_idx) && 05455 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 05456 ! ATD_TASK_FIRSTPRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 05457 05458 ATD_TASK_FIRSTPRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 05459 05460 NTR_IR_LIST_TBL(list3_idx); 05461 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 05462 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 05463 IL_IDX(list_idx) = list3_idx; 05464 IL_LIST_CNT(list_idx)++; 05465 05466 IL_FLD(list3_idx) = AT_Tbl_Idx; 05467 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 05468 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 05469 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 05470 } 05471 } 05472 } 05473 else { 05474 /* SB_Tbl_Idx here */ 05475 add_common_blk_objects_to_list(list2_idx, list_idx); 05476 } 05477 05478 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 05479 } 05480 } 05481 } 05482 05483 if (open_mp_clause_allowed[directive][Copyin_Omp_Clause]) { 05484 /* process COPYIN var list */ 05485 05486 list_idx = list_array[OPEN_MP_COPYIN_IDX]; 05487 cdir_switches.copyin_list_idx = list_idx; 05488 05489 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05490 05491 list2_idx = IL_IDX(list_idx); 05492 05493 while (list2_idx) { 05494 05495 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 05496 attr_idx = IL_IDX(list2_idx); 05497 AT_LOCKED_IN(attr_idx) = TRUE; 05498 05499 while (AT_ATTR_LINK(attr_idx)) { 05500 attr_idx = AT_ATTR_LINK(attr_idx); 05501 AT_LOCKED_IN(attr_idx) = TRUE; 05502 } 05503 05504 IL_IDX(list2_idx) = attr_idx; 05505 05506 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 05507 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05508 IL_COL_NUM(list2_idx), 05509 AT_OBJ_NAME_PTR(attr_idx), 05510 "COPYIN", open_mp_dir_str[directive]); 05511 } 05512 else if (ATD_CLASS(attr_idx) == Constant) { 05513 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05514 IL_COL_NUM(list2_idx), 05515 AT_OBJ_NAME_PTR(attr_idx), 05516 "COPYIN", open_mp_dir_str[directive]); 05517 } 05518 else if (ATD_CLASS(attr_idx) == CRI__Pointee) { 05519 PRINTMSG(IL_LINE_NUM(list2_idx), 1477, Error, 05520 IL_COL_NUM(list2_idx), 05521 AT_OBJ_NAME_PTR(attr_idx)); 05522 } 05523 else if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ptr || 05524 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ch_Ptr) { 05525 05526 PRINTMSG(IL_LINE_NUM(list2_idx), 1484, Error, 05527 IL_COL_NUM(list2_idx), 05528 "Cray pointer", 05529 AT_OBJ_NAME_PTR(attr_idx), 05530 open_mp_dir_str[directive]); 05531 } 05532 else if (ATD_POINTER(attr_idx)) { 05533 05534 PRINTMSG(IL_LINE_NUM(list2_idx), 1484, Error, 05535 IL_COL_NUM(list2_idx), 05536 "Pointer", 05537 AT_OBJ_NAME_PTR(attr_idx), 05538 open_mp_dir_str[directive]); 05539 } 05540 else if (ATD_ALLOCATABLE(attr_idx)) { 05541 05542 PRINTMSG(IL_LINE_NUM(list2_idx), 1484, Error, 05543 IL_COL_NUM(list2_idx), 05544 "Allocatable array", 05545 AT_OBJ_NAME_PTR(attr_idx), 05546 open_mp_dir_str[directive]); 05547 } 05548 else if (multiple_clause_err(attr_idx, OPEN_MP_COPYIN_IDX)) { 05549 PRINTMSG(IL_LINE_NUM(list2_idx), 1476, Error, 05550 IL_COL_NUM(list2_idx), 05551 AT_OBJ_NAME_PTR(attr_idx)); 05552 } 05553 else { 05554 ATD_TASK_COPYIN(attr_idx) = TRUE; 05555 05556 if (ATD_CLASS(attr_idx) == Variable && 05557 ATD_AUTOMATIC(attr_idx) && 05558 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 05559 ! ATD_TASK_COPYIN(ATD_AUTO_BASE_IDX(attr_idx))) { 05560 05561 ATD_TASK_COPYIN(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 05562 05563 NTR_IR_LIST_TBL(list3_idx); 05564 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 05565 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 05566 IL_IDX(list_idx) = list3_idx; 05567 IL_LIST_CNT(list_idx)++; 05568 05569 IL_FLD(list3_idx) = AT_Tbl_Idx; 05570 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 05571 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 05572 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 05573 } 05574 } 05575 } 05576 else { 05577 /* SB_Tbl_Idx here */ 05578 add_common_blk_objects_to_list(list2_idx, list_idx); 05579 } 05580 05581 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 05582 } 05583 } 05584 } 05585 05586 if (open_mp_clause_allowed[directive][Lastprivate_Omp_Clause]) { 05587 /* process LASTPRIVATE var list */ 05588 05589 list_idx = list_array[OPEN_MP_LASTPRIVATE_IDX]; 05590 cdir_switches.lastprivate_list_idx = list_idx; 05591 05592 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05593 05594 list2_idx = IL_IDX(list_idx); 05595 05596 while (list2_idx) { 05597 05598 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 05599 attr_idx = IL_IDX(list2_idx); 05600 AT_LOCKED_IN(attr_idx) = TRUE; 05601 05602 while (AT_ATTR_LINK(attr_idx)) { 05603 attr_idx = AT_ATTR_LINK(attr_idx); 05604 AT_LOCKED_IN(attr_idx) = TRUE; 05605 } 05606 05607 IL_IDX(list2_idx) = attr_idx; 05608 05609 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 05610 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05611 IL_COL_NUM(list2_idx), 05612 AT_OBJ_NAME_PTR(attr_idx), 05613 "LASTPRIVATE", open_mp_dir_str[directive]); 05614 } 05615 else if (ATD_CLASS(attr_idx) == Constant) { 05616 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05617 IL_COL_NUM(list2_idx), 05618 AT_OBJ_NAME_PTR(attr_idx), 05619 "LASTPRIVATE", open_mp_dir_str[directive]); 05620 } 05621 else if (ATD_CLASS(attr_idx) == CRI__Pointee) { 05622 PRINTMSG(IL_LINE_NUM(list2_idx), 1477, Error, 05623 IL_COL_NUM(list2_idx), 05624 AT_OBJ_NAME_PTR(attr_idx)); 05625 } 05626 else if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ptr || 05627 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ch_Ptr) { 05628 05629 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05630 IL_COL_NUM(list2_idx), 05631 "Cray pointer", 05632 AT_OBJ_NAME_PTR(attr_idx)); 05633 } 05634 else if (ATD_POINTER(attr_idx)) { 05635 05636 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05637 IL_COL_NUM(list2_idx), 05638 "Pointer", 05639 AT_OBJ_NAME_PTR(attr_idx)); 05640 } 05641 else if (ATD_ALLOCATABLE(attr_idx)) { 05642 05643 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05644 IL_COL_NUM(list2_idx), 05645 "Allocatable array", 05646 AT_OBJ_NAME_PTR(attr_idx)); 05647 } 05648 else if (ATD_ARRAY_IDX(attr_idx) != NULL_IDX && 05649 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05650 Assumed_Size || 05651 BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05652 Assumed_Shape)) { 05653 05654 PRINTMSG(IL_LINE_NUM(list2_idx), 1482, Error, 05655 IL_COL_NUM(list2_idx), 05656 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05657 Assumed_Size ? 05658 "Assumed size" : "Assumed shape"), 05659 AT_OBJ_NAME_PTR(attr_idx)); 05660 } 05661 else if (multiple_clause_err(attr_idx, OPEN_MP_LASTPRIVATE_IDX)){ 05662 PRINTMSG(IL_LINE_NUM(list2_idx), 1476, Error, 05663 IL_COL_NUM(list2_idx), 05664 AT_OBJ_NAME_PTR(attr_idx)); 05665 } 05666 else if (work_sharing_dir && 05667 has_been_reprivatized(attr_idx)) { 05668 PRINTMSG(IL_LINE_NUM(list2_idx), 1651, Error, 05669 IL_COL_NUM(list2_idx), 05670 "Privatized", 05671 AT_OBJ_NAME_PTR(attr_idx)); 05672 } 05673 else if (ATD_CLASS(attr_idx) == Dummy_Argument && 05674 ATD_INTENT(attr_idx) == Intent_In) { 05675 PRINTMSG(IL_LINE_NUM(list2_idx), 1492, Error, 05676 IL_COL_NUM(list2_idx), 05677 AT_OBJ_NAME_PTR(attr_idx), 05678 "LASTPRIVATE"); 05679 } 05680 else if (ATD_PURE(attr_idx)) { 05681 PRINTMSG(IL_LINE_NUM(list2_idx), 1493, Error, 05682 IL_COL_NUM(list2_idx), 05683 AT_OBJ_NAME_PTR(attr_idx), 05684 "LASTPRIVATE"); 05685 } 05686 else { 05687 ATD_TASK_LASTPRIVATE(attr_idx) = TRUE; 05688 05689 if (ATD_CLASS(attr_idx) == Variable && 05690 ATD_AUTOMATIC(attr_idx) && 05691 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 05692 ! ATD_TASK_LASTPRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 05693 05694 ATD_TASK_LASTPRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 05695 05696 NTR_IR_LIST_TBL(list3_idx); 05697 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 05698 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 05699 IL_IDX(list_idx) = list3_idx; 05700 IL_LIST_CNT(list_idx)++; 05701 05702 IL_FLD(list3_idx) = AT_Tbl_Idx; 05703 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 05704 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 05705 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 05706 } 05707 } 05708 } 05709 else { 05710 /* SB_Tbl_Idx here */ 05711 add_common_blk_objects_to_list(list2_idx, list_idx); 05712 } 05713 05714 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 05715 } 05716 } 05717 } 05718 05719 if (open_mp_clause_allowed[directive][Reduction_Omp_Clause]) { 05720 /* process REDUCTION var list */ 05721 05722 list_idx = list_array[OPEN_MP_REDUCTION_LIST_IDX]; 05723 cdir_switches.reduction_list_idx = list_idx; 05724 05725 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05726 05727 list_idx = IL_IDX(list_idx); 05728 while (list_idx) { 05729 05730 list2_idx = IL_IDX(list_idx); 05731 05732 while (list2_idx) { 05733 05734 attr_idx = IL_IDX(list2_idx); 05735 AT_LOCKED_IN(attr_idx) = TRUE; 05736 05737 while (AT_ATTR_LINK(attr_idx)) { 05738 attr_idx = AT_ATTR_LINK(attr_idx); 05739 AT_LOCKED_IN(attr_idx) = TRUE; 05740 } 05741 05742 IL_IDX(list2_idx) = attr_idx; 05743 05744 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 05745 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05746 IL_COL_NUM(list2_idx), 05747 AT_OBJ_NAME_PTR(attr_idx), 05748 "REDUCTION", open_mp_dir_str[directive]); 05749 } 05750 else if (ATD_CLASS(attr_idx) == Constant) { 05751 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05752 IL_COL_NUM(list2_idx), 05753 AT_OBJ_NAME_PTR(attr_idx), 05754 "REDUCTION", open_mp_dir_str[directive]); 05755 } 05756 else if (ATD_ARRAY_IDX(attr_idx) != NULL_IDX) { 05757 PRINTMSG(IL_LINE_NUM(list2_idx), 1483, Error, 05758 IL_COL_NUM(list2_idx), 05759 AT_OBJ_NAME_PTR(attr_idx), 05760 open_mp_dir_str[directive]); 05761 } 05762 else if (ATD_CLASS(attr_idx) == CRI__Pointee) { 05763 PRINTMSG(IL_LINE_NUM(list2_idx), 1477, Error, 05764 IL_COL_NUM(list2_idx), 05765 AT_OBJ_NAME_PTR(attr_idx)); 05766 } 05767 else if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ptr || 05768 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ch_Ptr) { 05769 05770 PRINTMSG(IL_LINE_NUM(list2_idx), 1484, Error, 05771 IL_COL_NUM(list2_idx), 05772 "Cray pointer", 05773 AT_OBJ_NAME_PTR(attr_idx), 05774 open_mp_dir_str[directive]); 05775 } 05776 else if (ATD_POINTER(attr_idx)) { 05777 05778 PRINTMSG(IL_LINE_NUM(list2_idx), 1484, Error, 05779 IL_COL_NUM(list2_idx), 05780 "Pointer", 05781 AT_OBJ_NAME_PTR(attr_idx), 05782 open_mp_dir_str[directive]); 05783 } 05784 else if (ATD_ALLOCATABLE(attr_idx)) { 05785 05786 PRINTMSG(IL_LINE_NUM(list2_idx), 1484, Error, 05787 IL_COL_NUM(list2_idx), 05788 "Allocatable array", 05789 AT_OBJ_NAME_PTR(attr_idx), 05790 open_mp_dir_str[directive]); 05791 } 05792 else if (multiple_clause_err(attr_idx, 05793 OPEN_MP_REDUCTION_LIST_IDX)) { 05794 PRINTMSG(IL_LINE_NUM(list2_idx), 1476, Error, 05795 IL_COL_NUM(list2_idx), 05796 AT_OBJ_NAME_PTR(attr_idx)); 05797 } 05798 else if (work_sharing_dir && 05799 has_been_reprivatized(attr_idx)) { 05800 PRINTMSG(IL_LINE_NUM(list2_idx), 1651, Error, 05801 IL_COL_NUM(list2_idx), 05802 "Reduction", 05803 AT_OBJ_NAME_PTR(attr_idx)); 05804 } 05805 else if (ATD_CLASS(attr_idx) == Dummy_Argument && 05806 ATD_INTENT(attr_idx) == Intent_In) { 05807 PRINTMSG(IL_LINE_NUM(list2_idx), 1492, Error, 05808 IL_COL_NUM(list2_idx), 05809 AT_OBJ_NAME_PTR(attr_idx), 05810 "REDUCTION"); 05811 } 05812 else if (ATD_PURE(attr_idx)) { 05813 PRINTMSG(IL_LINE_NUM(list2_idx), 1493, Error, 05814 IL_COL_NUM(list2_idx), 05815 AT_OBJ_NAME_PTR(attr_idx), 05816 "REDUCTION"); 05817 } 05818 else { 05819 ATD_TASK_REDUCTION(attr_idx) = TRUE; 05820 } 05821 05822 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 05823 } 05824 05825 list_idx = IL_NEXT_LIST_IDX(list_idx); 05826 05827 } 05828 } 05829 } 05830 05831 if (open_mp_clause_allowed[directive][Copyprivate_Omp_Clause]) { 05832 /* process COPYPRIVATE var list */ 05833 05834 list_idx = list_array[OPEN_MP_COPYPRIVATE_IDX]; 05835 cdir_switches.copyprivate_list_idx = list_idx; 05836 05837 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05838 05839 list2_idx = IL_IDX(list_idx); 05840 05841 while (list2_idx) { 05842 05843 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 05844 attr_idx = IL_IDX(list2_idx); 05845 AT_LOCKED_IN(attr_idx) = TRUE; 05846 05847 while (AT_ATTR_LINK(attr_idx)) { 05848 attr_idx = AT_ATTR_LINK(attr_idx); 05849 AT_LOCKED_IN(attr_idx) = TRUE; 05850 } 05851 05852 IL_IDX(list2_idx) = attr_idx; 05853 05854 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 05855 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05856 IL_COL_NUM(list2_idx), 05857 AT_OBJ_NAME_PTR(attr_idx), 05858 "COPYPRIVATE", open_mp_dir_str[directive]); 05859 } 05860 else if (ATD_CLASS(attr_idx) == Constant) { 05861 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 05862 IL_COL_NUM(list2_idx), 05863 AT_OBJ_NAME_PTR(attr_idx), 05864 "COPYPRIVATE", open_mp_dir_str[directive]); 05865 } 05866 else if (ATD_CLASS(attr_idx) == CRI__Pointee) { 05867 PRINTMSG(IL_LINE_NUM(list2_idx), 1477, Error, 05868 IL_COL_NUM(list2_idx), 05869 AT_OBJ_NAME_PTR(attr_idx)); 05870 } 05871 else if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ptr || 05872 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ch_Ptr) { 05873 05874 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05875 IL_COL_NUM(list2_idx), 05876 "Cray pointer", 05877 AT_OBJ_NAME_PTR(attr_idx)); 05878 } 05879 else if (ATD_POINTER(attr_idx)) { 05880 05881 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05882 IL_COL_NUM(list2_idx), 05883 "Pointer", 05884 AT_OBJ_NAME_PTR(attr_idx)); 05885 } 05886 else if (ATD_ALLOCATABLE(attr_idx)) { 05887 05888 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 05889 IL_COL_NUM(list2_idx), 05890 "Allocatable array", 05891 AT_OBJ_NAME_PTR(attr_idx)); 05892 } 05893 else if (ATD_ARRAY_IDX(attr_idx) != NULL_IDX && 05894 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05895 Assumed_Size || 05896 BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05897 Assumed_Shape)) { 05898 05899 PRINTMSG(IL_LINE_NUM(list2_idx), 1482, Error, 05900 IL_COL_NUM(list2_idx), 05901 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 05902 Assumed_Size ? 05903 "Assumed size" : "Assumed shape"), 05904 AT_OBJ_NAME_PTR(attr_idx)); 05905 } 05906 else if (multiple_clause_err(attr_idx, 05907 OPEN_MP_COPYPRIVATE_IDX)) { 05908 PRINTMSG(IL_LINE_NUM(list2_idx), 1476, Error, 05909 IL_COL_NUM(list2_idx), 05910 AT_OBJ_NAME_PTR(attr_idx)); 05911 } 05912 else if (work_sharing_dir && 05913 has_been_reprivatized(attr_idx)) { 05914 PRINTMSG(IL_LINE_NUM(list2_idx), 1651, Error, 05915 IL_COL_NUM(list2_idx), 05916 "Privatized", 05917 AT_OBJ_NAME_PTR(attr_idx)); 05918 } 05919 else if (ATD_CLASS(attr_idx) == Dummy_Argument && 05920 ATD_INTENT(attr_idx) == Intent_In) { 05921 PRINTMSG(IL_LINE_NUM(list2_idx), 1492, Error, 05922 IL_COL_NUM(list2_idx), 05923 AT_OBJ_NAME_PTR(attr_idx), 05924 "COPYPRIVATE"); 05925 } 05926 else if (ATD_PURE(attr_idx)) { 05927 PRINTMSG(IL_LINE_NUM(list2_idx), 1493, Error, 05928 IL_COL_NUM(list2_idx), 05929 AT_OBJ_NAME_PTR(attr_idx), 05930 "COPYPRIVATE"); 05931 } 05932 else { 05933 ATD_TASK_COPYPRIVATE(attr_idx) = TRUE; 05934 05935 if (ATD_CLASS(attr_idx) == Variable && 05936 ATD_AUTOMATIC(attr_idx) && 05937 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 05938 ! ATD_TASK_COPYPRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) { 05939 05940 ATD_TASK_COPYPRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 05941 05942 NTR_IR_LIST_TBL(list3_idx); 05943 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 05944 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 05945 IL_IDX(list_idx) = list3_idx; 05946 IL_LIST_CNT(list_idx)++; 05947 05948 IL_FLD(list3_idx) = AT_Tbl_Idx; 05949 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 05950 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 05951 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 05952 } 05953 } 05954 } 05955 else { 05956 /* SB_Tbl_Idx here */ 05957 add_common_blk_objects_to_list(list2_idx, list_idx); 05958 } 05959 05960 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 05961 } 05962 } 05963 } 05964 05965 /* no calls to expr_semantics can be made before the NEST processing */ 05966 05967 if (open_mp_clause_allowed[directive][Nest_Omp_Clause]) { 05968 /* process NEST var list */ 05969 05970 list_idx = list_array[OPEN_MP_NEST_IDX]; 05971 05972 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 05973 05974 list2_idx = IL_IDX(list_idx); 05975 05976 while (list2_idx) { 05977 05978 attr_idx = IL_IDX(list2_idx); 05979 AT_LOCKED_IN(attr_idx) = TRUE; 05980 05981 while (AT_ATTR_LINK(attr_idx)) { 05982 attr_idx = AT_ATTR_LINK(attr_idx); 05983 AT_LOCKED_IN(attr_idx) = TRUE; 05984 } 05985 05986 # if 0 05987 /* do not do this for open mp. pv 658750 */ 05988 05989 if (! ATD_TASK_PRIVATE(attr_idx) && 05990 ! ATD_TASK_FIRSTPRIVATE(attr_idx) && 05991 ! ATD_TASK_LASTPRIVATE(attr_idx) && 05992 ! ATD_TASK_COPYPRIVATE(attr_idx)) { 05993 05994 NTR_IR_LIST_TBL(list3_idx); 05995 IL_NEXT_LIST_IDX(list3_idx) = 05996 IL_IDX(cdir_switches.lastprivate_list_idx); 05997 if (IL_IDX(cdir_switches.lastprivate_list_idx) != NULL_IDX) { 05998 IL_PREV_LIST_IDX(IL_IDX(cdir_switches.lastprivate_list_idx))= 05999 list3_idx; 06000 } 06001 IL_IDX(cdir_switches.lastprivate_list_idx) = list3_idx; 06002 IL_FLD(cdir_switches.lastprivate_list_idx) = IL_Tbl_Idx; 06003 IL_LIST_CNT(cdir_switches.lastprivate_list_idx)++; 06004 IL_FLD(list3_idx) = AT_Tbl_Idx; 06005 IL_IDX(list3_idx) = attr_idx; 06006 ATD_TASK_LASTPRIVATE(attr_idx) = TRUE; 06007 } 06008 # endif 06009 06010 IL_IDX(list2_idx) = attr_idx; 06011 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06012 } 06013 } 06014 } 06015 06016 if (open_mp_clause_allowed[directive][Affinity_Omp_Clause]) { 06017 /* process AFFINITY var list */ 06018 06019 list_idx = list_array[OPEN_MP_AFFINITY_IDX]; 06020 06021 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06022 06023 list2_idx = IL_IDX(list_idx); 06024 list3_idx = list_array[OPEN_MP_NEST_IDX]; 06025 list3_idx = IL_IDX(list3_idx); 06026 06027 while (list2_idx) { 06028 06029 attr_idx = IL_IDX(list2_idx); 06030 AT_LOCKED_IN(attr_idx) = TRUE; 06031 06032 while (AT_ATTR_LINK(attr_idx)) { 06033 attr_idx = AT_ATTR_LINK(attr_idx); 06034 AT_LOCKED_IN(attr_idx) = TRUE; 06035 } 06036 06037 IL_IDX(list2_idx) = attr_idx; 06038 06039 if (list3_idx == NULL_IDX || 06040 IL_IDX(list3_idx) != attr_idx) { 06041 find_opnd_line_and_column(&IL_OPND(list2_idx), &line, &column); 06042 06043 PRINTMSG(line, 1417, Error, column); 06044 break; 06045 } 06046 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06047 list3_idx = IL_NEXT_LIST_IDX(list3_idx); 06048 } 06049 06050 06051 list_idx = list_array[OPEN_MP_THREAD_DATA_IDX]; 06052 06053 # ifdef _DEBUG 06054 if (IL_FLD(list_idx) == NO_Tbl_Idx || 06055 IL_FLD(list_array[OPEN_MP_IS_THREAD_IDX]) != CN_Tbl_Idx) { 06056 06057 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col, 06058 "THREAD/DATA list item", "open_mp_directive_semantics"); 06059 } 06060 # endif 06061 06062 if (compare_cn_and_value(IL_IDX(list_array[OPEN_MP_IS_THREAD_IDX]), 06063 0, 06064 Eq_Opr)) { 06065 /* DATA */ 06066 COPY_OPND(opnd, IL_OPND(list_idx)); 06067 exp_desc.rank = 0; 06068 xref_state = CIF_Symbol_Reference; 06069 expr_semantics(&opnd, &exp_desc); 06070 COPY_OPND(IL_OPND(list_idx), opnd); 06071 06072 if (! exp_desc.array_elt) { 06073 /* error, must be array element */ 06074 find_opnd_line_and_column(&opnd, &line, &column); 06075 06076 PRINTMSG(line, 1372, Error, column); 06077 } 06078 06079 list2_idx = list_array[OPEN_MP_ONTO_IDX]; 06080 if (IL_FLD(list2_idx) != NO_Tbl_Idx) { 06081 /* can't have ONTO with DATA affinity. */ 06082 find_opnd_line_and_column(&IL_OPND(list2_idx), &line, &column); 06083 06084 PRINTMSG(line, 1418, Error, column); 06085 } 06086 } 06087 else { 06088 /* THREAD */ 06089 COPY_OPND(opnd, IL_OPND(list_idx)); 06090 exp_desc.rank = 0; 06091 xref_state = CIF_Symbol_Reference; 06092 expr_semantics(&opnd, &exp_desc); 06093 COPY_OPND(IL_OPND(list_idx), opnd); 06094 06095 if (exp_desc.type != Integer || 06096 exp_desc.rank != 0) { 06097 /* error, must be array element */ 06098 find_opnd_line_and_column(&opnd, &line, &column); 06099 06100 PRINTMSG(line, 1371, Error, column); 06101 } 06102 } 06103 } 06104 } 06105 06106 if (open_mp_clause_allowed[directive][Onto_Omp_Clause]) { 06107 /* process ONTO var list */ 06108 06109 list_idx = list_array[OPEN_MP_ONTO_IDX]; 06110 06111 if (IL_FLD(list_idx) == IL_Tbl_Idx) { 06112 list_idx = IL_IDX(list_idx); 06113 06114 while (list_idx != NULL_IDX) { 06115 06116 COPY_OPND(opnd, IL_OPND(list_idx)); 06117 exp_desc.rank = 0; 06118 xref_state = CIF_Symbol_Reference; 06119 expr_semantics(&opnd, &exp_desc); 06120 COPY_OPND(IL_OPND(list_idx), opnd); 06121 06122 find_opnd_line_and_column(&opnd, &line, &column); 06123 06124 if (OPND_FLD(opnd) != CN_Tbl_Idx || 06125 exp_desc.type != Integer) { 06126 /* error, must be a constant */ 06127 PRINTMSG(line, 1368, Error, column); 06128 } 06129 else if (compare_cn_and_value(OPND_IDX(opnd), 06130 0, 06131 Lt_Opr)) { 06132 06133 /* error, must be greater than zero */ 06134 PRINTMSG(line, 1368, Error, column); 06135 } 06136 06137 list_idx = IL_NEXT_LIST_IDX(list_idx); 06138 } 06139 } 06140 } 06141 06142 06143 if (open_mp_clause_allowed[directive][Flush_Omp_Clause]) { 06144 /* process FLUSH var list */ 06145 /* there is no FLUSH clause in OpenMP ([email protected]) */ 06146 /* we fake this clause in order to treat FLUSH directive the same as the others */ 06147 06148 list_idx = list_array[OPEN_MP_FLUSH_IDX]; 06149 cdir_switches.flush_list_idx = list_idx; 06150 06151 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06152 06153 list2_idx = IL_IDX(list_idx); 06154 06155 while (list2_idx) { 06156 06157 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 06158 attr_idx = IL_IDX(list2_idx); 06159 AT_LOCKED_IN(attr_idx) = TRUE; 06160 06161 while (AT_ATTR_LINK(attr_idx)) { 06162 attr_idx = AT_ATTR_LINK(attr_idx); 06163 AT_LOCKED_IN(attr_idx) = TRUE; 06164 } 06165 06166 IL_IDX(list2_idx) = attr_idx; 06167 06168 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 06169 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 06170 IL_COL_NUM(list2_idx), 06171 AT_OBJ_NAME_PTR(attr_idx), 06172 "FLUSH", open_mp_dir_str[directive]); 06173 } 06174 else if (ATD_CLASS(attr_idx) == Constant) { 06175 PRINTMSG(IL_LINE_NUM(list2_idx), 1473, Error, 06176 IL_COL_NUM(list2_idx), 06177 AT_OBJ_NAME_PTR(attr_idx), 06178 "FLUSH", open_mp_dir_str[directive]); 06179 } 06180 else if (ATD_CLASS(attr_idx) == CRI__Pointee) { 06181 PRINTMSG(IL_LINE_NUM(list2_idx), 1477, Error, 06182 IL_COL_NUM(list2_idx), 06183 AT_OBJ_NAME_PTR(attr_idx)); 06184 } 06185 else if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ptr || 06186 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ch_Ptr) { 06187 06188 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 06189 IL_COL_NUM(list2_idx), 06190 "Cray pointer", 06191 AT_OBJ_NAME_PTR(attr_idx)); 06192 } 06193 else if (ATD_POINTER(attr_idx)) { 06194 06195 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 06196 IL_COL_NUM(list2_idx), 06197 "Pointer", 06198 AT_OBJ_NAME_PTR(attr_idx)); 06199 } 06200 else if (ATD_ALLOCATABLE(attr_idx)) { 06201 06202 PRINTMSG(IL_LINE_NUM(list2_idx), 1478, Error, 06203 IL_COL_NUM(list2_idx), 06204 "Allocatable array", 06205 AT_OBJ_NAME_PTR(attr_idx)); 06206 } 06207 else if (ATD_ARRAY_IDX(attr_idx) != NULL_IDX && 06208 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 06209 Assumed_Size || 06210 BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 06211 Assumed_Shape)) { 06212 06213 PRINTMSG(IL_LINE_NUM(list2_idx), 1482, Error, 06214 IL_COL_NUM(list2_idx), 06215 (BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == 06216 Assumed_Size ? 06217 "Assumed size" : "Assumed shape"), 06218 AT_OBJ_NAME_PTR(attr_idx)); 06219 } 06220 else if (multiple_clause_err(attr_idx, OPEN_MP_FLUSH_IDX)) { 06221 PRINTMSG(IL_LINE_NUM(list2_idx), 1476, Error, 06222 IL_COL_NUM(list2_idx), 06223 AT_OBJ_NAME_PTR(attr_idx)); 06224 } 06225 else if (work_sharing_dir && 06226 has_been_reprivatized(attr_idx)) { 06227 PRINTMSG(IL_LINE_NUM(list2_idx), 1651, Error, 06228 IL_COL_NUM(list2_idx), 06229 "Privatized", 06230 AT_OBJ_NAME_PTR(attr_idx)); 06231 } 06232 else if (ATD_CLASS(attr_idx) == Dummy_Argument && 06233 ATD_INTENT(attr_idx) == Intent_In) { 06234 PRINTMSG(IL_LINE_NUM(list2_idx), 1492, Error, 06235 IL_COL_NUM(list2_idx), 06236 AT_OBJ_NAME_PTR(attr_idx), 06237 "FLUSH"); 06238 } 06239 else if (ATD_PURE(attr_idx)) { 06240 PRINTMSG(IL_LINE_NUM(list2_idx), 1493, Error, 06241 IL_COL_NUM(list2_idx), 06242 AT_OBJ_NAME_PTR(attr_idx), 06243 "FLUSH"); 06244 } 06245 else { 06246 ATD_TASK_FLUSH(attr_idx) = TRUE; 06247 06248 if (ATD_CLASS(attr_idx) == Variable && 06249 ATD_AUTOMATIC(attr_idx) && 06250 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX && 06251 ! ATD_TASK_FLUSH(ATD_AUTO_BASE_IDX(attr_idx))) { 06252 06253 ATD_TASK_FLUSH(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE; 06254 06255 NTR_IR_LIST_TBL(list3_idx); 06256 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx; 06257 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx); 06258 IL_IDX(list_idx) = list3_idx; 06259 IL_LIST_CNT(list_idx)++; 06260 06261 IL_FLD(list3_idx) = AT_Tbl_Idx; 06262 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx); 06263 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx); 06264 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx); 06265 } 06266 } 06267 } 06268 else { 06269 /* SB_Tbl_Idx here */ 06270 add_common_blk_objects_to_list(list2_idx, list_idx); 06271 } 06272 06273 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06274 } 06275 } 06276 } 06277 06278 06279 if (open_mp_clause_allowed[directive][Default_Omp_Clause]) { 06280 /* save the DEFAULT scope list idx */ 06281 06282 list_idx = list_array[OPEN_MP_DEFAULT_IDX]; 06283 06284 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06285 cdir_switches.default_scope_list_idx = list_idx; 06286 } 06287 } 06288 06289 curr_stmt_sh_idx = save_curr_stmt_sh_idx; 06290 06291 /* restore error flag on curr_stmt_sh_idx. */ 06292 SH_ERR_FLG(orig_sh_idx) = save_error_flag; 06293 06294 TRACE (Func_Exit, "open_mp_directive_semantics", NULL); 06295 06296 return; 06297 06298 } /* open_mp_directive_semantics */ 06299 06300 /******************************************************************************\ 06301 |* *| 06302 |* Description: *| 06303 |* <description> *| 06304 |* *| 06305 |* Input parameters: *| 06306 |* NONE *| 06307 |* *| 06308 |* Output parameters: *| 06309 |* NONE *| 06310 |* *| 06311 |* Returns: *| 06312 |* NOTHING *| 06313 |* *| 06314 \******************************************************************************/ 06315 06316 static void end_blk_mp_semantics(boolean open_mp) 06317 06318 { 06319 int ir_idx; 06320 int list_idx; 06321 06322 TRACE (Func_Entry, "end_blk_mp_semantics", NULL); 06323 06324 # if defined _DEBUG 06325 if (IR_FLD_R(SH_IR_IDX(curr_stmt_sh_idx)) != SH_Tbl_Idx) { 06326 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col, 06327 "SH_Tbl_Idx", "end_blk_mp_semantics"); 06328 } 06329 # endif 06330 06331 /* get back to start stmt of block */ 06332 06333 if (SH_ERR_FLG(IR_IDX_R(SH_IR_IDX(curr_stmt_sh_idx)))) { 06334 goto EXIT; 06335 } 06336 06337 ir_idx = SH_IR_IDX(IR_IDX_R(SH_IR_IDX(curr_stmt_sh_idx))); 06338 06339 if (open_mp) { 06340 set_open_mp_task_flags(ir_idx, FALSE); 06341 } 06342 else { 06343 set_mp_task_flags(ir_idx, FALSE); 06344 } 06345 06346 # if 0 06347 {extern char *operator_str[]; 06348 printf(" ending block for %s\n", operator_str[IR_OPR(ir_idx)]); 06349 } 06350 # endif 06351 06352 pop_task_blk(); 06353 06354 if (OPND_FLD(cdir_switches.first_sh_blk_stk) == IL_Tbl_Idx) { 06355 list_idx = OPND_IDX(cdir_switches.first_sh_blk_stk); 06356 /* find the end and process each blk backwards */ 06357 06358 while (IL_NEXT_LIST_IDX(list_idx) != NULL_IDX) { 06359 list_idx = IL_NEXT_LIST_IDX(list_idx); 06360 } 06361 06362 while (list_idx) { 06363 ir_idx = SH_IR_IDX(IL_IDX(list_idx)); 06364 06365 if (open_mp) { 06366 set_open_mp_task_flags(ir_idx, TRUE); 06367 } 06368 else { 06369 set_mp_task_flags(ir_idx, TRUE); 06370 } 06371 06372 list_idx = IL_PREV_LIST_IDX(list_idx); 06373 } 06374 } 06375 06376 EXIT: 06377 06378 TRACE (Func_Exit, "end_blk_mp_semantics", NULL); 06379 06380 return; 06381 06382 } /* end_blk_mp_semantics */ 06383 06384 /******************************************************************************\ 06385 |* *| 06386 |* Description: *| 06387 |* <description> *| 06388 |* *| 06389 |* Input parameters: *| 06390 |* NONE *| 06391 |* *| 06392 |* Output parameters: *| 06393 |* NONE *| 06394 |* *| 06395 |* Returns: *| 06396 |* NOTHING *| 06397 |* *| 06398 \******************************************************************************/ 06399 06400 static void set_open_mp_task_flags(int ir_idx, 06401 boolean flag) 06402 06403 { 06404 int attr_idx; 06405 open_mp_directive_type directive; 06406 int i; 06407 int list_array[OPEN_MP_LIST_CNT]; 06408 int list_idx; 06409 int list2_idx; 06410 06411 06412 TRACE (Func_Entry, "set_open_mp_task_flags", NULL); 06413 06414 list_idx = IR_IDX_L(ir_idx); 06415 06416 for (i = 0; i < OPEN_MP_LIST_CNT; i++) { 06417 list_array[i] = list_idx; 06418 list_idx = IL_NEXT_LIST_IDX(list_idx); 06419 } 06420 06421 switch (IR_OPR(ir_idx)) { 06422 case Do_Open_Mp_Opr: 06423 directive = Do_Omp; 06424 break; 06425 06426 case Parallel_Open_Mp_Opr: 06427 directive = Parallel_Omp; 06428 break; 06429 06430 case Paralleldo_Open_Mp_Opr: 06431 directive = Parallel_Do_Omp; 06432 break; 06433 06434 case Parallelsections_Open_Mp_Opr: 06435 directive = Parallel_Sections_Omp; 06436 break; 06437 06438 case Parallelworkshare_Open_Mp_Opr: 06439 directive = Parallel_Workshare_Omp; 06440 break; 06441 06442 case Sections_Open_Mp_Opr: 06443 directive = Sections_Omp; 06444 break; 06445 06446 case Single_Open_Mp_Opr: 06447 directive = Single_Omp; 06448 break; 06449 06450 } 06451 06452 if (open_mp_clause_allowed[directive][Shared_Omp_Clause]) { 06453 /* process SHARED var list */ 06454 06455 list_idx = list_array[OPEN_MP_SHARED_IDX]; 06456 06457 cdir_switches.shared_list_idx = (flag ? list_idx : NULL_IDX) ; 06458 06459 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06460 06461 list2_idx = IL_IDX(list_idx); 06462 06463 while (list2_idx) { 06464 06465 attr_idx = IL_IDX(list2_idx); 06466 06467 ATD_TASK_SHARED(attr_idx) = flag; 06468 06469 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06470 } 06471 } 06472 } 06473 06474 if (open_mp_clause_allowed[directive][Private_Omp_Clause]) { 06475 /* process PRIVATE var list */ 06476 06477 list_idx = list_array[OPEN_MP_PRIVATE_IDX]; 06478 06479 cdir_switches.private_list_idx = (flag ? list_idx : NULL_IDX) ; 06480 06481 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06482 06483 list2_idx = IL_IDX(list_idx); 06484 06485 while (list2_idx) { 06486 06487 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 06488 attr_idx = IL_IDX(list2_idx); 06489 06490 ATD_TASK_PRIVATE(attr_idx) = flag; 06491 } 06492 06493 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06494 } 06495 } 06496 } 06497 06498 if (open_mp_clause_allowed[directive][Firstprivate_Omp_Clause]) { 06499 /* process FIRSTPRIVATE var list */ 06500 06501 list_idx = list_array[OPEN_MP_FIRSTPRIVATE_IDX]; 06502 06503 cdir_switches.firstprivate_list_idx = (flag ? list_idx : NULL_IDX) ; 06504 06505 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06506 06507 list2_idx = IL_IDX(list_idx); 06508 06509 while (list2_idx) { 06510 06511 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 06512 attr_idx = IL_IDX(list2_idx); 06513 ATD_TASK_FIRSTPRIVATE(attr_idx) = flag; 06514 } 06515 06516 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06517 } 06518 } 06519 } 06520 06521 if (open_mp_clause_allowed[directive][Copyin_Omp_Clause]) { 06522 /* process COPYIN var list */ 06523 06524 list_idx = list_array[OPEN_MP_COPYIN_IDX]; 06525 06526 cdir_switches.copyin_list_idx = (flag ? list_idx : NULL_IDX) ; 06527 06528 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06529 06530 list2_idx = IL_IDX(list_idx); 06531 06532 while (list2_idx) { 06533 06534 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 06535 attr_idx = IL_IDX(list2_idx); 06536 ATD_TASK_COPYIN(attr_idx) = flag; 06537 } 06538 06539 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06540 } 06541 } 06542 } 06543 06544 if (open_mp_clause_allowed[directive][Lastprivate_Omp_Clause]) { 06545 /* process LASTPRIVATE var list */ 06546 06547 list_idx = list_array[OPEN_MP_LASTPRIVATE_IDX]; 06548 06549 cdir_switches.lastprivate_list_idx = (flag ? list_idx : NULL_IDX) ; 06550 06551 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06552 06553 list2_idx = IL_IDX(list_idx); 06554 06555 while (list2_idx) { 06556 06557 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 06558 attr_idx = IL_IDX(list2_idx); 06559 ATD_TASK_LASTPRIVATE(attr_idx) = flag; 06560 } 06561 06562 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06563 } 06564 } 06565 } 06566 06567 if (open_mp_clause_allowed[directive][Reduction_Omp_Clause]) { 06568 /* process REDUCTION var list */ 06569 06570 list_idx = list_array[OPEN_MP_REDUCTION_LIST_IDX]; 06571 06572 cdir_switches.reduction_list_idx = (flag ? list_idx : NULL_IDX) ; 06573 06574 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06575 06576 list_idx = IL_IDX(list_idx); 06577 while (list_idx) { 06578 06579 list2_idx = IL_IDX(list_idx); 06580 06581 while (list2_idx) { 06582 06583 attr_idx = IL_IDX(list2_idx); 06584 ATD_TASK_REDUCTION(attr_idx) = flag; 06585 06586 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06587 } 06588 06589 list_idx = IL_NEXT_LIST_IDX(list_idx); 06590 06591 } 06592 } 06593 } 06594 06595 if (open_mp_clause_allowed[directive][Default_Omp_Clause]) { 06596 /* process the DEFAULT scope list idx */ 06597 06598 list_idx = list_array[OPEN_MP_DEFAULT_IDX]; 06599 06600 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06601 cdir_switches.default_scope_list_idx = (flag ? list_idx : NULL_IDX) ; 06602 } 06603 } 06604 06605 if (open_mp_clause_allowed[directive][Copyprivate_Omp_Clause]) { 06606 /* process COPYPRIVATE var list */ 06607 06608 list_idx = list_array[OPEN_MP_COPYPRIVATE_IDX]; 06609 06610 cdir_switches.copyprivate_list_idx = (flag ? list_idx : NULL_IDX) ; 06611 06612 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06613 06614 list2_idx = IL_IDX(list_idx); 06615 06616 while (list2_idx) { 06617 06618 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 06619 attr_idx = IL_IDX(list2_idx); 06620 ATD_TASK_COPYPRIVATE(attr_idx) = flag; 06621 } 06622 06623 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06624 } 06625 } 06626 } 06627 06628 if (open_mp_clause_allowed[directive][Flush_Omp_Clause]) { 06629 /* process FLUSH var list */ 06630 /* there is no FLUSH clause in OpenMP ([email protected]) */ 06631 /* we fake this clause in order to treat FLUSH directive the same as the others */ 06632 06633 list_idx = list_array[OPEN_MP_FLUSH_IDX]; 06634 06635 cdir_switches.flush_list_idx = (flag ? list_idx : NULL_IDX) ; 06636 06637 if (IL_FLD(list_idx) != NO_Tbl_Idx) { 06638 06639 list2_idx = IL_IDX(list_idx); 06640 06641 while (list2_idx) { 06642 06643 if (IL_FLD(list2_idx) == AT_Tbl_Idx) { 06644 attr_idx = IL_IDX(list2_idx); 06645 ATD_TASK_FLUSH(attr_idx) = flag; 06646 } 06647 06648 list2_idx = IL_NEXT_LIST_IDX(list2_idx); 06649 } 06650 } 06651 } 06652 06653 cdir_switches.parallel_region = flag; 06654 06655 TRACE (Func_Exit, "set_open_mp_task_flags", NULL); 06656 06657 return; 06658 06659 } /* set_open_mp_task_flags */ 06660 06661 /******************************************************************************\ 06662 |* *| 06663 |* Description: *| 06664 |* <description> *| 06665 |* *| 06666 |* Input parameters: *| 06667 |* NONE *| 06668 |* *| 06669 |* Output parameters: *| 06670 |* NONE *| 06671 |* *| 06672 |* Returns: *| 06673 |* NOTHING *| 06674 |* *| 06675 \******************************************************************************/ 06676 06677 static void push_task_blk(int sh_idx) 06678 06679 { 06680 int list_idx; 06681 06682 TRACE (Func_Entry, "push_task_blk", NULL); 06683 06684 NTR_IR_LIST_TBL(list_idx); 06685 06686 if (OPND_FLD(cdir_switches.first_sh_blk_stk) == NO_Tbl_Idx) { 06687 OPND_FLD(cdir_switches.first_sh_blk_stk) = IL_Tbl_Idx; 06688 OPND_IDX(cdir_switches.first_sh_blk_stk) = list_idx; 06689 OPND_LIST_CNT(cdir_switches.first_sh_blk_stk) = 1; 06690 } 06691 else { 06692 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(cdir_switches.first_sh_blk_stk); 06693 IL_PREV_LIST_IDX(OPND_IDX(cdir_switches.first_sh_blk_stk)) = list_idx; 06694 OPND_IDX(cdir_switches.first_sh_blk_stk) = list_idx; 06695 OPND_LIST_CNT(cdir_switches.first_sh_blk_stk) += 1; 06696 } 06697 06698 IL_FLD(list_idx) = SH_Tbl_Idx; 06699 IL_IDX(list_idx) = sh_idx; 06700 06701 TRACE (Func_Exit, "push_task_blk", NULL); 06702 06703 return; 06704 06705 } /* push_task_blk */ 06706 06707 /******************************************************************************\ 06708 |* *| 06709 |* Description: *| 06710 |* <description> *| 06711 |* *| 06712 |* Input parameters: *| 06713 |* NONE *| 06714 |* *| 06715 |* Output parameters: *| 06716 |* NONE *| 06717 |* *| 06718 |* Returns: *| 06719 |* NOTHING *| 06720 |* *| 06721 \******************************************************************************/ 06722 06723 static int pop_task_blk(void) 06724 06725 { 06726 int sh_idx = NULL_IDX; 06727 int list_idx; 06728 int trash_list_idx; 06729 06730 TRACE (Func_Entry, "pop_task_blk", NULL); 06731 06732 if (OPND_FLD(cdir_switches.first_sh_blk_stk) == IL_Tbl_Idx) { 06733 list_idx = OPND_IDX(cdir_switches.first_sh_blk_stk); 06734 sh_idx = IL_IDX(list_idx); 06735 06736 trash_list_idx = list_idx; 06737 06738 list_idx = IL_NEXT_LIST_IDX(list_idx); 06739 06740 FREE_IR_LIST_NODE(trash_list_idx); 06741 06742 OPND_IDX(cdir_switches.first_sh_blk_stk) = list_idx; 06743 OPND_LIST_CNT(cdir_switches.first_sh_blk_stk) -= 1; 06744 06745 if (list_idx) { 06746 IL_PREV_LIST_IDX(list_idx) = NULL_IDX; 06747 } 06748 else { 06749 OPND_FLD(cdir_switches.first_sh_blk_stk) = NO_Tbl_Idx; 06750 OPND_IDX(cdir_switches.first_sh_blk_stk) = NULL_IDX; 06751 } 06752 } 06753 06754 TRACE (Func_Exit, "pop_task_blk", NULL); 06755 06756 return(sh_idx); 06757 06758 } /* pop_task_blk */ 06759 06760 /******************************************************************************\ 06761 |* *| 06762 |* Description: *| 06763 |* <description> *| 06764 |* *| 06765 |* Input parameters: *| 06766 |* NONE *| 06767 |* *| 06768 |* Output parameters: *| 06769 |* NONE *| 06770 |* *| 06771 |* Returns: *| 06772 |* NOTHING *| 06773 |* *| 06774 \******************************************************************************/ 06775 06776 static boolean multiple_clause_err(int attr_idx, 06777 int clause_idx) 06778 06779 { 06780 boolean issue_err = FALSE; 06781 int i; 06782 int list_idx; 06783 int test_clause_idx = -1; 06784 06785 TRACE (Func_Entry, "multiple_clause_err", NULL); 06786 06787 if (ATD_TASK_SHARED(attr_idx) && 06788 clause_idx != OPEN_MP_SHARED_IDX) { 06789 test_clause_idx = OPEN_MP_SHARED_IDX; 06790 } 06791 else if (ATD_TASK_PRIVATE(attr_idx) && 06792 clause_idx != OPEN_MP_PRIVATE_IDX) { 06793 test_clause_idx = OPEN_MP_PRIVATE_IDX; 06794 } 06795 else if (ATD_TASK_FIRSTPRIVATE(attr_idx) && 06796 clause_idx != OPEN_MP_COPYPRIVATE_IDX && 06797 clause_idx != OPEN_MP_LASTPRIVATE_IDX && 06798 clause_idx != OPEN_MP_FIRSTPRIVATE_IDX) { 06799 test_clause_idx = OPEN_MP_FIRSTPRIVATE_IDX; 06800 } 06801 else if (ATD_TASK_LASTPRIVATE(attr_idx) && 06802 clause_idx != OPEN_MP_COPYPRIVATE_IDX && 06803 clause_idx != OPEN_MP_LASTPRIVATE_IDX && 06804 clause_idx != OPEN_MP_FIRSTPRIVATE_IDX) { 06805 test_clause_idx = OPEN_MP_LASTPRIVATE_IDX; 06806 } 06807 else if (ATD_TASK_COPYIN(attr_idx) && 06808 clause_idx != OPEN_MP_COPYIN_IDX) { 06809 test_clause_idx = OPEN_MP_COPYIN_IDX; 06810 } 06811 else if (ATD_TASK_REDUCTION(attr_idx)) { 06812 test_clause_idx = OPEN_MP_REDUCTION_LIST_IDX; 06813 } 06814 else if (ATD_TASK_COPYPRIVATE(attr_idx) && 06815 clause_idx != OPEN_MP_COPYPRIVATE_IDX && 06816 clause_idx != OPEN_MP_LASTPRIVATE_IDX && 06817 clause_idx != OPEN_MP_FIRSTPRIVATE_IDX) { 06818 test_clause_idx = OPEN_MP_COPYPRIVATE_IDX; 06819 } 06820 06821 if (test_clause_idx >= 0) { 06822 06823 list_idx = IR_IDX_L(SH_IR_IDX(curr_stmt_sh_idx)); 06824 06825 for (i = 0; i < test_clause_idx; i++) { 06826 list_idx = IL_NEXT_LIST_IDX(list_idx); 06827 } 06828 06829 if (list_idx != NULL_IDX && 06830 IL_FLD(list_idx) == IL_Tbl_Idx && 06831 attr_is_in_list(IL_IDX(list_idx), attr_idx)) { 06832 06833 issue_err = TRUE; 06834 } 06835 } 06836 06837 TRACE (Func_Exit, "multiple_clause_err", NULL); 06838 06839 return(issue_err); 06840 06841 } /* multiple_clause_err */ 06842 06843 /******************************************************************************\ 06844 |* *| 06845 |* Description: *| 06846 |* <description> *| 06847 |* *| 06848 |* Input parameters: *| 06849 |* NONE *| 06850 |* *| 06851 |* Output parameters: *| 06852 |* NONE *| 06853 |* *| 06854 |* Returns: *| 06855 |* NOTHING *| 06856 |* *| 06857 \******************************************************************************/ 06858 06859 static boolean attr_is_in_list(int list_idx, 06860 int attr_idx) 06861 06862 { 06863 boolean its_here = FALSE; 06864 int list_idx2; 06865 06866 TRACE (Func_Entry, "attr_is_in_list", NULL); 06867 06868 if (IL_FLD(list_idx) == IL_Tbl_Idx) { 06869 06870 while (list_idx) { 06871 list_idx2 = IL_IDX(list_idx); 06872 06873 while (list_idx2) { 06874 if (IL_FLD(list_idx2) == AT_Tbl_Idx && 06875 IL_IDX(list_idx2) == attr_idx) { 06876 its_here = TRUE; 06877 break; 06878 } 06879 list_idx2 = IL_NEXT_LIST_IDX(list_idx2); 06880 } 06881 06882 list_idx = IL_NEXT_LIST_IDX(list_idx); 06883 } 06884 } 06885 else { 06886 06887 while (list_idx) { 06888 06889 if (IL_FLD(list_idx) == AT_Tbl_Idx && 06890 IL_IDX(list_idx) == attr_idx) { 06891 its_here = TRUE; 06892 break; 06893 } 06894 list_idx = IL_NEXT_LIST_IDX(list_idx); 06895 } 06896 } 06897 06898 06899 TRACE (Func_Exit, "attr_is_in_list", NULL); 06900 06901 return(its_here); 06902 06903 } /* attr_is_in_list */ 06904 06905 /******************************************************************************\ 06906 |* *| 06907 |* Description: *| 06908 |* <description> *| 06909 |* *| 06910 |* Input parameters: *| 06911 |* NONE *| 06912 |* *| 06913 |* Output parameters: *| 06914 |* NONE *| 06915 |* *| 06916 |* Returns: *| 06917 |* NOTHING *| 06918 |* *| 06919 \******************************************************************************/ 06920 06921 static void add_common_blk_objects_to_list(int sb_list_idx, 06922 int head_list_idx) 06923 06924 { 06925 int attr_idx; 06926 int col; 06927 int line; 06928 int list_idx; 06929 int prev_list_idx; 06930 06931 TRACE (Func_Entry, "add_common_blk_objects_to_list", NULL); 06932 06933 find_opnd_line_and_column(&IL_OPND(sb_list_idx), &line, &col); 06934 06935 # if defined(_DEBUG) 06936 if (IL_FLD(sb_list_idx) != SB_Tbl_Idx) { 06937 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col, 06938 "SB_Tbl_Idx", "add_common_blk_objects_to_list"); 06939 } 06940 else if (IL_FLD(head_list_idx) != IL_Tbl_Idx) { 06941 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col, 06942 "IL_Tbl_Idx", "add_common_blk_objects_to_list"); 06943 } 06944 # endif 06945 06946 attr_idx = SB_FIRST_ATTR_IDX(IL_IDX(sb_list_idx)); 06947 06948 prev_list_idx = sb_list_idx; 06949 06950 while (attr_idx) { 06951 NTR_IR_LIST_TBL(list_idx); 06952 06953 IL_NEXT_LIST_IDX(list_idx) = IL_NEXT_LIST_IDX(prev_list_idx); 06954 06955 if (IL_NEXT_LIST_IDX(list_idx)) { 06956 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 06957 } 06958 06959 IL_NEXT_LIST_IDX(prev_list_idx) = list_idx; 06960 IL_PREV_LIST_IDX(list_idx) = prev_list_idx; 06961 06962 IL_LIST_CNT(head_list_idx)++; 06963 prev_list_idx = list_idx; 06964 06965 IL_FLD(list_idx) = AT_Tbl_Idx; 06966 IL_IDX(list_idx) = attr_idx; 06967 IL_LINE_NUM(list_idx) = line; 06968 IL_COL_NUM(list_idx) = col; 06969 attr_idx = ATD_NEXT_MEMBER_IDX(attr_idx); 06970 } 06971 06972 TRACE (Func_Exit, "add_common_blk_objects_to_list", NULL); 06973 06974 return; 06975 06976 } /* add_common_blk_objects_to_list */ 06977 06978 /******************************************************************************\ 06979 |* *| 06980 |* Description: *| 06981 |* <description> *| 06982 |* *| 06983 |* Input parameters: *| 06984 |* NONE *| 06985 |* *| 06986 |* Output parameters: *| 06987 |* NONE *| 06988 |* *| 06989 |* Returns: *| 06990 |* NOTHING *| 06991 |* *| 06992 \******************************************************************************/ 06993 06994 static boolean has_been_reprivatized(int attr_idx) 06995 06996 { 06997 int i; 06998 int ir_idx; 06999 int list_array[OPEN_MP_LIST_CNT]; 07000 int list_idx; 07001 boolean reprivatized = FALSE; 07002 int sh_idx; 07003 07004 TRACE (Func_Entry, "has_been_reprivatized", NULL); 07005 07006 if (OPND_FLD(cdir_switches.first_sh_blk_stk) == IL_Tbl_Idx && 07007 OPND_LIST_CNT(cdir_switches.first_sh_blk_stk) > 1) { 07008 07009 list_idx = OPND_IDX(cdir_switches.first_sh_blk_stk); 07010 list_idx = IL_NEXT_LIST_IDX(list_idx); 07011 sh_idx = IL_IDX(list_idx); 07012 ir_idx = SH_IR_IDX(sh_idx); 07013 07014 # ifdef _DEBUG 07015 if (IR_OPR(ir_idx) != Parallel_Open_Mp_Opr) { 07016 PRINTMSG(stmt_start_line, 626, Internal,stmt_start_col, 07017 "Parallel_Open_Mp_Opr", 07018 "has_been_reprivatized"); 07019 } 07020 # endif 07021 07022 list_idx = IR_IDX_L(ir_idx); 07023 07024 for (i = 0; i < OPEN_MP_LIST_CNT; i++) { 07025 list_array[i] = list_idx; 07026 list_idx = IL_NEXT_LIST_IDX(list_idx); 07027 } 07028 07029 if (ATD_TASK_PRIVATE(attr_idx)) { 07030 list_idx = list_array[OPEN_MP_PRIVATE_IDX]; 07031 07032 if (list_idx != NULL_IDX && 07033 IL_FLD(list_idx) == IL_Tbl_Idx && 07034 attr_is_in_list(IL_IDX(list_idx), attr_idx)) { 07035 reprivatized = TRUE; 07036 goto EXIT; 07037 } 07038 } 07039 07040 if (ATD_TASK_FIRSTPRIVATE(attr_idx)) { 07041 list_idx = list_array[OPEN_MP_FIRSTPRIVATE_IDX]; 07042 07043 if (list_idx != NULL_IDX && 07044 IL_FLD(list_idx) == IL_Tbl_Idx && 07045 attr_is_in_list(IL_IDX(list_idx), attr_idx)) { 07046 reprivatized = TRUE; 07047 goto EXIT; 07048 } 07049 } 07050 07051 if (ATD_TASK_LASTPRIVATE(attr_idx)) { 07052 list_idx = list_array[OPEN_MP_LASTPRIVATE_IDX]; 07053 07054 if (list_idx != NULL_IDX && 07055 IL_FLD(list_idx) == IL_Tbl_Idx && 07056 attr_is_in_list(IL_IDX(list_idx), attr_idx)) { 07057 reprivatized = TRUE; 07058 goto EXIT; 07059 } 07060 } 07061 07062 if (ATD_TASK_REDUCTION(attr_idx)) { 07063 list_idx = list_array[OPEN_MP_REDUCTION_LIST_IDX]; 07064 07065 if (list_idx != NULL_IDX && 07066 IL_FLD(list_idx) == IL_Tbl_Idx && 07067 attr_is_in_list(IL_IDX(list_idx), attr_idx)) { 07068 reprivatized = TRUE; 07069 goto EXIT; 07070 } 07071 } 07072 } 07073 07074 EXIT: 07075 07076 TRACE (Func_Exit, "has_been_reprivatized", NULL); 07077 07078 return(reprivatized); 07079 07080 } /* has_been_reprivatized */ 07081 07082 /******************************************************************************\ 07083 |* *| 07084 |* Description: *| 07085 |* <description> *| 07086 |* *| 07087 |* Input parameters: *| 07088 |* NONE *| 07089 |* *| 07090 |* Output parameters: *| 07091 |* NONE *| 07092 |* *| 07093 |* Returns: *| 07094 |* NOTHING *| 07095 |* *| 07096 \******************************************************************************/ 07097 static void wait_send_semantics(void) 07098 07099 { 07100 int column; 07101 boolean first_span; 07102 int il_idx; 07103 int line; 07104 int matched; 07105 int max_idx; 07106 long max_waits; 07107 long_type num[MAX_WORDS_FOR_INTEGER]; 07108 long num_waits = 0; 07109 boolean pointless_wait = FALSE; 07110 int prev_idx; 07111 boolean remove; 07112 long_type result[MAX_WORDS_FOR_NUMERIC]; 07113 long_type result1[MAX_WORDS_FOR_NUMERIC]; 07114 int send_il_idx; 07115 opnd_type span_opnd; 07116 int type_idx; 07117 int type_idx1; 07118 boolean variable_send; 07119 07120 long max_num_waits = 65L; 07121 07122 07123 TRACE (Func_Entry, "wait_send_semantics", NULL); 07124 07125 if (cdir_switches.wait_list_idx == NULL_IDX && 07126 cdir_switches.send_list_idx == NULL_IDX) { 07127 07128 /* There are no wait/send directives. */ 07129 07130 return; 07131 } 07132 07133 OPND_FLD(span_opnd) = NO_Tbl_Idx; 07134 OPND_IDX(span_opnd) = NULL_IDX; 07135 OPND_LINE_NUM(span_opnd) = stmt_start_line; 07136 OPND_COL_NUM(span_opnd) = stmt_start_col; 07137 07138 /* For each wait, find one or more sends that match via point */ 07139 /* Check the span to see what the max number of waits is and */ 07140 /* then check for the maximum number of waits. */ 07141 07142 if (cdir_switches.wait_list_idx != NULL_IDX) { 07143 il_idx = cdir_switches.wait_list_idx; 07144 variable_send = FALSE; 07145 first_span = TRUE; 07146 07147 while (il_idx != NULL_IDX) { 07148 num_waits++; /* Include all waits, including pointless waits */ 07149 07150 if (first_span) { /* All the rest must match this one. */ 07151 first_span = FALSE; 07152 07153 /* All the rest of the spans must match this one. The default */ 07154 /* is one, if no SPAN is specified and is set during parse. */ 07155 /* It must be in the range of 1 to 64. */ 07156 07157 COPY_OPND(span_opnd, IR_OPND_R(IL_IDX(il_idx))); 07158 07159 type_idx = CG_LOGICAL_DEFAULT_TYPE; 07160 07161 folder_driver((char *) &CN_CONST(OPND_IDX(span_opnd)), 07162 CN_TYPE_IDX(OPND_IDX(span_opnd)), 07163 (char *) &CN_CONST(CN_INTEGER_ONE_IDX), 07164 CN_TYPE_IDX(CN_INTEGER_ONE_IDX), 07165 result, 07166 &type_idx, 07167 OPND_LINE_NUM(span_opnd), 07168 OPND_COL_NUM(span_opnd), 07169 2, 07170 Lt_Opr); 07171 07172 if (THIS_IS_TRUE(result, type_idx)) { 07173 find_opnd_line_and_column(&span_opnd, &line, &column); 07174 PRINTMSG(line, 1532, Error, column); 07175 OPND_FLD(span_opnd) = CN_Tbl_Idx; 07176 OPND_IDX(span_opnd) = CN_INTEGER_ONE_IDX; 07177 } 07178 else { 07179 C_TO_F_INT(num, 64, CG_INTEGER_DEFAULT_TYPE); 07180 type_idx = CG_LOGICAL_DEFAULT_TYPE; 07181 07182 folder_driver((char *) &CN_CONST(OPND_IDX(span_opnd)), 07183 CN_TYPE_IDX(OPND_IDX(span_opnd)), 07184 (char *) &num, 07185 CG_INTEGER_DEFAULT_TYPE, 07186 result, 07187 &type_idx, 07188 OPND_LINE_NUM(span_opnd), 07189 OPND_COL_NUM(span_opnd), 07190 2, 07191 Gt_Opr); 07192 07193 if (THIS_IS_TRUE(result, type_idx)) { 07194 find_opnd_line_and_column(&span_opnd, &line, &column); 07195 PRINTMSG(line, 1532, Error, column); 07196 OPND_FLD(span_opnd) = CN_Tbl_Idx; 07197 OPND_IDX(span_opnd) = CN_INTEGER_ONE_IDX; 07198 } 07199 } 07200 } 07201 else if (IR_FLD_R(IL_IDX(il_idx)) == CN_Tbl_Idx && 07202 OPND_FLD(span_opnd) == CN_Tbl_Idx) { 07203 07204 if (fold_relationals(IR_IDX_R(IL_IDX(il_idx)), 07205 OPND_IDX(span_opnd), 07206 Ne_Opr)) { 07207 find_opnd_line_and_column(&IR_OPND_R(IL_IDX(il_idx)), 07208 &line, &column); 07209 PRINTMSG(line, 1525, Error, column); 07210 } 07211 } 07212 else if (!compare_opnds(&(IR_OPND_R(IL_IDX(il_idx))), &span_opnd)) { 07213 find_opnd_line_and_column(&IR_OPND_R(IL_IDX(il_idx)), 07214 &line, &column); 07215 PRINTMSG(line, 1525, Error, column); 07216 } 07217 07218 /* Remove matching sends from the send list. */ 07219 07220 send_il_idx = cdir_switches.send_list_idx; 07221 prev_idx = NULL_IDX; 07222 matched = FALSE; 07223 07224 while (send_il_idx != NULL_IDX) { 07225 07226 if (IR_FLD_L(IL_IDX(send_il_idx)) == IR_FLD_L(IL_IDX(il_idx))) { 07227 remove = FALSE; 07228 07229 switch (IR_FLD_L(IL_IDX(il_idx))) { 07230 case NO_Tbl_Idx: /* Pointless */ 07231 remove = TRUE; 07232 pointless_wait = TRUE; 07233 break; 07234 07235 case CN_Tbl_Idx: /* Constant - must be same */ 07236 remove = fold_relationals(IR_IDX_L(IL_IDX(il_idx)), 07237 IR_IDX_L(IL_IDX(send_il_idx)), 07238 Eq_Opr); 07239 break; 07240 07241 default: /* Variable */ 07242 remove = TRUE; 07243 variable_send = TRUE; 07244 break; 07245 } 07246 07247 if (remove) { 07248 matched = TRUE; 07249 07250 if (prev_idx == NULL_IDX) { 07251 cdir_switches.send_list_idx=IL_NEXT_LIST_IDX(send_il_idx); 07252 } 07253 else { 07254 IL_NEXT_LIST_IDX(prev_idx) = IL_NEXT_LIST_IDX(send_il_idx); 07255 } 07256 } 07257 } 07258 send_il_idx = IL_NEXT_LIST_IDX(send_il_idx); 07259 } 07260 07261 if (!matched && !variable_send) { 07262 07263 if (IR_FLD_L(IL_IDX(il_idx)) == NO_Tbl_Idx) { 07264 line = IL_LINE_NUM(il_idx); 07265 column = IL_COL_NUM(il_idx); 07266 } 07267 else { 07268 find_opnd_line_and_column(&IR_OPND_L(IL_IDX(il_idx)), 07269 &line, &column); 07270 } 07271 PRINTMSG(line, 1527, Error, column, "WAIT", "SEND"); 07272 } 07273 il_idx = IL_NEXT_LIST_IDX(il_idx); 07274 } 07275 } 07276 07277 send_il_idx = cdir_switches.send_list_idx; 07278 07279 while (send_il_idx != NULL_IDX) { 07280 07281 /* Have a send without a wait. Issue error. */ 07282 07283 PRINTMSG(IR_LINE_NUM(IL_IDX(send_il_idx)), 1527, Error, 07284 IR_COL_NUM(IL_IDX(send_il_idx)), "SEND", "WAIT"); 07285 send_il_idx = IL_NEXT_LIST_IDX(send_il_idx); 07286 } 07287 07288 if (OPND_FLD(span_opnd) == CN_Tbl_Idx) { 07289 07290 /* See the explanation for message 1526. It describes what is */ 07291 /* being checked in the next if and else clause. */ 07292 07293 if (fold_relationals(OPND_IDX(span_opnd), 07294 CN_INTEGER_ONE_IDX, 07295 Eq_Opr)) { 07296 07297 if (num_waits > (pointless_wait ? max_num_waits : max_num_waits - 1)) { 07298 find_opnd_line_and_column(&span_opnd, &line, &column); 07299 PRINTMSG(line, 1526, Error, column, 07300 (pointless_wait ? max_num_waits : (max_num_waits-1))); 07301 } 07302 max_waits = pointless_wait ? max_num_waits : (max_num_waits - 1); 07303 max_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, max_waits); 07304 } 07305 else { /* Adjust maximum number of waits based on span value. */ 07306 type_idx = CG_INTEGER_DEFAULT_TYPE; 07307 C_TO_F_INT(num, 64, CG_INTEGER_DEFAULT_TYPE); 07308 folder_driver((char *) &num, 07309 CG_INTEGER_DEFAULT_TYPE, 07310 (char *) &CN_CONST(OPND_IDX(span_opnd)), 07311 CN_TYPE_IDX(OPND_IDX(span_opnd)), 07312 result, 07313 &type_idx, 07314 OPND_LINE_NUM(span_opnd), 07315 OPND_COL_NUM(span_opnd), 07316 2, 07317 Div_Opr); 07318 07319 if (!pointless_wait) { 07320 07321 /* If not a pointess wait. Subtract one from the maximum */ 07322 07323 type_idx1 = CG_INTEGER_DEFAULT_TYPE; 07324 folder_driver((char *) &result, 07325 type_idx, 07326 (char *) &CN_CONST(CN_INTEGER_ONE_IDX), 07327 CN_TYPE_IDX(CN_INTEGER_ONE_IDX), 07328 result1, 07329 &type_idx1, 07330 OPND_LINE_NUM(span_opnd), 07331 OPND_COL_NUM(span_opnd), 07332 2, 07333 Minus_Opr); 07334 07335 max_idx = ntr_const_tbl(type_idx1, 07336 FALSE, 07337 result1); 07338 } 07339 else { 07340 max_idx = ntr_const_tbl(type_idx, 07341 FALSE, 07342 result); 07343 } 07344 07345 type_idx = CG_LOGICAL_DEFAULT_TYPE; 07346 C_TO_F_INT(num, num_waits, CG_INTEGER_DEFAULT_TYPE); 07347 07348 folder_driver((char *) &num_waits, 07349 CG_INTEGER_DEFAULT_TYPE, 07350 (char *) &CN_CONST(max_idx), 07351 CN_TYPE_IDX(max_idx), 07352 result, 07353 &type_idx, 07354 OPND_LINE_NUM(span_opnd), 07355 OPND_COL_NUM(span_opnd), 07356 2, 07357 Gt_Opr); 07358 07359 if (THIS_IS_TRUE(result, type_idx)) { 07360 find_opnd_line_and_column(&span_opnd, &line, &column); 07361 PRINTMSG(line, 1526, Error, column, CN_INT_TO_C(max_idx)); 07362 } 07363 } 07364 07365 if (cdir_switches.wait_list_idx != NULL_IDX) { 07366 il_idx = cdir_switches.wait_list_idx; 07367 07368 while (il_idx != NULL_IDX) { 07369 07370 if (IR_FLD_L(IL_IDX(il_idx)) == CN_Tbl_Idx) { 07371 07372 /* Check that point value does not exceed max number of waits */ 07373 07374 type_idx = CG_LOGICAL_DEFAULT_TYPE; 07375 07376 folder_driver((char *)&CN_CONST(IR_IDX_L(IL_IDX(il_idx))), 07377 CN_TYPE_IDX(IR_IDX_L(IL_IDX(il_idx))), 07378 (char *)&CN_CONST(max_idx), 07379 CN_TYPE_IDX(max_idx), 07380 result, 07381 &type_idx, 07382 IR_LINE_NUM_L(IR_IDX_L(IL_IDX(il_idx))), 07383 IR_COL_NUM_L(IR_IDX_L(IL_IDX(il_idx))), 07384 2, 07385 Gt_Opr); 07386 07387 if (THIS_IS_TRUE(result, type_idx)) { 07388 find_opnd_line_and_column(&IR_OPND_L(IL_IDX(il_idx)), 07389 &line, &column); 07390 PRINTMSG(line, 1528, Error, column, CN_INT_TO_C(max_idx)); 07391 } 07392 } 07393 il_idx = IL_NEXT_LIST_IDX(il_idx); 07394 } 07395 } 07396 } 07397 07398 cdir_switches.wait_list_idx = NULL_IDX; 07399 cdir_switches.send_list_idx = NULL_IDX; 07400 07401 TRACE (Func_Exit, "wait_send_semantics", NULL); 07402 07403 return; 07404 07405 } /* wait_send_semantics */ 07406 07407 /******************************************************************************\ 07408 |* *| 07409 |* Description: *| 07410 |* <description> *| 07411 |* *| 07412 |* Input parameters: *| 07413 |* NONE *| 07414 |* *| 07415 |* Output parameters: *| 07416 |* NONE *| 07417 |* *| 07418 |* Returns: *| 07419 |* NOTHING *| 07420 |* *| 07421 \******************************************************************************/ 07422 07423 void bounds_cdir_handler(int ir_idx) 07424 07425 { 07426 int attr_idx; 07427 int col; 07428 int line; 07429 int list_idx1; 07430 int list_idx2; 07431 07432 TRACE (Func_Entry, "bounds_cdir_handler", NULL); 07433 07434 line = IR_LINE_NUM(ir_idx); 07435 col = IR_COL_NUM(ir_idx); 07436 07437 if (IR_OPR(ir_idx) == Bounds_Cdir_Opr) { 07438 07439 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) { 07440 list_idx1 = IR_IDX_L(ir_idx); 07441 07442 while (list_idx1) { 07443 attr_idx = IL_IDX(list_idx1); 07444 07445 /* if ATD_NOBOUNDS_CHECK set, clear and remove from nobounds list */ 07446 07447 if (ATD_NOBOUNDS_CHECK(attr_idx)) { 07448 ATD_NOBOUNDS_CHECK(attr_idx) = FALSE; 07449 list_idx2 = cdir_switches.nobounds_il_list; 07450 07451 while (list_idx2 != NULL_IDX) { 07452 if (IL_IDX(list_idx2) == attr_idx) { 07453 /* remove the attr from the list */ 07454 07455 if (list_idx2 == cdir_switches.nobounds_il_list) { 07456 cdir_switches.nobounds_il_list = 07457 IL_NEXT_LIST_IDX(list_idx2); 07458 if (cdir_switches.nobounds_il_list) { 07459 IL_PREV_LIST_IDX(cdir_switches.nobounds_il_list) = 07460 NULL_IDX; 07461 } 07462 } 07463 else { 07464 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list_idx2)) = 07465 IL_NEXT_LIST_IDX(list_idx2); 07466 if (IL_NEXT_LIST_IDX(list_idx2)) { 07467 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) = 07468 IL_PREV_LIST_IDX(list_idx2); 07469 } 07470 } 07471 FREE_IR_LIST_NODE(list_idx2); 07472 07473 break; 07474 } 07475 list_idx2 = IL_NEXT_LIST_IDX(list_idx2); 07476 } 07477 } 07478 07479 /* now add to bounds list if not already there */ 07480 07481 if (ATD_BOUNDS_CHECK(attr_idx) == FALSE) { 07482 ATD_BOUNDS_CHECK(attr_idx) = TRUE; 07483 07484 NTR_IR_LIST_TBL(list_idx2); 07485 IL_FLD(list_idx2) = AT_Tbl_Idx; 07486 IL_IDX(list_idx2) = attr_idx; 07487 IL_LINE_NUM(list_idx2) = line; 07488 IL_COL_NUM(list_idx2) = col; 07489 07490 IL_NEXT_LIST_IDX(list_idx2) = cdir_switches.bounds_il_list; 07491 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) = list_idx2; 07492 cdir_switches.bounds_il_list = list_idx2; 07493 } 07494 07495 list_idx1 = IL_NEXT_LIST_IDX(list_idx1); 07496 } 07497 } 07498 else { 07499 cdir_switches.bounds = TRUE; 07500 07501 /* clear the NOBOUNDS flag on all attrs in the nobounds list */ 07502 07503 list_idx1 = cdir_switches.nobounds_il_list; 07504 cdir_switches.nobounds_il_list = NULL_IDX; 07505 07506 while (list_idx1) { 07507 attr_idx = IL_IDX(list_idx1); 07508 ATD_NOBOUNDS_CHECK(attr_idx) = FALSE; 07509 07510 list_idx2 = list_idx1; 07511 list_idx1 = IL_NEXT_LIST_IDX(list_idx1); 07512 FREE_IR_LIST_NODE(list_idx2); 07513 } 07514 } 07515 } 07516 else if (IR_OPR(ir_idx) == Nobounds_Cdir_Opr) { 07517 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) { 07518 list_idx1 = IR_IDX_L(ir_idx); 07519 07520 while (list_idx1) { 07521 attr_idx = IL_IDX(list_idx1); 07522 07523 /* if ATD_BOUNDS_CHECK set, clear and remove from bounds list */ 07524 07525 if (ATD_BOUNDS_CHECK(attr_idx)) { 07526 ATD_BOUNDS_CHECK(attr_idx) = FALSE; 07527 list_idx2 = cdir_switches.bounds_il_list; 07528 07529 while (list_idx2 != NULL_IDX) { 07530 if (IL_IDX(list_idx2) == attr_idx) { 07531 /* remove the attr from the list */ 07532 07533 if (list_idx2 == cdir_switches.bounds_il_list) { 07534 cdir_switches.bounds_il_list = 07535 IL_NEXT_LIST_IDX(list_idx2); 07536 if (cdir_switches.bounds_il_list) { 07537 IL_PREV_LIST_IDX(cdir_switches.bounds_il_list) = 07538 NULL_IDX; 07539 } 07540 } 07541 else { 07542 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list_idx2)) = 07543 IL_NEXT_LIST_IDX(list_idx2); 07544 if (IL_NEXT_LIST_IDX(list_idx2)) { 07545 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) = 07546 IL_PREV_LIST_IDX(list_idx2); 07547 } 07548 } 07549 FREE_IR_LIST_NODE(list_idx2); 07550 07551 break; 07552 } 07553 list_idx2 = IL_NEXT_LIST_IDX(list_idx2); 07554 } 07555 } 07556 07557 /* now add to nobounds list if not already there */ 07558 07559 if (ATD_NOBOUNDS_CHECK(attr_idx) == FALSE) { 07560 ATD_NOBOUNDS_CHECK(attr_idx) = TRUE; 07561 07562 NTR_IR_LIST_TBL(list_idx2); 07563 IL_FLD(list_idx2) = AT_Tbl_Idx; 07564 IL_IDX(list_idx2) = attr_idx; 07565 IL_LINE_NUM(list_idx2) = line; 07566 IL_COL_NUM(list_idx2) = col; 07567 07568 IL_NEXT_LIST_IDX(list_idx2) = cdir_switches.nobounds_il_list; 07569 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) = list_idx2; 07570 cdir_switches.nobounds_il_list = list_idx2; 07571 } 07572 07573 list_idx1 = IL_NEXT_LIST_IDX(list_idx1); 07574 } 07575 } 07576 else { 07577 cdir_switches.bounds = FALSE; 07578 07579 /* clear the BOUNDS flag on all attrs in the nobounds list */ 07580 07581 list_idx1 = cdir_switches.bounds_il_list; 07582 cdir_switches.bounds_il_list = NULL_IDX; 07583 07584 while (list_idx1) { 07585 attr_idx = IL_IDX(list_idx1); 07586 ATD_BOUNDS_CHECK(attr_idx) = FALSE; 07587 07588 list_idx2 = list_idx1; 07589 list_idx1 = IL_NEXT_LIST_IDX(list_idx1); 07590 FREE_IR_LIST_NODE(list_idx2); 07591 } 07592 } 07593 } 07594 # ifdef _DEBUG 07595 else { 07596 PRINTMSG(line, 626, Internal, col, 07597 "Bounds_Cdir_Opr or Nobounds_Cdir_Opr", 07598 "bounds_cdir_handler"); 07599 } 07600 # endif 07601 07602 TRACE (Func_Exit, "bounds_cdir_handler", NULL); 07603 07604 return; 07605 07606 } /* bounds_cdir_handler */
1.7.6.1 
