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