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