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