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 static char USMID[] = "\n@(#)5.0_pl/sources/s_directiv.c 5.12 10/28/99 10:03:56\n";
00038
00039 # include "defines.h"
00040
00041 # include "host.m"
00042 # include "host.h"
00043 # include "target.m"
00044 # include "target.h"
00045
00046 # include "globals.m"
00047 # include "tokens.m"
00048 # include "sytb.m"
00049 # include "s_globals.m"
00050 # include "debug.m"
00051
00052 # include "globals.h"
00053 # include "tokens.h"
00054 # include "sytb.h"
00055 # include "s_globals.h"
00056
00057
00058
00059
00060
00061
00062 static void add_common_blk_objects_to_list(int, int);
00063 static boolean assert_semantics(void);
00064 static boolean attr_is_in_list(int, int);
00065 static void doall_cmic_semantics(void);
00066 static void doparallel_cmic_semantics(void);
00067 static void end_blk_mp_semantics(boolean);
00068 static void set_mp_task_flags(int, boolean);
00069 static void endparallel_cmic_semantics(void);
00070 static boolean has_been_reprivatized(int);
00071 static void mp_directive_semantics(mp_directive_type);
00072 static boolean multiple_clause_err(int, int);
00073 static void open_mp_directive_semantics(open_mp_directive_type);
00074 static void parallel_cmic_semantics(void);
00075 static int pop_task_blk(void);
00076 static boolean power_o_two(int);
00077 static void prefetch_ref_semantics(void);
00078 static void push_task_blk(int);
00079 static void set_open_mp_task_flags(int, boolean);
00080 static void wait_send_semantics(void);
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098 void directive_stmt_semantics(void)
00099
00100 {
00101 int attr_idx;
00102 int column;
00103 expr_arg_type exp_desc;
00104 int host_attr_idx;
00105 int idx;
00106 int il_idx;
00107 int ir_idx;
00108 opnd_type l_opnd;
00109 int line;
00110 int list_idx;
00111 int name_idx;
00112 int new_il_idx;
00113 boolean null_point;
00114 long64 num_cpus;
00115 long num_cpu_value;
00116 boolean ok = TRUE;
00117 int old_ir_idx;
00118 opnd_type opnd;
00119 int prev_idx;
00120 expr_mode_type save_expr_mode;
00121 int sn_idx;
00122
00123
00124 TRACE (Func_Entry, "directive_stmt_semantics", NULL);
00125
00126 ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
00127
00128 switch(IR_OPR(ir_idx)) {
00129
00130 case Aggressiveinnerloopfission_Opr:
00131 cdir_switches.aggressiveinnerloopfission = TRUE;
00132 break;
00133
00134 case Align_Cdir_Opr:
00135 cdir_switches.align = TRUE;
00136 break;
00137
00138
00139 case Bl_Cdir_Opr:
00140 cdir_switches.bl = TRUE;
00141 break;
00142
00143
00144 case Blockable_Dir_Opr:
00145 cdir_switches.blockable_sh_idx = curr_stmt_sh_idx;
00146 cdir_switches.blockable_group++;
00147 cdir_switches.blockable_count =
00148 IR_LIST_CNT_L(SH_IR_IDX(curr_stmt_sh_idx));
00149 break;
00150
00151
00152 case Bounds_Cdir_Opr:
00153 case Nobounds_Cdir_Opr:
00154
00155 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) {
00156 list_idx = IR_IDX_L(ir_idx);
00157
00158 while (list_idx) {
00159
00160
00161
00162
00163 in_call_list = TRUE;
00164
00165 COPY_OPND(opnd, IL_OPND(list_idx));
00166 xref_state = CIF_Symbol_Reference;
00167 exp_desc.rank = 0;
00168 ok &= expr_semantics(&opnd, &exp_desc);
00169 in_call_list = FALSE;
00170
00171 attr_idx = find_left_attr(&opnd);
00172
00173 find_opnd_line_and_column(&opnd, &line, &column);
00174
00175 if (attr_idx == NULL_IDX ||
00176 AT_OBJ_CLASS(attr_idx) != Data_Obj) {
00177
00178 PRINTMSG(line, 1141, Error, column,
00179 (IR_OPR(ir_idx) == Bounds_Cdir_Opr ?
00180 "BOUNDS" : "NOBOUNDS"));
00181 }
00182
00183 IL_FLD(list_idx) = AT_Tbl_Idx;
00184 IL_IDX(list_idx) = attr_idx;
00185 IL_LINE_NUM(list_idx) = line;
00186 IL_COL_NUM(list_idx) = column;
00187
00188 list_idx = IL_NEXT_LIST_IDX(list_idx);
00189 }
00190 }
00191
00192 bounds_cdir_handler(ir_idx);
00193
00194 break;
00195
00196
00197 case Cachealign_Cdir_Opr :
00198
00199 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx &&
00200 IR_LIST_CNT_L(ir_idx) > 0) {
00201
00202 list_idx = IR_IDX_L(ir_idx);
00203
00204 while (list_idx) {
00205
00206
00207
00208
00209 in_call_list = TRUE;
00210
00211 COPY_OPND(opnd, IL_OPND(list_idx));
00212 exp_desc.rank = 0;
00213 xref_state = CIF_Symbol_Reference;
00214 ok = expr_semantics(&opnd, &exp_desc);
00215
00216 attr_idx = find_left_attr(&opnd);
00217
00218 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
00219 ATD_CLASS(attr_idx) != Variable ||
00220 ATD_IN_COMMON(attr_idx)) {
00221
00222 find_opnd_line_and_column(&opnd, &line, &column);
00223 PRINTMSG(line, 1067, Error, column);
00224 }
00225 else if (ATD_CACHE_ALIGN(attr_idx)) {
00226 find_opnd_line_and_column(&opnd, &line, &column);
00227 PRINTMSG(line, 1065, Error, column);
00228 }
00229 else {
00230 ATD_CACHE_ALIGN(attr_idx) = TRUE;
00231 }
00232
00233 list_idx = IL_NEXT_LIST_IDX(list_idx);
00234 }
00235
00236 in_call_list = FALSE;
00237 }
00238
00239 break;
00240
00241 case Cache_Bypass_Cdir_Opr:
00242
00243 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) {
00244 cdir_switches.cache_bypass_ir_idx = ir_idx;
00245
00246 if (IR_LIST_CNT_L(ir_idx) > 0) {
00247 list_idx = IR_IDX_L(ir_idx);
00248
00249 while (list_idx) {
00250
00251
00252
00253
00254 in_call_list = TRUE;
00255
00256 COPY_OPND(opnd, IL_OPND(list_idx));
00257 exp_desc.rank = 0;
00258 xref_state = CIF_Symbol_Reference;
00259 ok = expr_semantics(&opnd, &exp_desc);
00260
00261 attr_idx = find_left_attr(&opnd);
00262
00263 if (AT_OBJ_CLASS(attr_idx) == Interface &&
00264 ATI_PROC_IDX(attr_idx) != NULL_IDX) {
00265 attr_idx = ATI_PROC_IDX(attr_idx);
00266 }
00267
00268 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit &&
00269 ATP_PGM_UNIT(attr_idx) == Function &&
00270 !ATP_RSLT_NAME(attr_idx)) {
00271 attr_idx = ATP_RSLT_IDX(attr_idx);
00272 }
00273
00274 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
00275 ATD_ARRAY_IDX(attr_idx) == NULL_IDX) {
00276 find_opnd_line_and_column(&opnd, &line, &column);
00277 PRINTMSG(line, 1318, Error, column,
00278 AT_OBJ_NAME_PTR(attr_idx));
00279 }
00280 else if (TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) != Integer_8 &&
00281 TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) != Real_8 &&
00282 TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) != Logical_8 &&
00283 TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) != Complex_8) {
00284 find_opnd_line_and_column(&opnd, &line, &column);
00285 PRINTMSG(line, 1320, Error, column,
00286 AT_OBJ_NAME_PTR(attr_idx));
00287 }
00288 else {
00289 ATD_CACHE_BYPASS_ARRAY(attr_idx) = TRUE;
00290 }
00291 list_idx = IL_NEXT_LIST_IDX(list_idx);
00292 }
00293 }
00294 in_call_list = FALSE;
00295 }
00296 break;
00297
00298 case Cncall_Cmic_Opr:
00299 cdir_switches.cncall = TRUE;
00300 break;
00301
00302 case Concurrentize_Star_Opr:
00303 break;
00304
00305 case Noconcurrentize_Star_Opr:
00306 break;
00307
00308 case Fissionable_Star_Opr:
00309 cdir_switches.fissionable = TRUE;
00310 break;
00311
00312 case Flush_Star_Opr:
00313 list_idx = IR_IDX_L(ir_idx);
00314
00315 while (list_idx != NULL_IDX) {
00316 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
00317 attr_idx = IL_IDX(list_idx);
00318 AT_LOCKED_IN(attr_idx) = TRUE;
00319
00320 while (AT_ATTR_LINK(attr_idx)) {
00321 attr_idx = AT_ATTR_LINK(attr_idx);
00322 AT_LOCKED_IN(attr_idx) = TRUE;
00323 }
00324
00325 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) {
00326 PRINTMSG(IL_LINE_NUM(list_idx), 1480, Error,
00327 IL_COL_NUM(list_idx));
00328 }
00329
00330 IL_IDX(list_idx) = attr_idx;
00331 }
00332
00333 list_idx = IL_NEXT_LIST_IDX(list_idx);
00334 }
00335 break;
00336
00337 case Fusable_Star_Opr:
00338 cdir_switches.fusable = TRUE;
00339 break;
00340
00341 case Inline_Cdir_Opr:
00342 cdir_switches.do_inline = TRUE;
00343 break;
00344
00345 case Interchange_Dir_Opr:
00346 cdir_switches.interchange_sh_idx = curr_stmt_sh_idx;;
00347 cdir_switches.interchange_group++;
00348 cdir_switches.interchange_count =
00349 IR_LIST_CNT_L(SH_IR_IDX(curr_stmt_sh_idx));
00350 break;
00351
00352 case Ivdep_Cdir_Opr:
00353 cdir_switches.ivdep = TRUE;
00354
00355 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
00356 COPY_OPND(opnd, IR_OPND_L(ir_idx));
00357 exp_desc.rank = 0;
00358 xref_state = CIF_Symbol_Reference;
00359 ok = expr_semantics(&opnd, &exp_desc);
00360
00361 if (OPND_FLD(opnd) != CN_Tbl_Idx ||
00362 exp_desc.rank != 0 ||
00363 exp_desc.type != Integer) {
00364 find_opnd_line_and_column(&opnd, &line, &column);
00365 PRINTMSG(line, 796, Error, column);
00366 }
00367 else if (compare_cn_and_value(OPND_IDX(opnd), 1, Lt_Opr) ||
00368 compare_cn_and_value(OPND_IDX(opnd), 1024, Gt_Opr)) {
00369 find_opnd_line_and_column(&opnd, &line, &column);
00370 PRINTMSG(line, 796, Error, column);
00371 }
00372 else {
00373 cdir_switches.safevl_idx = OPND_IDX(opnd);
00374 }
00375 }
00376 else {
00377 cdir_switches.safevl_idx = const_safevl_idx;
00378 }
00379
00380 break;
00381
00382
00383 case Concurrent_Cdir_Opr:
00384
00385 cdir_switches.concurrent = TRUE;
00386
00387 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
00388 COPY_OPND(opnd, IR_OPND_L(ir_idx));
00389 exp_desc.rank = 0;
00390 xref_state = CIF_Symbol_Reference;
00391 ok = expr_semantics(&opnd, &exp_desc);
00392
00393 if (OPND_FLD(opnd) != CN_Tbl_Idx ||
00394 exp_desc.rank != 0 ||
00395 exp_desc.type != Integer) {
00396 find_opnd_line_and_column(&opnd, &line, &column);
00397 PRINTMSG(line, 1422, Error, column);
00398 }
00399 else if (fold_relationals(OPND_IDX(opnd),
00400 CN_INTEGER_ONE_IDX,
00401 Lt_Opr)) {
00402
00403
00404
00405 find_opnd_line_and_column(&opnd, &line, &column);
00406 PRINTMSG(line, 1422, Error, column);
00407 }
00408 else {
00409 cdir_switches.concurrent_idx = OPND_IDX(opnd);
00410 }
00411 }
00412 break;
00413
00414 case Mark_Cdir_Opr:
00415 cdir_switches.mark = TRUE;
00416
00417 if (IR_FLD_L(ir_idx) == CN_Tbl_Idx) {
00418 cdir_switches.mark_dir_idx = IR_IDX_L(ir_idx);
00419 }
00420 break;
00421
00422 case Nextscalar_Cdir_Opr:
00423 cdir_switches.nextscalar = TRUE;
00424 break;
00425
00426 case Noblocking_Dir_Opr:
00427 cdir_switches.noblocking = TRUE;
00428 break;
00429
00430 case Nofission_Star_Opr:
00431 cdir_switches.nofission = TRUE;
00432 break;
00433
00434 case Nofusion_Star_Opr:
00435 cdir_switches.nofusion = TRUE;
00436 break;
00437
00438 case Nointerchange_Dir_Opr:
00439 cdir_switches.nointerchange = TRUE;
00440 break;
00441
00442 case Nomark_Cdir_Opr:
00443 cdir_switches.mark = FALSE;
00444 cdir_switches.mark_dir_idx = NULL_IDX;
00445 break;
00446
00447
00448 case Nobl_Cdir_Opr:
00449 cdir_switches.bl = FALSE;
00450 break;
00451
00452 case Noinline_Cdir_Opr:
00453 cdir_switches.do_inline = FALSE;
00454 break;
00455
00456 case Nopattern_Cdir_Opr:
00457 cdir_switches.pattern = FALSE;
00458 break;
00459
00460
00461 case Norecurrence_Cdir_Opr:
00462 cdir_switches.recurrence = FALSE;
00463 break;
00464
00465
00466 case Nosplit_Cdir_Opr:
00467 cdir_switches.split = FALSE;
00468 break;
00469
00470
00471 case Nostream_Dir_Opr:
00472 cdir_switches.stream = FALSE;
00473 break;
00474
00475
00476 case Notask_Cdir_Opr:
00477 cdir_switches.task = FALSE;
00478 cdir_switches.notask_region = TRUE;
00479 break;
00480
00481
00482 case Nounroll_Cdir_Opr:
00483
00484
00485
00486 cdir_switches.unroll_count_idx = CN_INTEGER_ONE_IDX;
00487 cdir_switches.unroll_dir = TRUE;
00488 break;
00489
00490
00491 case Novector_Cdir_Opr:
00492 cdir_switches.vector = FALSE;
00493 break;
00494
00495
00496 case Novsearch_Cdir_Opr:
00497 cdir_switches.vsearch = FALSE;
00498 break;
00499
00500 case Opaque_Star_Opr:
00501 cdir_switches.opaque = TRUE;
00502 break;
00503
00504
00505 case Pattern_Cdir_Opr:
00506 cdir_switches.pattern = TRUE;
00507 break;
00508
00509
00510 case Permutation_Cmic_Opr:
00511 cdir_switches.permutation = TRUE;
00512 break;
00513
00514
00515 case Preferstream_Nocinv_Dir_Opr:
00516 cdir_switches.preferstream_nocinv = TRUE;
00517
00518
00519
00520 case Preferstream_Dir_Opr:
00521 cdir_switches.preferstream = TRUE;
00522 break;
00523
00524
00525 case Prefertask_Cdir_Opr:
00526 cdir_switches.prefertask = TRUE;
00527 break;
00528
00529
00530 case Prefervector_Cdir_Opr:
00531 cdir_switches.prefervector = TRUE;
00532 break;
00533
00534 case Purpleconditional_Star_Opr:
00535 cdir_switches.purpleconditional = TRUE;
00536
00537 COPY_OPND(opnd, IR_OPND_L(ir_idx));
00538 exp_desc.rank = 0;
00539 xref_state = CIF_Symbol_Reference;
00540 ok = expr_semantics(&opnd, &exp_desc);
00541
00542 find_opnd_line_and_column(&opnd, &line, &column);
00543 if (exp_desc.type != Logical ||
00544 exp_desc.rank != 0) {
00545 PRINTMSG(line, 803, Error, column);
00546 }
00547
00548 idx = create_tmp_asg(&opnd,
00549 &exp_desc,
00550 &l_opnd,
00551 Intent_In,
00552 FALSE,
00553 FALSE);
00554 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
00555 IR_IDX_L(ir_idx) = idx;
00556 IR_LINE_NUM_L(ir_idx) = line;
00557 IR_COL_NUM_L(ir_idx) = column;
00558 break;
00559
00560 case Purpleunconditional_Star_Opr:
00561 cdir_switches.purpleunconditional = TRUE;
00562 break;
00563
00564 case Recurrence_Cdir_Opr:
00565 cdir_switches.recurrence = TRUE;
00566 break;
00567
00568
00569 case Shortloop_Cdir_Opr:
00570 cdir_switches.shortloop = TRUE;
00571
00572 if (cdir_switches.shortloop128) {
00573 cdir_switches.shortloop128 = FALSE;
00574 }
00575
00576 break;
00577
00578
00579 case Split_Cdir_Opr:
00580 cdir_switches.split = TRUE;
00581 break;
00582
00583
00584 case Shortloop128_Cdir_Opr:
00585 cdir_switches.shortloop128 = TRUE;
00586
00587 if (cdir_switches.shortloop) {
00588 cdir_switches.shortloop = FALSE;
00589 }
00590
00591 break;
00592
00593
00594 case Stream_Dir_Opr:
00595 cdir_switches.stream = TRUE;
00596 break;
00597
00598
00599 case Suppress_Opr:
00600 list_idx = IR_IDX_L(ir_idx);
00601
00602 while (list_idx) {
00603
00604
00605
00606 in_call_list = TRUE;
00607
00608 COPY_OPND(opnd, IL_OPND(list_idx));
00609 exp_desc.rank = 0;
00610 xref_state = CIF_Symbol_Reference;
00611 ok = expr_semantics(&opnd, &exp_desc);
00612
00613 while (OPND_FLD(opnd) == IR_Tbl_Idx &&
00614 (IR_OPR(OPND_IDX(opnd)) == Whole_Substring_Opr ||
00615 IR_OPR(OPND_IDX(opnd)) == Whole_Subscript_Opr ||
00616 (IR_OPR(OPND_IDX(opnd)) == Subscript_Opr &&
00617 IR_FLD_R(OPND_IDX(opnd)) == IL_Tbl_Idx &&
00618 IL_PE_SUBSCRIPT(IR_IDX_R(OPND_IDX(opnd)))) ||
00619 IR_OPR(OPND_IDX(opnd)) == Dv_Deref_Opr)) {
00620
00621 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
00622 }
00623
00624 if (OPND_FLD(opnd) != AT_Tbl_Idx) {
00625 find_opnd_line_and_column(&opnd, &line, &column);
00626 PRINTMSG(line, 1487, Error, column, "SUPPRESS");
00627 }
00628
00629 COPY_OPND(IL_OPND(list_idx), opnd);
00630
00631 list_idx = IL_NEXT_LIST_IDX(list_idx);
00632 }
00633
00634 in_call_list = FALSE;
00635 break;
00636
00637
00638 case Task_Cdir_Opr:
00639 cdir_switches.task = TRUE;
00640 cdir_switches.notask_region = FALSE;
00641 break;
00642
00643
00644 case Unroll_Cdir_Opr:
00645
00646 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
00647 COPY_OPND(opnd, IR_OPND_L(ir_idx));
00648 save_expr_mode = expr_mode;
00649 exp_desc.rank = 0;
00650 xref_state = CIF_Symbol_Reference;
00651 expr_mode = Initialization_Expr;
00652 ok = expr_semantics(&opnd, &exp_desc);
00653 COPY_OPND(IR_OPND_L(ir_idx), opnd);
00654
00655 if (OPND_FLD(opnd) != CN_Tbl_Idx ||
00656 exp_desc.rank != 0 ||
00657 exp_desc.type != Integer) {
00658 find_opnd_line_and_column(&opnd, &line, &column);
00659 PRINTMSG(line, 1105, Error, column);
00660 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
00661 IR_FLD_L(ir_idx) = CN_Tbl_Idx;
00662 }
00663 else if (fold_relationals(OPND_IDX(opnd),
00664 CN_INTEGER_ZERO_IDX,
00665 Eq_Opr)) {
00666
00667
00668
00669
00670 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
00671 IR_FLD_L(ir_idx) = CN_Tbl_Idx;
00672 }
00673 else if (compare_cn_and_value(OPND_IDX(opnd), 0, Lt_Opr) ||
00674 compare_cn_and_value(OPND_IDX(opnd), 1024, Gt_Opr)) {
00675 find_opnd_line_and_column(&opnd, &line, &column);
00676 PRINTMSG(line, 1105, Error, column);
00677 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
00678 IR_FLD_L(ir_idx) = CN_Tbl_Idx;
00679 }
00680
00681 cdir_switches.unroll_count_idx = IR_IDX_L(ir_idx);
00682 cdir_switches.unroll_dir = TRUE;
00683 expr_mode = save_expr_mode;
00684 }
00685 else {
00686 cdir_switches.unroll_count_idx = CN_INTEGER_ZERO_IDX;
00687 cdir_switches.unroll_dir = TRUE;
00688 }
00689 break;
00690
00691
00692 case Vector_Cdir_Opr:
00693 cdir_switches.vector = TRUE;
00694 break;
00695
00696
00697 case Vsearch_Cdir_Opr:
00698 cdir_switches.vsearch = TRUE;
00699 break;
00700
00701
00702
00703
00704
00705
00706
00707
00708
00709
00710
00711
00712 case Doall_Cmic_Opr:
00713
00714 doall_cmic_semantics();
00715 break;
00716
00717
00718
00719
00720
00721
00722 case Doparallel_Cmic_Opr:
00723
00724 doparallel_cmic_semantics();
00725 break;
00726
00727 case Enddo_Cmic_Opr:
00728 if (IR_OPR(SH_IR_IDX(SH_NEXT_IDX(curr_stmt_sh_idx))) ==
00729 Endparallel_Cmic_Opr) {
00730
00731 IR_FLD_L(ir_idx) = CN_Tbl_Idx;
00732 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
00733 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
00734 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
00735 }
00736
00737 wait_send_semantics();
00738 break;
00739
00740
00741
00742
00743
00744
00745 case Guard_Cmic_Opr:
00746 case Endguard_Cmic_Opr:
00747
00748 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
00749
00750 COPY_OPND(opnd, IR_OPND_L(ir_idx));
00751 exp_desc.rank = 0;
00752 xref_state = CIF_Symbol_Reference;
00753 ok = expr_semantics(&opnd, &exp_desc);
00754 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
00755 idx = create_tmp_asg(&opnd,
00756 &exp_desc,
00757 &l_opnd,
00758 Intent_In,
00759 FALSE,
00760 FALSE);
00761 IR_IDX_L(ir_idx) = idx;
00762 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
00763 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
00764 }
00765
00766 break;
00767
00768
00769
00770
00771
00772
00773 case Endparallel_Cmic_Opr:
00774
00775 endparallel_cmic_semantics();
00776 break;
00777
00778
00779
00780
00781
00782
00783 case Numcpus_Cmic_Opr:
00784
00785 if (cdir_switches.parallel_region) {
00786
00787
00788
00789 PRINTMSG(stmt_start_line, 1121, Error, stmt_start_col);
00790 }
00791
00792 COPY_OPND(opnd, IR_OPND_L(ir_idx));
00793 exp_desc.rank = 0;
00794 xref_state = CIF_Symbol_Reference;
00795 ok = expr_semantics(&opnd, &exp_desc);
00796 COPY_OPND(IR_OPND_L(ir_idx), opnd);
00797 num_cpus = CN_INT_TO_C(IR_IDX_L(ir_idx));
00798
00799 if (IR_FLD_L(ir_idx) == CN_Tbl_Idx && (num_cpus < 1 || num_cpus > 64)){
00800
00801 if (num_cpus < 1) {
00802 num_cpu_value = 1;
00803 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
00804 }
00805 else {
00806 num_cpu_value = 64;
00807 IR_IDX_L(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
00808 num_cpu_value);
00809 }
00810
00811 PRINTMSG(stmt_start_line, 1122, Warning,
00812 stmt_start_col,
00813 (long) num_cpus,
00814 num_cpu_value);
00815 }
00816
00817 break;
00818
00819
00820
00821
00822
00823
00824 case Parallel_Cmic_Opr:
00825
00826 parallel_cmic_semantics();
00827 break;
00828
00829
00830
00831
00832
00833 case Send_Cmic_Opr:
00834
00835 NTR_IR_LIST_TBL(new_il_idx);
00836
00837 IL_FLD(new_il_idx) = IR_Tbl_Idx;
00838 IL_IDX(new_il_idx) = ir_idx;
00839 IL_LINE_NUM(new_il_idx) = IR_LINE_NUM(ir_idx);
00840 IL_COL_NUM(new_il_idx) = IR_COL_NUM(ir_idx);
00841
00842 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
00843 COPY_OPND(opnd, IR_OPND_L(ir_idx));
00844 exp_desc.rank = 0;
00845 xref_state = CIF_Symbol_Reference;
00846 ok = expr_semantics(&opnd, &exp_desc);
00847
00848 if (exp_desc.type != Integer || exp_desc.rank != 0) {
00849 find_opnd_line_and_column(&opnd, &line, &column);
00850 PRINTMSG(line, 1431, Error, column, "POINT", "SEND");
00851 }
00852
00853 COPY_OPND(IR_OPND_L(ir_idx), opnd);
00854 }
00855
00856 if (IR_FLD_R(ir_idx) != NO_Tbl_Idx) {
00857 COPY_OPND(opnd, IR_OPND_R(ir_idx));
00858 exp_desc.rank = 0;
00859 xref_state = CIF_Symbol_Reference;
00860 ok = expr_semantics(&opnd, &exp_desc);
00861 find_opnd_line_and_column(&opnd, &line, &column);
00862
00863 if (ok && (exp_desc.type != Logical || exp_desc.rank != 0)) {
00864 PRINTMSG(line, 1433, Error, column, "IF", "SEND");
00865 }
00866 COPY_OPND(IR_OPND_R(ir_idx), opnd);
00867
00868 IR_FLD_R(ir_idx) = AT_Tbl_Idx;
00869 idx = create_tmp_asg(&opnd,
00870 &exp_desc,
00871 &l_opnd,
00872 Intent_In,
00873 FALSE,
00874 FALSE);
00875 IR_IDX_R(ir_idx) = idx;
00876 IR_LINE_NUM_R(ir_idx) = line;
00877 IR_COL_NUM_R(ir_idx) = column;
00878 }
00879
00880 if (cdir_switches.send_list_idx == NULL_IDX) {
00881 cdir_switches.send_list_idx = new_il_idx;
00882 }
00883 else {
00884 il_idx = cdir_switches.send_list_idx;
00885
00886 while (il_idx != NULL_IDX) {
00887 prev_idx = il_idx;
00888 il_idx = IL_NEXT_LIST_IDX(il_idx);
00889 }
00890
00891 IL_NEXT_LIST_IDX(prev_idx) = new_il_idx;
00892 }
00893 break;
00894
00895
00896
00897
00898
00899 case Wait_Cmic_Opr:
00900
00901
00902
00903 NTR_IR_LIST_TBL(new_il_idx);
00904
00905 IL_FLD(new_il_idx) = IR_Tbl_Idx;
00906 IL_IDX(new_il_idx) = ir_idx;
00907 IL_LINE_NUM(new_il_idx) = IR_LINE_NUM(ir_idx);
00908 IL_COL_NUM(new_il_idx) = IR_COL_NUM(ir_idx);
00909
00910 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
00911 COPY_OPND(opnd, IR_OPND_L(ir_idx));
00912 exp_desc.rank = 0;
00913 xref_state = CIF_Symbol_Reference;
00914 ok = expr_semantics(&opnd, &exp_desc);
00915
00916 if (exp_desc.type != Integer || exp_desc.rank != 0) {
00917 find_opnd_line_and_column(&opnd, &line, &column);
00918 PRINTMSG(line, 1431, Error, column, "POINT", "WAIT");
00919 }
00920
00921 COPY_OPND(IR_OPND_L(ir_idx), opnd);
00922 null_point = FALSE;
00923 }
00924 else {
00925 null_point = TRUE;
00926 }
00927
00928 COPY_OPND(opnd, IR_OPND_R(ir_idx));
00929 exp_desc.rank = 0;
00930 xref_state = CIF_Symbol_Reference;
00931 ok = expr_semantics(&opnd, &exp_desc);
00932
00933 if (exp_desc.type != Integer || exp_desc.rank != 0 ||
00934 OPND_FLD(opnd) != CN_Tbl_Idx) {
00935 find_opnd_line_and_column(&opnd, &line, &column);
00936 PRINTMSG(line, 1532, Error, column);
00937 IR_FLD_R(ir_idx) = CN_Tbl_Idx;
00938 IR_IDX_R(ir_idx) = CN_INTEGER_ONE_IDX;
00939 }
00940 else {
00941 COPY_OPND(IR_OPND_R(ir_idx), opnd);
00942 }
00943
00944 if (cdir_switches.wait_list_idx == NULL_IDX) {
00945
00946
00947
00948 cdir_switches.wait_list_idx = new_il_idx;
00949 }
00950 else {
00951
00952
00953
00954 il_idx = cdir_switches.wait_list_idx;
00955
00956 while (il_idx != NULL_IDX) {
00957 prev_idx = il_idx;
00958 old_ir_idx = IL_IDX(il_idx);
00959
00960 if (IR_FLD_L(old_ir_idx) == NO_Tbl_Idx) {
00961
00962 if (null_point) {
00963 PRINTMSG(IR_LINE_NUM(ir_idx), 1521, Error,
00964 IR_COL_NUM(ir_idx));
00965 ok = FALSE;
00966 break;
00967 }
00968 }
00969 else if (IR_FLD_L(ir_idx) == CN_Tbl_Idx &&
00970 IR_FLD_L(old_ir_idx) == CN_Tbl_Idx &&
00971 fold_relationals(IR_IDX_L(ir_idx),
00972 IR_IDX_L(old_ir_idx),
00973 Eq_Opr)) {
00974
00975
00976
00977 find_opnd_line_and_column(&(IR_OPND_L(ir_idx)),
00978 &line, &column);
00979 PRINTMSG(line, 1521, Error, column);
00980 ok = FALSE;
00981 break;
00982 }
00983 il_idx = IL_NEXT_LIST_IDX(il_idx);
00984 }
00985
00986 if (ok) {
00987 IL_NEXT_LIST_IDX(prev_idx) = new_il_idx;
00988 }
00989 }
00990 break;
00991
00992
00993
00994
00995
00996
00997
00998
00999
01000
01001
01002
01003
01004 case Doacross_Dollar_Opr:
01005 mp_directive_semantics(Doacross);
01006 break;
01007
01008
01009
01010
01011
01012 case Copyin_Dollar_Opr:
01013
01014 if (cdir_switches.doall_sh_idx != NULL_IDX ||
01015 cdir_switches.doacross_sh_idx != NULL_IDX ||
01016 cdir_switches.parallel_region ||
01017 cdir_switches.guard_in_par_reg) {
01018
01019 PRINTMSG(IR_LINE_NUM(ir_idx), 1395, Error, IR_COL_NUM(ir_idx));
01020 }
01021
01022 list_idx = IR_IDX_L(ir_idx);
01023
01024 while (list_idx) {
01025 if (IL_FLD(list_idx) != SB_Tbl_Idx &&
01026 IL_FLD(list_idx) != NO_Tbl_Idx) {
01027 COPY_OPND(opnd, IL_OPND(list_idx));
01028 xref_state = CIF_Symbol_Reference;
01029 exp_desc.rank = 0;
01030 ok &= expr_semantics(&opnd, &exp_desc);
01031 COPY_OPND(IL_OPND(list_idx), opnd);
01032
01033 find_opnd_line_and_column(&opnd, &line, &column);
01034 attr_idx = find_left_attr(&opnd);
01035
01036 if (! exp_desc.reference ||
01037 AT_OBJ_CLASS(attr_idx) != Data_Obj ||
01038 ! ATD_IN_COMMON(attr_idx) ||
01039 ATD_STOR_BLK_IDX(attr_idx) == NULL_IDX ||
01040 SB_BLANK_COMMON(ATD_STOR_BLK_IDX(attr_idx))) {
01041
01042
01043 PRINTMSG(line, 1394, Error, column);
01044 }
01045 }
01046 else {
01047
01048 }
01049 list_idx = IL_NEXT_LIST_IDX(list_idx);
01050 }
01051 break;
01052
01053
01054
01055
01056
01057
01058 case Dynamic_Dollar_Opr:
01059
01060 list_idx = IR_IDX_L(ir_idx);
01061
01062 while (list_idx) {
01063 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01064 attr_idx = IL_IDX(list_idx);
01065 AT_LOCKED_IN(attr_idx) = TRUE;
01066
01067 while (AT_ATTR_LINK(attr_idx)) {
01068 attr_idx = AT_ATTR_LINK(attr_idx);
01069 AT_LOCKED_IN(attr_idx) = TRUE;
01070 }
01071
01072 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
01073 ATD_ARRAY_IDX(attr_idx) == NULL_IDX) {
01074
01075 find_opnd_line_and_column(&IL_OPND(list_idx), &line, &column);
01076 PRINTMSG(line, 1396, Error, column, "C$DYNAMIC");
01077 }
01078
01079 IL_IDX(list_idx) = attr_idx;
01080 }
01081 list_idx = IL_NEXT_LIST_IDX(list_idx);
01082 }
01083 break;
01084
01085
01086
01087
01088
01089 case Page_Place_Dollar_Opr:
01090 list_idx = IR_IDX_L(ir_idx);
01091
01092 COPY_OPND(opnd, IL_OPND(list_idx));
01093 xref_state = CIF_Symbol_Reference;
01094 exp_desc.rank = 0;
01095 ok &= expr_semantics(&opnd, &exp_desc);
01096 COPY_OPND(IL_OPND(list_idx), opnd);
01097
01098
01099
01100 list_idx = IL_NEXT_LIST_IDX(list_idx);
01101
01102 COPY_OPND(opnd, IL_OPND(list_idx));
01103 xref_state = CIF_Symbol_Reference;
01104 exp_desc.rank = 0;
01105 ok &= expr_semantics(&opnd, &exp_desc);
01106 COPY_OPND(IL_OPND(list_idx), opnd);
01107
01108 if (exp_desc.type != Integer ||
01109 exp_desc.rank != 0) {
01110
01111 find_opnd_line_and_column(&opnd, &line, &column);
01112 PRINTMSG(line, 1397, Error, column);
01113 }
01114
01115 list_idx = IL_NEXT_LIST_IDX(list_idx);
01116
01117 COPY_OPND(opnd, IL_OPND(list_idx));
01118 xref_state = CIF_Symbol_Reference;
01119 exp_desc.rank = 0;
01120 ok &= expr_semantics(&opnd, &exp_desc);
01121 COPY_OPND(IL_OPND(list_idx), opnd);
01122
01123 if (exp_desc.type != Integer ||
01124 exp_desc.rank != 0) {
01125
01126 find_opnd_line_and_column(&opnd, &line, &column);
01127 PRINTMSG(line, 1397, Error, column);
01128 }
01129
01130 break;
01131
01132
01133
01134
01135
01136 case Redistribute_Dollar_Opr:
01137 attr_idx = IR_IDX_L(ir_idx);
01138 AT_LOCKED_IN(attr_idx) = TRUE;
01139
01140 while (AT_ATTR_LINK(attr_idx)) {
01141 attr_idx = AT_ATTR_LINK(attr_idx);
01142 AT_LOCKED_IN(attr_idx) = TRUE;
01143 }
01144
01145 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
01146 ATD_ARRAY_IDX(attr_idx) == NULL_IDX) {
01147
01148 find_opnd_line_and_column(&IR_OPND_L(ir_idx), &line, &column);
01149 PRINTMSG(line, 1396, Error, column, "C$REDISTRIBUTE");
01150 }
01151
01152 IR_IDX_L(ir_idx) = attr_idx;
01153
01154 list_idx = IL_IDX(IR_IDX_R(ir_idx));
01155
01156 while (list_idx) {
01157 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
01158 COPY_OPND(opnd, IL_OPND(list_idx));
01159 xref_state = CIF_Symbol_Reference;
01160 exp_desc.rank = 0;
01161 ok &= expr_semantics(&opnd, &exp_desc);
01162 COPY_OPND(IL_OPND(list_idx), opnd);
01163
01164 if (exp_desc.type != Integer ||
01165 exp_desc.rank != 0) {
01166
01167 find_opnd_line_and_column(&opnd, &line, &column);
01168 PRINTMSG(line, 1397, Error, column);
01169 }
01170 }
01171 list_idx = IL_NEXT_LIST_IDX(list_idx);
01172 }
01173
01174 list_idx = IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx));
01175
01176 if (list_idx) {
01177 list_idx = IL_IDX(list_idx);
01178
01179 while(list_idx) {
01180 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
01181 COPY_OPND(opnd, IL_OPND(list_idx));
01182 xref_state = CIF_Symbol_Reference;
01183 exp_desc.rank = 0;
01184 ok &= expr_semantics(&opnd, &exp_desc);
01185 COPY_OPND(IL_OPND(list_idx), opnd);
01186
01187 find_opnd_line_and_column(&opnd, &line, &column);
01188
01189 if (OPND_FLD(opnd) != CN_Tbl_Idx ||
01190 exp_desc.type != Integer) {
01191
01192 PRINTMSG(line, 1368, Error, column);
01193 }
01194 else if (compare_cn_and_value(OPND_IDX(opnd),
01195 0,
01196 Lt_Opr)) {
01197
01198
01199 PRINTMSG(line, 1368, Error, column);
01200 }
01201 }
01202
01203 list_idx = IL_NEXT_LIST_IDX(list_idx);
01204 }
01205 }
01206
01207 break;
01208
01209
01210
01211
01212
01213 case Pdo_Par_Opr:
01214 mp_directive_semantics(Pdo);
01215 break;
01216
01217
01218
01219
01220
01221 case Parallel_Do_Par_Opr:
01222 mp_directive_semantics(Parallel_Do);
01223 break;
01224
01225
01226
01227
01228
01229 case Parallel_Par_Opr:
01230 mp_directive_semantics(Parallel);
01231 break;
01232
01233
01234
01235
01236
01237 case Psection_Par_Opr:
01238 mp_directive_semantics(Psection);
01239 break;
01240
01241
01242
01243
01244
01245 case Singleprocess_Par_Opr:
01246 mp_directive_semantics(Singleprocess);
01247 break;
01248
01249 case Section_Par_Opr:
01250 break;
01251
01252 case End_Pdo_Par_Opr:
01253 end_blk_mp_semantics(FALSE);
01254 break;
01255
01256 case End_Parallel_Par_Opr:
01257 end_blk_mp_semantics(FALSE);
01258 break;
01259
01260 case Barrier_Par_Opr:
01261 break;
01262
01263 case Critical_Section_Par_Opr:
01264 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
01265 COPY_OPND(opnd, IR_OPND_L(ir_idx));
01266 xref_state = CIF_Symbol_Reference;
01267 exp_desc.rank = 0;
01268 ok &= expr_semantics(&opnd, &exp_desc);
01269 COPY_OPND(IR_OPND_L(ir_idx), opnd);
01270 }
01271 break;
01272
01273 case End_Critical_Section_Par_Opr:
01274 break;
01275
01276 case End_Psection_Par_Opr:
01277 end_blk_mp_semantics(FALSE);
01278 break;
01279
01280 case End_Singleprocess_Par_Opr:
01281 end_blk_mp_semantics(FALSE);
01282 break;
01283
01284
01285
01286
01287
01288
01289
01290
01291 case Blockingsize_Dir_Opr:
01292 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
01293 COPY_OPND(opnd, IR_OPND_L(ir_idx));
01294 xref_state = CIF_Symbol_Reference;
01295 exp_desc.rank = 0;
01296 ok &= expr_semantics(&opnd, &exp_desc);
01297
01298 # if 0
01299 if (OPND_FLD(opnd) == CN_Tbl_Idx &&
01300 exp_desc.rank == 0 &&
01301 exp_desc.type == Integer) {
01302
01303 if (compare_cn_and_value(OPND_IDX(opnd), 0, Lt_Opr) {
01304 find_opnd_line_and_column(&opnd, &line, &column);
01305 PRINTMSG(line, 796, Error, column);
01306 }
01307 }
01308 # endif
01309
01310 COPY_OPND(IR_OPND_L(ir_idx), opnd);
01311
01312
01313 }
01314
01315 if (IR_FLD_R(ir_idx) != NO_Tbl_Idx) {
01316 COPY_OPND(opnd, IR_OPND_R(ir_idx));
01317 xref_state = CIF_Symbol_Reference;
01318 exp_desc.rank = 0;
01319 ok &= expr_semantics(&opnd, &exp_desc);
01320 COPY_OPND(IR_OPND_R(ir_idx), opnd);
01321 }
01322 break;
01323
01324 case Assert_Star_Opr:
01325 ok = assert_semantics();
01326 break;
01327
01328 case Fission_Star_Opr:
01329 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
01330 COPY_OPND(opnd, IR_OPND_L(ir_idx));
01331 xref_state = CIF_Symbol_Reference;
01332 exp_desc.rank = 0;
01333 ok &= expr_semantics(&opnd, &exp_desc);
01334 COPY_OPND(IR_OPND_L(ir_idx), opnd);
01335 }
01336 break;
01337
01338 case Fuse_Star_Opr:
01339 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
01340 COPY_OPND(opnd, IR_OPND_L(ir_idx));
01341 xref_state = CIF_Symbol_Reference;
01342 exp_desc.rank = 0;
01343 ok &= expr_semantics(&opnd, &exp_desc);
01344 COPY_OPND(IR_OPND_L(ir_idx), opnd);
01345 }
01346 break;
01347
01348 case Regionbegin_Star_Opr:
01349 break;
01350
01351 case Regionend_Star_Opr:
01352 break;
01353
01354 case Section_Nongp_Star_Opr:
01355 case Section_Gp_Star_Opr:
01356 list_idx = IR_IDX_L(ir_idx);
01357
01358 while (list_idx != NULL_IDX) {
01359
01360 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01361
01362 if (ATD_IN_COMMON(IL_IDX(list_idx))) {
01363 PRINTMSG(IL_LINE_NUM(list_idx), 1440, Error,
01364 IL_COL_NUM(list_idx),
01365 SB_BLANK_COMMON(ATD_STOR_BLK_IDX(IL_IDX(list_idx))) ?
01366 "" : SB_NAME_PTR(ATD_STOR_BLK_IDX(IL_IDX(list_idx))),
01367 AT_OBJ_NAME_PTR(IL_IDX(list_idx)),
01368 (IR_OPR(ir_idx) == Section_Gp_Star_Opr) ?
01369 "SECTION_GP": "SECTION_NON_GP");
01370 }
01371 else if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) {
01372 PRINTMSG(IL_LINE_NUM(list_idx), 1547, Error,
01373 IL_COL_NUM(list_idx),
01374 AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx)),
01375 AT_OBJ_NAME_PTR(IL_IDX(list_idx)),
01376 (IR_OPR(ir_idx) == Section_Gp_Star_Opr) ?
01377 "SECTION_GP": "SECTION_NON_GP");
01378 }
01379 else if (ATD_STOR_BLK_IDX(IL_IDX(list_idx)) == NULL_IDX ||
01380 (SB_BLK_TYPE(ATD_STOR_BLK_IDX(IL_IDX(list_idx))) != Static &&
01381 SB_BLK_TYPE(ATD_STOR_BLK_IDX(IL_IDX(list_idx))) !=
01382 Static_Local &&
01383 SB_BLK_TYPE(ATD_STOR_BLK_IDX(IL_IDX(list_idx))) !=
01384 Static_Named)) {
01385
01386 if (!AT_DCL_ERR(IL_IDX(list_idx))) {
01387 PRINTMSG(IL_LINE_NUM(list_idx), 1497, Error,
01388 IL_COL_NUM(list_idx),
01389 AT_OBJ_NAME_PTR(IL_IDX(list_idx)),
01390 (IR_OPR(ir_idx) == Section_Gp_Star_Opr) ?
01391 "SECTION_GP": "SECTION_NON_GP");
01392 }
01393 }
01394 }
01395 else if (IL_FLD(list_idx) == SB_Tbl_Idx) {
01396
01397
01398 if (IR_OPR(ir_idx) == Section_Gp_Star_Opr &&
01399 SB_BLK_TYPE(IL_IDX(list_idx)) == Threadprivate) {
01400 PRINTMSG(IL_LINE_NUM(list_idx), 1645, Error,
01401 IL_COL_NUM(list_idx),
01402 SB_NAME_PTR(IL_IDX(list_idx)));
01403 }
01404 }
01405
01406 list_idx = IL_NEXT_LIST_IDX(list_idx);
01407 }
01408 break;
01409
01410 case Unroll_Star_Opr:
01411 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
01412 COPY_OPND(opnd, IR_OPND_L(ir_idx));
01413 xref_state = CIF_Symbol_Reference;
01414 exp_desc.rank = 0;
01415 ok &= expr_semantics(&opnd, &exp_desc);
01416 COPY_OPND(IR_OPND_L(ir_idx), opnd);
01417 }
01418 break;
01419
01420 case Prefetch_Manual_Star_Opr:
01421 if (IR_FLD_L(ir_idx) != CN_Tbl_Idx ||
01422 (compare_cn_and_value(IR_IDX_L(ir_idx),
01423 0,
01424 Ne_Opr) &&
01425 compare_cn_and_value(IR_IDX_L(ir_idx),
01426 1,
01427 Ne_Opr))) {
01428
01429 find_opnd_line_and_column(&IR_OPND_L(ir_idx), &line, &column);
01430 PRINTMSG(line, 1378, Error, column, "PREFETCH_MANUAL");
01431 }
01432 break;
01433
01434 case Prefetch_Ref_Star_Opr:
01435 prefetch_ref_semantics();
01436 break;
01437
01438 case Prefetch_Star_Opr:
01439 if (IR_FLD_L(ir_idx) != CN_Tbl_Idx ||
01440 (compare_cn_and_value(IR_IDX_L(ir_idx),
01441 0,
01442 Ne_Opr) &&
01443 compare_cn_and_value(IR_IDX_L(ir_idx),
01444 1,
01445 Ne_Opr) &&
01446 compare_cn_and_value(IR_IDX_L(ir_idx),
01447 2,
01448 Ne_Opr))) {
01449
01450 find_opnd_line_and_column(&IR_OPND_L(ir_idx), &line, &column);
01451 PRINTMSG(line, 1378, Error, column, "PREFETCH");
01452 }
01453
01454 if (IR_FLD_R(ir_idx) != NO_Tbl_Idx) {
01455 if (IR_FLD_R(ir_idx) != CN_Tbl_Idx ||
01456 (compare_cn_and_value(IR_IDX_R(ir_idx),
01457 0,
01458 Ne_Opr) &&
01459 compare_cn_and_value(IR_IDX_R(ir_idx),
01460 1,
01461 Ne_Opr) &&
01462 compare_cn_and_value(IR_IDX_R(ir_idx),
01463 2,
01464 Ne_Opr))) {
01465
01466 find_opnd_line_and_column(&IR_OPND_R(ir_idx), &line, &column);
01467 PRINTMSG(line, 1378, Error, column, "PREFETCH");
01468 }
01469 }
01470 else {
01471 IR_FLD_R(ir_idx) = CN_Tbl_Idx;
01472 IR_IDX_R(ir_idx) = CN_INTEGER_NEG_ONE_IDX;
01473 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
01474 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);;
01475 }
01476
01477 break;
01478
01479 case Prefetch_Ref_Disable_Star_Opr:
01480 # ifdef _DEBUG
01481 if (IR_FLD_L(ir_idx) != AT_Tbl_Idx) {
01482 PRINTMSG(IR_LINE_NUM(ir_idx), 626, Internal, IR_COL_NUM(ir_idx),
01483 "AT_Tbl_Idx", "directive_stmt_semantics");
01484 }
01485 # endif
01486 attr_idx = IR_IDX_L(ir_idx);
01487 AT_LOCKED_IN(attr_idx) = TRUE;
01488
01489 while (AT_ATTR_LINK(attr_idx)) {
01490 attr_idx = AT_ATTR_LINK(attr_idx);
01491 AT_LOCKED_IN(attr_idx) = TRUE;
01492 }
01493
01494 IR_IDX_L(ir_idx) = attr_idx;
01495
01496 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
01497 ATD_ARRAY_IDX(attr_idx) == NULL_IDX) {
01498
01499 find_opnd_line_and_column(&IR_OPND_L(ir_idx), &line, &column);
01500 PRINTMSG(line, 1382, Error, column);
01501 }
01502
01503 if (IR_FLD_R(ir_idx) != NO_Tbl_Idx) {
01504 COPY_OPND(opnd, IR_OPND_R(ir_idx));
01505 xref_state = CIF_Symbol_Reference;
01506 exp_desc.rank = 0;
01507 ok &= expr_semantics(&opnd, &exp_desc);
01508 COPY_OPND(IR_OPND_R(ir_idx), opnd);
01509
01510 if (OPND_FLD(opnd) != CN_Tbl_Idx) {
01511 find_opnd_line_and_column(&IR_OPND_R(ir_idx), &line, &column);
01512 PRINTMSG(line, 1383, Error, column, "PREFETCH_REF_DISABLE");
01513 }
01514 }
01515 break;
01516
01517 case Align_Symbol_Star_Opr:
01518 case Fill_Symbol_Star_Opr:
01519
01520 # ifdef _DEBUG
01521 if (IR_FLD_L(ir_idx) != AT_Tbl_Idx && IR_FLD_L(ir_idx) != SB_Tbl_Idx) {
01522 PRINTMSG(IR_LINE_NUM(ir_idx), 626, Internal, IR_COL_NUM(ir_idx),
01523 "AT_Tbl_Idx or SB_Tbl_Idx", "directive_stmt_semantics");
01524 }
01525 # endif
01526
01527 COPY_OPND(opnd, IR_OPND_R(ir_idx));
01528
01529 xref_state = CIF_Symbol_Reference;
01530 exp_desc.rank = 0;
01531 ok &= expr_semantics(&opnd, &exp_desc);
01532
01533 COPY_OPND(IR_OPND_R(ir_idx), opnd);
01534
01535 if (OPND_FLD(opnd) != CN_Tbl_Idx ||
01536 TYP_TYPE(CN_TYPE_IDX(OPND_IDX(opnd))) != Integer ||
01537 (compare_cn_and_value(OPND_IDX(opnd),
01538 -1,
01539 Ne_Opr) &&
01540 compare_cn_and_value(OPND_IDX(opnd),
01541 -2,
01542 Ne_Opr) &&
01543 compare_cn_and_value(OPND_IDX(opnd),
01544 -3,
01545 Ne_Opr) &&
01546 ! power_o_two(OPND_IDX(opnd)))) {
01547
01548 find_opnd_line_and_column(&opnd, &line, &column);
01549 PRINTMSG(line, 1386, Error, column,
01550 (IR_OPR(ir_idx) == Align_Symbol_Star_Opr ?
01551 "ALIGN_SYMBOL" : "FILL_SYMBOL"));
01552 }
01553
01554 break;
01555
01556 case Inline_Here_Star_Opr:
01557
01558 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) {
01559 cdir_switches.inline_here_sgi = TRUE;
01560 cdir_switches.noinline_here_sgi = FALSE;
01561
01562 if (cdir_switches.noinline_here_list_idx != NULL_IDX) {
01563 list_idx = cdir_switches.noinline_here_list_idx;
01564 cdir_switches.noinline_here_list_idx = NULL_IDX;
01565
01566 while (list_idx) {
01567
01568 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01569
01570 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) {
01571 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = FALSE;
01572 }
01573 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) {
01574 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx));
01575
01576 while (sn_idx != NULL_IDX) {
01577
01578 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01579 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx))=FALSE;
01580 }
01581 sn_idx = SN_SIBLING_LINK(sn_idx);
01582 }
01583 }
01584 }
01585 list_idx = IL_NEXT_LIST_IDX(list_idx);
01586 }
01587 }
01588
01589 if (cdir_switches.inline_here_list_idx != NULL_IDX) {
01590 list_idx = cdir_switches.inline_here_list_idx;
01591 cdir_switches.inline_here_list_idx = NULL_IDX;
01592
01593 while (list_idx) {
01594
01595 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01596
01597 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) {
01598 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = FALSE;
01599 }
01600 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) {
01601 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx));
01602
01603 while (sn_idx != NULL_IDX) {
01604
01605 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01606 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE;
01607 }
01608 sn_idx = SN_SIBLING_LINK(sn_idx);
01609 }
01610 }
01611 }
01612 list_idx = IL_NEXT_LIST_IDX(list_idx);
01613 }
01614 }
01615 }
01616 else {
01617 cdir_switches.inline_here_list_idx = IR_IDX_L(ir_idx);
01618 list_idx = IR_IDX_L(ir_idx);
01619
01620 while (list_idx) {
01621
01622 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01623
01624 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) {
01625 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = TRUE;
01626 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = FALSE;
01627 }
01628 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) {
01629 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx));
01630
01631 while (sn_idx != NULL_IDX) {
01632
01633 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01634 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = TRUE;
01635 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx)) = FALSE;
01636 }
01637 sn_idx = SN_SIBLING_LINK(sn_idx);
01638 }
01639 }
01640 }
01641 list_idx = IL_NEXT_LIST_IDX(list_idx);
01642 }
01643 }
01644 break;
01645
01646 case Noinline_Here_Star_Opr:
01647
01648 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) {
01649 cdir_switches.noinline_here_sgi = TRUE;
01650 cdir_switches.inline_here_sgi = FALSE;
01651
01652 if (cdir_switches.noinline_here_list_idx != NULL_IDX) {
01653 list_idx = cdir_switches.noinline_here_list_idx;
01654 cdir_switches.noinline_here_list_idx = NULL_IDX;
01655
01656 while (list_idx) {
01657
01658 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01659
01660 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) {
01661 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = FALSE;
01662 }
01663 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) {
01664 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx));
01665
01666 while (sn_idx != NULL_IDX) {
01667
01668 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01669 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx))=FALSE;
01670 }
01671 sn_idx = SN_SIBLING_LINK(sn_idx);
01672 }
01673 }
01674 }
01675 list_idx = IL_NEXT_LIST_IDX(list_idx);
01676 }
01677 }
01678
01679 if (cdir_switches.inline_here_list_idx != NULL_IDX) {
01680 list_idx = cdir_switches.inline_here_list_idx;
01681 cdir_switches.inline_here_list_idx = NULL_IDX;
01682
01683 while (list_idx) {
01684 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01685
01686 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) {
01687 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = FALSE;
01688 }
01689 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) {
01690 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx));
01691
01692 while (sn_idx != NULL_IDX) {
01693
01694 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01695 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE;
01696 }
01697 sn_idx = SN_SIBLING_LINK(sn_idx);
01698 }
01699 }
01700 }
01701 list_idx = IL_NEXT_LIST_IDX(list_idx);
01702 }
01703 }
01704 }
01705 else {
01706 cdir_switches.noinline_here_list_idx = IR_IDX_L(ir_idx);
01707 list_idx = IR_IDX_L(ir_idx);
01708
01709 while (list_idx) {
01710
01711 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01712
01713 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) {
01714 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = TRUE;
01715 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = FALSE;
01716 }
01717 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) {
01718 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx));
01719
01720 while (sn_idx != NULL_IDX) {
01721
01722 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01723 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx)) = TRUE;
01724 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE;
01725 }
01726 sn_idx = SN_SIBLING_LINK(sn_idx);
01727 }
01728 }
01729 }
01730 list_idx = IL_NEXT_LIST_IDX(list_idx);
01731 }
01732 }
01733 break;
01734
01735 case End_Inline_Here_Star_Opr:
01736
01737 cdir_switches.noinline_here_sgi = FALSE;
01738 cdir_switches.inline_here_sgi = FALSE;
01739
01740 if (cdir_switches.noinline_here_list_idx != NULL_IDX) {
01741 list_idx = cdir_switches.noinline_here_list_idx;
01742 cdir_switches.noinline_here_list_idx = NULL_IDX;
01743
01744 while (list_idx) {
01745
01746 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01747
01748 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) {
01749 ATP_SGI_LOCAL_NOINLINE(IL_IDX(list_idx)) = FALSE;
01750 }
01751 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) {
01752 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx));
01753
01754 while (sn_idx != NULL_IDX) {
01755
01756 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01757 ATP_SGI_LOCAL_NOINLINE(SN_ATTR_IDX(sn_idx)) = FALSE;
01758 }
01759 sn_idx = SN_SIBLING_LINK(sn_idx);
01760 }
01761 }
01762 }
01763 list_idx = IL_NEXT_LIST_IDX(list_idx);
01764 }
01765 }
01766
01767 if (cdir_switches.inline_here_list_idx != NULL_IDX) {
01768 list_idx = cdir_switches.inline_here_list_idx;
01769 cdir_switches.inline_here_list_idx = NULL_IDX;
01770
01771 while (list_idx) {
01772
01773 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
01774
01775 if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit) {
01776 ATP_SGI_LOCAL_INLINE(IL_IDX(list_idx)) = FALSE;
01777 }
01778 else if (AT_OBJ_CLASS(IL_IDX(list_idx)) == Interface) {
01779 sn_idx = ATI_FIRST_SPECIFIC_IDX(IL_IDX(list_idx));
01780
01781 while (sn_idx != NULL_IDX) {
01782
01783 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01784 ATP_SGI_LOCAL_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE;
01785 }
01786 sn_idx = SN_SIBLING_LINK(sn_idx);
01787 }
01788 }
01789 }
01790 list_idx = IL_NEXT_LIST_IDX(list_idx);
01791 }
01792 }
01793 break;
01794
01795
01796 case Inline_Routine_Star_Opr:
01797
01798 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) {
01799 SCP_INLINE_SGI(curr_scp_idx) = TRUE;
01800 SCP_NOINLINE_SGI(curr_scp_idx) = FALSE;
01801 }
01802 else {
01803 list_idx = IR_IDX_L(ir_idx);
01804
01805 while (list_idx) {
01806 attr_idx = IL_IDX(list_idx);
01807
01808 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) {
01809 ATP_SGI_ROUTINE_INLINE(attr_idx) = TRUE;
01810 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE;
01811 }
01812 else if (AT_OBJ_CLASS(attr_idx) == Interface) {
01813 sn_idx = ATI_FIRST_SPECIFIC_IDX(attr_idx);
01814
01815 while (sn_idx != NULL_IDX) {
01816
01817 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01818 ATP_SGI_ROUTINE_INLINE(SN_ATTR_IDX(sn_idx)) = TRUE;
01819 ATP_SGI_ROUTINE_NOINLINE(SN_ATTR_IDX(sn_idx)) = FALSE;
01820 }
01821 sn_idx = SN_SIBLING_LINK(sn_idx);
01822 }
01823 }
01824 list_idx = IL_NEXT_LIST_IDX(list_idx);
01825 }
01826 }
01827 break;
01828
01829 case Noinline_Routine_Star_Opr:
01830
01831 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) {
01832 SCP_NOINLINE_SGI(curr_scp_idx) = TRUE;
01833 SCP_INLINE_SGI(curr_scp_idx) = FALSE;
01834 }
01835 else {
01836 list_idx = IR_IDX_L(ir_idx);
01837
01838 while (list_idx) {
01839 attr_idx = IL_IDX(list_idx);
01840
01841 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) {
01842 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = TRUE;
01843 ATP_SGI_ROUTINE_INLINE(attr_idx) = FALSE;
01844 }
01845 else if (AT_OBJ_CLASS(attr_idx) == Interface) {
01846 sn_idx = ATI_FIRST_SPECIFIC_IDX(attr_idx);
01847
01848 while (sn_idx != NULL_IDX) {
01849
01850 if (!AT_IS_INTRIN(SN_ATTR_IDX(sn_idx))) {
01851 ATP_SGI_ROUTINE_NOINLINE(SN_ATTR_IDX(sn_idx)) = TRUE;
01852 ATP_SGI_ROUTINE_INLINE(SN_ATTR_IDX(sn_idx)) = FALSE;
01853 }
01854 sn_idx = SN_SIBLING_LINK(sn_idx);
01855 }
01856 }
01857
01858 list_idx = IL_NEXT_LIST_IDX(list_idx);
01859 }
01860 }
01861 break;
01862
01863 case Inline_Global_Star_Opr:
01864
01865 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) {
01866 inline_global_sgi = TRUE;
01867 noinline_global_sgi = FALSE;
01868 }
01869 else {
01870 list_idx = IR_IDX_L(ir_idx);
01871 while (list_idx) {
01872 attr_idx = IL_IDX(list_idx);
01873
01874 if (srch_global_name_tbl(AT_OBJ_NAME_PTR(attr_idx),
01875 AT_NAME_LEN(attr_idx),
01876 &name_idx)) {
01877
01878 }
01879 else {
01880 ntr_global_name_tbl(attr_idx, NULL_IDX, name_idx);
01881 GA_OBJ_CLASS(GN_ATTR_IDX(name_idx)) = Pgm_Unit;
01882 GAP_GLOBAL_DIR(GN_ATTR_IDX(name_idx)) = TRUE;
01883 }
01884
01885 GAP_INLINE_STATE(GN_ATTR_IDX(name_idx)) = Inline_Sgi;
01886
01887
01888
01889 ATP_SGI_ROUTINE_INLINE(attr_idx) = FALSE;
01890 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE;
01891
01892 ATP_SGI_GLOBAL_INLINE(attr_idx) = TRUE;
01893 ATP_SGI_GLOBAL_NOINLINE(attr_idx) = FALSE;
01894
01895 host_attr_idx = AT_ATTR_LINK(attr_idx);
01896
01897 while (host_attr_idx) {
01898 ATP_SGI_GLOBAL_INLINE(host_attr_idx) =
01899 ATP_SGI_GLOBAL_INLINE(attr_idx);
01900 ATP_SGI_GLOBAL_NOINLINE(host_attr_idx) =
01901 ATP_SGI_GLOBAL_NOINLINE(attr_idx);
01902
01903 ATP_SGI_ROUTINE_INLINE(host_attr_idx) = FALSE;
01904 ATP_SGI_ROUTINE_NOINLINE(host_attr_idx) = FALSE;
01905
01906 host_attr_idx = AT_ATTR_LINK(host_attr_idx);
01907 }
01908
01909 list_idx = IL_NEXT_LIST_IDX(list_idx);
01910 }
01911 }
01912
01913 if (! SH_COMPILER_GEN(curr_stmt_sh_idx)) {
01914 gen_gl_sh(After, Directive_Stmt, line, column,
01915 FALSE, FALSE, TRUE);
01916 GL_SH_IR_IDX(curr_gl_stmt_sh_idx) = copy_to_gl_subtree(ir_idx,
01917 IR_Tbl_Idx);
01918 }
01919 break;
01920
01921 case Noinline_Global_Star_Opr:
01922
01923 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) {
01924 noinline_global_sgi = TRUE;
01925 inline_global_sgi = FALSE;
01926 }
01927 else {
01928 list_idx = IR_IDX_L(ir_idx);
01929 while (list_idx) {
01930 attr_idx = IL_IDX(list_idx);
01931
01932 if (srch_global_name_tbl(AT_OBJ_NAME_PTR(attr_idx),
01933 AT_NAME_LEN(attr_idx),
01934 &name_idx)) {
01935
01936 }
01937 else {
01938 ntr_global_name_tbl(attr_idx, NULL_IDX, name_idx);
01939 GAP_GLOBAL_DIR(GN_ATTR_IDX(name_idx)) = TRUE;
01940 }
01941
01942 GAP_INLINE_STATE(GN_ATTR_IDX(name_idx)) = Noinline_Sgi;
01943
01944
01945
01946 ATP_SGI_ROUTINE_INLINE(attr_idx) = FALSE;
01947 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE;
01948
01949 ATP_SGI_GLOBAL_NOINLINE(attr_idx) = TRUE;
01950 ATP_SGI_GLOBAL_INLINE(attr_idx) = FALSE;
01951
01952 host_attr_idx = AT_ATTR_LINK(attr_idx);
01953
01954 while (host_attr_idx) {
01955 ATP_SGI_GLOBAL_INLINE(host_attr_idx) =
01956 ATP_SGI_GLOBAL_INLINE(attr_idx);
01957 ATP_SGI_GLOBAL_NOINLINE(host_attr_idx) =
01958 ATP_SGI_GLOBAL_NOINLINE(attr_idx);
01959
01960 ATP_SGI_ROUTINE_INLINE(host_attr_idx) = FALSE;
01961 ATP_SGI_ROUTINE_NOINLINE(host_attr_idx) = FALSE;
01962
01963 host_attr_idx = AT_ATTR_LINK(host_attr_idx);
01964 }
01965
01966 list_idx = IL_NEXT_LIST_IDX(list_idx);
01967 }
01968 }
01969
01970 if (! SH_COMPILER_GEN(curr_stmt_sh_idx)) {
01971 gen_gl_sh(After, Directive_Stmt, line, column,
01972 FALSE, FALSE, TRUE);
01973 GL_SH_IR_IDX(curr_gl_stmt_sh_idx) = copy_to_gl_subtree(ir_idx,
01974 IR_Tbl_Idx);
01975 }
01976 break;
01977
01978
01979 case Atomic_Open_Mp_Opr:
01980 break;
01981
01982 case Barrier_Open_Mp_Opr:
01983 break;
01984
01985 case Critical_Open_Mp_Opr:
01986 break;
01987
01988 case Do_Open_Mp_Opr:
01989 open_mp_directive_semantics(Do_Omp);
01990 break;
01991
01992 case Endcritical_Open_Mp_Opr:
01993 break;
01994
01995 case Enddo_Open_Mp_Opr:
01996 end_blk_mp_semantics(TRUE);
01997 break;
01998
01999 case Endparallel_Open_Mp_Opr:
02000 end_blk_mp_semantics(TRUE);
02001 break;
02002
02003 case Endparalleldo_Open_Mp_Opr:
02004 end_blk_mp_semantics(TRUE);
02005 break;
02006
02007 case Endparallelsections_Open_Mp_Opr:
02008 end_blk_mp_semantics(TRUE);
02009 break;
02010
02011 case Endparallelworkshare_Open_Mp_Opr:
02012 end_blk_mp_semantics(TRUE);
02013 break;
02014
02015 case Endworkshare_Open_Mp_Opr:
02016 break;
02017
02018 case Endmaster_Open_Mp_Opr:
02019 break;
02020
02021 case Endordered_Open_Mp_Opr:
02022 break;
02023
02024 case Endsections_Open_Mp_Opr:
02025 end_blk_mp_semantics(TRUE);
02026 break;
02027
02028 case Endsingle_Open_Mp_Opr:
02029 end_blk_mp_semantics(TRUE);
02030 break;
02031
02032 case Flush_Open_Mp_Opr:
02033 list_idx = IR_IDX_L(ir_idx);
02034
02035 while (list_idx != NULL_IDX) {
02036 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
02037 attr_idx = IL_IDX(list_idx);
02038 AT_LOCKED_IN(attr_idx) = TRUE;
02039
02040 while (AT_ATTR_LINK(attr_idx)) {
02041 attr_idx = AT_ATTR_LINK(attr_idx);
02042 AT_LOCKED_IN(attr_idx) = TRUE;
02043 }
02044
02045 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) {
02046 PRINTMSG(IL_LINE_NUM(list_idx), 1480, Error,
02047 IL_COL_NUM(list_idx));
02048 }
02049
02050 IL_IDX(list_idx) = attr_idx;
02051 }
02052
02053 list_idx = IL_NEXT_LIST_IDX(list_idx);
02054 }
02055 break;
02056
02057 case Master_Open_Mp_Opr:
02058 break;
02059
02060 case Ordered_Open_Mp_Opr:
02061 break;
02062
02063 case Parallel_Open_Mp_Opr:
02064 open_mp_directive_semantics(Parallel_Omp);
02065 break;
02066
02067 case Paralleldo_Open_Mp_Opr:
02068 open_mp_directive_semantics(Parallel_Do_Omp);
02069 break;
02070
02071 case Parallelsections_Open_Mp_Opr:
02072 open_mp_directive_semantics(Parallel_Sections_Omp);
02073 break;
02074
02075 case Parallelworkshare_Open_Mp_Opr:
02076 open_mp_directive_semantics(Parallel_Workshare_Omp);
02077 break;
02078
02079 case Section_Open_Mp_Opr:
02080 break;
02081
02082 case Sections_Open_Mp_Opr:
02083 open_mp_directive_semantics(Sections_Omp);
02084 break;
02085
02086 case Single_Open_Mp_Opr:
02087 open_mp_directive_semantics(Single_Omp);
02088 break;
02089
02090 case Workshare_Open_Mp_Opr:
02091 break;
02092
02093
02094 case XXX_OpenAD_Opr:
02095 case Dependent_OpenAD_Opr:
02096 case Independent_OpenAD_Opr:
02097 case Simple_OpenAD_Opr:
02098 case EndSimple_OpenAD_Opr:
02099 break;
02100
02101 }
02102
02103 TRACE (Func_Exit, "directive_stmt_semantics", NULL);
02104
02105 return;
02106
02107 }
02108
02109
02110
02111
02112
02113
02114
02115
02116
02117
02118
02119
02120
02121
02122
02123
02124
02125 static void doall_cmic_semantics(void)
02126
02127 {
02128 int attr_idx;
02129 int column;
02130 expr_arg_type exp_desc;
02131 int getfirst_list_idx;
02132 int idx;
02133 int ir_idx;
02134 int line;
02135 int list_idx;
02136 int list2_idx;
02137 int list3_idx;
02138 opnd_type l_opnd;
02139 opnd_type opnd;
02140 int private_list_idx;
02141 int save_curr_stmt_sh_idx;
02142 int shared_list_idx;
02143 long64 value;
02144
02145 # if defined(GENERATE_WHIRL)
02146 int max_idx;
02147 opnd_type opnd2;
02148 char string[13];
02149 # endif
02150
02151
02152 TRACE (Func_Entry, "doall_cmic_semantics", NULL);
02153
02154 ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
02155
02156 if (cdir_switches.doall_sh_idx != NULL_IDX ||
02157 cdir_switches.doacross_sh_idx != NULL_IDX ||
02158 cdir_switches.parallel_region ||
02159 cdir_switches.guard_in_par_reg) {
02160
02161
02162 PRINTMSG(IR_LINE_NUM(ir_idx), 814, Error, IR_COL_NUM(ir_idx));
02163 }
02164
02165 cdir_switches.doall_sh_idx = curr_stmt_sh_idx;
02166
02167
02168 remove_sh(curr_stmt_sh_idx);
02169 save_curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
02170
02171 SH_PREV_IDX(cdir_switches.doall_sh_idx) = NULL_IDX;
02172 SH_NEXT_IDX(cdir_switches.doall_sh_idx) = NULL_IDX;
02173
02174 list_idx = IR_IDX_L(ir_idx);
02175
02176
02177
02178 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
02179 COPY_OPND(opnd, IL_OPND(list_idx));
02180 exp_desc.rank = 0;
02181 xref_state = CIF_Symbol_Reference;
02182 expr_semantics(&opnd, &exp_desc);
02183
02184 find_opnd_line_and_column(&opnd, &line, &column);
02185 if (exp_desc.type != Logical ||
02186 exp_desc.rank != 0) {
02187 PRINTMSG(line, 803, Error, column);
02188 }
02189
02190 IL_FLD(list_idx) = AT_Tbl_Idx;
02191 idx = create_tmp_asg(&opnd,
02192 &exp_desc,
02193 &l_opnd,
02194 Intent_In,
02195 FALSE,
02196 FALSE);
02197 IL_IDX(list_idx) = idx;
02198 IL_LINE_NUM(list_idx) = line;
02199 IL_COL_NUM(list_idx) = column;
02200 }
02201
02202
02203
02204 list_idx = IL_NEXT_LIST_IDX(list_idx);
02205 cdir_switches.shared_list_idx = list_idx;
02206
02207 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
02208
02209 list2_idx = IL_IDX(list_idx);
02210
02211 while (list2_idx) {
02212
02213 attr_idx = IL_IDX(list2_idx);
02214 AT_LOCKED_IN(attr_idx) = TRUE;
02215
02216 while (AT_ATTR_LINK(attr_idx)) {
02217 attr_idx = AT_ATTR_LINK(attr_idx);
02218 AT_LOCKED_IN(attr_idx) = TRUE;
02219 }
02220
02221 IL_IDX(list2_idx) = attr_idx;
02222
02223 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit &&
02224 ATP_PROC(attr_idx) == Dummy_Proc) {
02225 ATP_TASK_SHARED(attr_idx) = TRUE;
02226 }
02227 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
02228 ATD_CLASS(attr_idx) == Constant) {
02229 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
02230 IL_COL_NUM(list2_idx),
02231 AT_OBJ_NAME_PTR(attr_idx),
02232 "SHARED", "DO ALL");
02233
02234
02235
02236 if (list2_idx == IL_IDX(cdir_switches.shared_list_idx)) {
02237
02238
02239
02240 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02241 IL_IDX(cdir_switches.shared_list_idx) = list2_idx;
02242 IL_IDX(list_idx) = list2_idx;
02243 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
02244 IL_LIST_CNT(list_idx)--;
02245 continue;
02246 }
02247 else {
02248 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
02249 IL_NEXT_LIST_IDX(list2_idx);
02250 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
02251 IL_PREV_LIST_IDX(list2_idx);
02252
02253 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02254 IL_LIST_CNT(list_idx)--;
02255 continue;
02256 }
02257 }
02258 else {
02259 ATD_TASK_SHARED(attr_idx) = TRUE;
02260 ATD_WAS_SCOPED(attr_idx) = TRUE;
02261 }
02262
02263 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx);
02264
02265 while (shared_list_idx != list2_idx &&
02266 shared_list_idx != NULL_IDX) {
02267
02268 if (attr_idx == IL_IDX(shared_list_idx)) {
02269
02270
02271
02272 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
02273 IL_NEXT_LIST_IDX(list2_idx);
02274 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
02275 IL_PREV_LIST_IDX(list2_idx);
02276
02277 list2_idx = IL_PREV_LIST_IDX(list2_idx);
02278 IL_LIST_CNT(list_idx)--;
02279 break;
02280 }
02281 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx);
02282 }
02283
02284 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02285 }
02286 }
02287
02288
02289
02290 list_idx = IL_NEXT_LIST_IDX(list_idx);
02291 cdir_switches.private_list_idx = list_idx;
02292
02293 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
02294
02295 list2_idx = IL_IDX(list_idx);
02296
02297 while (list2_idx) {
02298
02299 attr_idx = IL_IDX(list2_idx);
02300 AT_LOCKED_IN(attr_idx) = TRUE;
02301
02302 while (AT_ATTR_LINK(attr_idx)) {
02303 attr_idx = AT_ATTR_LINK(attr_idx);
02304 AT_LOCKED_IN(attr_idx) = TRUE;
02305 }
02306
02307 IL_IDX(list2_idx) = attr_idx;
02308
02309 # if defined(GENERATE_WHIRL)
02310 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
02311 (ATD_ALLOCATABLE(attr_idx) ||
02312 ATD_CLASS(attr_idx) == CRI__Pointee ||
02313 ATD_POINTER(attr_idx))) {
02314
02315 if (ATD_ALLOCATABLE(attr_idx)) {
02316 strcpy(string, "ALLOCATABLE");
02317 }
02318 else if (ATD_POINTER(attr_idx)) {
02319 strcpy(string, "POINTER");
02320 }
02321 else {
02322 strcpy(string, "Cray Pointee");
02323 }
02324
02325 PRINTMSG(IL_LINE_NUM(list2_idx), 1446, Error,
02326 IL_COL_NUM(list2_idx),
02327 string,
02328 AT_OBJ_NAME_PTR(attr_idx),
02329 "DOALL");
02330
02331 }
02332 else
02333 # endif
02334 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
02335 ATD_CLASS(attr_idx) == Constant) {
02336 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
02337 IL_COL_NUM(list2_idx),
02338 AT_OBJ_NAME_PTR(attr_idx),
02339 "PRIVATE", "DO ALL");
02340
02341
02342
02343 if (list2_idx == IL_IDX(cdir_switches.private_list_idx)) {
02344
02345
02346
02347 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02348 IL_IDX(cdir_switches.private_list_idx) = list2_idx;
02349 IL_IDX(list_idx) = list2_idx;
02350 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
02351 IL_LIST_CNT(list_idx)--;
02352 continue;
02353 }
02354 else {
02355 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
02356 IL_NEXT_LIST_IDX(list2_idx);
02357 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
02358 IL_PREV_LIST_IDX(list2_idx);
02359
02360 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02361 IL_LIST_CNT(list_idx)--;
02362 continue;
02363 }
02364 }
02365 else {
02366 ATD_TASK_PRIVATE(attr_idx) = TRUE;
02367 ATD_WAS_SCOPED(attr_idx) = TRUE;
02368
02369 if (ATD_CLASS(attr_idx) == Variable &&
02370 ATD_AUTOMATIC(attr_idx) &&
02371 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX &&
02372 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) {
02373
02374 ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE;
02375
02376 NTR_IR_LIST_TBL(list3_idx);
02377 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx;
02378 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx);
02379 IL_IDX(list_idx) = list3_idx;
02380 IL_LIST_CNT(list_idx)++;
02381
02382 IL_FLD(list3_idx) = AT_Tbl_Idx;
02383 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx);
02384 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx);
02385 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx);
02386 }
02387 }
02388
02389 private_list_idx = IL_IDX(cdir_switches.private_list_idx);
02390
02391 while (private_list_idx != list2_idx &&
02392 private_list_idx != NULL_IDX) {
02393
02394 if (attr_idx == IL_IDX(private_list_idx)) {
02395
02396
02397
02398 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
02399 IL_NEXT_LIST_IDX(list2_idx);
02400 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
02401 IL_PREV_LIST_IDX(list2_idx);
02402
02403 list2_idx = IL_PREV_LIST_IDX(list2_idx);
02404 IL_LIST_CNT(list_idx)--;
02405 goto CONTINUE;
02406 }
02407 private_list_idx = IL_NEXT_LIST_IDX(private_list_idx);
02408 }
02409
02410
02411 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx);
02412
02413 while (shared_list_idx) {
02414
02415 if (attr_idx == IL_IDX(shared_list_idx)) {
02416
02417
02418
02419 PRINTMSG(IL_LINE_NUM(list2_idx), 805, Error,
02420 IL_COL_NUM(list2_idx),
02421 AT_OBJ_NAME_PTR(attr_idx));
02422 break;
02423 }
02424 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx);
02425 }
02426
02427 CONTINUE:
02428 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02429 }
02430 }
02431
02432
02433
02434 list_idx = IL_NEXT_LIST_IDX(list_idx);
02435 cdir_switches.getfirst_list_idx = list_idx;
02436
02437 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
02438
02439 list2_idx = IL_IDX(list_idx);
02440
02441 while (list2_idx) {
02442
02443 attr_idx = IL_IDX(list2_idx);
02444 AT_LOCKED_IN(attr_idx) = TRUE;
02445
02446 while (AT_ATTR_LINK(attr_idx)) {
02447 attr_idx = AT_ATTR_LINK(attr_idx);
02448 AT_LOCKED_IN(attr_idx) = TRUE;
02449 }
02450
02451 IL_IDX(list2_idx) = attr_idx;
02452
02453 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
02454 ATD_CLASS(attr_idx) == Constant) {
02455 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
02456 IL_COL_NUM(list2_idx),
02457 AT_OBJ_NAME_PTR(attr_idx),
02458 "GETFIRST", "DO ALL");
02459
02460
02461
02462 if (list2_idx == IL_IDX(cdir_switches.getfirst_list_idx)) {
02463
02464
02465
02466 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02467 IL_IDX(cdir_switches.getfirst_list_idx) = list2_idx;
02468 IL_IDX(list_idx) = list2_idx;
02469 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
02470 IL_LIST_CNT(list_idx)--;
02471 continue;
02472 }
02473 else {
02474 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
02475 IL_NEXT_LIST_IDX(list2_idx);
02476 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
02477 IL_PREV_LIST_IDX(list2_idx);
02478
02479 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02480 IL_LIST_CNT(list_idx)--;
02481 continue;
02482 }
02483 }
02484 else {
02485 ATD_TASK_GETFIRST(attr_idx) = TRUE;
02486
02487 if (ATD_CLASS(attr_idx) == Variable &&
02488 ATD_AUTOMATIC(attr_idx) &&
02489 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX &&
02490 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) {
02491
02492 ATD_TASK_GETFIRST(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE;
02493
02494 NTR_IR_LIST_TBL(list3_idx);
02495 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx;
02496 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx);
02497 IL_IDX(list_idx) = list3_idx;
02498 IL_LIST_CNT(list_idx)++;
02499
02500 IL_FLD(list3_idx) = AT_Tbl_Idx;
02501 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx);
02502 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx);
02503 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx);
02504 }
02505 }
02506
02507 getfirst_list_idx = IL_IDX(cdir_switches.getfirst_list_idx);
02508
02509 while (getfirst_list_idx != list2_idx &&
02510 getfirst_list_idx != NULL_IDX) {
02511
02512 if (attr_idx == IL_IDX(getfirst_list_idx)) {
02513
02514
02515
02516 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
02517 IL_NEXT_LIST_IDX(list2_idx);
02518 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
02519 IL_PREV_LIST_IDX(list2_idx);
02520
02521 list2_idx = IL_PREV_LIST_IDX(list2_idx);
02522 IL_LIST_CNT(list_idx)--;
02523 goto CONTINUE2;
02524 }
02525 getfirst_list_idx = IL_NEXT_LIST_IDX(getfirst_list_idx);
02526 }
02527
02528
02529 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx);
02530
02531 while (shared_list_idx) {
02532
02533 if (attr_idx == IL_IDX(shared_list_idx)) {
02534
02535
02536
02537 PRINTMSG(IL_LINE_NUM(list2_idx), 1314, Error,
02538 IL_COL_NUM(list2_idx),
02539 AT_OBJ_NAME_PTR(attr_idx),
02540 "SHARED", "GETFIRST");
02541 break;
02542 }
02543 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx);
02544 }
02545
02546 private_list_idx = IL_IDX(cdir_switches.private_list_idx);
02547
02548 while (private_list_idx) {
02549
02550 if (attr_idx == IL_IDX(private_list_idx)) {
02551
02552
02553
02554 PRINTMSG(IL_LINE_NUM(list2_idx), 1314, Error,
02555 IL_COL_NUM(list2_idx),
02556 AT_OBJ_NAME_PTR(attr_idx),
02557 "PRIVATE", "GETFIRST");
02558 break;
02559 }
02560 private_list_idx = IL_NEXT_LIST_IDX(private_list_idx);
02561 }
02562
02563
02564 CONTINUE2:
02565 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02566 }
02567 }
02568
02569
02570
02571
02572 list_idx = IL_NEXT_LIST_IDX(list_idx);
02573
02574 if (IL_FLD(list_idx) == CN_Tbl_Idx) {
02575 cdir_switches.autoscope = TRUE;
02576 }
02577
02578
02579
02580 list_idx = IL_NEXT_LIST_IDX(list_idx);
02581
02582 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
02583
02584 list2_idx = IL_IDX(list_idx);
02585
02586 while (list2_idx) {
02587
02588 attr_idx = IL_IDX(list2_idx);
02589 AT_LOCKED_IN(attr_idx) = TRUE;
02590
02591 while (AT_ATTR_LINK(attr_idx)) {
02592 attr_idx = AT_ATTR_LINK(attr_idx);
02593 AT_LOCKED_IN(attr_idx) = TRUE;
02594 }
02595
02596 IL_IDX(list2_idx) = attr_idx;
02597
02598 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
02599 ATD_CLASS(attr_idx) == Constant) {
02600 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
02601 IL_COL_NUM(list2_idx),
02602 AT_OBJ_NAME_PTR(attr_idx),
02603 "CONTROL", "DO ALL");
02604
02605
02606 if (list2_idx == IL_IDX(list_idx)) {
02607
02608 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02609 IL_IDX(list_idx) = list2_idx;
02610 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
02611 IL_LIST_CNT(list_idx)--;
02612 continue;
02613 }
02614 else {
02615 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
02616 IL_NEXT_LIST_IDX(list2_idx);
02617 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
02618 IL_PREV_LIST_IDX(list2_idx);
02619
02620 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02621 IL_LIST_CNT(list_idx)--;
02622 continue;
02623 }
02624 }
02625
02626 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02627 }
02628 }
02629
02630
02631
02632 list_idx = IL_NEXT_LIST_IDX(list_idx);
02633
02634
02635
02636 list_idx = IL_NEXT_LIST_IDX(list_idx);
02637
02638 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
02639 COPY_OPND(opnd, IL_OPND(list_idx));
02640 exp_desc.rank = 0;
02641 xref_state = CIF_Symbol_Reference;
02642 expr_semantics(&opnd, &exp_desc);
02643
02644 find_opnd_line_and_column(&opnd, &line, &column);
02645
02646 if (exp_desc.type != Integer ||
02647 exp_desc.rank != 0) {
02648 PRINTMSG(line, 806, Error, column);
02649 }
02650
02651 IL_FLD(list_idx) = AT_Tbl_Idx;
02652 idx = create_tmp_asg(&opnd,
02653 &exp_desc,
02654 &l_opnd,
02655 Intent_In,
02656 FALSE,
02657 FALSE);
02658 IL_IDX(list_idx) = idx;
02659 IL_LINE_NUM(list_idx) = line;
02660 IL_COL_NUM(list_idx) = column;
02661 }
02662 else if (cdir_switches.maxcpus) {
02663 COPY_OPND(IL_OPND(list_idx), cdir_switches.maxcpus_opnd);
02664 cdir_switches.maxcpus = FALSE;
02665 }
02666
02667
02668
02669 list_idx = IL_NEXT_LIST_IDX(list_idx);
02670
02671
02672
02673 list_idx = IL_NEXT_LIST_IDX(list_idx);
02674
02675 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
02676 COPY_OPND(opnd, IL_OPND(list_idx));
02677 exp_desc.rank = 0;
02678 xref_state = CIF_Symbol_Reference;
02679 expr_semantics(&opnd, &exp_desc);
02680
02681 find_opnd_line_and_column(&opnd, &line, &column);
02682
02683 value = (IL_FLD(IL_PREV_LIST_IDX(list_idx)) != CN_Tbl_Idx) ? 0 :
02684 CN_INT_TO_C(IL_IDX(IL_PREV_LIST_IDX(list_idx)));
02685
02686 if (exp_desc.type != Integer || exp_desc.rank != 0) {
02687 PRINTMSG(line, 806, Error, column);
02688 }
02689 else if (OPND_FLD(opnd) == CN_Tbl_Idx &&
02690 IL_FLD(IL_PREV_LIST_IDX(list_idx)) == CN_Tbl_Idx &&
02691 compare_cn_and_value(OPND_IDX(opnd),
02692 0,
02693 Le_Opr)) {
02694
02695 if (value == CMIC_WORK_DIST_CHUNKSIZE) {
02696 PRINTMSG(line, 1499, Error, column, "CHUNKSIZE");
02697 }
02698 else if (value == CMIC_WORK_DIST_NUMCHUNKS) {
02699 PRINTMSG(line, 1499, Error, column, "NUMCHUNKS");
02700 }
02701 }
02702 # if defined(GENERATE_WHIRL)
02703 else if (OPND_FLD(opnd) != CN_Tbl_Idx && OPND_FLD(opnd) != NO_Tbl_Idx &&
02704 (value == CMIC_WORK_DIST_CHUNKSIZE ||
02705 value == CMIC_WORK_DIST_NUMCHUNKS)) {
02706
02707
02708
02709 NTR_IR_TBL(max_idx);
02710 IR_OPR(max_idx) = Max_Opr;
02711 IR_TYPE_IDX(max_idx) = exp_desc.type_idx;
02712 IR_LINE_NUM(ir_idx) = line;
02713 IR_COL_NUM(ir_idx) = column;
02714
02715 OPND_FLD(opnd2) = CN_Tbl_Idx;
02716 OPND_IDX(opnd2) = CN_INTEGER_ONE_IDX;
02717 OPND_LINE_NUM(opnd2) = line;
02718 OPND_COL_NUM(opnd2) = column;
02719
02720 cast_opnd_to_type_idx(&opnd2, exp_desc.type_idx);
02721
02722 NTR_IR_LIST_TBL(list2_idx);
02723 IR_FLD_L(max_idx) = IL_Tbl_Idx;
02724 IR_LIST_CNT_L(max_idx) = 2;
02725 IR_IDX_L(max_idx) = list2_idx;
02726
02727 COPY_OPND(IL_OPND(list2_idx), opnd);
02728
02729 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx));
02730 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx;
02731 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02732
02733 COPY_OPND(IL_OPND(list2_idx), opnd2);
02734
02735 OPND_FLD(opnd) = IR_Tbl_Idx;
02736 OPND_IDX(opnd) = max_idx;
02737 }
02738 # endif
02739
02740 IL_FLD(list_idx) = AT_Tbl_Idx;
02741 idx = create_tmp_asg(&opnd,
02742 &exp_desc,
02743 &l_opnd,
02744 Intent_In,
02745 FALSE,
02746 FALSE);
02747 IL_IDX(list_idx) = idx;
02748 IL_LINE_NUM(list_idx) = line;
02749 IL_COL_NUM(list_idx) = column;
02750 }
02751
02752 curr_stmt_sh_idx = save_curr_stmt_sh_idx;
02753
02754
02755 TRACE (Func_Exit, "doall_cmic_semantics", NULL);
02756
02757 return;
02758
02759 }
02760
02761
02762
02763
02764
02765
02766
02767
02768
02769
02770
02771
02772
02773
02774
02775
02776
02777 static void doparallel_cmic_semantics(void)
02778
02779 {
02780 int column;
02781 expr_arg_type exp_desc;
02782 int idx;
02783 int ir_idx;
02784 int line;
02785 int list_idx;
02786 opnd_type l_opnd;
02787 opnd_type opnd;
02788 int save_curr_stmt_sh_idx;
02789 long64 value;
02790
02791 # if defined(GENERATE_WHIRL)
02792 int list2_idx;
02793 int max_idx;
02794 opnd_type opnd2;
02795 # endif
02796
02797
02798 TRACE (Func_Entry, "doparallel_cmic_semantics", NULL);
02799
02800 ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
02801
02802 cdir_switches.dopar_sh_idx = curr_stmt_sh_idx;
02803
02804
02805 remove_sh(curr_stmt_sh_idx);
02806 save_curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
02807
02808 SH_PREV_IDX(cdir_switches.dopar_sh_idx) = NULL_IDX;
02809 SH_NEXT_IDX(cdir_switches.dopar_sh_idx) = NULL_IDX;
02810
02811 list_idx = IR_IDX_L(ir_idx);
02812
02813
02814
02815
02816
02817 list_idx = IL_NEXT_LIST_IDX(list_idx);
02818
02819 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
02820 COPY_OPND(opnd, IL_OPND(list_idx));
02821 exp_desc.rank = 0;
02822 xref_state = CIF_Symbol_Reference;
02823 expr_semantics(&opnd, &exp_desc);
02824
02825 find_opnd_line_and_column(&opnd, &line, &column);
02826
02827 value = (IL_FLD(IL_PREV_LIST_IDX(list_idx)) != CN_Tbl_Idx) ? 0 :
02828 CN_INT_TO_C(IL_IDX(IL_PREV_LIST_IDX(list_idx)));
02829
02830 if (exp_desc.type != Integer ||
02831 exp_desc.rank != 0) {
02832 PRINTMSG(line, 806, Error, column);
02833 }
02834 else if (OPND_FLD(opnd) == CN_Tbl_Idx &&
02835 IL_FLD(IL_PREV_LIST_IDX(list_idx)) == CN_Tbl_Idx &&
02836 compare_cn_and_value(OPND_IDX(opnd),
02837 0,
02838 Le_Opr)) {
02839
02840 if (value == CMIC_WORK_DIST_CHUNKSIZE) {
02841 PRINTMSG(line, 1499, Error, column, "CHUNKSIZE");
02842 }
02843 else if (value == CMIC_WORK_DIST_NUMCHUNKS) {
02844 PRINTMSG(line, 1499, Error, column, "NUMCHUNKS");
02845 }
02846 }
02847 # if defined(GENERATE_WHIRL)
02848 else if (OPND_FLD(opnd) != CN_Tbl_Idx && OPND_FLD(opnd) != NO_Tbl_Idx &&
02849 (value == CMIC_WORK_DIST_CHUNKSIZE ||
02850 value == CMIC_WORK_DIST_NUMCHUNKS)) {
02851
02852
02853
02854 NTR_IR_TBL(max_idx);
02855 IR_OPR(max_idx) = Max_Opr;
02856 IR_TYPE_IDX(max_idx) = exp_desc.type_idx;
02857 IR_LINE_NUM(ir_idx) = line;
02858 IR_COL_NUM(ir_idx) = column;
02859
02860 OPND_FLD(opnd2) = CN_Tbl_Idx;
02861 OPND_IDX(opnd2) = CN_INTEGER_ONE_IDX;
02862 OPND_LINE_NUM(opnd2) = line;
02863 OPND_COL_NUM(opnd2) = column;
02864
02865 cast_opnd_to_type_idx(&opnd2, exp_desc.type_idx);
02866
02867 NTR_IR_LIST_TBL(list2_idx);
02868 IR_FLD_L(max_idx) = IL_Tbl_Idx;
02869 IR_LIST_CNT_L(max_idx) = 2;
02870 IR_IDX_L(max_idx) = list2_idx;
02871
02872 COPY_OPND(IL_OPND(list2_idx), opnd);
02873
02874 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx));
02875 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx;
02876 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02877
02878 COPY_OPND(IL_OPND(list2_idx), opnd2);
02879
02880 OPND_FLD(opnd) = IR_Tbl_Idx;
02881 OPND_IDX(opnd) = max_idx;
02882 }
02883 # endif
02884
02885
02886 IL_FLD(list_idx) = AT_Tbl_Idx;
02887 idx = create_tmp_asg(&opnd,
02888 &exp_desc,
02889 &l_opnd,
02890 Intent_In,
02891 FALSE,
02892 FALSE);
02893 IL_IDX(list_idx) = idx;
02894 IL_LINE_NUM(list_idx) = line;
02895 IL_COL_NUM(list_idx) = column;
02896 }
02897
02898 curr_stmt_sh_idx = save_curr_stmt_sh_idx;
02899
02900 TRACE (Func_Exit, "doparallel_cmic_semantics", NULL);
02901
02902 return;
02903
02904 }
02905
02906
02907
02908
02909
02910
02911
02912
02913
02914
02915
02916
02917
02918
02919
02920
02921
02922 static void endparallel_cmic_semantics(void)
02923
02924 {
02925 int list_idx;
02926
02927 TRACE (Func_Entry, "endparallel_cmic_semantics", NULL);
02928
02929 cdir_switches.no_internal_calls = FALSE;
02930 cdir_switches.parallel_region = FALSE;
02931 cdir_switches.autoscope = FALSE;
02932
02933 if (cdir_switches.private_list_idx &&
02934 IL_FLD(cdir_switches.private_list_idx) != NO_Tbl_Idx) {
02935
02936 list_idx = IL_IDX(cdir_switches.private_list_idx);
02937
02938 while (list_idx) {
02939 if (IL_FLD(list_idx) == AT_Tbl_Idx &&
02940 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) {
02941
02942 ATD_TASK_PRIVATE(IL_IDX(list_idx)) = FALSE;
02943 }
02944 list_idx = IL_NEXT_LIST_IDX(list_idx);
02945 }
02946 }
02947
02948 if (cdir_switches.getfirst_list_idx &&
02949 IL_FLD(cdir_switches.getfirst_list_idx) != NO_Tbl_Idx) {
02950
02951 list_idx = IL_IDX(cdir_switches.getfirst_list_idx);
02952
02953 while (list_idx) {
02954 if (IL_FLD(list_idx) == AT_Tbl_Idx &&
02955 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) {
02956
02957 ATD_TASK_GETFIRST(IL_IDX(list_idx)) = FALSE;
02958 }
02959 list_idx = IL_NEXT_LIST_IDX(list_idx);
02960 }
02961 }
02962
02963
02964 if (cdir_switches.shared_list_idx &&
02965 IL_FLD(cdir_switches.shared_list_idx) != NO_Tbl_Idx) {
02966
02967 list_idx = IL_IDX(cdir_switches.shared_list_idx);
02968
02969 while (list_idx) {
02970 if (IL_FLD(list_idx) == AT_Tbl_Idx &&
02971 AT_OBJ_CLASS(IL_IDX(list_idx)) == Data_Obj) {
02972
02973 ATD_TASK_SHARED(IL_IDX(list_idx)) = FALSE;
02974 }
02975 else if (IL_FLD(list_idx) == AT_Tbl_Idx &&
02976 AT_OBJ_CLASS(IL_IDX(list_idx)) == Pgm_Unit &&
02977 ATP_PROC(IL_IDX(list_idx)) == Dummy_Proc) {
02978
02979 ATP_TASK_SHARED(IL_IDX(list_idx)) = FALSE;
02980 }
02981 list_idx = IL_NEXT_LIST_IDX(list_idx);
02982 }
02983 }
02984
02985 cdir_switches.getfirst_list_idx = NULL_IDX;
02986 cdir_switches.private_list_idx = NULL_IDX;
02987 cdir_switches.shared_list_idx = NULL_IDX;
02988
02989 TRACE (Func_Exit, "endparallel_cmic_semantics", NULL);
02990
02991 return;
02992
02993 }
02994
02995
02996
02997
02998
02999
03000
03001
03002
03003
03004
03005
03006
03007
03008
03009
03010
03011 static void parallel_cmic_semantics(void)
03012
03013 {
03014 int attr_idx;
03015 int column;
03016 expr_arg_type exp_desc;
03017 int getfirst_list_idx;
03018 int idx;
03019 int ir_idx;
03020 int line;
03021 int list_idx;
03022 int list2_idx;
03023 int list3_idx;
03024 opnd_type l_opnd;
03025 opnd_type opnd;
03026 int private_list_idx;
03027 int shared_list_idx;
03028
03029 # if defined(GENERATE_WHIRL)
03030 char string[13];
03031 # endif
03032
03033
03034 TRACE (Func_Entry, "parallel_cmic_semantics", NULL);
03035
03036 ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
03037
03038 if (cdir_switches.doall_sh_idx != NULL_IDX ||
03039 cdir_switches.doacross_sh_idx != NULL_IDX ||
03040 cdir_switches.parallel_region ||
03041 cdir_switches.guard_in_par_reg) {
03042
03043
03044 PRINTMSG(IR_LINE_NUM(ir_idx), 818, Error, IR_COL_NUM(ir_idx));
03045 }
03046
03047 list_idx = IR_IDX_L(ir_idx);
03048
03049
03050
03051 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03052 COPY_OPND(opnd, IL_OPND(list_idx));
03053 exp_desc.rank = 0;
03054 xref_state = CIF_Symbol_Reference;
03055 expr_semantics(&opnd, &exp_desc);
03056
03057 find_opnd_line_and_column(&opnd, &line, &column);
03058
03059 if (exp_desc.type != Logical ||
03060 exp_desc.rank != 0) {
03061 PRINTMSG(line, 803, Error, column);
03062 }
03063
03064 IL_FLD(list_idx) = AT_Tbl_Idx;
03065 idx = create_tmp_asg(&opnd,
03066 &exp_desc,
03067 &l_opnd,
03068 Intent_In,
03069 FALSE,
03070 FALSE);
03071 IL_IDX(list_idx) = idx;
03072
03073 IL_LINE_NUM(list_idx) = line;
03074 IL_COL_NUM(list_idx) = column;
03075 }
03076
03077
03078
03079 list_idx = IL_NEXT_LIST_IDX(list_idx);
03080 cdir_switches.shared_list_idx = list_idx;
03081
03082 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03083
03084 list2_idx = IL_IDX(list_idx);
03085
03086 while (list2_idx) {
03087
03088 attr_idx = IL_IDX(list2_idx);
03089 AT_LOCKED_IN(attr_idx) = TRUE;
03090
03091 while (AT_ATTR_LINK(attr_idx)) {
03092 attr_idx = AT_ATTR_LINK(attr_idx);
03093 AT_LOCKED_IN(attr_idx) = TRUE;
03094 }
03095
03096 IL_IDX(list2_idx) = attr_idx;
03097
03098 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit &&
03099 ATP_PROC(attr_idx) == Dummy_Proc) {
03100 ATP_TASK_SHARED(attr_idx) = TRUE;
03101 }
03102 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
03103 ATD_CLASS(attr_idx) == Constant) {
03104 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
03105 IL_COL_NUM(list2_idx),
03106 AT_OBJ_NAME_PTR(attr_idx),
03107 "SHARED", "PARALLEL");
03108
03109
03110 if (list2_idx == IL_IDX(cdir_switches.shared_list_idx)) {
03111
03112 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03113 IL_IDX(cdir_switches.shared_list_idx) = list2_idx;
03114 IL_IDX(list_idx) = list2_idx;
03115 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
03116 IL_LIST_CNT(list_idx)--;
03117 continue;
03118 }
03119 else {
03120 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03121 IL_NEXT_LIST_IDX(list2_idx);
03122 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03123 IL_PREV_LIST_IDX(list2_idx);
03124
03125 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03126 IL_LIST_CNT(list_idx)--;
03127 continue;
03128 }
03129 }
03130 else {
03131 ATD_TASK_SHARED(attr_idx) = TRUE;
03132 ATD_WAS_SCOPED(attr_idx) = TRUE;
03133 }
03134
03135 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx);
03136
03137 while (shared_list_idx != list2_idx &&
03138 shared_list_idx != NULL_IDX) {
03139
03140 if (attr_idx == IL_IDX(shared_list_idx)) {
03141
03142 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03143 IL_NEXT_LIST_IDX(list2_idx);
03144 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03145 IL_PREV_LIST_IDX(list2_idx);
03146
03147 list2_idx = IL_PREV_LIST_IDX(list2_idx);
03148 IL_LIST_CNT(list_idx)--;
03149 break;
03150 }
03151 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx);
03152 }
03153
03154 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03155 }
03156 }
03157
03158
03159
03160 list_idx = IL_NEXT_LIST_IDX(list_idx);
03161 cdir_switches.private_list_idx = list_idx;
03162
03163 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03164
03165 list2_idx = IL_IDX(list_idx);
03166
03167 while (list2_idx) {
03168
03169 attr_idx = IL_IDX(list2_idx);
03170 AT_LOCKED_IN(attr_idx) = TRUE;
03171
03172 while (AT_ATTR_LINK(attr_idx)) {
03173 attr_idx = AT_ATTR_LINK(attr_idx);
03174 AT_LOCKED_IN(attr_idx) = TRUE;
03175 }
03176
03177 IL_IDX(list2_idx) = attr_idx;
03178
03179 # if defined(GENERATE_WHIRL)
03180 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
03181 (ATD_ALLOCATABLE(attr_idx) ||
03182 ATD_CLASS(attr_idx) == CRI__Pointee ||
03183 ATD_POINTER(attr_idx))) {
03184
03185 if (ATD_ALLOCATABLE(attr_idx)) {
03186 strcpy(string, "ALLOCATABLE");
03187 }
03188 else if (ATD_POINTER(attr_idx)) {
03189 strcpy(string, "POINTER");
03190 }
03191 else {
03192 strcpy(string, "Cray Pointee");
03193 }
03194
03195 PRINTMSG(IL_LINE_NUM(list2_idx), 1446, Error,
03196 IL_COL_NUM(list2_idx),
03197 string,
03198 "PARALLEL");
03199
03200 }
03201 else
03202 # endif
03203 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
03204 ATD_CLASS(attr_idx) == Constant) {
03205 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
03206 IL_COL_NUM(list2_idx),
03207 AT_OBJ_NAME_PTR(attr_idx),
03208 "PRIVATE", "PARALLEL");
03209
03210
03211 if (list2_idx == IL_IDX(cdir_switches.private_list_idx)) {
03212
03213 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03214 IL_IDX(cdir_switches.private_list_idx) = list2_idx;
03215 IL_IDX(list_idx) = list2_idx;
03216 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
03217 IL_LIST_CNT(list_idx)--;
03218 continue;
03219 }
03220 else {
03221 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03222 IL_NEXT_LIST_IDX(list2_idx);
03223 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03224 IL_PREV_LIST_IDX(list2_idx);
03225
03226 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03227 IL_LIST_CNT(list_idx)--;
03228 continue;
03229 }
03230 }
03231 else {
03232 ATD_TASK_PRIVATE(attr_idx) = TRUE;
03233 ATD_WAS_SCOPED(attr_idx) = TRUE;
03234
03235 if (ATD_CLASS(attr_idx) == Variable &&
03236 ATD_AUTOMATIC(attr_idx) &&
03237 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX &&
03238 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) {
03239
03240 ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE;
03241
03242 NTR_IR_LIST_TBL(list3_idx);
03243 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx;
03244 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx);
03245 IL_IDX(list_idx) = list3_idx;
03246 IL_LIST_CNT(list_idx)++;
03247
03248 IL_FLD(list3_idx) = AT_Tbl_Idx;
03249 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx);
03250 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx);
03251 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx);
03252 }
03253 }
03254
03255 private_list_idx = IL_IDX(cdir_switches.private_list_idx);
03256
03257 while (private_list_idx != list2_idx &&
03258 private_list_idx != NULL_IDX) {
03259
03260 if (attr_idx == IL_IDX(private_list_idx)) {
03261
03262 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03263 IL_NEXT_LIST_IDX(list2_idx);
03264 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03265 IL_PREV_LIST_IDX(list2_idx);
03266
03267 list2_idx = IL_PREV_LIST_IDX(list2_idx);
03268 IL_LIST_CNT(list_idx)--;
03269 goto CONTINUE3;
03270 }
03271 private_list_idx = IL_NEXT_LIST_IDX(private_list_idx);
03272 }
03273
03274 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx);
03275
03276 while (shared_list_idx) {
03277
03278 if (attr_idx == IL_IDX(shared_list_idx)) {
03279
03280 PRINTMSG(IL_LINE_NUM(list2_idx), 805, Error,
03281 IL_COL_NUM(list2_idx),
03282 AT_OBJ_NAME_PTR(attr_idx));
03283 break;
03284 }
03285 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx);
03286 }
03287
03288 CONTINUE3:
03289 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03290 }
03291 }
03292
03293
03294
03295 list_idx = IL_NEXT_LIST_IDX(list_idx);
03296 cdir_switches.getfirst_list_idx = list_idx;
03297
03298 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03299
03300 list2_idx = IL_IDX(list_idx);
03301
03302 while (list2_idx) {
03303
03304 attr_idx = IL_IDX(list2_idx);
03305 AT_LOCKED_IN(attr_idx) = TRUE;
03306
03307 while (AT_ATTR_LINK(attr_idx)) {
03308 attr_idx = AT_ATTR_LINK(attr_idx);
03309 AT_LOCKED_IN(attr_idx) = TRUE;
03310 }
03311
03312 IL_IDX(list2_idx) = attr_idx;
03313
03314 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
03315 ATD_CLASS(attr_idx) == Constant) {
03316 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
03317 IL_COL_NUM(list2_idx),
03318 AT_OBJ_NAME_PTR(attr_idx),
03319 "GETFIRST", "PARALLEL");
03320
03321
03322
03323 if (list2_idx == IL_IDX(cdir_switches.getfirst_list_idx)) {
03324
03325
03326
03327 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03328 IL_IDX(cdir_switches.getfirst_list_idx) = list2_idx;
03329 IL_IDX(list_idx) = list2_idx;
03330 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
03331 IL_LIST_CNT(list_idx)--;
03332 continue;
03333 }
03334 else {
03335 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03336 IL_NEXT_LIST_IDX(list2_idx);
03337 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03338 IL_PREV_LIST_IDX(list2_idx);
03339
03340 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03341 IL_LIST_CNT(list_idx)--;
03342 continue;
03343 }
03344 }
03345 else {
03346 ATD_TASK_GETFIRST(attr_idx) = TRUE;
03347
03348 if (ATD_CLASS(attr_idx) == Variable &&
03349 ATD_AUTOMATIC(attr_idx) &&
03350 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX &&
03351 ! ATD_TASK_PRIVATE(ATD_AUTO_BASE_IDX(attr_idx))) {
03352
03353 ATD_TASK_GETFIRST(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE;
03354
03355 NTR_IR_LIST_TBL(list3_idx);
03356 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx;
03357 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx);
03358 IL_IDX(list_idx) = list3_idx;
03359 IL_LIST_CNT(list_idx)++;
03360
03361 IL_FLD(list3_idx) = AT_Tbl_Idx;
03362 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx);
03363 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx);
03364 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx);
03365 }
03366 }
03367
03368 getfirst_list_idx = IL_IDX(cdir_switches.getfirst_list_idx);
03369
03370 while (getfirst_list_idx != list2_idx &&
03371 getfirst_list_idx != NULL_IDX) {
03372
03373 if (attr_idx == IL_IDX(getfirst_list_idx)) {
03374
03375
03376
03377 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03378 IL_NEXT_LIST_IDX(list2_idx);
03379 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03380 IL_PREV_LIST_IDX(list2_idx);
03381
03382 list2_idx = IL_PREV_LIST_IDX(list2_idx);
03383 IL_LIST_CNT(list_idx)--;
03384 goto CONTINUE4;
03385 }
03386 getfirst_list_idx = IL_NEXT_LIST_IDX(getfirst_list_idx);
03387 }
03388
03389
03390 shared_list_idx = IL_IDX(cdir_switches.shared_list_idx);
03391
03392 while (shared_list_idx) {
03393
03394 if (attr_idx == IL_IDX(shared_list_idx)) {
03395
03396
03397
03398 PRINTMSG(IL_LINE_NUM(list2_idx), 1314, Error,
03399 IL_COL_NUM(list2_idx),
03400 AT_OBJ_NAME_PTR(attr_idx),
03401 "SHARED", "GETFIRST");
03402 break;
03403 }
03404 shared_list_idx = IL_NEXT_LIST_IDX(shared_list_idx);
03405 }
03406
03407 private_list_idx = IL_IDX(cdir_switches.private_list_idx);
03408
03409 while (private_list_idx) {
03410
03411 if (attr_idx == IL_IDX(private_list_idx)) {
03412
03413
03414
03415 PRINTMSG(IL_LINE_NUM(list2_idx), 1314, Error,
03416 IL_COL_NUM(list2_idx),
03417 AT_OBJ_NAME_PTR(attr_idx),
03418 "PRIVATE", "GETFIRST");
03419 break;
03420 }
03421 private_list_idx = IL_NEXT_LIST_IDX(private_list_idx);
03422 }
03423
03424
03425 CONTINUE4:
03426 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03427 }
03428 }
03429
03430
03431
03432
03433 list_idx = IL_NEXT_LIST_IDX(list_idx);
03434
03435 if (IL_FLD(list_idx) == CN_Tbl_Idx) {
03436 cdir_switches.autoscope = TRUE;
03437 }
03438
03439
03440
03441 list_idx = IL_NEXT_LIST_IDX(list_idx);
03442
03443 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03444
03445 list2_idx = IL_IDX(list_idx);
03446
03447 while (list2_idx) {
03448
03449 attr_idx = IL_IDX(list2_idx);
03450 AT_LOCKED_IN(attr_idx) = TRUE;
03451
03452 while (AT_ATTR_LINK(attr_idx)) {
03453 attr_idx = AT_ATTR_LINK(attr_idx);
03454 AT_LOCKED_IN(attr_idx) = TRUE;
03455 }
03456
03457 IL_IDX(list2_idx) = attr_idx;
03458
03459 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
03460 ATD_CLASS(attr_idx) == Constant) {
03461 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
03462 IL_COL_NUM(list2_idx),
03463 AT_OBJ_NAME_PTR(attr_idx),
03464 "CONTROL", "PARALLEL");
03465
03466
03467 if (list2_idx == IL_IDX(list_idx)) {
03468
03469 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03470 IL_IDX(list_idx) = list2_idx;
03471 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
03472 IL_LIST_CNT(list_idx)--;
03473 continue;
03474 }
03475 else {
03476 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03477 IL_NEXT_LIST_IDX(list2_idx);
03478 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03479 IL_PREV_LIST_IDX(list2_idx);
03480
03481 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03482 IL_LIST_CNT(list_idx)--;
03483 continue;
03484 }
03485 }
03486
03487 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03488 }
03489 }
03490
03491
03492
03493 list_idx = IL_NEXT_LIST_IDX(list_idx);
03494
03495 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03496 COPY_OPND(opnd, IL_OPND(list_idx));
03497 exp_desc.rank = 0;
03498 xref_state = CIF_Symbol_Reference;
03499 expr_semantics(&opnd, &exp_desc);
03500
03501 find_opnd_line_and_column(&opnd, &line, &column);
03502 if (exp_desc.type != Integer ||
03503 exp_desc.rank != 0) {
03504 PRINTMSG(line, 806, Error, column);
03505 }
03506
03507 IL_FLD(list_idx) = AT_Tbl_Idx;
03508 idx = create_tmp_asg(&opnd,
03509 &exp_desc,
03510 &l_opnd,
03511 Intent_In,
03512 FALSE,
03513 FALSE);
03514 IL_IDX(list_idx) = idx;
03515 IL_LINE_NUM(list_idx) = line;
03516 IL_COL_NUM(list_idx) = column;
03517 }
03518 else if (cdir_switches.maxcpus) {
03519 COPY_OPND(IL_OPND(list_idx), cdir_switches.maxcpus_opnd);
03520 cdir_switches.maxcpus = FALSE;
03521 }
03522
03523 cdir_switches.no_internal_calls = TRUE;
03524 cdir_switches.parallel_region = TRUE;
03525 TRACE (Func_Exit, "parallel_cmic_semantics", NULL);
03526
03527 return;
03528
03529 }
03530
03531
03532
03533
03534
03535
03536
03537
03538
03539
03540
03541
03542
03543
03544
03545
03546
03547
03548
03549
03550
03551
03552
03553
03554
03555
03556
03557
03558
03559
03560
03561
03562
03563
03564
03565
03566 static void mp_directive_semantics(mp_directive_type directive)
03567
03568 {
03569 int attr_idx;
03570 int column;
03571 expr_arg_type exp_desc;
03572 int i;
03573 int idx;
03574 int ir_idx;
03575 int line;
03576 int list_array[MP_DIR_LIST_CNT];
03577 int list_idx;
03578 int list2_idx;
03579 int list3_idx;
03580 opnd_type l_opnd;
03581 opnd_type opnd;
03582 int orig_sh_idx;
03583 int save_curr_stmt_sh_idx;
03584 boolean save_error_flag;
03585 char string[13];
03586
03587
03588 TRACE (Func_Entry, "mp_directive_semantics", NULL);
03589
03590 ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
03591 save_curr_stmt_sh_idx = curr_stmt_sh_idx;
03592 orig_sh_idx = curr_stmt_sh_idx;
03593 save_error_flag = SH_ERR_FLG(curr_stmt_sh_idx);
03594
03595 list_idx = IR_IDX_L(ir_idx);
03596
03597 for (i = 0; i < MP_DIR_LIST_CNT; i++) {
03598 list_array[i] = list_idx;
03599 list_idx = IL_NEXT_LIST_IDX(list_idx);
03600 }
03601
03602 if (directive == Doacross ||
03603 directive == Parallel_Do ||
03604 directive == Pdo) {
03605
03606
03607 remove_sh(curr_stmt_sh_idx);
03608 save_curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
03609
03610 switch (directive) {
03611 case Doacross:
03612 cdir_switches.doacross_sh_idx = curr_stmt_sh_idx;
03613 SH_PREV_IDX(cdir_switches.doacross_sh_idx) = NULL_IDX;
03614 SH_NEXT_IDX(cdir_switches.doacross_sh_idx) = NULL_IDX;
03615 break;
03616
03617 case Parallel_Do:
03618 cdir_switches.paralleldo_sh_idx = curr_stmt_sh_idx;
03619 SH_PREV_IDX(cdir_switches.paralleldo_sh_idx) = NULL_IDX;
03620 SH_NEXT_IDX(cdir_switches.paralleldo_sh_idx) = NULL_IDX;
03621 break;
03622
03623 case Pdo:
03624 cdir_switches.pdo_sh_idx = curr_stmt_sh_idx;
03625 SH_PREV_IDX(cdir_switches.pdo_sh_idx) = NULL_IDX;
03626 SH_NEXT_IDX(cdir_switches.pdo_sh_idx) = NULL_IDX;
03627 break;
03628 }
03629 }
03630 else {
03631 cdir_switches.parallel_region = TRUE;
03632 }
03633
03634 if (clause_allowed[directive][If_Clause]) {
03635 list_idx = list_array[MP_DIR_IF_IDX];
03636
03637
03638
03639 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03640 COPY_OPND(opnd, IL_OPND(list_idx));
03641 exp_desc.rank = 0;
03642 xref_state = CIF_Symbol_Reference;
03643 expr_semantics(&opnd, &exp_desc);
03644
03645 find_opnd_line_and_column(&opnd, &line, &column);
03646 if (exp_desc.type != Logical ||
03647 exp_desc.rank != 0) {
03648 PRINTMSG(line, 803, Error, column);
03649 }
03650
03651 IL_FLD(list_idx) = AT_Tbl_Idx;
03652 idx = create_tmp_asg(&opnd,
03653 &exp_desc,
03654 &l_opnd,
03655 Intent_In,
03656 FALSE,
03657 FALSE);
03658 IL_IDX(list_idx) = idx;
03659 IL_LINE_NUM(list_idx) = line;
03660 IL_COL_NUM(list_idx) = column;
03661 }
03662 }
03663
03664 if (clause_allowed[directive][Chunk_Clause]) {
03665
03666
03667 list_idx = list_array[MP_DIR_CHUNK_IDX];
03668
03669 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03670 COPY_OPND(opnd, IL_OPND(list_idx));
03671 exp_desc.rank = 0;
03672 xref_state = CIF_Symbol_Reference;
03673 expr_semantics(&opnd, &exp_desc);
03674
03675 find_opnd_line_and_column(&opnd, &line, &column);
03676
03677 if (exp_desc.type != Integer ||
03678 exp_desc.rank != 0) {
03679 PRINTMSG(line, 1364, Error, column);
03680 }
03681
03682 IL_FLD(list_idx) = AT_Tbl_Idx;
03683 idx = create_tmp_asg(&opnd,
03684 &exp_desc,
03685 &l_opnd,
03686 Intent_In,
03687 FALSE,
03688 FALSE);
03689 IL_IDX(list_idx) = idx;
03690 IL_LINE_NUM(list_idx) = line;
03691 IL_COL_NUM(list_idx) = column;
03692 }
03693 }
03694
03695 if (directive != Doacross &&
03696 directive != Parallel_Do) {
03697
03698 push_task_blk(curr_stmt_sh_idx);
03699 }
03700
03701 cdir_switches.lastlocal_list_idx = list_array[MP_DIR_LASTLOCAL_IDX];
03702 cdir_switches.private_list_idx = list_array[MP_DIR_LOCAL_IDX];
03703 cdir_switches.shared_list_idx = list_array[MP_DIR_SHARE_IDX];
03704 cdir_switches.reduction_list_idx = list_array[MP_DIR_REDUCTION_IDX];
03705 cdir_switches.lastthread_list_idx = list_array[MP_DIR_LASTTHREAD_IDX];
03706
03707 if (clause_allowed[directive][Share_Clause]) {
03708
03709
03710 list_idx = list_array[MP_DIR_SHARE_IDX];
03711
03712 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03713
03714 list2_idx = IL_IDX(list_idx);
03715
03716 while (list2_idx) {
03717
03718 attr_idx = IL_IDX(list2_idx);
03719 AT_LOCKED_IN(attr_idx) = TRUE;
03720
03721 while (AT_ATTR_LINK(attr_idx)) {
03722 attr_idx = AT_ATTR_LINK(attr_idx);
03723 AT_LOCKED_IN(attr_idx) = TRUE;
03724 }
03725
03726 IL_IDX(list2_idx) = attr_idx;
03727
03728 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit &&
03729 ATP_PROC(attr_idx) == Dummy_Proc) {
03730 ATP_TASK_SHARED(attr_idx) = TRUE;
03731 }
03732 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
03733 ATD_CLASS(attr_idx) == Constant) {
03734 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
03735 IL_COL_NUM(list2_idx),
03736 AT_OBJ_NAME_PTR(attr_idx),
03737 "SHARE", mp_dir_str[directive]);
03738
03739
03740
03741 if (list2_idx == IL_IDX(cdir_switches.shared_list_idx)) {
03742
03743
03744
03745 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03746 IL_IDX(cdir_switches.shared_list_idx) = list2_idx;
03747 IL_IDX(list_idx) = list2_idx;
03748 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
03749 IL_LIST_CNT(list_idx)--;
03750 continue;
03751 }
03752 else {
03753 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03754 IL_NEXT_LIST_IDX(list2_idx);
03755 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03756 IL_PREV_LIST_IDX(list2_idx);
03757
03758 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03759 IL_LIST_CNT(list_idx)--;
03760 continue;
03761 }
03762 }
03763 else if (! ATD_TASK_PRIVATE(attr_idx) &&
03764 ! ATD_TASK_LASTTHREAD(attr_idx) &&
03765 ! ATD_TASK_LASTLOCAL(attr_idx)) {
03766
03767
03768
03769 ATD_TASK_SHARED(attr_idx) = TRUE;
03770 ATD_WAS_SCOPED(attr_idx) = TRUE;
03771
03772 if (ATD_CLASS(attr_idx) == Variable &&
03773 ATD_AUTOMATIC(attr_idx) &&
03774 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX &&
03775 ! ATD_TASK_SHARED(ATD_AUTO_BASE_IDX(attr_idx))) {
03776
03777 ATD_TASK_SHARED(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE;
03778
03779 NTR_IR_LIST_TBL(list3_idx);
03780 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx;
03781 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx);
03782 IL_IDX(list_idx) = list3_idx;
03783 IL_LIST_CNT(list_idx)++;
03784
03785 IL_FLD(list3_idx) = AT_Tbl_Idx;
03786 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx);
03787 IL_LINE_NUM(list3_idx) = IL_LINE_NUM(list2_idx);
03788 IL_COL_NUM(list3_idx) = IL_COL_NUM(list2_idx);
03789 }
03790 }
03791 else {
03792 PRINTMSG(IL_LINE_NUM(list2_idx), 1362, Error,
03793 IL_COL_NUM(list2_idx),
03794 AT_OBJ_NAME_PTR(attr_idx));
03795 }
03796
03797 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03798 }
03799 }
03800 }
03801
03802 if (clause_allowed[directive][Lastlocal_Clause]) {
03803
03804
03805 list_idx = list_array[MP_DIR_LASTLOCAL_IDX];
03806
03807 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03808
03809 list2_idx = IL_IDX(list_idx);
03810
03811 while (list2_idx) {
03812
03813 attr_idx = IL_IDX(list2_idx);
03814 AT_LOCKED_IN(attr_idx) = TRUE;
03815
03816 while (AT_ATTR_LINK(attr_idx)) {
03817 attr_idx = AT_ATTR_LINK(attr_idx);
03818 AT_LOCKED_IN(attr_idx) = TRUE;
03819 }
03820
03821 IL_IDX(list2_idx) = attr_idx;
03822
03823 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
03824 ATD_CLASS(attr_idx) == Constant) {
03825
03826 PRINTMSG(IL_LINE_NUM(list2_idx), 804, Caution,
03827 IL_COL_NUM(list2_idx),
03828 AT_OBJ_NAME_PTR(attr_idx),
03829 "LASTLOCAL", mp_dir_str[directive]);
03830
03831
03832
03833 if (list2_idx == IL_IDX(cdir_switches.lastlocal_list_idx)) {
03834
03835
03836
03837 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03838 IL_IDX(cdir_switches.lastlocal_list_idx) = list2_idx;
03839 IL_IDX(list_idx) = list2_idx;
03840 IL_PREV_LIST_IDX(list2_idx) = NULL_IDX;
03841 IL_LIST_CNT(list_idx)--;
03842 continue;
03843 }
03844 else {
03845 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list2_idx)) =
03846 IL_NEXT_LIST_IDX(list2_idx);
03847 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) =
03848 IL_PREV_LIST_IDX(list2_idx);
03849
03850 list2_idx = IL_NEXT_LIST_IDX(list2_idx);
03851 IL_LIST_CNT(list_idx)--;
03852 continue;
03853 }
03854 }
03855 else if (! ATD_TASK_PRIVATE(attr_idx) &&
03856 ! ATD_TASK_LASTTHREAD(attr_idx) &&
03857 ! ATD_TASK_SHARED(attr_idx) &&
03858 ! ATD_TASK_REDUCTION(attr_idx)) {
03859
03860 ATD_TASK_LASTLOCAL(attr_idx) = TRUE;
03861
03862 if (ATD_CLASS(attr_idx) == Variable &&
03863 ATD_AUTOMATIC(attr_idx) &&
03864 ATD_AUTO_BASE_IDX(attr_idx) != NULL_IDX &&
03865 ! ATD_TASK_LASTLOCAL(ATD_AUTO_BASE_IDX(attr_idx))) {
03866
03867 ATD_TASK_LASTLOCAL(ATD_AUTO_BASE_IDX(attr_idx)) = TRUE;
03868
03869 NTR_IR_LIST_TBL(list3_idx);
03870 IL_PREV_LIST_IDX(IL_IDX(list_idx)) = list3_idx;
03871 IL_NEXT_LIST_IDX(list3_idx) = IL_IDX(list_idx);
03872 IL_IDX(list_idx) = list3_idx;
03873 IL_LIST_CNT(list_idx)++;
03874
03875 IL_FLD(list3_idx) = AT_Tbl_Idx;
03876 IL_IDX(list3_idx) = ATD_AUTO_BASE_IDX(attr_idx);
03877