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_data.c 5.7 09/02/99 17:06:53\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 "debug.m"
00050 # include "s_globals.m"
00051
00052 # include "globals.h"
00053 # include "tokens.h"
00054 # include "sytb.h"
00055 # include "s_globals.h"
00056 # include "s_data.h"
00057
00058
00059
00060
00061
00062
00063 static void adjust_char_value_len (int, int, long64, long64);
00064 static void build_loop_tbl (int, boolean);
00065 static boolean check_target_and_value (int, int);
00066 static void data_imp_do_semantics (int, int, boolean, boolean *);
00067 static void fold_all_subscripts (opnd_type *);
00068 static void gen_section_ref(int,long64,int,int,int,long64 *,long64 *,
00069 long64 *);
00070 static boolean good_data_imp_do_expr(int);
00071 static boolean imp_do_metamorphed (int);
00072 static boolean init_whole_array(int, long64 *, int, int, boolean *);
00073 static void interpret_data_imp_do(int);
00074 static void object_semantics (opnd_type *, expr_mode_type, expr_arg_type *,
00075 boolean, boolean);
00076 static boolean optimize_whole_array_init(int);
00077 static void process_data_imp_do_target(int, int, long64);
00078 static void section_semantics (int, opnd_type *, int *);
00079 static void set_global_value_variables (opnd_type *, opnd_type *, int);
00080 static void vv_subscript_semantics(int, int, expr_arg_type *);
00081
00082 # if 0
00083 static int reenter_const_as_hollerith(int, int, int, holler_type);
00084 # endif
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126 static boolean init_whole_array(int whole_sub_ir_idx,
00127 long64 *dup_count,
00128 int root_ir_idx,
00129 int init_ir_idx,
00130 boolean *optimized)
00131
00132 {
00133 static int attr_idx;
00134 int bd_idx;
00135 static long64 curr_subscript;
00136 int curr_subscript_idx;
00137 int eq_idx;
00138 int eq_tmp_idx;
00139 boolean first_call;
00140 int il_idx;
00141 int ir_idx;
00142 size_offset_type length;
00143 boolean long_value;
00144 boolean ok = TRUE;
00145 opnd_type opnd;
00146 int overlay_attr_idx;
00147 size_offset_type result;
00148 int var_attr_idx;
00149 boolean word_size_target;
00150
00151 # if defined(_SEPARATE_NONCOMMON_EQUIV_GROUPS)
00152 int sb_idx;
00153 # endif
00154
00155
00156 TRACE(Func_Entry, "init_whole_array", NULL);
00157
00158 if (obj_count == 0) {
00159 first_call = TRUE;
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175 if (IR_FLD_L(whole_sub_ir_idx) == AT_Tbl_Idx) {
00176 attr_idx = IR_IDX_L(whole_sub_ir_idx);
00177 }
00178 else {
00179 attr_idx = IR_IDX_R(IR_IDX_L(whole_sub_ir_idx));
00180 }
00181
00182 obj_count = CN_INT_TO_C(BD_LEN_IDX(ATD_ARRAY_IDX(attr_idx)));
00183
00184 if (BD_RANK(ATD_ARRAY_IDX(attr_idx)) == 1 ) {
00185 curr_subscript_idx = BD_LB_IDX(ATD_ARRAY_IDX(attr_idx), 1);
00186 curr_subscript = CN_INT_TO_C(curr_subscript_idx);
00187 }
00188 else {
00189 AT_DEFINED(attr_idx) = TRUE;
00190
00191 overlay_attr_idx = gen_compiler_tmp(IR_LINE_NUM_L(whole_sub_ir_idx),
00192 IR_COL_NUM_L(whole_sub_ir_idx),
00193 Shared, TRUE);
00194
00195 ATD_TYPE_IDX(overlay_attr_idx) = ATD_TYPE_IDX(attr_idx);
00196 ATD_STOR_BLK_IDX(overlay_attr_idx) = ATD_STOR_BLK_IDX(attr_idx);
00197 ATD_EQUIV(overlay_attr_idx) = TRUE;
00198 AT_REFERENCED(overlay_attr_idx) = Referenced;
00199 AT_SEMANTICS_DONE(overlay_attr_idx) = TRUE;
00200
00201
00202 if (ATD_CLASS(attr_idx) != Struct_Component) {
00203
00204 ATD_OFFSET_FLD(overlay_attr_idx) = ATD_OFFSET_FLD(attr_idx);
00205 ATD_OFFSET_IDX(overlay_attr_idx) = ATD_OFFSET_IDX(attr_idx);
00206 ATD_OFFSET_ASSIGNED(overlay_attr_idx) =
00207 ATD_OFFSET_ASSIGNED(attr_idx);
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217 if (ATD_EQUIV(attr_idx)) {
00218 eq_idx = SCP_FIRST_EQUIV_GRP(curr_scp_idx);
00219
00220 while (eq_idx != NULL_IDX) {
00221 eq_tmp_idx = eq_idx;
00222 eq_idx = EQ_NEXT_EQUIV_GRP(eq_idx);
00223
00224 while (eq_tmp_idx != NULL_IDX) {
00225
00226 if (EQ_ATTR_IDX(eq_tmp_idx) == attr_idx) {
00227 NTR_EQ_TBL(eq_idx);
00228 COPY_TBL_NTRY(equiv_tbl, eq_idx, eq_tmp_idx);
00229 EQ_NEXT_EQUIV_OBJ(eq_tmp_idx) = eq_idx;
00230 EQ_ATTR_IDX(eq_idx) = overlay_attr_idx;
00231 ATD_OFFSET_FLD(overlay_attr_idx)=
00232 ATD_OFFSET_FLD(attr_idx);
00233 ATD_OFFSET_IDX(overlay_attr_idx)=
00234 ATD_OFFSET_IDX(attr_idx);
00235 ATD_EQUIV(attr_idx) = TRUE;
00236 goto FOUND;
00237 }
00238 eq_tmp_idx = EQ_NEXT_EQUIV_OBJ(eq_tmp_idx);
00239 }
00240 }
00241 }
00242
00243
00244
00245
00246 NTR_EQ_TBL(eq_idx);
00247 NTR_EQ_TBL(eq_tmp_idx);
00248
00249 EQ_NEXT_EQUIV_GRP(eq_idx) = SCP_FIRST_EQUIV_GRP(curr_scp_idx);
00250 SCP_FIRST_EQUIV_GRP(curr_scp_idx) = eq_idx;
00251 EQ_ATTR_IDX(eq_idx) = attr_idx;
00252 EQ_ATTR_IDX(eq_tmp_idx) = overlay_attr_idx;
00253 EQ_NEXT_EQUIV_OBJ(eq_idx) = eq_tmp_idx;
00254 ATD_EQUIV(attr_idx) = TRUE;
00255 ATD_VARIABLE_TMP_IDX(attr_idx) = overlay_attr_idx;
00256 ATD_FLD(attr_idx) = AT_Tbl_Idx;
00257
00258 # if defined(_SEPARATE_NONCOMMON_EQUIV_GROUPS)
00259
00260 sb_idx = ATD_STOR_BLK_IDX(attr_idx);
00261 if (sb_idx == NULL_IDX ||
00262
00263
00264
00265
00266 !SB_IS_COMMON(sb_idx)) {
00267
00268 if (SB_HOSTED_STATIC(sb_idx)) {
00269 sb_idx = create_equiv_stor_blk(attr_idx, SB_BLK_TYPE(sb_idx));
00270 SB_HOSTED_STATIC(sb_idx) = TRUE;
00271 }
00272 else {
00273 sb_idx = create_equiv_stor_blk(attr_idx, SB_BLK_TYPE(sb_idx));
00274 }
00275
00276 ATD_STOR_BLK_IDX(attr_idx) = sb_idx;
00277 ATD_STOR_BLK_IDX(overlay_attr_idx) = sb_idx;
00278 }
00279 # endif
00280
00281 }
00282 else {
00283
00284 ATD_OFFSET_FLD(overlay_attr_idx) = ATD_OFFSET_FLD(attr_idx);
00285 ATD_OFFSET_IDX(overlay_attr_idx) = ATD_CPNT_OFFSET_IDX(attr_idx);
00286 ATD_OFFSET_ASSIGNED(overlay_attr_idx) =
00287 ATD_OFFSET_ASSIGNED(attr_idx);
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302 ir_idx = IR_IDX_L(whole_sub_ir_idx);
00303
00304 if (ATD_OFFSET_IDX(overlay_attr_idx) == NULL_IDX) {
00305 ATD_OFFSET_FLD(overlay_attr_idx) = CN_Tbl_Idx;
00306 ATD_OFFSET_IDX(overlay_attr_idx) = CN_INTEGER_ZERO_IDX;
00307 }
00308
00309 # if defined(_DEBUG)
00310
00311
00312
00313 if (ATD_OFFSET_FLD(overlay_attr_idx) != CN_Tbl_Idx) {
00314 PRINTMSG(AT_DEF_LINE(overlay_attr_idx), 1201, Internal,
00315 AT_DEF_COLUMN(overlay_attr_idx),
00316 AT_OBJ_NAME_PTR(overlay_attr_idx));
00317 }
00318 # endif
00319
00320 result.fld = ATD_OFFSET_FLD(overlay_attr_idx);
00321 result.idx = ATD_OFFSET_IDX(overlay_attr_idx);
00322
00323 while (IR_FLD_L(ir_idx) == IR_Tbl_Idx) {
00324 ir_idx = IR_IDX_L(ir_idx);
00325 length.fld = ATD_OFFSET_FLD(IR_IDX_R(ir_idx));
00326 length.idx = ATD_CPNT_OFFSET_IDX(IR_IDX_R(ir_idx));
00327
00328 if (!size_offset_binary_calc(&length,
00329 &result,
00330 Plus_Opr,
00331 &result)) {
00332 break;
00333 }
00334 }
00335
00336 if (result.fld == NO_Tbl_Idx) {
00337 ATD_OFFSET_FLD(overlay_attr_idx) = CN_Tbl_Idx;
00338 ATD_OFFSET_IDX(overlay_attr_idx) = ntr_const_tbl(result.type_idx,
00339 FALSE,
00340 result.constant);
00341 }
00342 else {
00343 ATD_OFFSET_FLD(overlay_attr_idx) = result.fld;
00344 ATD_OFFSET_IDX(overlay_attr_idx) = result.idx;
00345 }
00346
00347 var_attr_idx = IR_IDX_L(ir_idx);
00348 ATD_OFFSET_ASSIGNED(overlay_attr_idx) = FALSE;
00349 ATD_DATA_INIT(overlay_attr_idx) = TRUE;
00350
00351 ATD_STOR_BLK_IDX(overlay_attr_idx) = ATD_STOR_BLK_IDX(var_attr_idx);
00352
00353 if (ATD_EQUIV(var_attr_idx)) {
00354 eq_idx = SCP_FIRST_EQUIV_GRP(curr_scp_idx);
00355
00356 while (eq_idx != NULL_IDX) {
00357 eq_tmp_idx = eq_idx;
00358 eq_idx = EQ_NEXT_EQUIV_GRP(eq_idx);
00359
00360 while (eq_tmp_idx != NULL_IDX) {
00361
00362 if (EQ_ATTR_IDX(eq_tmp_idx) == var_attr_idx) {
00363
00364 if (ATD_OFFSET_IDX(var_attr_idx) == NULL_IDX) {
00365 ATD_OFFSET_FLD(var_attr_idx) = CN_Tbl_Idx;
00366 ATD_OFFSET_IDX(var_attr_idx) = CN_INTEGER_ZERO_IDX;
00367 }
00368 NTR_EQ_TBL(eq_idx);
00369 COPY_TBL_NTRY(equiv_tbl, eq_idx, eq_tmp_idx);
00370 EQ_NEXT_EQUIV_OBJ(eq_tmp_idx) = eq_idx;
00371 EQ_ATTR_IDX(eq_idx) = overlay_attr_idx;
00372
00373 result.fld = EQ_OFFSET_FLD(eq_idx);
00374 result.idx = EQ_OFFSET_IDX(eq_idx);
00375 length.fld = ATD_OFFSET_FLD(overlay_attr_idx);
00376 length.idx = ATD_OFFSET_IDX(overlay_attr_idx);
00377
00378 if (!size_offset_binary_calc(&result,
00379 &length,
00380 Plus_Opr,
00381 &result)) {
00382 break;
00383 }
00384
00385 if (result.fld == NO_Tbl_Idx) {
00386 EQ_OFFSET_FLD(eq_idx) = CN_Tbl_Idx;
00387 EQ_OFFSET_IDX(eq_idx) = ntr_const_tbl(
00388 result.type_idx,
00389 FALSE,
00390 result.constant);
00391 }
00392 else if (result.fld == CN_Tbl_Idx) {
00393 EQ_OFFSET_FLD(eq_idx) = result.fld;
00394 EQ_OFFSET_IDX(eq_idx) = result.idx;
00395 }
00396
00397 result.fld = ATD_OFFSET_FLD(var_attr_idx);
00398 result.idx = ATD_OFFSET_IDX(var_attr_idx);
00399
00400 if (!size_offset_binary_calc(&length,
00401 &result,
00402 Plus_Opr,
00403 &result)) {
00404 break;
00405 }
00406
00407 if (result.fld == NO_Tbl_Idx) {
00408 ATD_OFFSET_FLD(overlay_attr_idx) = CN_Tbl_Idx;
00409 ATD_OFFSET_IDX(overlay_attr_idx) = ntr_const_tbl(
00410 result.type_idx,
00411 FALSE,
00412 result.constant);
00413 }
00414 else {
00415 ATD_OFFSET_FLD(overlay_attr_idx) = result.fld;
00416 ATD_OFFSET_IDX(overlay_attr_idx) = result.idx;
00417 }
00418
00419 ATD_EQUIV(var_attr_idx) = TRUE;
00420 goto FOUND;
00421 }
00422 eq_tmp_idx = EQ_NEXT_EQUIV_OBJ(eq_tmp_idx);
00423 }
00424 }
00425 }
00426
00427
00428
00429
00430 NTR_EQ_TBL(eq_idx);
00431 NTR_EQ_TBL(eq_tmp_idx);
00432
00433 EQ_NEXT_EQUIV_GRP(eq_idx) = SCP_FIRST_EQUIV_GRP(curr_scp_idx);
00434 SCP_FIRST_EQUIV_GRP(curr_scp_idx)= eq_idx;
00435 EQ_OFFSET_IDX(eq_tmp_idx) = ATD_OFFSET_IDX(overlay_attr_idx);
00436 EQ_OFFSET_FLD(eq_tmp_idx) = ATD_OFFSET_FLD(overlay_attr_idx);
00437 EQ_ATTR_IDX(eq_idx) = var_attr_idx;
00438 EQ_ATTR_IDX(eq_tmp_idx) = overlay_attr_idx;
00439 EQ_NEXT_EQUIV_OBJ(eq_idx) = eq_tmp_idx;
00440 ATD_EQUIV(var_attr_idx) = TRUE;
00441
00442 # if defined(_SEPARATE_NONCOMMON_EQUIV_GROUPS)
00443
00444 sb_idx = ATD_STOR_BLK_IDX(var_attr_idx);
00445
00446 if (sb_idx == NULL_IDX ||
00447 (!SB_MODULE(sb_idx) && !SB_IS_COMMON(sb_idx))) {
00448
00449 if (SB_HOSTED_STATIC(sb_idx)) {
00450 sb_idx = create_equiv_stor_blk(attr_idx, SB_BLK_TYPE(sb_idx));
00451 SB_HOSTED_STATIC(sb_idx) = TRUE;
00452 }
00453 else {
00454 sb_idx = create_equiv_stor_blk(attr_idx, SB_BLK_TYPE(sb_idx));
00455 }
00456
00457 ATD_STOR_BLK_IDX(var_attr_idx) = sb_idx;
00458 ATD_STOR_BLK_IDX(overlay_attr_idx) = sb_idx;
00459 }
00460 # endif
00461
00462 NTR_IR_LIST_TBL(il_idx);
00463 IL_IDX(il_idx) = overlay_attr_idx;
00464 IL_FLD(il_idx) = AT_Tbl_Idx;
00465 IL_LINE_NUM(il_idx) = stmt_start_line;
00466 IL_COL_NUM(il_idx) = stmt_start_col;
00467
00468 if (ATD_FLD(var_attr_idx) == NO_Tbl_Idx) {
00469 ATD_FLD(var_attr_idx) = IL_Tbl_Idx;
00470 IL_LIST_CNT(il_idx) = 1;
00471 }
00472 else {
00473 IL_LIST_CNT(il_idx) = 1 +
00474 IL_LIST_CNT(ATD_VARIABLE_TMP_IDX(var_attr_idx));
00475 IL_NEXT_LIST_IDX(il_idx) = ATD_VARIABLE_TMP_IDX(var_attr_idx);
00476 }
00477 ATD_VARIABLE_TMP_IDX(var_attr_idx) = il_idx;
00478 }
00479
00480 FOUND:;
00481
00482
00483
00484 bd_idx = reserve_array_ntry(1);
00485 BD_RESOLVED(bd_idx) = TRUE;
00486 BD_LEN_FLD(bd_idx) = CN_Tbl_Idx;
00487 BD_LEN_IDX(bd_idx) = BD_LEN_IDX(ATD_ARRAY_IDX(attr_idx));
00488 BD_RANK(bd_idx) = 1;
00489 BD_ARRAY_CLASS(bd_idx) = Explicit_Shape;
00490 BD_ARRAY_SIZE(bd_idx) = Constant_Size;
00491 BD_LINE_NUM(bd_idx) = IR_LINE_NUM_L(whole_sub_ir_idx);
00492 BD_COLUMN_NUM(bd_idx) = IR_COL_NUM_L(whole_sub_ir_idx);
00493 BD_LB_FLD(bd_idx,1) = CN_Tbl_Idx;
00494 BD_LB_IDX(bd_idx,1) = CN_INTEGER_ONE_IDX;
00495 BD_UB_FLD(bd_idx,1) = CN_Tbl_Idx;
00496 BD_UB_IDX(bd_idx,1) = BD_LEN_IDX(ATD_ARRAY_IDX(attr_idx));
00497 BD_XT_FLD(bd_idx,1) = CN_Tbl_Idx;
00498 BD_XT_IDX(bd_idx,1) = BD_LEN_IDX(ATD_ARRAY_IDX(attr_idx));
00499 BD_SM_FLD(bd_idx,1) = CN_Tbl_Idx;
00500 BD_SM_IDX(bd_idx,1) = BD_SM_IDX(ATD_ARRAY_IDX(attr_idx),1);
00501
00502 ATD_ARRAY_IDX(overlay_attr_idx) = ntr_array_in_bd_tbl(bd_idx);
00503
00504 curr_subscript = 1;
00505 curr_subscript_idx = CN_INTEGER_ONE_IDX;
00506
00507 attr_idx = overlay_attr_idx;
00508 }
00509 }
00510 else {
00511 first_call = FALSE;
00512 curr_subscript += *dup_count;
00513 curr_subscript_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
00514 curr_subscript);
00515 }
00516
00517 word_size_target = FALSE;
00518
00519 if (TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) == INTEGER_DEFAULT_TYPE ||
00520 TYP_LINEAR(ATD_TYPE_IDX(attr_idx)) == REAL_DEFAULT_TYPE) {
00521
00522 if (storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(attr_idx))] ==
00523 TARGET_BITS_PER_WORD) {
00524 word_size_target = TRUE;
00525 }
00526 }
00527
00528 long_value = FALSE;
00529
00530 if (value_desc.type == Typeless) {
00531
00532 if (TYP_BIT_LEN(CN_TYPE_IDX(OPND_IDX(value_opnd))) >
00533 TARGET_BITS_PER_WORD) {
00534 long_value = TRUE;
00535 }
00536 }
00537 else if (value_desc.type == Character) {
00538
00539 if (CN_INT_TO_C(TYP_IDX(value_desc.type_idx)) > TARGET_CHARS_PER_WORD) {
00540 long_value = TRUE;
00541 }
00542 }
00543
00544 if (word_size_target && long_value) {
00545 PRINTMSG(OPND_LINE_NUM(value_opnd), 733, Error, OPND_COL_NUM(value_opnd));
00546 }
00547 else {
00548
00549
00550
00551
00552
00553
00554
00555
00556
00557
00558
00559
00560
00561 if (first_call &&
00562 IR_FLD_L(IR_IDX_L(init_ir_idx)) == AT_Tbl_Idx &&
00563 TYP_TYPE(ATD_TYPE_IDX(IR_IDX_L(IR_IDX_L(init_ir_idx)))) !=
00564 Structure) {
00565
00566 if (ATD_CLASS(attr_idx) == Compiler_Tmp) {
00567 IR_IDX_L(IR_IDX_L(init_ir_idx)) = attr_idx;
00568 }
00569
00570 if (TYP_TYPE(CN_TYPE_IDX(OPND_IDX(value_opnd))) == Character &&
00571 (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == Integer ||
00572 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == Real)) {
00573 *optimized = FALSE;
00574 }
00575 else {
00576 *optimized = optimize_whole_array_init(init_ir_idx);
00577 }
00578
00579 if (SH_ERR_FLG(curr_stmt_sh_idx)) {
00580 ok = FALSE;
00581 goto EXIT;
00582 }
00583
00584 if (*optimized) {
00585 goto EXIT;
00586 }
00587 }
00588 else {
00589 *optimized = FALSE;
00590 }
00591 }
00592
00593
00594
00595
00596
00597
00598
00599
00600
00601 gen_opnd(&opnd, root_ir_idx, IR_Tbl_Idx, stmt_start_line, stmt_start_col);
00602 copy_subtree(&opnd, &opnd);
00603 ir_idx = OPND_IDX(opnd);
00604 IR_FLD_L(init_ir_idx) = IR_Tbl_Idx;
00605 IR_IDX_L(init_ir_idx) = ir_idx;
00606
00607 while (IR_OPR(ir_idx) != Whole_Subscript_Opr) {
00608 ir_idx = IR_IDX_L(ir_idx);
00609 }
00610
00611 IR_OPR(ir_idx) = Subscript_Opr;
00612 IR_RANK(ir_idx) = 1;
00613
00614
00615
00616
00617
00618
00619
00620
00621
00622
00623 if (ATD_CLASS(attr_idx) == Compiler_Tmp) {
00624
00625 if (IR_FLD_L(ir_idx) == AT_Tbl_Idx) {
00626 IR_IDX_L(ir_idx) = attr_idx;
00627 }
00628 else {
00629 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
00630 IR_IDX_L(ir_idx) = attr_idx;
00631 IR_LINE_NUM_L(ir_idx) = stmt_start_line;
00632 IR_COL_NUM_L(ir_idx) = stmt_start_col;
00633 }
00634 }
00635
00636 il_idx = IR_IDX_R(ir_idx);
00637 IL_NEXT_LIST_IDX(il_idx) = NULL_IDX;
00638 IR_LIST_CNT_R(ir_idx) = 1;
00639
00640 IL_FLD(il_idx) = CN_Tbl_Idx;
00641 IL_IDX(il_idx) = curr_subscript_idx;
00642 IL_LINE_NUM(il_idx) = stmt_start_line;
00643 IL_COL_NUM(il_idx) = stmt_start_col;
00644
00645
00646 EXIT:
00647
00648 TRACE(Func_Exit, "init_whole_array", NULL);
00649
00650 return(ok);
00651
00652 }
00653
00654
00655
00656
00657
00658
00659
00660
00661
00662
00663
00664
00665
00666
00667
00668
00669
00670
00671
00672
00673 void data_stmt_semantics(void)
00674 {
00675 int array_ir_idx;
00676 int attr_idx;
00677 int column;
00678 boolean compiler_gen_imp_do;
00679 int const_il_idx;
00680 int dim_item_idx;
00681 int dup_cnt_il_idx;
00682 opnd_type dup_cnt_opnd;
00683 long64 dup_count;
00684 boolean dup_count_calculated = FALSE;
00685 boolean first_obj = TRUE;
00686 int first_triplet_idx;
00687 int i;
00688 int il_idx;
00689 int init_ir_idx;
00690 int ir_idx;
00691 size_offset_type length;
00692 int line;
00693 boolean metamorphed;
00694 expr_arg_type obj_desc;
00695 opnd_type obj_opnd;
00696 boolean optimized;
00697 opnd_type rep_factor_opnd;
00698 int root_ir_idx;
00699 long64 section_inc_value;
00700 long64 section_start_value = 0;
00701 int stride_il_idx;
00702 size_offset_type stride_in_bits;
00703 opnd_type stride_opnd;
00704 int struct_ir_idx;
00705
00706 int target_attr_idx;
00707 boolean vv_sub_present;
00708
00709
00710 TRACE (Func_Entry, "data_stmt_semantics", NULL);
00711
00712 OPND_IDX(rep_factor_opnd) = NULL_IDX;
00713 init_ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
00714 obj_il_idx = IR_IDX_L(init_ir_idx);
00715 value_il_idx = IR_IDX_R(init_ir_idx);
00716 metamorphed = FALSE;
00717 obj_count = 0;
00718 rep_factor = 0;
00719
00720 while (obj_il_idx != NULL_IDX) {
00721
00722 if (first_obj) {
00723 first_obj = FALSE;
00724 }
00725 else {
00726 gen_sh(After, Data_Stmt, IL_LINE_NUM(obj_il_idx),
00727 IL_COL_NUM(obj_il_idx), FALSE, FALSE, TRUE);
00728
00729 NTR_IR_TBL(init_ir_idx);
00730 SH_IR_IDX(curr_stmt_sh_idx) = init_ir_idx;
00731 IR_OPR(init_ir_idx) = Init_Opr;
00732 IR_TYPE_IDX(init_ir_idx) = TYPELESS_DEFAULT_TYPE;
00733 IR_LINE_NUM(init_ir_idx) = IL_LINE_NUM(obj_il_idx);
00734 IR_COL_NUM(init_ir_idx) = IL_COL_NUM(obj_il_idx);
00735 }
00736
00737 RESTART:
00738
00739 if (obj_count == 0) {
00740 stride_opnd = null_opnd;
00741 array_ir_idx = NULL_IDX;
00742 struct_ir_idx = NULL_IDX;
00743
00744 target_attr_idx = NULL_IDX;
00745 obj_desc.rank = 0;
00746 compiler_gen_imp_do = FALSE;
00747 vv_sub_present = FALSE;
00748
00749 COPY_OPND(obj_opnd, IL_OPND(obj_il_idx));
00750
00751 if (OPND_FLD(obj_opnd) == AT_Tbl_Idx ||
00752 (OPND_FLD(obj_opnd) == IR_Tbl_Idx &&
00753 IR_OPR(OPND_IDX(obj_opnd)) != Implied_Do_Opr)) {
00754 object_semantics(&obj_opnd,
00755 Data_Stmt_Target,
00756 &obj_desc,
00757 TRUE,
00758 metamorphed);
00759
00760 if (OPND_FLD(obj_opnd) == AT_Tbl_Idx) {
00761 root_ir_idx = NULL_IDX;
00762 }
00763 else {
00764 root_ir_idx = OPND_IDX(obj_opnd);
00765
00766
00767
00768
00769
00770
00771
00772
00773
00774
00775 ir_idx = OPND_IDX(obj_opnd);
00776
00777 while (IR_FLD_L(ir_idx) == IR_Tbl_Idx) {
00778
00779 if (IR_OPR(ir_idx) == Struct_Opr) {
00780 break;
00781 }
00782 else {
00783 ir_idx = IR_IDX_L(ir_idx);
00784 }
00785 }
00786
00787 target_attr_idx = (IR_OPR(ir_idx) == Struct_Opr) ?
00788 IR_IDX_R(ir_idx) : IR_IDX_L(ir_idx);
00789 }
00790
00791 if (! SH_ERR_FLG(curr_stmt_sh_idx)) {
00792 COPY_OPND(IR_OPND_L(init_ir_idx), obj_opnd);
00793 }
00794 else {
00795 goto EXIT;
00796 }
00797 }
00798 }
00799
00800
00801
00802
00803
00804
00805
00806
00807 if (rep_factor == 0) {
00808 set_global_value_variables(&rep_factor_opnd,
00809 &dup_cnt_opnd,
00810 target_attr_idx);
00811
00812 if (SH_ERR_FLG(curr_stmt_sh_idx)) {
00813 goto EXIT;
00814 }
00815 }
00816
00817
00818
00819
00820
00821
00822
00823 PROCESS_THE_TARGET:
00824
00825
00826
00827
00828
00829 if (obj_desc.rank > 0 && !obj_desc.pointer) {
00830
00831
00832
00833
00834 if (array_ir_idx == NULL_IDX) {
00835 array_ir_idx = OPND_IDX(obj_opnd);
00836
00837 while (IR_OPR(array_ir_idx) != Whole_Subscript_Opr &&
00838 IR_OPR(array_ir_idx) != Section_Subscript_Opr) {
00839
00840
00841
00842
00843
00844
00845
00846
00847 if (IR_OPR(array_ir_idx) == Struct_Opr) {
00848 struct_ir_idx = array_ir_idx;
00849 }
00850
00851 array_ir_idx = IR_IDX_L(array_ir_idx);
00852 }
00853 }
00854
00855 if (IR_OPR(array_ir_idx) == Whole_Subscript_Opr) {
00856
00857
00858
00859
00860 if (IR_FLD_L(array_ir_idx) == AT_Tbl_Idx) {
00861 dim_item_idx = IR_IDX_L(array_ir_idx);
00862 }
00863 else {
00864
00865
00866
00867
00868
00869
00870
00871
00872 if (struct_ir_idx == NULL_IDX) {
00873 dim_item_idx = IR_IDX_R(IR_IDX_L(array_ir_idx));
00874 }
00875 else {
00876 ir_idx = IR_IDX_L(array_ir_idx);
00877
00878 while (IR_FLD_L(ir_idx) == IR_Tbl_Idx) {
00879 ir_idx = IR_IDX_L(ir_idx);
00880 }
00881
00882 dim_item_idx = IR_IDX_L(ir_idx);
00883 }
00884
00885 }
00886
00887 if (compare_cn_and_value(BD_LEN_IDX(ATD_ARRAY_IDX(dim_item_idx)),
00888 0, Eq_Opr)) {
00889 SH_IR_IDX(curr_stmt_sh_idx) = NULL_IDX;
00890 obj_il_idx = IL_NEXT_LIST_IDX(obj_il_idx);
00891 continue;
00892 }
00893
00894 if (struct_ir_idx == NULL_IDX ||
00895 (struct_ir_idx != NULL_IDX && obj_desc.rank == 1)) {
00896
00897 if (init_whole_array(array_ir_idx,
00898 &dup_count,
00899 root_ir_idx,
00900 init_ir_idx,
00901 &optimized)) {
00902
00903 if (optimized) {
00904 obj_il_idx = IL_NEXT_LIST_IDX(obj_il_idx);
00905 continue;
00906 }
00907 }
00908 else {
00909 goto EXIT;
00910 }
00911 }
00912 else {
00913 IR_OPR(array_ir_idx) = Section_Subscript_Opr;
00914 goto PROCESS_THE_TARGET;
00915 }
00916 }
00917 else {
00918
00919
00920
00921 if (obj_count == 0) {
00922 il_idx = IR_IDX_R(array_ir_idx);
00923
00924 for (i = 1; i <= IR_LIST_CNT_R(array_ir_idx); ++i) {
00925
00926 if (IL_VECTOR_SUBSCRIPT(il_idx)) {
00927 vv_sub_present = TRUE;
00928 break;
00929 }
00930
00931 il_idx = IL_NEXT_LIST_IDX(il_idx);
00932 }
00933
00934
00935
00936
00937
00938
00939
00940 if (vv_sub_present) {
00941 vv_subscript_semantics(init_ir_idx,
00942 array_ir_idx,
00943 &obj_desc);
00944
00945 data_imp_do_semantics(init_ir_idx,
00946 IR_IDX_L(init_ir_idx),
00947 TRUE,
00948 &metamorphed);
00949
00950 obj_il_idx = IL_NEXT_LIST_IDX(obj_il_idx);
00951 continue;
00952 }
00953 else {
00954 section_semantics(array_ir_idx,
00955 &stride_opnd,
00956 &first_triplet_idx);
00957 }
00958 }
00959
00960 if (SH_ERR_FLG(curr_stmt_sh_idx)) {
00961 goto EXIT;
00962 }
00963
00964 if (obj_count != 0) {
00965 gen_section_ref( array_ir_idx,
00966 rep_factor,
00967 first_triplet_idx,
00968 root_ir_idx,
00969 init_ir_idx,
00970 &dup_count,
00971 §ion_start_value,
00972 §ion_inc_value);
00973 dup_count_calculated = TRUE;
00974 }
00975 else {
00976 SH_IR_IDX(curr_stmt_sh_idx) = NULL_IDX;
00977 obj_il_idx = IL_NEXT_LIST_IDX(obj_il_idx);
00978 continue;
00979 }
00980 }
00981 }
00982 else {
00983
00984
00985
00986 if (OPND_FLD(obj_opnd) == AT_Tbl_Idx) {
00987 obj_count = 1;
00988 target_attr_idx = OPND_IDX(obj_opnd);
00989 }
00990 else {
00991
00992
00993
00994 if (IR_OPR(OPND_IDX(obj_opnd)) == Implied_Do_Opr) {
00995
00996 data_imp_do_semantics(init_ir_idx,
00997 IL_IDX(obj_il_idx),
00998 compiler_gen_imp_do,
00999 &metamorphed);
01000
01001 if (SH_ERR_FLG(curr_stmt_sh_idx)) {
01002 goto EXIT;
01003 }
01004
01005 if (metamorphed) {
01006 IL_FLD(obj_il_idx) = IL_FLD(IR_IDX_L(init_ir_idx));
01007 IL_IDX(obj_il_idx) = IL_IDX(IR_IDX_L(init_ir_idx));
01008 goto RESTART;
01009 }
01010
01011 COPY_OPND(IR_OPND_L(init_ir_idx), obj_opnd);
01012 obj_il_idx = IL_NEXT_LIST_IDX(obj_il_idx);
01013
01014 continue;
01015 }
01016 else {
01017
01018
01019
01020
01021
01022 obj_count = 1;
01023
01024
01025
01026
01027
01028
01029
01030
01031
01032 }
01033 }
01034 }
01035
01036
01037
01038 if (value_il_idx == NULL_IDX) {
01039 find_opnd_line_and_column(&obj_opnd, &line, &column);
01040 PRINTMSG(line, 667, Error, column);
01041 goto EXIT;
01042 }
01043
01044
01045
01046 if (! check_target_and_value(target_attr_idx, init_ir_idx)) {
01047 goto EXIT;
01048 }
01049
01050
01051
01052 NTR_IR_LIST_TBL(const_il_idx);
01053 IR_LIST_CNT_R(init_ir_idx) = 3;
01054 IR_FLD_R(init_ir_idx) = IL_Tbl_Idx;
01055 IR_IDX_R(init_ir_idx) = const_il_idx;
01056 COPY_OPND(IL_OPND(const_il_idx), value_opnd);
01057
01058
01059
01060 NTR_IR_LIST_TBL(dup_cnt_il_idx);
01061 IL_PREV_LIST_IDX(dup_cnt_il_idx) = const_il_idx;
01062 IL_NEXT_LIST_IDX(const_il_idx) = dup_cnt_il_idx;
01063
01064 if (OPND_IDX(rep_factor_opnd) == NULL_IDX) {
01065 find_opnd_line_and_column(&value_opnd, &line, &column);
01066 IL_LINE_NUM(dup_cnt_il_idx) = line;
01067 IL_COL_NUM(dup_cnt_il_idx) = column;
01068 IL_FLD(dup_cnt_il_idx) = CN_Tbl_Idx;
01069 IL_IDX(dup_cnt_il_idx) = CN_INTEGER_ONE_IDX;
01070 dup_count = 1;
01071 }
01072 else {
01073
01074 if (dup_count_calculated) {
01075 dup_count_calculated = FALSE;
01076 }
01077 else {
01078 dup_count = (obj_count <= rep_factor) ? obj_count : rep_factor;
01079 }
01080
01081 OPND_IDX(dup_cnt_opnd) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01082 dup_count);
01083 COPY_OPND(IL_OPND(dup_cnt_il_idx), dup_cnt_opnd);
01084 }
01085
01086
01087
01088
01089 NTR_IR_LIST_TBL(stride_il_idx);
01090 IL_PREV_LIST_IDX(stride_il_idx) = dup_cnt_il_idx;
01091 IL_NEXT_LIST_IDX(dup_cnt_il_idx) = stride_il_idx;
01092
01093 if (dup_count == 1 ||
01094 (OPND_IDX(stride_opnd) == NULL_IDX && array_ir_idx == NULL_IDX)) {
01095 find_opnd_line_and_column(&obj_opnd, &line, &column);
01096 IL_LINE_NUM(stride_il_idx) = line;
01097 IL_COL_NUM(stride_il_idx) = column;
01098 IL_FLD(stride_il_idx) = CN_Tbl_Idx;
01099 IL_IDX(stride_il_idx) = CN_INTEGER_ZERO_IDX;
01100 }
01101 else {
01102
01103
01104
01105
01106
01107
01108 if (OPND_FLD(stride_opnd) == NO_Tbl_Idx) {
01109
01110 if (struct_ir_idx == NULL_IDX) {
01111 attr_idx = (IR_FLD_L(array_ir_idx) == AT_Tbl_Idx) ?
01112 IR_IDX_L(array_ir_idx) :
01113 IR_IDX_R(IR_IDX_L(array_ir_idx));
01114 }
01115 else {
01116 ir_idx = array_ir_idx;
01117
01118 while (IR_FLD_L(ir_idx) == IR_Tbl_Idx) {
01119 ir_idx = IR_IDX_L(ir_idx);
01120 }
01121
01122 attr_idx = IR_IDX_L(ir_idx);
01123 }
01124
01125 stride_in_bits = stor_bit_size_of(attr_idx, FALSE, FALSE);
01126
01127 if (OPND_IDX(stride_opnd) != NULL_IDX) {
01128 length.fld = CN_Tbl_Idx;
01129 length.idx = OPND_IDX(stride_opnd);
01130
01131 size_offset_binary_calc(&stride_in_bits,
01132 &length,
01133 Mult_Opr,
01134 &stride_in_bits);
01135 }
01136
01137 if (stride_in_bits.fld == NO_Tbl_Idx) {
01138 OPND_FLD(stride_opnd) = CN_Tbl_Idx;
01139 OPND_IDX(stride_opnd) = ntr_const_tbl(stride_in_bits.type_idx,
01140 FALSE,
01141 stride_in_bits.constant);
01142 }
01143 else {
01144 OPND_FLD(stride_opnd) = stride_in_bits.fld;
01145 OPND_IDX(stride_opnd) = stride_in_bits.idx;
01146 }
01147
01148 OPND_LINE_NUM(stride_opnd) = stmt_start_line;
01149 OPND_COL_NUM(stride_opnd) = stmt_start_col;
01150 }
01151
01152 COPY_OPND(IL_OPND(stride_il_idx), stride_opnd);
01153 }
01154
01155
01156
01157
01158 if (TYP_TYPE(ATD_TYPE_IDX(target_attr_idx)) == Character) {
01159 adjust_char_value_len(init_ir_idx,
01160 array_ir_idx,
01161 section_start_value,
01162 section_inc_value);
01163 }
01164
01165
01166
01167
01168
01169
01170 if ((obj_count -= dup_count) == 0) {
01171 obj_il_idx = IL_NEXT_LIST_IDX(obj_il_idx);
01172 }
01173
01174 if ((rep_factor -= dup_count) == 0) {
01175 value_il_idx = IL_NEXT_LIST_IDX(value_il_idx);
01176
01177 if (value_il_idx != NULL_IDX) {
01178 IL_PREV_LIST_IDX(value_il_idx) = NULL_IDX;
01179 }
01180
01181 if (value_il_idx == NULL_IDX && obj_count != 0) {
01182
01183
01184
01185
01186
01187
01188
01189
01190
01191
01192 if (OPND_FLD(obj_opnd) == IR_Tbl_Idx &&
01193 IR_OPR(OPND_IDX(obj_opnd)) == Whole_Subscript_Opr &&
01194 IL_NEXT_LIST_IDX(obj_il_idx) == NULL_IDX) {
01195
01196 if (IR_OPR(init_ir_idx) == Init_Opr) {
01197 PRINTMSG(IR_LINE_NUM_L(OPND_IDX(obj_opnd)), 698, Ansi,
01198 IR_COL_NUM_L(OPND_IDX(obj_opnd)));
01199 }
01200
01201 break;
01202 }
01203 else {
01204 find_opnd_line_and_column(&obj_opnd, &line, &column);
01205 PRINTMSG(line, 667, Error, column);
01206 obj_il_idx = NULL_IDX;
01207 }
01208 }
01209 }
01210
01211 }
01212
01213 if (value_il_idx != NULL_IDX) {
01214 PRINTMSG(IL_LINE_NUM(value_il_idx), 668, Error, IL_COL_NUM(value_il_idx));
01215 }
01216
01217 EXIT:
01218
01219 TRACE (Func_Exit, "data_stmt_semantics", NULL);
01220
01221 return;
01222
01223 }
01224
01225
01226
01227
01228
01229
01230
01231
01232
01233
01234
01235
01236
01237
01238
01239
01240
01241
01242
01243
01244
01245
01246
01247
01248
01249
01250 static void object_semantics(opnd_type *obj_opnd,
01251 expr_mode_type target_expr_mode,
01252 expr_arg_type *obj_desc,
01253 boolean fold_subscripts,
01254 boolean metamorphed)
01255
01256 {
01257 int attr_idx;
01258 opnd_type data_obj;
01259
01260
01261 TRACE (Func_Entry, "object_semantics", NULL);
01262
01263
01264
01265
01266 COPY_OPND(data_obj, *obj_opnd);
01267
01268 while (OPND_FLD(data_obj) == IR_Tbl_Idx) {
01269 COPY_OPND(data_obj, IR_OPND_L(OPND_IDX(data_obj)));
01270 }
01271
01272 if (AT_DCL_ERR(OPND_IDX(data_obj))) {
01273 SH_ERR_FLG(curr_stmt_sh_idx) = TRUE;
01274 goto EXIT;
01275 }
01276
01277
01278
01279 expr_mode = target_expr_mode;
01280 obj_desc->rank = 0;
01281
01282
01283
01284
01285 xref_state = (metamorphed) ? CIF_No_Usage_Rec :
01286 (cif_usage_code_type)
01287 (CIF_Symbol_Modification + 100);
01288
01289 if (expr_semantics(obj_opnd, obj_desc)) {
01290
01291 COPY_OPND(data_obj, *obj_opnd);
01292
01293 while (OPND_FLD(data_obj) == IR_Tbl_Idx) {
01294 COPY_OPND(data_obj, IR_OPND_L(OPND_IDX(data_obj)));
01295 }
01296
01297 attr_idx = OPND_IDX(data_obj);
01298
01299
01300
01301
01302
01303
01304
01305
01306
01307
01308
01309
01310
01311
01312 if (ATD_IN_COMMON(attr_idx)) {
01313
01314 if (SB_BLK_TYPE(ATD_STOR_BLK_IDX(attr_idx)) == Common) {
01315
01316 if (! metamorphed) {
01317
01318 if (SB_BLANK_COMMON(ATD_STOR_BLK_IDX(attr_idx))) {
01319 PRINTMSG(OPND_LINE_NUM(data_obj), 1109, Ansi,
01320 OPND_COL_NUM(data_obj));
01321 }
01322 else if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) != Blockdata) {
01323
01324 # if defined(_ALLOW_DATA_INIT_OF_COMMON)
01325 PRINTMSG(OPND_LINE_NUM(data_obj), 692, Ansi,
01326 OPND_COL_NUM(data_obj));
01327 # else
01328 PRINTMSG(OPND_LINE_NUM(data_obj), 1542, Warning,
01329 OPND_COL_NUM(data_obj));
01330 # endif
01331 }
01332 }
01333 }
01334 else if (SB_BLK_TYPE(ATD_STOR_BLK_IDX(attr_idx)) == Task_Common) {
01335 PRINTMSG(OPND_LINE_NUM(data_obj), 851, Error,
01336 OPND_COL_NUM(data_obj));
01337 }
01338 }
01339 else if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Blockdata &&
01340 !(ATD_EQUIV(attr_idx) &&
01341 SB_IS_COMMON(ATD_STOR_BLK_IDX(attr_idx)))) {
01342 PRINTMSG(OPND_LINE_NUM(data_obj), 825, Warning,
01343 OPND_COL_NUM(data_obj));
01344 }
01345
01346
01347
01348
01349 if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == CRI_Ch_Ptr) {
01350 # ifdef _EXTENDED_CRI_CHAR_POINTER
01351 transform_cri_ch_ptr(obj_opnd);
01352 # else
01353 PRINTMSG(OPND_LINE_NUM(data_obj), 695, Error, OPND_COL_NUM(data_obj));
01354 # endif
01355 }
01356
01357 if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == Structure &&
01358 ATT_DEFAULT_INITIALIZED(TYP_IDX(ATD_TYPE_IDX(attr_idx)))) {
01359 PRINTMSG(OPND_LINE_NUM(data_obj), 1589, Error,
01360 OPND_COL_NUM(data_obj),
01361 AT_OBJ_NAME_PTR(attr_idx),
01362 AT_OBJ_NAME_PTR(TYP_IDX(ATD_TYPE_IDX(attr_idx))));
01363 }
01364
01365
01366
01367
01368
01369
01370
01371
01372 if (OPND_FLD((*obj_opnd)) == IR_Tbl_Idx && fold_subscripts) {
01373 fold_all_subscripts(obj_opnd);
01374 }
01375 }
01376
01377 EXIT:
01378
01379 expr_mode = Regular_Expr;
01380
01381 TRACE (Func_Exit, "object_semantics", NULL);
01382
01383 return;
01384
01385 }
01386
01387
01388
01389
01390
01391
01392
01393
01394
01395
01396
01397
01398
01399
01400
01401
01402
01403
01404
01405
01406 static void set_global_value_variables(opnd_type *rep_factor_opnd,
01407 opnd_type *dup_cnt_opnd,
01408 int target_attr_idx)
01409 {
01410 expr_arg_type expr_desc;
01411 int rep_count_ir_idx;
01412
01413
01414 TRACE (Func_Entry, "set_global_value_variables", NULL);
01415
01416
01417
01418
01419 while (rep_factor == 0 && value_il_idx != NULL_IDX) {
01420
01421 if (IL_FLD(value_il_idx) == IR_Tbl_Idx &&
01422 IR_OPR(IL_IDX(value_il_idx)) == Rep_Count_Opr) {
01423 rep_count_ir_idx = IL_IDX(value_il_idx);
01424 COPY_OPND(*rep_factor_opnd, IR_OPND_L(rep_count_ir_idx));
01425
01426 # ifdef _DEBUG
01427
01428 if (OPND_FLD((*rep_factor_opnd)) != CN_Tbl_Idx) {
01429 PRINTMSG(IR_LINE_NUM(rep_count_ir_idx), 626, Internal,
01430 IR_COL_NUM(rep_count_ir_idx),
01431 "CN_Tbl_Idx", "set_global_value_variables");
01432 }
01433
01434 # endif
01435
01436 expr_desc.type_idx = CN_TYPE_IDX(OPND_IDX((*rep_factor_opnd)));
01437 expr_desc.type = TYP_TYPE(expr_desc.type_idx);
01438 expr_desc.linear_type = TYP_LINEAR(expr_desc.type_idx);
01439
01440 rep_factor = CN_INT_TO_C(OPND_IDX((*rep_factor_opnd)));
01441
01442 if (rep_factor > 0) {
01443 COPY_OPND(*dup_cnt_opnd, *rep_factor_opnd);
01444 COPY_OPND(value_opnd, IR_OPND_R(rep_count_ir_idx));
01445 }
01446 else if (rep_factor == 0) {
01447 OPND_IDX((*rep_factor_opnd)) = NULL_IDX;
01448
01449 if (IL_PREV_LIST_IDX(value_il_idx) != NULL_IDX) {
01450 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(value_il_idx)) =
01451 IL_NEXT_LIST_IDX(value_il_idx);
01452 }
01453
01454 if (IL_NEXT_LIST_IDX(value_il_idx) != NULL_IDX) {
01455 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(value_il_idx)) =
01456 IL_PREV_LIST_IDX(value_il_idx);
01457 }
01458
01459 value_il_idx = IL_NEXT_LIST_IDX(value_il_idx);
01460 continue;
01461 }
01462 else {
01463 PRINTMSG(OPND_LINE_NUM((*rep_factor_opnd)), 679, Error,
01464 OPND_COL_NUM((*rep_factor_opnd)));
01465 goto EXIT;
01466 }
01467 }
01468 else {
01469 COPY_OPND(value_opnd, IL_OPND(value_il_idx));
01470 rep_factor = 1;
01471 OPND_IDX((*rep_factor_opnd)) = NULL_IDX;
01472 rep_count_ir_idx = NULL_IDX;
01473 }
01474
01475 }
01476
01477 if (value_il_idx == NULL_IDX) {
01478 goto EXIT;
01479 }
01480
01481
01482
01483
01484
01485 if (OPND_FLD(value_opnd) == CN_Tbl_Idx) {
01486 value_desc.type_idx = CN_TYPE_IDX(OPND_IDX(value_opnd));
01487 value_desc.type = TYP_TYPE(value_desc.type_idx);
01488 value_desc.linear_type = TYP_LINEAR(value_desc.type_idx);
01489 }
01490 else if (OPND_FLD(value_opnd) == AT_Tbl_Idx &&
01491 AT_OBJ_CLASS(OPND_IDX(value_opnd)) == Data_Obj &&
01492 ATD_CLASS(OPND_IDX(value_opnd)) == Compiler_Tmp &&
01493 ATD_FLD(OPND_IDX(value_opnd)) == CN_Tbl_Idx) {
01494
01495 value_desc.type_idx = ATD_TYPE_IDX(OPND_IDX(value_opnd));
01496 value_desc.type = TYP_TYPE(value_desc.type_idx);
01497 value_desc.linear_type = TYP_LINEAR(value_desc.type_idx);
01498
01499 OPND_FLD(value_opnd) = CN_Tbl_Idx;
01500 OPND_IDX(value_opnd) = ATD_TMP_IDX(OPND_IDX(value_opnd));
01501
01502 if (rep_count_ir_idx == NULL_IDX) {
01503 COPY_OPND(IL_OPND(value_il_idx), value_opnd);
01504 }
01505 else {
01506 COPY_OPND(IR_OPND_R(rep_count_ir_idx), value_opnd);
01507 }
01508 }
01509 else if (OPND_FLD(value_opnd) == IR_Tbl_Idx &&
01510 IR_OPR(OPND_IDX(value_opnd)) == Null_Intrinsic_Opr) {
01511 value_desc.type_idx = ATD_TYPE_IDX(target_attr_idx);
01512 value_desc.type = TYP_TYPE(ATD_TYPE_IDX(target_attr_idx));
01513 value_desc.linear_type = TYP_LINEAR(ATD_TYPE_IDX(target_attr_idx));
01514 }
01515
01516 # ifdef _DEBUG
01517
01518 else {
01519 PRINTMSG(IR_LINE_NUM(rep_count_ir_idx), 626, Internal,
01520 IR_COL_NUM(rep_count_ir_idx),
01521 "CN_Tbl_Idx or AT_Tbl_Idx", "set_global_value_variables");
01522 }
01523
01524 # endif
01525
01526
01527 EXIT:
01528
01529 TRACE (Func_Exit, "set_global_value_variables", NULL);
01530
01531 return;
01532
01533 }
01534
01535
01536
01537
01538
01539
01540
01541
01542
01543
01544
01545
01546
01547
01548
01549
01550
01551
01552
01553
01554
01555
01556
01557 static void section_semantics(int section_sub_ir_idx,
01558 opnd_type *stride_opnd,
01559 int *first_triplet_idx)
01560
01561 {
01562 long64 actual_stride;
01563 int attr_idx;
01564 int bd_idx;
01565 long64 dcl_lb;
01566 long64 dcl_ub;
01567 int end_il_idx;
01568 boolean error_found;
01569 expr_arg_type expr_desc;
01570 opnd_type expr_opnd;
01571 int i;
01572 int ignore_this_arg;
01573 int ignore_this_arg_too;
01574 int il_idx;
01575 int last_triplet_idx = NULL_IDX;
01576 long64 num_iterations;
01577 int start_il_idx;
01578 int stride_il_idx;
01579
01580
01581 TRACE(Func_Entry, "section_semantics", NULL);
01582
01583 obj_count = 1;
01584 *first_triplet_idx = NULL_IDX;
01585
01586
01587
01588 expr_desc = init_exp_desc;
01589 expr_desc.type = Integer;
01590 expr_desc.type_idx = INTEGER_DEFAULT_TYPE;
01591 expr_desc.linear_type = INTEGER_DEFAULT_TYPE;
01592
01593 il_idx = IR_IDX_R(section_sub_ir_idx);
01594
01595 for (lt_idx = 1; lt_idx <= IR_LIST_CNT_R(section_sub_ir_idx); ++lt_idx) {
01596 loop_tbl[lt_idx].sibling_idx = NULL_IDX;
01597
01598 if (IL_FLD(il_idx) == CN_Tbl_Idx) {
01599 loop_tbl[lt_idx].curr_value = CN_INT_TO_C(IL_IDX(il_idx));
01600 }
01601 else if (IL_FLD(il_idx) == IR_Tbl_Idx) {
01602
01603
01604
01605 if (IR_OPR(IL_IDX(il_idx)) != Triplet_Opr) {
01606 PRINTMSG(IL_LINE_NUM(il_idx), 704, Internal, IL_COL_NUM(il_idx));
01607 }
01608
01609 error_found = FALSE;
01610
01611
01612
01613
01614
01615
01616 attr_idx = find_base_attr(&IR_OPND_L(section_sub_ir_idx),
01617 &ignore_this_arg,
01618 &ignore_this_arg_too);
01619
01620 dcl_lb = CN_INT_TO_C(BD_LB_IDX(ATD_ARRAY_IDX(attr_idx), lt_idx));
01621 dcl_ub = CN_INT_TO_C(BD_UB_IDX(ATD_ARRAY_IDX(attr_idx), lt_idx));
01622
01623
01624
01625
01626 start_il_idx = IR_IDX_L(IL_IDX(il_idx));
01627
01628 if (IL_FLD(start_il_idx) == CN_Tbl_Idx) {
01629
01630 }
01631 else if (IL_FLD(start_il_idx) == IR_Tbl_Idx) {
01632 COPY_OPND(expr_opnd, IL_OPND(start_il_idx));
01633
01634 if (fold_aggragate_expression(&expr_opnd, &expr_desc, TRUE)) {
01635 COPY_OPND(IL_OPND(start_il_idx), expr_opnd);
01636 }
01637 else {
01638 PRINTMSG(IR_LINE_NUM(IL_IDX(start_il_idx)),
01639 861,
01640 Internal,
01641 IR_COL_NUM(IL_IDX(start_il_idx)),
01642 "section_semantics");
01643 }
01644 }
01645 else {
01646 PRINTMSG(IR_LINE_NUM(IL_IDX(start_il_idx)),
01647 704,
01648 Internal,
01649 IR_COL_NUM(IL_IDX(start_il_idx)));
01650 }
01651
01652 loop_tbl[lt_idx].start_value = CN_INT_TO_C(IL_IDX(start_il_idx));
01653 loop_tbl[lt_idx].curr_value = loop_tbl[lt_idx].start_value;
01654
01655
01656
01657
01658 end_il_idx = IL_NEXT_LIST_IDX(start_il_idx);
01659
01660 if (IL_FLD(end_il_idx) == CN_Tbl_Idx) {
01661
01662 }
01663 else if (IL_FLD(end_il_idx) == IR_Tbl_Idx) {
01664 COPY_OPND(expr_opnd, IL_OPND(end_il_idx));
01665
01666 if (fold_aggragate_expression(&expr_opnd, &expr_desc, TRUE)) {
01667 COPY_OPND(IL_OPND(end_il_idx), expr_opnd);
01668 }
01669 else {
01670 PRINTMSG(IR_LINE_NUM(IL_IDX(end_il_idx)),
01671 861,
01672 Internal,
01673 IR_COL_NUM(IL_IDX(end_il_idx)),
01674 "section_semantics");
01675 }
01676 }
01677 else {
01678 PRINTMSG(IR_LINE_NUM(IL_IDX(end_il_idx)),
01679 704,
01680 Internal,
01681 IR_COL_NUM(IL_IDX(end_il_idx)));
01682 }
01683
01684 loop_tbl[lt_idx].end_value = CN_INT_TO_C(IL_IDX(end_il_idx));
01685
01686
01687
01688
01689 stride_il_idx = IL_NEXT_LIST_IDX(end_il_idx);
01690
01691 if (IL_FLD(stride_il_idx) == CN_Tbl_Idx) {
01692
01693 }
01694 else if (IL_FLD(stride_il_idx) == IR_Tbl_Idx) {
01695 COPY_OPND(expr_opnd, IL_OPND(stride_il_idx));
01696
01697 if (fold_aggragate_expression(&expr_opnd, &expr_desc, TRUE)) {
01698 COPY_OPND(IL_OPND(stride_il_idx), expr_opnd);
01699 }
01700 else {
01701 PRINTMSG(IR_LINE_NUM(IL_IDX(stride_il_idx)),
01702 861,
01703 Internal,
01704 IR_COL_NUM(IL_IDX(stride_il_idx)),
01705 "section_semantics");
01706 }
01707 }
01708 else {
01709 PRINTMSG(IR_LINE_NUM(IL_IDX(stride_il_idx)),
01710 704,
01711 Internal,
01712 IR_COL_NUM(IL_IDX(stride_il_idx)));
01713 }
01714
01715 loop_tbl[lt_idx].inc_value = CN_INT_TO_C(IL_IDX(stride_il_idx));
01716
01717
01718
01719
01720 if (loop_tbl[lt_idx].inc_value > 0) {
01721
01722 if (loop_tbl[lt_idx].start_value < dcl_lb) {
01723
01724
01725
01726
01727 PRINTMSG(IL_LINE_NUM(start_il_idx),
01728 841,
01729 Error,
01730 IL_COL_NUM(start_il_idx));
01731 error_found = TRUE;
01732 }
01733
01734 if (loop_tbl[lt_idx].start_value > dcl_ub) {
01735
01736
01737
01738
01739 PRINTMSG(IL_LINE_NUM(start_il_idx),
01740 849,
01741 Error,
01742 IL_COL_NUM(start_il_idx));
01743 error_found = TRUE;
01744 }
01745
01746 num_iterations =
01747 (loop_tbl[lt_idx].end_value - loop_tbl[lt_idx].start_value +
01748 loop_tbl[lt_idx].inc_value) /
01749 loop_tbl[lt_idx].inc_value;
01750
01751 if (num_iterations > 0) {
01752 obj_count *= num_iterations;
01753
01754 if ((loop_tbl[lt_idx].start_value +
01755 (num_iterations - 1)*loop_tbl[lt_idx].inc_value) > dcl_ub) {
01756
01757
01758
01759
01760 PRINTMSG(IL_LINE_NUM(start_il_idx),
01761 905,
01762 Error,
01763 IL_COL_NUM(start_il_idx));
01764 error_found = TRUE;
01765 }
01766 }
01767 else {
01768 obj_count = 0;
01769 }
01770 }
01771 else if (loop_tbl[lt_idx].inc_value < 0) {
01772
01773 if (loop_tbl[lt_idx].start_value > dcl_ub) {
01774
01775
01776
01777
01778 PRINTMSG(IL_LINE_NUM(start_il_idx),
01779 849,
01780 Error,
01781 IL_COL_NUM(start_il_idx));
01782 error_found = TRUE;
01783 }
01784
01785 if (loop_tbl[lt_idx].start_value < dcl_lb) {
01786
01787
01788
01789
01790 PRINTMSG(IL_LINE_NUM(start_il_idx),
01791 841,
01792 Error,
01793 IL_COL_NUM(start_il_idx));
01794 error_found = TRUE;
01795 }
01796
01797 num_iterations =
01798 (loop_tbl[lt_idx].end_value - loop_tbl[lt_idx].start_value +
01799 loop_tbl[lt_idx].inc_value) /
01800 loop_tbl[lt_idx].inc_value;
01801
01802 if (num_iterations > 0) {
01803 obj_count *= num_iterations;
01804
01805 if ((loop_tbl[lt_idx].start_value +
01806 (num_iterations - 1)*loop_tbl[lt_idx].inc_value) < dcl_lb) {
01807
01808
01809
01810
01811 PRINTMSG(IL_LINE_NUM(start_il_idx),
01812 997,
01813 Error,
01814 IL_COL_NUM(start_il_idx));
01815 error_found = TRUE;
01816 }
01817 }
01818 else {
01819 obj_count = 0;
01820 }
01821 }
01822 else {
01823
01824
01825
01826 PRINTMSG(IL_LINE_NUM(stride_il_idx),
01827 998,
01828 Error,
01829 IL_COL_NUM(stride_il_idx));
01830 error_found = TRUE;
01831 }
01832
01833 if (! error_found) {
01834
01835
01836
01837
01838
01839
01840
01841
01842 if (*first_triplet_idx == NULL_IDX) {
01843 *first_triplet_idx = lt_idx;
01844 COPY_OPND(*stride_opnd, IL_OPND(stride_il_idx));
01845 OPND_FLD((*stride_opnd)) = NO_Tbl_Idx;
01846
01847 if (lt_idx != 1) {
01848 actual_stride = CN_INT_TO_C(IL_IDX(stride_il_idx));
01849 bd_idx = ATD_ARRAY_IDX(IR_IDX_L(section_sub_ir_idx));
01850
01851 for (i = 1; i < lt_idx; ++i) {
01852 actual_stride *= CN_INT_TO_C(BD_XT_IDX(bd_idx, i));
01853 }
01854
01855 OPND_IDX((*stride_opnd)) =C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01856 actual_stride);
01857 }
01858 }
01859 else {
01860 loop_tbl[last_triplet_idx].sibling_idx = lt_idx;
01861 }
01862
01863 last_triplet_idx = lt_idx;
01864 }
01865 }
01866
01867 il_idx = IL_NEXT_LIST_IDX(il_idx);
01868
01869 }
01870
01871 TRACE(Func_Exit, "section_semantics", NULL);
01872
01873 return;
01874
01875 }
01876
01877
01878
01879
01880
01881
01882
01883
01884
01885
01886
01887
01888
01889
01890
01891
01892
01893
01894
01895
01896
01897
01898
01899
01900
01901
01902
01903
01904
01905
01906
01907
01908
01909
01910
01911
01912
01913 static void gen_section_ref(int section_sub_ir_idx,
01914 long64 value_count,
01915 int first_triplet_idx,
01916 int root_ir_idx,
01917 int init_ir_idx,
01918 long64 *dup_count,
01919 long64 *section_start_value,
01920 long64 *section_inc_value)
01921
01922 {
01923 int i;
01924 int il_idx;
01925 int last_il_idx;
01926 long64 local_obj_count;
01927 int ir_idx;
01928 opnd_type opnd;
01929
01930
01931 TRACE(Func_Entry, "gen_section_ref", NULL);
01932
01933
01934
01935
01936
01937
01938 gen_opnd(&opnd, root_ir_idx, IR_Tbl_Idx, stmt_start_line, stmt_start_col);
01939 copy_subtree(&opnd, &opnd);
01940 ir_idx = OPND_IDX(opnd);
01941 IR_FLD_L(init_ir_idx) = IR_Tbl_Idx;
01942 IR_IDX_L(init_ir_idx) = ir_idx;
01943
01944 while (IR_OPR(ir_idx) != Section_Subscript_Opr) {
01945 ir_idx = IR_IDX_L(ir_idx);
01946 }
01947
01948 IR_OPR(ir_idx) = Subscript_Opr;
01949 IR_RANK(ir_idx) = 1;
01950
01951 NTR_IR_LIST_TBL(il_idx);
01952 IR_FLD_R(ir_idx) = IL_Tbl_Idx;
01953 IR_IDX_R(ir_idx) = il_idx;
01954 IL_FLD(il_idx) = CN_Tbl_Idx;
01955 IL_IDX(il_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01956 loop_tbl[1].curr_value);
01957 IL_LINE_NUM(il_idx) = stmt_start_line;
01958 IL_COL_NUM(il_idx) = stmt_start_col;
01959
01960 last_il_idx = il_idx;
01961
01962 for (i = 2; i <= IR_LIST_CNT_R(section_sub_ir_idx); ++i) {
01963 NTR_IR_LIST_TBL(il_idx);
01964 IL_NEXT_LIST_IDX(last_il_idx) = il_idx;
01965 IL_PREV_LIST_IDX(il_idx) = last_il_idx;
01966 last_il_idx = il_idx;
01967 IL_FLD(il_idx) = CN_Tbl_Idx;
01968 IL_IDX(il_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01969 loop_tbl[i].curr_value);
01970 IL_LINE_NUM(il_idx) = stmt_start_line;
01971 IL_COL_NUM(il_idx) = stmt_start_col;
01972 }
01973
01974
01975
01976
01977
01978 *section_start_value = loop_tbl[first_triplet_idx].curr_value;
01979 *section_inc_value = loop_tbl[first_triplet_idx].inc_value;
01980
01981
01982
01983
01984
01985 local_obj_count = (loop_tbl[first_triplet_idx].end_value -
01986 loop_tbl[first_triplet_idx].curr_value +
01987 loop_tbl[first_triplet_idx].inc_value) /
01988 loop_tbl[first_triplet_idx].inc_value;
01989
01990
01991
01992
01993
01994
01995
01996
01997
01998 if (local_obj_count <= value_count) {
01999 *dup_count = local_obj_count;
02000
02001 if (obj_count != local_obj_count) {
02002 loop_tbl[first_triplet_idx].curr_value =
02003 loop_tbl[first_triplet_idx].start_value;
02004 lt_idx = loop_tbl[first_triplet_idx].sibling_idx;
02005
02006 while (lt_idx != NULL_IDX) {
02007 loop_tbl[lt_idx].curr_value += loop_tbl[lt_idx].inc_value;
02008
02009 if ((loop_tbl[lt_idx].inc_value > 0 &&
02010 loop_tbl[lt_idx].curr_value <= loop_tbl[lt_idx].end_value) ||
02011 (loop_tbl[lt_idx].inc_value < 0 &&
02012 loop_tbl[lt_idx].curr_value >= loop_tbl[lt_idx].end_value)) {
02013 break;
02014 }
02015
02016 loop_tbl[lt_idx].curr_value = loop_tbl[lt_idx].start_value;
02017 lt_idx = loop_tbl[lt_idx].sibling_idx;
02018 }
02019
02020 }
02021 }
02022 else {
02023 *dup_count = value_count;
02024 loop_tbl[first_triplet_idx].curr_value +=
02025 value_count * loop_tbl[first_triplet_idx].inc_value;
02026 }
02027
02028 TRACE(Func_Exit, "gen_section_ref", NULL);
02029
02030 return;
02031
02032 }
02033
02034
02035
02036
02037
02038
02039
02040
02041
02042
02043
02044
02045
02046
02047
02048
02049
02050
02051
02052
02053
02054
02055 static void vv_subscript_semantics(int init_ir_idx,
02056 int array_ir_idx,
02057 expr_arg_type *obj_desc)
02058 {
02059 int do_var_il_idx;
02060 int end_il_idx;
02061 int i;
02062 int il_idx;
02063 int imp_do_ir_idx;
02064 int inc_il_idx;
02065 expr_arg_type shape_desc;
02066 int shape_idx;
02067 opnd_type shape_opnd;
02068 int start_il_idx;
02069 int subscript_il_idx;
02070 int tmp_idx;
02071 int triplet_ir_idx;
02072
02073
02074 TRACE (Func_Entry, "vv_subscript_semantics", NULL);
02075
02076
02077
02078
02079
02080 shape_idx = -1;
02081 subscript_il_idx = IR_IDX_R(array_ir_idx);
02082
02083 for (i = 1; i <= IR_LIST_CNT_R(array_ir_idx); ++i) {
02084
02085 switch (IL_FLD(subscript_il_idx)) {
02086
02087 case CN_Tbl_Idx:
02088 break;
02089
02090 case IR_Tbl_Idx:
02091
02092
02093
02094
02095
02096
02097
02098
02099
02100
02101
02102
02103 ++shape_idx;
02104
02105 NTR_IR_TBL(imp_do_ir_idx);
02106 IR_OPR(imp_do_ir_idx) = Implied_Do_Opr;
02107 IR_TYPE_IDX(imp_do_ir_idx) = TYPELESS_DEFAULT_TYPE;
02108 IR_LINE_NUM(imp_do_ir_idx) = IR_LINE_NUM(init_ir_idx);
02109 IR_COL_NUM(imp_do_ir_idx) = IR_COL_NUM(init_ir_idx);
02110
02111 NTR_IR_LIST_TBL(il_idx);
02112 IR_LIST_CNT_L(imp_do_ir_idx) = 1;
02113 IR_FLD_L(imp_do_ir_idx) = IL_Tbl_Idx;
02114 IR_IDX_L(imp_do_ir_idx) = il_idx;
02115
02116 COPY_OPND(IL_OPND(il_idx), IR_OPND_L(init_ir_idx));
02117
02118 IR_IDX_L(init_ir_idx) = imp_do_ir_idx;
02119
02120
02121
02122
02123 if (IR_OPR(IL_IDX(subscript_il_idx)) == Triplet_Opr) {
02124 triplet_ir_idx = IL_IDX(subscript_il_idx);
02125 }
02126
02127
02128
02129
02130
02131
02132
02133
02134
02135
02136
02137 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(imp_do_ir_idx),
02138 IR_COL_NUM(imp_do_ir_idx),
02139 Priv, TRUE);
02140 AT_SEMANTICS_DONE(tmp_idx) = TRUE;
02141 ATD_TYPE_IDX(tmp_idx) = INTEGER_DEFAULT_TYPE;
02142 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
02143 ATD_LCV_IS_CONST(tmp_idx) = TRUE;
02144
02145
02146
02147
02148 AT_REFERENCED(tmp_idx) = Not_Referenced;
02149
02150 NTR_IR_LIST_TBL(do_var_il_idx);
02151 IL_LINE_NUM(do_var_il_idx) = IR_LINE_NUM(imp_do_ir_idx);
02152 IL_COL_NUM(do_var_il_idx) = IR_COL_NUM(imp_do_ir_idx);
02153 IL_FLD(do_var_il_idx) = AT_Tbl_Idx;
02154 IL_IDX(do_var_il_idx) = tmp_idx;
02155
02156 if (IL_VECTOR_SUBSCRIPT(subscript_il_idx)) {
02157 NTR_IR_LIST_TBL(start_il_idx);
02158 IL_NEXT_LIST_IDX(do_var_il_idx) = start_il_idx;
02159 IL_PREV_LIST_IDX(start_il_idx) = do_var_il_idx;
02160 IL_LINE_NUM(start_il_idx) = IR_LINE_NUM(init_ir_idx);
02161 IL_COL_NUM(start_il_idx) = IR_COL_NUM(init_ir_idx);
02162 IL_FLD(start_il_idx) = CN_Tbl_Idx;
02163 IL_IDX(start_il_idx) = CN_INTEGER_ONE_IDX;
02164
02165 NTR_IR_LIST_TBL(end_il_idx);
02166 IL_NEXT_LIST_IDX(start_il_idx) = end_il_idx;
02167 IL_PREV_LIST_IDX(end_il_idx) = start_il_idx;
02168
02169 if (obj_desc->shape[shape_idx].fld != CN_Tbl_Idx) {
02170 COPY_OPND(shape_opnd, obj_desc->shape[shape_idx]);
02171
02172 shape_desc = init_exp_desc;
02173 shape_desc.type = Integer;
02174 shape_desc.type_idx = INTEGER_DEFAULT_TYPE;
02175 shape_desc.linear_type = INTEGER_DEFAULT_TYPE;
02176
02177 if (fold_aggragate_expression(&shape_opnd,
02178 &shape_desc,
02179 TRUE)) {
02180 COPY_OPND(IL_OPND(end_il_idx), shape_opnd);
02181 }
02182 else {
02183 PRINTMSG(obj_desc->shape[shape_idx].line_num,
02184 861,
02185 Internal,
02186 obj_desc->shape[shape_idx].col_num,
02187 "vv_subscript_semantics");
02188 }
02189 }
02190 else {
02191 IL_LINE_NUM(end_il_idx) = IR_LINE_NUM(init_ir_idx);
02192 IL_COL_NUM(end_il_idx) = IR_COL_NUM(init_ir_idx);
02193 IL_FLD(end_il_idx) = CN_Tbl_Idx;
02194 IL_IDX(end_il_idx) = obj_desc->shape[shape_idx].idx;
02195 }
02196
02197 NTR_IR_LIST_TBL(inc_il_idx);
02198 IL_NEXT_LIST_IDX(end_il_idx) = inc_il_idx;
02199 IL_PREV_LIST_IDX(inc_il_idx) = end_il_idx;
02200 IL_LINE_NUM(inc_il_idx) = IR_LINE_NUM(init_ir_idx);
02201 IL_COL_NUM(inc_il_idx) = IR_COL_NUM(init_ir_idx);
02202 IL_FLD(inc_il_idx) = CN_Tbl_Idx;
02203 IL_IDX(inc_il_idx) = CN_INTEGER_ONE_IDX;
02204
02205
02206
02207
02208
02209 NTR_IR_LIST_TBL(il_idx);
02210 IL_NEXT_LIST_IDX(inc_il_idx) = il_idx;
02211 IL_PREV_LIST_IDX(il_idx) = inc_il_idx;
02212 COPY_OPND(IL_OPND(il_idx), IL_OPND(subscript_il_idx));
02213
02214 IR_LIST_CNT_R(imp_do_ir_idx) = 5;
02215 }
02216 else {
02217 IL_NEXT_LIST_IDX(do_var_il_idx) = IR_IDX_L(triplet_ir_idx);
02218 IR_LIST_CNT_R(imp_do_ir_idx) = 4;
02219 }
02220
02221 IR_FLD_R(imp_do_ir_idx) = IL_Tbl_Idx;
02222 IR_IDX_R(imp_do_ir_idx) = do_var_il_idx;
02223
02224 IL_FLD(subscript_il_idx) = AT_Tbl_Idx;
02225 IL_IDX(subscript_il_idx) = tmp_idx;
02226 IL_LINE_NUM(subscript_il_idx) = IR_LINE_NUM(init_ir_idx);
02227 IL_COL_NUM(subscript_il_idx) = IR_COL_NUM(init_ir_idx);
02228
02229 break;
02230
02231 default:
02232 PRINTMSG(IR_LINE_NUM(init_ir_idx), 179, Internal,
02233 IR_COL_NUM(init_ir_idx), "vv_section_semantics");
02234 }
02235
02236 subscript_il_idx = IL_NEXT_LIST_IDX(subscript_il_idx);
02237 }
02238
02239 TRACE (Func_Exit, "vv_subscript_semantics", NULL);
02240
02241 return;
02242
02243 }
02244
02245
02246
02247
02248
02249
02250
02251
02252
02253
02254
02255
02256
02257
02258
02259
02260
02261
02262
02263
02264
02265
02266
02267
02268
02269
02270
02271 static boolean optimize_whole_array_init(int init_ir_idx)
02272 {
02273 int attr_idx;
02274 int i;
02275 opnd_type ignore_this_opnd;
02276 int ir_idx;
02277 expr_arg_type loc_exp_desc;
02278 opnd_type opnd;
02279 boolean optimized = TRUE;
02280 opnd_type rep_factor_opnd;
02281 boolean save_insert_subs_ok;
02282 opnd_type save_left_opnd;
02283 long64 save_rep_factor;
02284 opnd_type save_right_opnd;
02285 expr_arg_type save_value_desc;
02286 int save_value_il_idx;
02287 opnd_type save_value_opnd;
02288
02289
02290 TRACE(Func_Entry, "optimize_whole_array_init", NULL);
02291
02292 if (value_il_idx == NULL_IDX) {
02293 optimized = FALSE;
02294 goto EXIT;
02295 }
02296
02297 COPY_OPND(save_left_opnd, IR_OPND_L(init_ir_idx));
02298 COPY_OPND(save_right_opnd, IR_OPND_R(init_ir_idx));
02299 COPY_OPND(save_value_opnd, value_opnd);
02300 save_value_il_idx = value_il_idx;
02301 save_value_desc = value_desc;
02302 save_rep_factor = rep_factor;
02303
02304 IR_LIST_CNT_R(init_ir_idx) = 0;
02305
02306 if (IR_FLD_R(init_ir_idx) == NO_Tbl_Idx) {
02307 IR_FLD_R(init_ir_idx) = IL_Tbl_Idx;
02308 IR_IDX_R(init_ir_idx) = value_il_idx;
02309 }
02310
02311 COPY_OPND(opnd, IR_OPND_L(init_ir_idx));
02312
02313 while (OPND_FLD(opnd) == IR_Tbl_Idx) {
02314
02315 if (IR_OPR(OPND_IDX(opnd)) == Substring_Opr ||
02316 IR_OPR(OPND_IDX(opnd)) == Whole_Substring_Opr) {
02317 break;
02318 }
02319
02320 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
02321 }
02322
02323 attr_idx = IR_IDX_L(IR_IDX_L(init_ir_idx));
02324
02325 for (i = 1; i <= obj_count; ++i) {
02326
02327
02328
02329
02330
02331
02332 if (IL_FLD(value_il_idx) == IR_Tbl_Idx) {
02333 optimized = FALSE;
02334 COPY_OPND(IR_OPND_L(init_ir_idx), save_left_opnd);
02335 COPY_OPND(IR_OPND_R(init_ir_idx), save_right_opnd);
02336 COPY_OPND(value_opnd, save_value_opnd);
02337 value_il_idx = save_value_il_idx;
02338 value_desc = save_value_desc;
02339 rep_factor = save_rep_factor;
02340 goto EXIT;
02341 }
02342
02343 if (check_target_and_value(attr_idx, init_ir_idx)) {
02344 --rep_factor;
02345
02346 if (rep_factor == 0) {
02347 ++IR_LIST_CNT_R(init_ir_idx);
02348 value_il_idx = IL_NEXT_LIST_IDX(value_il_idx);
02349
02350 if (value_il_idx == NULL_IDX) {
02351 break;
02352 }
02353 else {
02354 set_global_value_variables(&rep_factor_opnd,
02355 &ignore_this_opnd,
02356 attr_idx);
02357
02358 if (SH_ERR_FLG(curr_stmt_sh_idx)) {
02359 goto EXIT;
02360 }
02361 }
02362 }
02363 }
02364 else {
02365 goto EXIT;
02366 }
02367 }
02368
02369 if (value_il_idx != NULL_IDX) {
02370 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(value_il_idx)) = NULL_IDX;
02371 IL_PREV_LIST_IDX(value_il_idx) = NULL_IDX;
02372 }
02373
02374
02375
02376
02377
02378
02379
02380 if (IR_LIST_CNT_R(init_ir_idx) < obj_count) {
02381
02382 if (IL_NEXT_LIST_IDX(obj_il_idx) == NULL_IDX) {
02383 PRINTMSG(IR_LINE_NUM_L(init_ir_idx), 698, Ansi,
02384 IR_COL_NUM_L(init_ir_idx));
02385 }
02386 else {
02387 PRINTMSG(IR_LINE_NUM_L(init_ir_idx), 667, Error,
02388 IR_COL_NUM_L(init_ir_idx));
02389 optimized = FALSE;
02390 obj_il_idx = NULL_IDX;
02391 goto EXIT;
02392 }
02393 }
02394
02395
02396
02397
02398
02399
02400 OPND_FLD(init_target_opnd) = AT_Tbl_Idx;
02401 OPND_IDX(init_target_opnd) = attr_idx;
02402 OPND_LINE_NUM(init_target_opnd) = stmt_start_line;
02403 OPND_COL_NUM(init_target_opnd) = stmt_start_col;
02404
02405 target_array_idx = ATD_ARRAY_IDX(attr_idx);
02406 target_type_idx = ATD_TYPE_IDX(attr_idx);
02407 check_type_conversion = TRUE;
02408 save_insert_subs_ok = insert_subs_ok;
02409 insert_subs_ok = FALSE;
02410
02411 NTR_IR_TBL(ir_idx);
02412 IR_OPR(ir_idx) = Constant_Array_Construct_Opr;
02413 IR_LINE_NUM(ir_idx) = stmt_start_line;
02414 IR_COL_NUM(ir_idx) = stmt_start_col;
02415 IR_TYPE_IDX(ir_idx) = target_type_idx;
02416
02417 COPY_OPND(IR_OPND_R(ir_idx), IR_OPND_R(init_ir_idx));
02418
02419 OPND_IDX(opnd) = ir_idx;
02420 OPND_FLD(opnd) = IR_Tbl_Idx;
02421
02422 loc_exp_desc = init_exp_desc;
02423 loc_exp_desc.type_idx = target_type_idx;
02424 loc_exp_desc.type = TYP_TYPE(target_type_idx);
02425 loc_exp_desc.linear_type = TYP_LINEAR(target_type_idx);
02426 loc_exp_desc.rank = 1;
02427
02428 if (IR_LIST_CNT_R(init_ir_idx) == obj_count) {
02429 loc_exp_desc.shape[0].fld = BD_XT_FLD(target_array_idx, 1);
02430 loc_exp_desc.shape[0].idx = BD_XT_IDX(target_array_idx, 1);
02431 }
02432 else {
02433 loc_exp_desc.shape[0].fld = CN_Tbl_Idx;
02434 loc_exp_desc.shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02435 IR_LIST_CNT_R(init_ir_idx));
02436 }
02437
02438 loc_exp_desc.constructor_size_level = Simple_Expr_Size;
02439
02440 create_constructor_constant(&opnd, &loc_exp_desc);
02441
02442 init_target_opnd = null_opnd;
02443 target_array_idx = NULL_IDX;
02444 insert_subs_ok = save_insert_subs_ok;
02445
02446 remove_sh(curr_stmt_sh_idx);
02447 curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
02448
02449 obj_count = 0;
02450
02451 EXIT:
02452
02453 TRACE(Func_Exit, "optimize_whole_array_init", NULL);
02454
02455 return(optimized);
02456
02457 }
02458
02459
02460
02461
02462
02463
02464
02465
02466
02467
02468
02469
02470
02471
02472
02473
02474
02475
02476
02477
02478
02479
02480 static void data_imp_do_semantics(int init_ir_idx,
02481 int imp_do_idx,
02482 boolean compiler_gen_imp_do,
02483 boolean *metamorphed)
02484
02485 {
02486 int il_idx;
02487 int local_rep_count_ir_idx;
02488 long64 local_rep_factor;
02489 int local_value_il_idx;
02490 int rep_count_ir_idx;
02491 boolean save_runtime_bounds;
02492
02493
02494 TRACE (Func_Entry, "data_imp_do_semantics", NULL);
02495 save_runtime_bounds = cdir_switches.bounds;
02496 cdir_switches.bounds = TRUE;
02497
02498 *metamorphed = FALSE;
02499
02500
02501
02502
02503
02504
02505
02506
02507 arg_info_list_base = arg_info_list_top;
02508
02509
02510
02511
02512 last_lt_idx = NULL_IDX;
02513 curr_parent_idx = NULL_IDX;
02514
02515 build_loop_tbl(imp_do_idx, compiler_gen_imp_do);
02516
02517 if (SH_ERR_FLG(curr_stmt_sh_idx)) {
02518 goto EXIT;
02519 }
02520
02521
02522
02523
02524
02525
02526
02527 if (IL_NEXT_LIST_IDX(obj_il_idx) == NULL_IDX) {
02528
02529 if (imp_do_metamorphed(init_ir_idx)) {
02530 *metamorphed = TRUE;
02531 goto EXIT;
02532 }
02533 }
02534
02535
02536
02537
02538
02539
02540
02541 if (IL_FLD(value_il_idx) == IR_Tbl_Idx &&
02542 rep_factor != CN_INT_TO_C(IR_IDX_L(IL_IDX(value_il_idx)))) {
02543
02544 IR_IDX_L(IL_IDX(value_il_idx)) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02545 rep_factor);
02546 }
02547
02548
02549
02550
02551
02552
02553
02554 IR_LIST_CNT_R(init_ir_idx) = 1;
02555 IR_FLD_R(init_ir_idx) = IL_Tbl_Idx;
02556 IR_IDX_R(init_ir_idx) = value_il_idx;
02557
02558 lt_idx = 1;
02559
02560 interpret_data_imp_do(init_ir_idx);
02561
02562 if (SH_ERR_FLG(curr_stmt_sh_idx)) {
02563 goto EXIT;
02564 }
02565
02566 if (rep_factor == 0) {
02567
02568
02569
02570 if (value_il_idx != NULL_IDX) {
02571 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(value_il_idx)) = NULL_IDX;
02572 }
02573 }
02574 else if (IL_FLD(value_il_idx) == IR_Tbl_Idx) {
02575
02576
02577
02578
02579
02580
02581
02582
02583
02584
02585 rep_count_ir_idx = IL_IDX(value_il_idx);
02586
02587 local_rep_factor = CN_INT_TO_C(IR_IDX_L(rep_count_ir_idx)) - rep_factor;
02588
02589 local_value_il_idx = IL_PREV_LIST_IDX(value_il_idx);
02590
02591 NTR_IR_LIST_TBL(il_idx);
02592
02593 if (IR_LIST_CNT_R(init_ir_idx) == 1) {
02594 IR_IDX_R(init_ir_idx) = il_idx;
02595 }
02596 else {
02597 IL_NEXT_LIST_IDX(local_value_il_idx) = il_idx;
02598 IL_PREV_LIST_IDX(il_idx) = local_value_il_idx;
02599 }
02600
02601 local_value_il_idx = il_idx;
02602
02603 if (local_rep_factor > 1) {
02604 NTR_IR_TBL(local_rep_count_ir_idx);
02605 IR_TYPE_IDX(local_rep_count_ir_idx) = TYPELESS_DEFAULT_TYPE;
02606 IL_FLD(local_value_il_idx) = IR_Tbl_Idx;
02607 IL_IDX(local_value_il_idx) = local_rep_count_ir_idx;
02608 COPY_TBL_NTRY(ir_tbl, local_rep_count_ir_idx, rep_count_ir_idx);
02609
02610 IR_IDX_L(local_rep_count_ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02611 local_rep_factor);
02612 COPY_OPND(IR_OPND_R(local_rep_count_ir_idx), value_opnd);
02613 }
02614 else {
02615 COPY_OPND(IL_OPND(local_value_il_idx), value_opnd);
02616 }
02617
02618
02619
02620
02621
02622
02623 if (rep_factor == 1) {
02624 COPY_OPND(IL_OPND(value_il_idx), IR_OPND_R(rep_count_ir_idx));
02625 }
02626 else {
02627 IR_IDX_L(rep_count_ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02628 rep_factor);
02629 }
02630 }
02631
02632 EXIT:
02633
02634 cdir_switches.bounds = save_runtime_bounds;
02635
02636 TRACE (Func_Exit, "data_imp_do_semantics", NULL);
02637
02638 return;
02639
02640 }
02641
02642
02643
02644
02645
02646
02647
02648
02649
02650
02651
02652
02653
02654
02655
02656
02657
02658
02659
02660
02661
02662
02663
02664 static void build_loop_tbl(int imp_do_idx,
02665 boolean compiler_gen_imp_do)
02666
02667 {
02668 int attr_idx;
02669 int column;
02670 int do_var_tmp_idx;
02671 expr_arg_type expr_desc;
02672 int il_idx;
02673 int lcv_col;
02674 int lcv_line;
02675 int line;
02676 opnd_type opnd;
02677 boolean save_in_implied_do;
02678 boolean save_imp_do_lcv;
02679 int search_idx;
02680 boolean semantics_ok;
02681 int target_idx;
02682 int temp_ir_idx;
02683
02684
02685 TRACE (Func_Entry, "build_loop_tbl", NULL);
02686
02687 if (++last_lt_idx > LOOP_TBL_SIZE) {
02688 PRINTMSG(IR_LINE_NUM(imp_do_idx), 237, Internal, IR_COL_NUM(imp_do_idx),
02689 "DATA implied-DO loop_tbl");
02690 }
02691
02692 lt_idx = last_lt_idx;
02693
02694
02695
02696
02697
02698
02699
02700
02701
02702
02703
02704
02705
02706
02707
02708
02709
02710
02711
02712
02713
02714
02715
02716
02717
02718
02719
02720
02721
02722
02723
02724
02725 loop_tbl[lt_idx].num_targets = 0;
02726 loop_tbl[lt_idx].sibling_idx = NULL_IDX;
02727 loop_tbl[lt_idx].offspring_idx = NULL_IDX;
02728 loop_tbl[lt_idx].target_list = NULL_IDX;
02729 loop_tbl[lt_idx].curr_value = NULL_IDX;
02730
02731 if (curr_parent_idx == NULL_IDX) {
02732 loop_tbl[lt_idx].parent_idx = NULL_IDX;
02733 }
02734 else {
02735 loop_tbl[lt_idx].parent_idx = curr_parent_idx;
02736
02737 if (loop_tbl[curr_parent_idx].offspring_idx == NULL_IDX) {
02738 loop_tbl[curr_parent_idx].offspring_idx = lt_idx;
02739 }
02740 else {
02741 loop_tbl[loop_tbl[curr_parent_idx].curr_value].sibling_idx = lt_idx;
02742 }
02743
02744 loop_tbl[curr_parent_idx].curr_value = lt_idx;
02745 }
02746
02747 attr_idx = NULL_IDX;
02748
02749
02750
02751
02752
02753
02754
02755
02756
02757
02758
02759
02760 il_idx = IL_NEXT_LIST_IDX(IR_IDX_R(imp_do_idx));
02761
02762 if (compiler_gen_imp_do) {
02763 loop_tbl[lt_idx].start_value = CN_INT_TO_C(IL_IDX(il_idx));
02764 }
02765 else {
02766 COPY_OPND(opnd, IL_OPND(il_idx));
02767 expr_mode = Restricted_Imp_Do_Expr;
02768 expr_desc.rank = 0;
02769 xref_state = CIF_Symbol_Reference;
02770
02771 if (! expr_sem(&opnd, &expr_desc)) {
02772
02773
02774
02775
02776 SH_ERR_FLG(curr_stmt_sh_idx) = TRUE;
02777 goto EXIT;
02778 }
02779
02780 if (expr_desc.linear_type == Short_Typeless_Const) {
02781 OPND_IDX(opnd) = cast_typeless_constant(OPND_IDX(opnd),
02782 INTEGER_DEFAULT_TYPE,
02783 OPND_LINE_NUM(opnd),
02784 OPND_COL_NUM(opnd));
02785 expr_desc.type_idx = INTEGER_DEFAULT_TYPE;
02786 expr_desc.type = Integer;
02787 expr_desc.linear_type = INTEGER_DEFAULT_TYPE;
02788 }
02789
02790
02791 if (expr_desc.rank == 0 &&
02792 expr_desc.type == Integer) {
02793 COPY_OPND(IL_OPND(il_idx), opnd);
02794 loop_tbl[lt_idx].start_fld = IL_FLD(il_idx);
02795 loop_tbl[lt_idx].start_idx = IL_IDX(il_idx);
02796
02797 switch (loop_tbl[lt_idx].start_fld) {
02798
02799 case CN_Tbl_Idx:
02800 loop_tbl[lt_idx].start_value = CN_INT_TO_C(IL_IDX(il_idx));
02801 break;
02802
02803 case AT_Tbl_Idx:
02804 search_idx = loop_tbl[lt_idx].parent_idx;
02805
02806 while (search_idx != NULL_IDX) {
02807
02808 if (loop_tbl[search_idx].lcv_idx == IL_IDX(il_idx)) {
02809 loop_tbl[lt_idx].start_idx = search_idx;
02810 break;
02811 }
02812 else {
02813 search_idx = loop_tbl[search_idx].parent_idx;
02814 }
02815
02816 }
02817
02818 if (search_idx == NULL_IDX) {
02819 PRINTMSG(IL_LINE_NUM(il_idx), 658, Error, IL_COL_NUM(il_idx),
02820 AT_OBJ_NAME_PTR(IL_IDX(il_idx)));
02821 goto EXIT;
02822 }
02823
02824 break;
02825
02826 case IR_Tbl_Idx:
02827 if (good_data_imp_do_expr(loop_tbl[lt_idx].start_idx)) {
02828 arg_info_list_top = arg_info_list_base + 1;
02829
02830 loop_tbl[lt_idx].start_expr_desc_idx = arg_info_list_top;
02831
02832 if (arg_info_list_top > arg_info_list_size) {
02833 enlarge_info_list_table();
02834 }
02835
02836 arg_info_list[arg_info_list_top] = init_arg_info;
02837 arg_info_list[arg_info_list_top].ed = expr_desc;
02838 }
02839
02840 break;
02841
02842 default:
02843 PRINTMSG(IR_LINE_NUM(imp_do_idx), 179, Internal,
02844 IR_COL_NUM(imp_do_idx), "build_loop_tbl");
02845 }
02846 }
02847 else {
02848 PRINTMSG(IL_LINE_NUM(il_idx), 936, Error, IL_COL_NUM(il_idx));
02849 }
02850 }
02851
02852
02853
02854
02855
02856 il_idx = IL_NEXT_LIST_IDX(il_idx);
02857
02858 if (compiler_gen_imp_do) {
02859 loop_tbl[lt_idx].end_value = CN_INT_TO_C(IL_IDX(il_idx));
02860 }
02861 else {
02862 COPY_OPND(opnd, IL_OPND(il_idx));
02863 expr_desc.rank = 0;
02864 xref_state = CIF_Symbol_Reference;
02865
02866 if (! expr_sem(&opnd, &expr_desc)) {
02867 SH_ERR_FLG(curr_stmt_sh_idx) = TRUE;
02868 goto EXIT;
02869 }
02870
02871 if (expr_desc.linear_type == Short_Typeless_Const) {
02872 OPND_IDX(opnd) = cast_typeless_constant(OPND_IDX(opnd),
02873 INTEGER_DEFAULT_TYPE,
02874 OPND_LINE_NUM(opnd),
02875 OPND_COL_NUM(opnd));
02876 expr_desc.type_idx = INTEGER_DEFAULT_TYPE;
02877 expr_desc.type = Integer;
02878 expr_desc.linear_type = INTEGER_DEFAULT_TYPE;
02879 }
02880
02881 if (expr_desc.rank == 0 &&
02882 expr_desc.type == Integer) {
02883
02884 COPY_OPND(IL_OPND(il_idx), opnd);
02885 loop_tbl[lt_idx].end_fld = IL_FLD(il_idx);
02886 loop_tbl[lt_idx].end_idx = IL_IDX(il_idx);
02887
02888 switch (loop_tbl[lt_idx].end_fld) {
02889
02890 case CN_Tbl_Idx:
02891 loop_tbl[lt_idx].end_value = CN_INT_TO_C(IL_IDX(il_idx));
02892 break;
02893
02894 case AT_Tbl_Idx:
02895 search_idx = loop_tbl[lt_idx].parent_idx;
02896
02897 while (search_idx != NULL_IDX) {
02898
02899 if (loop_tbl[search_idx].lcv_idx == IL_IDX(il_idx)) {
02900 loop_tbl[lt_idx].end_idx = search_idx;
02901 break;
02902 }
02903 else {
02904 search_idx = loop_tbl[search_idx].parent_idx;
02905 }
02906
02907 }
02908
02909 if (search_idx == NULL_IDX) {
02910 PRINTMSG(IL_LINE_NUM(il_idx), 658, Error, IL_COL_NUM(il_idx),
02911 AT_OBJ_NAME_PTR(IL_IDX(il_idx)));
02912 goto EXIT;
02913 }
02914
02915 break;
02916
02917 case IR_Tbl_Idx:
02918 if (good_data_imp_do_expr(loop_tbl[lt_idx].end_idx)) {
02919 arg_info_list_top = arg_info_list_base + 1;
02920
02921 loop_tbl[lt_idx].end_expr_desc_idx = arg_info_list_top;
02922
02923 if (arg_info_list_top > arg_info_list_size) {
02924 enlarge_info_list_table();
02925 }
02926
02927 arg_info_list[arg_info_list_top] = init_arg_info;
02928 arg_info_list[arg_info_list_top].ed = expr_desc;
02929 }
02930
02931 break;
02932
02933 default:
02934 PRINTMSG(IR_LINE_NUM(imp_do_idx), 179, Internal,
02935 IR_COL_NUM(imp_do_idx), "build_loop_tbl");
02936 }
02937 }
02938 else {
02939 PRINTMSG(IL_LINE_NUM(il_idx), 936, Error, IL_COL_NUM(il_idx));
02940 }
02941 }
02942
02943
02944
02945
02946
02947
02948 if (IL_NEXT_LIST_IDX(il_idx) == NULL_IDX) {
02949 loop_tbl[lt_idx].inc_fld = CN_Tbl_Idx;
02950 loop_tbl[lt_idx].inc_idx = CN_INTEGER_ONE_IDX;
02951 loop_tbl[lt_idx].inc_value = CN_INT_TO_C(CN_INTEGER_ONE_IDX);
02952
02953 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(il_idx));
02954 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(il_idx)) = il_idx;
02955 il_idx = IL_NEXT_LIST_IDX(il_idx);
02956 IL_LINE_NUM(il_idx) = IL_LINE_NUM(IL_PREV_LIST_IDX(il_idx));
02957 IL_COL_NUM(il_idx) = IL_COL_NUM(IL_PREV_LIST_IDX(il_idx));
02958 IL_FLD(il_idx) = CN_Tbl_Idx;
02959 IL_IDX(il_idx) = CN_INTEGER_ONE_IDX;
02960 ++IR_LIST_CNT_R(imp_do_idx);
02961 }
02962 else if (compiler_gen_imp_do) {
02963 il_idx = IL_NEXT_LIST_IDX(il_idx);
02964 loop_tbl[lt_idx].inc_value = CN_INT_TO_C(IL_IDX(il_idx));
02965 }
02966 else {
02967 il_idx = IL_NEXT_LIST_IDX(il_idx);
02968 COPY_OPND(opnd, IL_OPND(il_idx));
02969 expr_desc.rank = 0;
02970 xref_state = CIF_Symbol_Reference;
02971
02972 if (! expr_sem(&opnd, &expr_desc)) {
02973 SH_ERR_FLG(curr_stmt_sh_idx) = TRUE;
02974 goto EXIT;
02975 }
02976
02977 if (expr_desc.linear_type == Short_Typeless_Const) {
02978 OPND_IDX(opnd) = cast_typeless_constant(OPND_IDX(opnd),
02979 INTEGER_DEFAULT_TYPE,
02980 OPND_LINE_NUM(opnd),
02981 OPND_COL_NUM(opnd));
02982 expr_desc.type_idx = INTEGER_DEFAULT_TYPE;
02983 expr_desc.type = Integer;
02984 expr_desc.linear_type = INTEGER_DEFAULT_TYPE;
02985 }
02986
02987 if (expr_desc.rank == 0 &&
02988 expr_desc.type == Integer) {
02989
02990 COPY_OPND(IL_OPND(il_idx), opnd);
02991 loop_tbl[lt_idx].inc_fld = IL_FLD(il_idx);
02992 loop_tbl[lt_idx].inc_idx = IL_IDX(il_idx);
02993
02994 switch (loop_tbl[lt_idx].inc_fld) {
02995
02996 case CN_Tbl_Idx:
02997 if (fold_relationals(IL_IDX(il_idx),
02998 CN_INTEGER_ZERO_IDX,
02999 Eq_Opr)) {
03000 PRINTMSG(IL_LINE_NUM(il_idx), 1084, Error,
03001 IL_COL_NUM(il_idx));
03002 }
03003 else {
03004 loop_tbl[lt_idx].inc_value = CN_INT_TO_C(IL_IDX(il_idx));
03005 }
03006
03007 break;
03008
03009 case AT_Tbl_Idx:
03010 search_idx = loop_tbl[lt_idx].parent_idx;
03011
03012 while (search_idx != NULL_IDX) {
03013
03014 if (loop_tbl[search_idx].lcv_idx == IL_IDX(il_idx)) {
03015 loop_tbl[lt_idx].inc_idx = search_idx;
03016 break;
03017 }
03018 else {
03019 search_idx = loop_tbl[search_idx].parent_idx;
03020 }
03021
03022 }
03023
03024 if (search_idx == NULL_IDX) {
03025 PRINTMSG(IL_LINE_NUM(il_idx), 658, Error, IL_COL_NUM(il_idx),
03026 AT_OBJ_NAME_PTR(IL_IDX(il_idx)));
03027 goto EXIT;
03028 }
03029
03030 break;
03031
03032 case IR_Tbl_Idx:
03033 if (good_data_imp_do_expr(loop_tbl[lt_idx].inc_idx)) {
03034 arg_info_list_top = arg_info_list_base + 1;
03035
03036 loop_tbl[lt_idx].inc_expr_desc_idx = arg_info_list_top;
03037
03038 if (arg_info_list_top > arg_info_list_size) {
03039 enlarge_info_list_table();
03040 }
03041
03042 arg_info_list[arg_info_list_top] = init_arg_info;
03043 arg_info_list[arg_info_list_top].ed = expr_desc;
03044 }
03045
03046 break;
03047
03048 default:
03049 PRINTMSG(IR_LINE_NUM(imp_do_idx), 179, Internal,
03050 IR_COL_NUM(imp_do_idx), "build_loop_tbl");
03051 }
03052 }
03053 else {
03054 PRINTMSG(IL_LINE_NUM(il_idx), 936, Error, IL_COL_NUM(il_idx));
03055 }
03056 }
03057
03058
03059
03060
03061
03062
03063
03064 il_idx = IR_IDX_R(imp_do_idx);
03065
03066 if (compiler_gen_imp_do) {
03067 loop_tbl[lt_idx].lcv_idx = IL_IDX(il_idx);
03068 }
03069 else {
03070 COPY_OPND(opnd, IL_OPND(il_idx));
03071 expr_desc.rank = 0;
03072 expr_mode = Regular_Expr;
03073 xref_state = CIF_No_Usage_Rec;
03074 save_in_implied_do = in_implied_do;
03075 in_implied_do = FALSE;
03076
03077 lcv_line = OPND_LINE_NUM(opnd);
03078 lcv_col = OPND_COL_NUM(opnd);
03079 attr_idx = find_base_attr(&opnd, &lcv_line, &lcv_col);
03080
03081 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
03082 save_imp_do_lcv = ATD_IMP_DO_LCV(attr_idx);
03083 ATD_IMP_DO_LCV(attr_idx) = TRUE;
03084 }
03085
03086 semantics_ok = expr_semantics(&opnd, &expr_desc);
03087
03088 COPY_OPND(IL_OPND(il_idx), opnd);
03089 in_implied_do = save_in_implied_do;
03090
03091 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
03092 ATD_IMP_DO_LCV(attr_idx) = save_imp_do_lcv;
03093 }
03094
03095 if (expr_desc.reference) {
03096
03097 if (expr_desc.type != Integer) {
03098 find_opnd_line_and_column(&opnd, &line, &column);
03099 PRINTMSG(line, 675, Error, column);
03100 semantics_ok = FALSE;
03101 }
03102
03103 if (OPND_FLD(opnd) == IR_Tbl_Idx &&
03104 IR_OPR(OPND_IDX(opnd)) == Whole_Subscript_Opr) {
03105 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
03106 }
03107
03108 if (OPND_FLD(opnd) == IR_Tbl_Idx &&
03109 IR_OPR(OPND_IDX(opnd)) == Dv_Deref_Opr) {
03110 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
03111 }
03112
03113
03114
03115 if (semantics_ok && OPND_FLD(opnd) != AT_Tbl_Idx) {
03116 find_opnd_line_and_column(&opnd, &line, &column);
03117 PRINTMSG(line, 199, Error, column);
03118 semantics_ok = FALSE;
03119 }
03120 else {
03121 attr_idx = OPND_IDX(opnd);
03122 }
03123
03124 if (semantics_ok && expr_desc.rank != 0) {
03125 find_opnd_line_and_column(&opnd, &line, &column);
03126 PRINTMSG(line, 837, Ansi, column);
03127 }
03128 }
03129 else {
03130
03131
03132
03133
03134 find_opnd_line_and_column(&opnd, &line, &column);
03135 PRINTMSG(line, 675, Error, column);
03136 semantics_ok = FALSE;
03137 }
03138
03139 if (semantics_ok) {
03140 find_opnd_line_and_column(&opnd, &line, &column);
03141
03142 if (AT_ATTR_LINK(attr_idx)) {
03143 PRINTMSG(line, 533, Error, column,
03144 AT_OBJ_NAME_PTR(attr_idx));
03145 semantics_ok = FALSE;
03146 }
03147 else {
03148 do_var_tmp_idx = gen_compiler_tmp(line, column, Priv, TRUE);
03149 AT_SEMANTICS_DONE(do_var_tmp_idx) = TRUE;
03150 ATD_TYPE_IDX(do_var_tmp_idx) = ATD_TYPE_IDX(attr_idx);
03151 ATD_STOR_BLK_IDX(do_var_tmp_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
03152
03153 AT_ATTR_LINK(attr_idx) = do_var_tmp_idx;
03154 AT_IGNORE_ATTR_LINK(attr_idx) = TRUE;
03155
03156 ATD_IMP_DO_LCV(do_var_tmp_idx) = TRUE;
03157 ATD_LCV_IS_CONST(do_var_tmp_idx) = TRUE;
03158 ATD_TMP_NEEDS_CIF(do_var_tmp_idx) = TRUE;
03159
03160
03161 AT_NAME_IDX(do_var_tmp_idx) = AT_NAME_IDX(attr_idx);
03162 AT_NAME_LEN(do_var_tmp_idx) = AT_NAME_LEN(attr_idx);
03163
03164
03165
03166
03167 AT_REFERENCED(do_var_tmp_idx) = Not_Referenced;
03168
03169 IL_FLD(il_idx) = AT_Tbl_Idx;
03170 IL_IDX(il_idx) = do_var_tmp_idx;
03171 IL_LINE_NUM(il_idx) = line;
03172 IL_COL_NUM(il_idx) = column;
03173
03174 loop_tbl[lt_idx].lcv_idx = do_var_tmp_idx;
03175
03176
03177 if ((cif_flags & XREF_RECS) != 0) {
03178 cif_usage_rec(do_var_tmp_idx, AT_Tbl_Idx, line, column,
03179 CIF_Symbol_Modification);
03180 }
03181
03182 }
03183 }
03184 }
03185
03186
03187 if (SH_ERR_FLG(curr_stmt_sh_idx)) {
03188 goto EXIT;
03189 }
03190
03191
03192
03193
03194
03195 in_implied_do = TRUE;
03196 target_idx = IR_IDX_L(imp_do_idx);
03197 loop_tbl[lt_idx].target_list = target_idx;
03198
03199 while (target_idx != NULL_IDX) {
03200 ++loop_tbl[lt_idx].num_targets;
03201
03202 if (IL_FLD(target_idx) == IR_Tbl_Idx &&
03203 IR_OPR(IL_IDX(target_idx)) == Implied_Do_Opr) {
03204 curr_parent_idx = lt_idx;
03205 build_loop_tbl(IL_IDX(target_idx), compiler_gen_imp_do);
03206 }
03207 else if (! compiler_gen_imp_do) {
03208 COPY_OPND(opnd, IL_OPND(target_idx));
03209 object_semantics(&opnd,
03210 Restricted_Imp_Do_Target,
03211 &expr_desc,
03212 FALSE,
03213 FALSE);
03214
03215 if (! SH_ERR_FLG(curr_stmt_sh_idx)) {
03216
03217
03218
03219
03220
03221
03222 if (expr_desc.rank != 0 || OPND_FLD(opnd) != IR_Tbl_Idx) {
03223 find_opnd_line_and_column(&opnd, &line, &column);
03224 PRINTMSG(line, 709, Error, column);
03225 goto EXIT;
03226 }
03227
03228
03229
03230
03231
03232 temp_ir_idx = OPND_IDX(opnd);
03233
03234 if (IR_OPR(temp_ir_idx) == Whole_Substring_Opr ||
03235 IR_OPR(temp_ir_idx) == Substring_Opr) {
03236 temp_ir_idx = IR_IDX_L(temp_ir_idx);
03237 }
03238
03239 if (IR_OPR(temp_ir_idx) != Subscript_Opr &&
03240 IR_OPR(temp_ir_idx) != Struct_Opr) {
03241 find_opnd_line_and_column(&opnd, &line, &column);
03242 PRINTMSG(line, 709, Error, column);
03243 goto EXIT;
03244 }
03245
03246 COPY_OPND(IL_OPND(target_idx), opnd);
03247 }
03248 }
03249
03250 target_idx = IL_NEXT_LIST_IDX(target_idx);
03251 }
03252
03253
03254
03255
03256 lt_idx = curr_parent_idx;
03257
03258 if (curr_parent_idx != NULL_IDX) {
03259 curr_parent_idx = loop_tbl[lt_idx].parent_idx;
03260 }
03261
03262
03263 EXIT:
03264
03265
03266
03267
03268
03269 if (semantics_ok && attr_idx != NULL_IDX) {
03270 AT_ATTR_LINK(attr_idx) = NULL_IDX;
03271 AT_IGNORE_ATTR_LINK(attr_idx) = FALSE;
03272 }
03273
03274 in_implied_do = save_in_implied_do;
03275 expr_mode = Regular_Expr;
03276
03277 TRACE (Func_Exit, "build_loop_tbl", NULL);
03278
03279 return;
03280
03281 }
03282
03283
03284
03285
03286
03287
03288
03289
03290
03291
03292
03293
03294
03295
03296
03297
03298
03299
03300
03301
03302 static boolean good_data_imp_do_expr(int ir_idx)
03303
03304 {
03305 boolean result = TRUE;
03306
03307
03308 TRACE (Func_Entry, "good_data_imp_do_expr", NULL);
03309
03310 switch (IR_OPR(ir_idx)) {
03311
03312 case Power_Opr:
03313 case Mult_Opr:
03314 case Div_Opr:
03315 case Uplus_Opr:
03316 case Uminus_Opr:
03317 case Plus_Opr:
03318 case Minus_Opr:
03319 case Paren_Opr:
03320 case Cvrt_Opr:
03321 case Cvrt_Unsigned_Opr:
03322 if (IR_FLD_L(ir_idx) == IR_Tbl_Idx) {
03323
03324 if (! good_data_imp_do_expr(IR_IDX_L(ir_idx))) {
03325 result = FALSE;
03326 }
03327 }
03328
03329 if (IR_FLD_R(ir_idx) == IR_Tbl_Idx) {
03330
03331 if (! good_data_imp_do_expr(IR_IDX_R(ir_idx))) {
03332 result = FALSE;
03333 }
03334 }
03335
03336 break;
03337
03338 case Struct_Opr:
03339 case Subscript_Opr:
03340 PRINTMSG(IR_LINE_NUM(ir_idx), 1081, Error, IR_COL_NUM(ir_idx));
03341 result = FALSE;
03342 break;
03343
03344 default:
03345 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal, 0,
03346 "good_data_imp_do_expr");
03347 }
03348
03349 TRACE (Func_Exit, "good_data_imp_do_expr", NULL);
03350
03351 return(result);
03352
03353 }
03354
03355
03356
03357
03358
03359
03360
03361
03362
03363
03364
03365
03366
03367
03368
03369
03370
03371
03372
03373
03374
03375
03376
03377
03378
03379
03380
03381
03382
03383
03384
03385
03386
03387
03388
03389
03390
03391
03392
03393
03394
03395
03396
03397
03398
03399
03400
03401
03402
03403
03404
03405
03406
03407
03408
03409
03410
03411
03412
03413
03414
03415
03416
03417
03418
03419
03420
03421
03422
03423
03424
03425
03426
03427
03428
03429
03430
03431
03432
03433
03434
03435
03436
03437
03438
03439
03440
03441
03442
03443
03444
03445
03446
03447
03448
03449
03450
03451
03452
03453
03454
03455
03456
03457
03458
03459
03460
03461
03462
03463 static boolean imp_do_metamorphed(int init_ir_idx)
03464 {
03465 int attr_idx;
03466 expr_arg_type expr_desc;
03467 opnd_type expr_opnd;
03468 int i;
03469 int il_idx;
03470 int ir_idx;
03471 int iter_count_ir_idx;
03472 int local_lt_idx;
03473 boolean loops_match_bounds;
03474 boolean metamorphed;
03475 int num_elements_idx;
03476 long num_single_values;
03477 int num_single_values_idx;
03478 int num_values_idx;
03479 int result_type_idx;
03480 long_type result_value[MAX_WORDS_FOR_NUMERIC];
03481 int subscript_ir_idx;
03482 int triplet_ir_idx;
03483 int t1_il_idx;
03484 int t2_il_idx;
03485
03486
03487 TRACE (Func_Entry, "imp_do_metamorphed", NULL);
03488
03489 metamorphed = FALSE;
03490 num_elements_idx = CN_INTEGER_ONE_IDX;
03491 num_values_idx = CN_INTEGER_ZERO_IDX;
03492 num_single_values = 0;
03493 num_single_values_idx = CN_INTEGER_ZERO_IDX;
03494
03495
03496
03497
03498
03499
03500 for (i = 1; i <= last_lt_idx; ++i) {
03501
03502 if (loop_tbl[i].num_targets != 1) {
03503 goto EXIT;
03504 }
03505 }
03506
03507
03508
03509
03510
03511
03512 subscript_ir_idx = IL_IDX(loop_tbl[last_lt_idx].target_list);
03513
03514 if (IR_OPR(subscript_ir_idx) != Subscript_Opr ||
03515 IR_FLD_L(subscript_ir_idx) != AT_Tbl_Idx) {
03516 goto EXIT;
03517 }
03518
03519 attr_idx = IR_IDX_L(subscript_ir_idx);
03520
03521 if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) != Integer &&
03522 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) != Real &&
03523 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) != Complex &&
03524 TYP_TYPE(ATD_TYPE_IDX(attr_idx)) != Logical) {
03525 goto EXIT;
03526 }
03527
03528
03529
03530
03531
03532
03533
03534
03535
03536
03537
03538 loops_match_bounds = TRUE;
03539 local_lt_idx = last_lt_idx;
03540 il_idx = IR_IDX_R(subscript_ir_idx);
03541
03542
03543 for (i = 1; i <= IR_LIST_CNT_R(subscript_ir_idx); ++i) {
03544
03545 if (IL_FLD(il_idx) == AT_Tbl_Idx) {
03546
03547 if (IL_IDX(il_idx) != loop_tbl[local_lt_idx].lcv_idx) {
03548 goto EXIT;
03549 }
03550
03551 if (loop_tbl[local_lt_idx].start_fld == CN_Tbl_Idx &&
03552 loop_tbl[local_lt_idx].end_fld == CN_Tbl_Idx &&
03553 loop_tbl[local_lt_idx].inc_fld == CN_Tbl_Idx) {
03554
03555 if (fold_relationals(loop_tbl[local_lt_idx].start_idx,
03556 BD_LB_IDX(ATD_ARRAY_IDX(attr_idx), i),
03557 Ne_Opr) ||
03558 fold_relationals(loop_tbl[local_lt_idx].end_idx,
03559 BD_UB_IDX(ATD_ARRAY_IDX(attr_idx), i),
03560 Ne_Opr) ||
03561 fold_relationals(loop_tbl[local_lt_idx].inc_idx,
03562 CN_INTEGER_ONE_IDX,
03563 Ne_Opr)) {
03564 loops_match_bounds = FALSE;
03565 }
03566
03567
03568
03569
03570
03571 NTR_IR_TBL(iter_count_ir_idx);
03572 IR_OPR(iter_count_ir_idx) = Minus_Opr;
03573 IR_TYPE_IDX(iter_count_ir_idx) = INTEGER_DEFAULT_TYPE;
03574 IR_LINE_NUM(iter_count_ir_idx) = stmt_start_line;
03575 IR_COL_NUM(iter_count_ir_idx) = stmt_start_col;
03576 IR_FLD_L(iter_count_ir_idx) = CN_Tbl_Idx;
03577 IR_IDX_L(iter_count_ir_idx) = loop_tbl[local_lt_idx].end_idx;
03578 IR_LINE_NUM_L(iter_count_ir_idx) = stmt_start_line;
03579 IR_COL_NUM_L(iter_count_ir_idx) = stmt_start_col;
03580 IR_FLD_R(iter_count_ir_idx) = CN_Tbl_Idx;
03581 IR_IDX_R(iter_count_ir_idx) = loop_tbl[local_lt_idx].start_idx;
03582 IR_LINE_NUM_R(iter_count_ir_idx) = stmt_start_line;
03583 IR_COL_NUM_R(iter_count_ir_idx) = stmt_start_col;
03584
03585 NTR_IR_TBL(ir_idx);
03586 IR_OPR(ir_idx) = Plus_Opr;
03587 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
03588 IR_LINE_NUM(ir_idx) = stmt_start_line;
03589 IR_COL_NUM(ir_idx) = stmt_start_col;
03590 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03591 IR_IDX_L(ir_idx) = iter_count_ir_idx;
03592 IR_FLD_R(ir_idx) = CN_Tbl_Idx;
03593 IR_IDX_R(ir_idx) = loop_tbl[local_lt_idx].inc_idx;
03594 IR_LINE_NUM_R(ir_idx) = stmt_start_line;
03595 IR_COL_NUM_R(ir_idx) = stmt_start_col;
03596
03597 NTR_IR_TBL(iter_count_ir_idx);
03598 IR_OPR(iter_count_ir_idx) = Div_Opr;
03599 IR_TYPE_IDX(iter_count_ir_idx) = INTEGER_DEFAULT_TYPE;
03600 IR_LINE_NUM(iter_count_ir_idx) = stmt_start_line;
03601 IR_COL_NUM(iter_count_ir_idx) = stmt_start_col;
03602 IR_FLD_L(iter_count_ir_idx) = IR_Tbl_Idx;
03603 IR_IDX_L(iter_count_ir_idx) = ir_idx;
03604 IR_FLD_R(iter_count_ir_idx) = CN_Tbl_Idx;
03605 IR_IDX_R(iter_count_ir_idx) = loop_tbl[local_lt_idx].inc_idx;
03606 IR_LINE_NUM_R(iter_count_ir_idx) = stmt_start_line;
03607 IR_COL_NUM_R(iter_count_ir_idx) = stmt_start_col;
03608
03609 OPND_FLD(expr_opnd) = IR_Tbl_Idx;
03610 OPND_IDX(expr_opnd) = iter_count_ir_idx;
03611
03612 if (! expr_semantics(&expr_opnd, &expr_desc)) {
03613 PRINTMSG(IR_LINE_NUM(init_ir_idx), 857, Internal,
03614 IR_COL_NUM(init_ir_idx));
03615 }
03616
03617
03618
03619
03620 result_type_idx = INTEGER_DEFAULT_TYPE;
03621
03622 if (folder_driver( (char *) &CN_CONST(num_elements_idx),
03623 CN_TYPE_IDX(num_elements_idx),
03624 (char *) &CN_CONST(OPND_IDX(expr_opnd)),
03625 expr_desc.type_idx,
03626 result_value,
03627 &result_type_idx,
03628 IR_LINE_NUM(init_ir_idx),
03629 IR_COL_NUM(init_ir_idx),
03630 2,
03631 Mult_Opr)) {
03632 num_elements_idx = ntr_const_tbl(INTEGER_DEFAULT_TYPE,
03633 FALSE,
03634 result_value);
03635 }
03636 else {
03637 PRINTMSG(IR_LINE_NUM(init_ir_idx), 1024, Internal,
03638 IR_COL_NUM(init_ir_idx));
03639 }
03640
03641 --local_lt_idx;
03642 }
03643 else {
03644 goto EXIT;
03645 }
03646 }
03647 else if (IL_FLD(il_idx) == CN_Tbl_Idx) {
03648 loops_match_bounds = FALSE;
03649 }
03650 else {
03651 goto EXIT;
03652 }
03653
03654 il_idx = IL_NEXT_LIST_IDX(il_idx);
03655 }
03656
03657
03658
03659
03660
03661
03662
03663
03664 il_idx = value_il_idx;
03665
03666 while (il_idx != NULL_IDX) {
03667
03668 if (IL_FLD(il_idx) == CN_Tbl_Idx) {
03669
03670 if (TYP_TYPE(CN_TYPE_IDX(IL_IDX(il_idx))) != Character &&
03671 TYP_LINEAR(CN_TYPE_IDX(IL_IDX(il_idx))) != Long_Typeless) {
03672 ++num_single_values;
03673 }
03674 else {
03675 goto EXIT;
03676 }
03677 }
03678 else if (IL_FLD(il_idx) == IR_Tbl_Idx) {
03679 ir_idx = IL_IDX(il_idx);
03680
03681 if (IR_OPR(ir_idx) == Rep_Count_Opr) {
03682
03683 if (IR_FLD_R(ir_idx) ==