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