00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048 static char USMID[] = "\n@(#)5.0_pl/sources/s_intrin.c 5.31 10/27/99 16:50:34\n";
00049
00050 # include "defines.h"
00051 # include "host.m"
00052 # include "host.h"
00053 # include "target.m"
00054 # include "target.h"
00055 # include "globals.m"
00056 # include "tokens.m"
00057 # include "sytb.m"
00058 # include "s_globals.m"
00059 # include "debug.m"
00060 # include "fmath.h"
00061 # include "globals.h"
00062 # include "tokens.h"
00063 # include "sytb.h"
00064 # include "s_globals.h"
00065
00066 # if defined(_HOST_OS_UNICOS) || defined(_HOST_OS_MAX)
00067 # include <fortran.h>
00068 # endif
00069
00070
00071 extern boolean has_present_opr;
00072 #ifdef KEY
00073 #ifdef TARG_X8664
00074 extern boolean Target_SSE2;
00075 extern boolean Target_SSE3;
00076 #endif
00077 #endif
00078
00079 #ifdef KEY
00080
00081
00082
00083
00084
00085
00086 static int
00087 is_optional_dummy(int list_idx) {
00088 if (list_idx == NULL_IDX || IL_IDX(list_idx) == NULL_IDX) {
00089 return FALSE;
00090 }
00091 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
00092 return AT_OPTIONAL(IL_IDX(list_idx));
00093 }
00094 int ignore_line, ignore_col;
00095 int attr_idx = find_base_attr(&IL_OPND(list_idx), &ignore_line, &ignore_col);
00096 return (attr_idx != NULL_IDX && AT_OPTIONAL(attr_idx)) ? attr_idx : NULL_IDX;
00097 }
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116 static boolean
00117 gen_select_present(int line, int col, int dummy_idx,
00118 fld_type true_fld, int true_idx,
00119 fld_type false_fld, int false_idx,
00120 int result_type_idx) {
00121 int present_idx = gen_ir(AT_Tbl_Idx, dummy_idx,
00122 Present_Opr, CG_LOGICAL_DEFAULT_TYPE, line, col,
00123 NO_Tbl_Idx, NULL_IDX);
00124 int select_arglist_idx = gen_il(3, TRUE, line, col,
00125 true_fld, true_idx,
00126 false_fld, false_idx,
00127 IR_Tbl_Idx, present_idx);
00128 int select_idx = gen_ir(IL_Tbl_Idx, select_arglist_idx,
00129 Cselect_Opr,
00130 result_type_idx, line, col,
00131 NO_Tbl_Idx, NULL_IDX);
00132 return select_idx;
00133 }
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148 static void
00149 pass_dummy_or_default(int list_idx, fld_type default_fld, int default_idx,
00150 int default_type_idx, boolean need_temp) {
00151 int ignore_line, ignore_col;
00152 int attr_idx = find_base_attr(&IL_OPND(list_idx), &ignore_line, &ignore_col);
00153 int select_idx =
00154 gen_select_present(IL_LINE_NUM(list_idx), IL_COL_NUM(list_idx), attr_idx,
00155 IL_FLD(list_idx), IL_IDX(list_idx),
00156 default_fld, default_idx, default_type_idx);
00157 int line = IL_LINE_NUM(list_idx);
00158 int col = IL_COL_NUM(list_idx);
00159 if (need_temp) {
00160 int tmp_attr = gen_compiler_tmp(line, col, Priv, TRUE);
00161 int cn_type_idx = ATD_TYPE_IDX(tmp_attr) = CN_TYPE_IDX(default_idx);
00162 ATD_STOR_BLK_IDX(tmp_attr) = SCP_SB_STACK_IDX(curr_scp_idx);
00163 AT_SEMANTICS_DONE(tmp_attr) = TRUE;
00164 int asg_idx = gen_ir(AT_Tbl_Idx, tmp_attr, Asg_Opr, cn_type_idx, line, col,
00165 IR_Tbl_Idx, select_idx);
00166 gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00167 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
00168 IL_FLD(list_idx) = AT_Tbl_Idx;
00169 IL_IDX(list_idx) = tmp_attr;
00170 }
00171 else {
00172 IL_FLD(list_idx) = IR_Tbl_Idx;
00173 IL_IDX(list_idx) = select_idx;
00174 }
00175 }
00176
00177
00178 static void
00179 pass_dummy_or_default_const(int list_idx, int default_idx, boolean need_temp) {
00180 pass_dummy_or_default(list_idx, CN_Tbl_Idx, default_idx,
00181 CN_TYPE_IDX(default_idx), need_temp);
00182 }
00183 #endif
00184 #ifdef KEY
00185
00186
00187
00188
00189
00190
00191
00192
00193 static void
00194 typeless_to_type(int list_idx1, Uint result_type_idx) {
00195 long_type dst[MAX_WORDS_FOR_INTEGER];
00196 memset(dst, 0, MAX_WORDS_FOR_INTEGER * sizeof *dst);
00197 long_type *src = (long_type *) &CN_CONST(IL_IDX(list_idx1));
00198 int info_idx1 = IL_ARG_DESC_IDX(list_idx1);
00199 Uint src_type_idx = arg_info_list[info_idx1].ed.type_idx;
00200 int src_len = TYP_BIT_LEN(src_type_idx) / TARGET_BITS_PER_WORD;
00201
00202
00203
00204
00205
00206
00207
00208 if (!(on_off_flags.issue_ansi_messages || on_off_flags.fortran2003)) {
00209 result_type_idx = Integer_8;
00210 }
00211 linear_type_type result_linear_type = TYP_LINEAR(result_type_idx);
00212 int dst_len = num_host_wds[result_linear_type];
00213
00214 copy_and_pad_boz(dst, dst_len, src, src_len);
00215 IL_IDX(list_idx1) = ntr_const_tbl(result_type_idx, TRUE, dst);
00216 }
00217 #endif
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236 static void generate_bounds_list(int bd_idx,
00237 opnd_type *result_opnd,
00238 expr_arg_type *exp_desc)
00239
00240 {
00241
00242 int col;
00243 int i;
00244 int ir_idx;
00245 int line;
00246 int list_idx = NULL_IDX;
00247 opnd_type opnd;
00248 cif_usage_code_type save_xref_state;
00249
00250
00251 TRACE (Func_Entry, "generate_bounds_list", NULL);
00252
00253 find_opnd_line_and_column(result_opnd, &line, &col);
00254
00255 NTR_IR_TBL(ir_idx);
00256 IR_OPR(ir_idx) = Array_Construct_Opr;
00257 IR_LINE_NUM(ir_idx) = line;
00258 IR_COL_NUM(ir_idx) = col;
00259
00260 IR_FLD_R(ir_idx) = IL_Tbl_Idx;
00261 IR_LIST_CNT_R(ir_idx) = 2 * BD_RANK(bd_idx);
00262
00263
00264 for (i = 1; i <= BD_RANK(bd_idx); i++) {
00265 if (list_idx == NULL_IDX) {
00266 NTR_IR_LIST_TBL(list_idx);
00267 IR_IDX_R(ir_idx) = list_idx;
00268 }
00269 else {
00270 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
00271 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
00272 list_idx = IL_NEXT_LIST_IDX(list_idx);
00273 }
00274
00275 IL_FLD(list_idx) = BD_LB_FLD(bd_idx, i);
00276 IL_IDX(list_idx) = BD_LB_IDX(bd_idx, i);
00277 IL_LINE_NUM(list_idx) = line;
00278 IL_COL_NUM(list_idx) = col;
00279
00280 COPY_OPND(opnd, IL_OPND(list_idx));
00281 cast_opnd_to_type_idx(&opnd, CG_INTEGER_DEFAULT_TYPE);
00282 COPY_OPND(IL_OPND(list_idx), opnd);
00283
00284 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
00285 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
00286 list_idx = IL_NEXT_LIST_IDX(list_idx);
00287
00288 if (BD_ARRAY_CLASS(bd_idx) == Assumed_Size &&
00289 i == BD_RANK(bd_idx)) {
00290
00291 IL_FLD(list_idx) = CN_Tbl_Idx;
00292 IL_IDX(list_idx) = CN_INTEGER_ZERO_IDX;
00293 }
00294 else {
00295 IL_FLD(list_idx) = BD_UB_FLD(bd_idx, i);
00296 IL_IDX(list_idx) = BD_UB_IDX(bd_idx, i);
00297 }
00298
00299 IL_LINE_NUM(list_idx) = line;
00300 IL_COL_NUM(list_idx) = col;
00301
00302 COPY_OPND(opnd, IL_OPND(list_idx));
00303 cast_opnd_to_type_idx(&opnd, CG_INTEGER_DEFAULT_TYPE);
00304 COPY_OPND(IL_OPND(list_idx), opnd);
00305 }
00306
00307 save_xref_state = xref_state;
00308 xref_state = CIF_No_Usage_Rec;
00309 OPND_FLD((*result_opnd)) = IR_Tbl_Idx;
00310 OPND_IDX((*result_opnd)) = ir_idx;
00311 exp_desc->rank = 0;
00312 expr_semantics(result_opnd, exp_desc);
00313 xref_state = save_xref_state;
00314
00315 TRACE (Func_Exit, "generate_bounds_list", NULL);
00316
00317 return;
00318
00319 }
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339 static int cri_ptr_type(int type_idx)
00340
00341 {
00342 int ptr_type;
00343
00344
00345 TRACE (Func_Entry, "cri_ptr_type", NULL);
00346
00347 ptr_type = CRI_Ptr_8;
00348
00349 # ifdef _TRANSFORM_CHAR_SEQUENCE
00350 if (TYP_TYPE(type_idx) == Character ||
00351 (TYP_TYPE(type_idx) == Structure &&
00352 ATT_CHAR_SEQ(TYP_IDX(type_idx))))
00353 # else
00354 if (TYP_TYPE(type_idx) == Character)
00355 # endif
00356 {
00357
00358 ptr_type = CRI_Ch_Ptr_8;
00359 }
00360 # ifdef _TARGET32
00361 else if (TARGET_32BIT_DOUBLE_WORD_STORAGE_TYPE(type_idx) ||
00362 TYP_LINEAR(type_idx) == Complex_4) {
00363
00364 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
00365 TYP_TYPE(TYP_WORK_IDX) = CRI_Ptr;
00366 TYP_LINEAR(TYP_WORK_IDX) = CRI_Ptr_8;
00367 TYP_PTR_INCREMENT(TYP_WORK_IDX) = 64;
00368 ptr_type = ntr_type_tbl();
00369
00370 }
00371 # endif
00372
00373 # ifdef _TARGET_OS_MAX
00374 else if (TARGET_MAX_HALF_WORD_STORAGE_TYPE(type_idx)) {
00375
00376 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
00377 TYP_TYPE(TYP_WORK_IDX) = CRI_Ptr;
00378 TYP_LINEAR(TYP_WORK_IDX) = CRI_Ptr_8;
00379 TYP_PTR_INCREMENT(TYP_WORK_IDX) = 32;
00380 ptr_type = ntr_type_tbl();
00381 }
00382 # endif
00383
00384
00385 TRACE (Func_Exit, "cri_ptr_type", NULL);
00386
00387 return(ptr_type);
00388
00389 }
00390
00391
00392
00393
00394
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406
00407
00408 #if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
00409 #if COMPILER_VERSION < 730
00410 static void dummydummydummy(void *a, void *b){}
00411 #endif
00412 #endif
00413
00414 static boolean optimize_reshape(opnd_type *result_opnd,
00415 expr_arg_type *res_exp_desc)
00416
00417 {
00418 int asg_idx;
00419 int attr_idx;
00420 int bd_idx;
00421 int col;
00422 expr_arg_type exp_desc1;
00423 expr_arg_type exp_desc2;
00424 expr_arg_type exp_desc4;
00425 long i;
00426 int info_idx1;
00427 int info_idx2;
00428 int info_idx4;
00429 int ir_idx;
00430 int line;
00431 int list_idx1;
00432 int list_idx2;
00433 int list_idx3;
00434 int list_idx4;
00435 expr_arg_type loc_exp_desc;
00436 int loc_idx;
00437 opnd_type l_opnd;
00438 boolean ok;
00439 opnd_type opnd;
00440 boolean optimized = FALSE;
00441 boolean equal = TRUE;
00442 int ptee_idx;
00443 int ptr_idx;
00444 opnd_type r_opnd;
00445 int type_idx;
00446 int unused1;
00447 int unused2;
00448
00449
00450 TRACE (Func_Entry, "optimize_reshape", NULL);
00451
00452 if (OPND_FLD((*result_opnd)) == IR_Tbl_Idx &&
00453 IR_OPR(OPND_IDX((*result_opnd))) == Call_Opr) {
00454
00455 ir_idx = OPND_IDX((*result_opnd));
00456
00457 list_idx1 = IR_IDX_R(ir_idx);
00458 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
00459 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
00460 list_idx4 = IL_NEXT_LIST_IDX(list_idx3);
00461
00462 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
00463 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
00464
00465 #if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
00466 #if COMPILER_VERSION < 730
00467
00468 dummydummydummy(&info_idx1,&info_idx2);
00469 #endif
00470 #endif
00471
00472 exp_desc1 = arg_info_list[info_idx1].ed;
00473 exp_desc2 = arg_info_list[info_idx2].ed;
00474
00475 if (IL_FLD(list_idx4) != NO_Tbl_Idx) {
00476 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
00477 exp_desc4 = arg_info_list[info_idx4].ed;
00478
00479 if (exp_desc4.foldable) {
00480
00481 attr_idx = find_base_attr(&IL_OPND(list_idx4), &line, &col);
00482 loc_exp_desc = init_exp_desc;
00483 loc_exp_desc.type_idx = ATD_TYPE_IDX(attr_idx);
00484 loc_exp_desc.type = TYP_TYPE(loc_exp_desc.type_idx);
00485 loc_exp_desc.linear_type = TYP_LINEAR(loc_exp_desc.type_idx);
00486
00487 loc_exp_desc.foldable = TRUE;
00488 loc_exp_desc.constant = TRUE;
00489
00490 for (i = 1; i <= res_exp_desc->rank; i++) {
00491 change_section_to_this_element(&IL_OPND(list_idx4),
00492 &opnd,
00493 i);
00494
00495 ok = fold_aggragate_expression(&opnd,
00496 &loc_exp_desc,
00497 TRUE);
00498
00499 equal = equal && compare_cn_and_value(OPND_IDX(opnd), i, Eq_Opr);
00500 }
00501
00502 if (equal && compare_cn_and_value(OPND_IDX(exp_desc4.shape[0]),
00503 (long) res_exp_desc->rank,
00504 Eq_Opr)) {
00505 IL_OPND(list_idx4) = null_opnd;
00506 }
00507 }
00508
00509 }
00510
00511 if (IL_FLD(list_idx3) == NO_Tbl_Idx &&
00512 IL_FLD(list_idx4) == NO_Tbl_Idx) {
00513
00514 if (exp_desc1.reference ||
00515 exp_desc1.tmp_reference) {
00516
00517 if (! exp_desc1.contig_array) {
00518 goto EXIT;
00519 }
00520
00521 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
00522
00523 if (ATD_POINTER(attr_idx)) {
00524 goto EXIT;
00525 }
00526
00527 if (ATD_ARRAY_IDX(attr_idx) &&
00528 BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == Assumed_Shape) {
00529 goto EXIT;
00530 }
00531 }
00532 else {
00533
00534
00535 COPY_OPND(r_opnd, IL_OPND(list_idx1));
00536 attr_idx = create_tmp_asg(&r_opnd,
00537 &exp_desc1,
00538 &l_opnd,
00539 Intent_In,
00540 FALSE,
00541 FALSE);
00542
00543 COPY_OPND(IL_OPND(list_idx1), l_opnd);
00544 arg_info_list[info_idx1].ed = exp_desc1;
00545 }
00546
00547
00548 if (! exp_desc2.reference &&
00549 ! exp_desc2.tmp_reference) {
00550
00551 COPY_OPND(r_opnd, IL_OPND(list_idx2));
00552 attr_idx = create_tmp_asg(&r_opnd,
00553 &exp_desc2,
00554 &l_opnd,
00555 Intent_In,
00556 FALSE,
00557 FALSE);
00558
00559 COPY_OPND(IL_OPND(list_idx2), l_opnd);
00560 arg_info_list[info_idx2].ed = exp_desc2;
00561 }
00562
00563 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
00564 loc_exp_desc = init_exp_desc;
00565 loc_exp_desc.type_idx = ATD_TYPE_IDX(attr_idx);
00566 loc_exp_desc.type = TYP_TYPE(loc_exp_desc.type_idx);
00567 loc_exp_desc.linear_type = TYP_LINEAR(loc_exp_desc.type_idx);
00568
00569 if (exp_desc2.foldable) {
00570 loc_exp_desc.foldable = TRUE;
00571 loc_exp_desc.constant = TRUE;
00572 }
00573
00574 for (i = 1; i <= res_exp_desc->rank; i++) {
00575
00576 change_section_to_this_element(&IL_OPND(list_idx2),
00577 &opnd,
00578 i);
00579 if (exp_desc2.foldable) {
00580 ok = fold_aggragate_expression(&opnd,
00581 &loc_exp_desc,
00582 TRUE);
00583 }
00584
00585 COPY_OPND(res_exp_desc->shape[i-1], opnd);
00586 }
00587
00588 if (gen_bd_entry(NULL, res_exp_desc, &bd_idx, line, col)) {
00589
00590 }
00591
00592 type_idx = cri_ptr_type(exp_desc1.type_idx);
00593
00594
00595
00596 ptr_idx = gen_compiler_tmp(line, col, Shared, TRUE);
00597 ATD_TYPE_IDX(ptr_idx) = type_idx;
00598 AT_SEMANTICS_DONE(ptr_idx) = TRUE;
00599 ATD_STOR_BLK_IDX(ptr_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
00600
00601 ptee_idx = gen_compiler_tmp(line, col, Shared, TRUE);
00602 ATD_CLASS(ptee_idx) = CRI__Pointee;
00603 AT_SEMANTICS_DONE(ptee_idx) = TRUE;
00604 ATD_STOR_BLK_IDX(ptee_idx) = SCP_SB_BASED_IDX(curr_scp_idx);
00605 ATD_TYPE_IDX(ptee_idx) = exp_desc1.type_idx;
00606 ATD_ARRAY_IDX(ptee_idx) = bd_idx;
00607 ATD_PTR_IDX(ptee_idx) = ptr_idx;
00608
00609
00610
00611 attr_idx = find_base_attr(&IL_OPND(list_idx1), &unused1, &unused2);
00612
00613 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
00614 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
00615 ATD_NOT_PT_UNIQUE_MEM(attr_idx) = TRUE;
00616 }
00617 # endif
00618
00619 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
00620 ATD_CLASS(attr_idx) == Compiler_Tmp &&
00621 exp_desc1.type != Character &&
00622 ATD_IM_A_DOPE(attr_idx)) {
00623
00624 asg_idx = gen_ir(AT_Tbl_Idx, ptr_idx,
00625 Asg_Opr, type_idx, line, col,
00626 IR_Tbl_Idx, gen_ir(AT_Tbl_Idx, attr_idx,
00627 Dv_Access_Base_Addr,
00628 SA_INTEGER_DEFAULT_TYPE,line,col,
00629 NO_Tbl_Idx, NULL_IDX));
00630
00631 }
00632 else {
00633
00634 COPY_OPND(opnd, IL_OPND(list_idx1));
00635 unused1 = NULL_IDX;
00636 unused2 = NULL_IDX;
00637 make_base_subtree(&opnd, &r_opnd, &unused1, &unused2);
00638
00639 loc_idx = gen_ir(OPND_FLD(r_opnd), OPND_IDX(r_opnd),
00640 Loc_Opr, type_idx, line, col,
00641 NO_Tbl_Idx, NULL_IDX);
00642
00643 # ifdef _TRANSFORM_CHAR_SEQUENCE
00644 if (exp_desc1.type == Structure &&
00645 ATT_CHAR_SEQ(TYP_IDX(exp_desc1.type_idx))) {
00646
00647 COPY_OPND(opnd, IR_OPND_L(loc_idx));
00648 transform_char_sequence_ref(&opnd, exp_desc1.type_idx);
00649 COPY_OPND(IR_OPND_L(loc_idx), opnd);
00650 }
00651 # endif
00652
00653 asg_idx = gen_ir(AT_Tbl_Idx, ptr_idx,
00654 Asg_Opr, type_idx, line, col,
00655 IR_Tbl_Idx, loc_idx);
00656
00657 }
00658
00659 gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00660
00661 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
00662 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00663
00664 gen_opnd(result_opnd, ptee_idx, AT_Tbl_Idx, line, col);
00665
00666 res_exp_desc->tmp_reference = TRUE;
00667 ok = gen_whole_subscript(result_opnd, res_exp_desc);
00668
00669 optimized = TRUE;
00670 }
00671 }
00672
00673 EXIT:
00674
00675 TRACE (Func_Exit, "optimize_reshape", NULL);
00676
00677 return(optimized);
00678
00679 }
00680
00681
00682
00683
00684
00685
00686
00687
00688
00689
00690
00691
00692
00693
00694
00695
00696
00697
00698
00699 void conform_check(int check_args,
00700 int ir_idx,
00701 expr_arg_type *res_exp_desc,
00702 int *spec_idx,
00703 boolean assumed_size_allowed)
00704 {
00705 int line;
00706 int col;
00707 #ifdef KEY
00708 int which_arg = 0;
00709 #else
00710 int which_arg;
00711 #endif
00712 int max_rank;
00713 int attr_idx;
00714 int temp_ir_idx;
00715 int i;
00716 int info_idx;
00717
00718
00719 TRACE (Func_Entry, "conform_check", NULL);
00720
00721 max_rank = 0;
00722
00723 temp_ir_idx = IR_IDX_R(ir_idx);
00724
00725 if (temp_ir_idx != NULL_IDX) {
00726 which_arg = IL_ARG_DESC_IDX(temp_ir_idx);
00727 }
00728
00729 res_exp_desc->will_fold_later = TRUE;
00730 res_exp_desc->foldable = TRUE;
00731
00732 for (i = 1; i <= IR_LIST_CNT_R(ir_idx); i++) {
00733
00734 if (IL_FLD(temp_ir_idx) == NO_Tbl_Idx) {
00735 temp_ir_idx = IL_NEXT_LIST_IDX(temp_ir_idx);
00736 continue;
00737 }
00738
00739 info_idx = IL_ARG_DESC_IDX(temp_ir_idx);
00740
00741 if (! assumed_size_allowed &&
00742 arg_info_list[info_idx].ed.rank != 0 &&
00743 (IL_FLD(temp_ir_idx) == AT_Tbl_Idx ||
00744 (IL_FLD(temp_ir_idx) == IR_Tbl_Idx &&
00745 IR_OPR(IL_IDX(temp_ir_idx)) == Whole_Substring_Opr &&
00746 IR_FLD_L(IL_IDX(temp_ir_idx)) == AT_Tbl_Idx))) {
00747
00748 PRINTMSG(arg_info_list[info_idx].line, 412, Error,
00749 arg_info_list[info_idx].col);
00750 }
00751
00752 attr_idx = 0;
00753 if ((IL_FLD(temp_ir_idx) == IR_Tbl_Idx) &&
00754 ((IR_OPR(IL_IDX(temp_ir_idx)) == Whole_Subscript_Opr) ||
00755 (IR_OPR(IL_IDX(temp_ir_idx)) == Section_Subscript_Opr))) {
00756 attr_idx = find_base_attr(&IL_OPND(temp_ir_idx), &line, &col);
00757 }
00758
00759 if ((check_args != 0) &&
00760 (i >= check_args) &&
00761 (arg_info_list[info_idx].ed.rank != max_rank) &&
00762 (attr_idx != 0) &&
00763 (!(ATP_INTRIN_ENUM(*spec_idx) == Present_Intrinsic)) &&
00764 (AT_OPTIONAL(attr_idx))) {
00765 PRINTMSG(arg_info_list[info_idx].line, 947, Error,
00766 arg_info_list[info_idx].col);
00767 }
00768
00769 if (!arg_info_list[info_idx].ed.foldable &&
00770 !arg_info_list[info_idx].ed.will_fold_later) {
00771 res_exp_desc->will_fold_later = FALSE;
00772 }
00773
00774 if (! arg_info_list[info_idx].ed.foldable) {
00775 res_exp_desc->foldable = FALSE;
00776 }
00777
00778 if (max_rank != 0 &&
00779 AT_ELEMENTAL_INTRIN(*spec_idx) &&
00780 arg_info_list[info_idx].ed.rank != 0 &&
00781 max_rank != arg_info_list[info_idx].ed.rank) {
00782 PRINTMSG(arg_info_list[info_idx].line, 363, Error,
00783 arg_info_list[info_idx].col);
00784 }
00785
00786 if (arg_info_list[info_idx].ed.rank > max_rank) {
00787 max_rank = arg_info_list[info_idx].ed.rank;
00788 which_arg = info_idx;
00789 }
00790
00791 temp_ir_idx = IL_NEXT_LIST_IDX(temp_ir_idx);
00792 }
00793
00794 if (ATP_PGM_UNIT(*spec_idx) != Subroutine) {
00795 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
00796 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
00797 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
00798 }
00799 res_exp_desc->rank = max_rank;
00800
00801 if (max_rank > 0 && AT_ELEMENTAL_INTRIN(*spec_idx)) {
00802 COPY_SHAPE(res_exp_desc->shape,
00803 arg_info_list[which_arg].ed.shape,
00804 arg_info_list[which_arg].ed.rank);
00805 }
00806
00807 TRACE (Func_Exit, "conform_check", NULL);
00808
00809 }
00810
00811
00812
00813
00814
00815
00816
00817
00818
00819
00820
00821
00822
00823
00824
00825
00826
00827
00828
00829
00830
00831
00832
00833
00834
00835
00836
00837
00838
00839
00840
00841
00842
00843
00844
00845
00846
00847
00848
00849
00850
00851
00852
00853
00854
00855
00856
00857
00858
00859
00860
00861
00862
00863
00864
00865
00866
00867
00868
00869
00870
00871
00872
00873
00874
00875
00876
00877
00878
00879
00880
00881
00882
00883
00884
00885
00886
00887
00888
00889
00890
00891
00892
00893
00894
00895
00896
00897
00898
00899
00900
00901 void sin_intrinsic(opnd_type *result_opnd,
00902 expr_arg_type *res_exp_desc,
00903 int *spec_idx)
00904 {
00905
00906 int info_idx1;
00907 int list_idx1;
00908 int ir_idx;
00909
00910
00911 TRACE (Func_Entry, "sin_intrinsic", NULL);
00912
00913 ir_idx = OPND_IDX((*result_opnd));
00914 list_idx1 = IR_IDX_R(ir_idx);
00915 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
00916 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
00917
00918 conform_check(0,
00919 ir_idx,
00920 res_exp_desc,
00921 spec_idx,
00922 FALSE);
00923
00924 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
00925 IR_RANK(ir_idx) = res_exp_desc->rank;
00926
00927 switch (ATP_INTRIN_ENUM(*spec_idx)) {
00928 case Sin_Intrinsic:
00929 case Dsin_Intrinsic:
00930 case Qsin_Intrinsic:
00931 case Csin_Intrinsic:
00932 case Cdsin_Intrinsic:
00933 case Cqsin_Intrinsic:
00934 # ifdef KEY
00935 case Zsin_Intrinsic:
00936 # endif
00937 IR_OPR(ir_idx) = Sin_Opr;
00938 break;
00939
00940 case Sind_Intrinsic:
00941 case Dsind_Intrinsic:
00942 case Qsind_Intrinsic:
00943 IR_OPR(ir_idx) = Sind_Opr;
00944 break;
00945
00946 case Cos_Intrinsic:
00947 case Dcos_Intrinsic:
00948 case Qcos_Intrinsic:
00949 case Ccos_Intrinsic:
00950 case Cdcos_Intrinsic:
00951 case Cqcos_Intrinsic:
00952 # ifdef KEY
00953 case Zcos_Intrinsic:
00954 # endif
00955 IR_OPR(ir_idx) = Cos_Opr;
00956 break;
00957
00958 case Cosd_Intrinsic:
00959 case Dcosd_Intrinsic:
00960 case Qcosd_Intrinsic:
00961 IR_OPR(ir_idx) = Cosd_Opr;
00962 break;
00963
00964 case Log_Intrinsic:
00965 case Alog_Intrinsic:
00966 case Dlog_Intrinsic:
00967 case Qlog_Intrinsic:
00968 case Clog_Intrinsic:
00969 case Cdlog_Intrinsic:
00970 case Cqlog_Intrinsic:
00971 # ifdef KEY
00972 case Zlog_Intrinsic:
00973 # endif
00974 if ((IL_FLD(list_idx1) == CN_Tbl_Idx) &&
00975 (arg_info_list[info_idx1].ed.type == Real)) {
00976
00977 if (fold_relationals(IL_IDX(list_idx1),
00978 CN_INTEGER_ZERO_IDX,
00979 Le_Opr)) {
00980
00981 PRINTMSG(arg_info_list[info_idx1].line, 1062, Error,
00982 arg_info_list[info_idx1].col);
00983 }
00984 }
00985
00986 IR_OPR(ir_idx) = Log_E_Opr;
00987 break;
00988
00989 case Log10_Intrinsic:
00990 case Alog10_Intrinsic:
00991 case Dlog10_Intrinsic:
00992 case Qlog10_Intrinsic:
00993 IR_OPR(ir_idx) = Log_10_Opr;
00994 break;
00995
00996 case Tan_Intrinsic:
00997 case Dtan_Intrinsic:
00998 case Qtan_Intrinsic:
00999 IR_OPR(ir_idx) = Tan_Opr;
01000 break;
01001
01002 case Tand_Intrinsic:
01003 case Dtand_Intrinsic:
01004 case Qtand_Intrinsic:
01005 IR_OPR(ir_idx) = Tand_Opr;
01006 break;
01007
01008 case Tanh_Intrinsic:
01009 case Dtanh_Intrinsic:
01010 case Qtanh_Intrinsic:
01011 IR_OPR(ir_idx) = Tanh_Opr;
01012 break;
01013
01014 case Sinh_Intrinsic:
01015 case Dsinh_Intrinsic:
01016 case Qsinh_Intrinsic:
01017 IR_OPR(ir_idx) = Sinh_Opr;
01018 break;
01019
01020 case Cosh_Intrinsic:
01021 case Dcosh_Intrinsic:
01022 case Qcosh_Intrinsic:
01023 IR_OPR(ir_idx) = Cosh_Opr;
01024 break;
01025
01026 case Acos_Intrinsic:
01027 case Dacos_Intrinsic:
01028 case Qacos_Intrinsic:
01029 IR_OPR(ir_idx) = Acos_Opr;
01030 break;
01031
01032 case Acosd_Intrinsic:
01033 case Dacosd_Intrinsic:
01034 case Qacosd_Intrinsic:
01035 IR_OPR(ir_idx) = Acosd_Opr;
01036 break;
01037
01038 case Asin_Intrinsic:
01039 case Dasin_Intrinsic:
01040 case Qasin_Intrinsic:
01041 IR_OPR(ir_idx) = Asin_Opr;
01042 break;
01043
01044 case Asind_Intrinsic:
01045 case Dasind_Intrinsic:
01046 case Qasind_Intrinsic:
01047 IR_OPR(ir_idx) = Asind_Opr;
01048 break;
01049
01050 case Atan_Intrinsic:
01051 case Datan_Intrinsic:
01052 case Qatan_Intrinsic:
01053 IR_OPR(ir_idx) = Atan_Opr;
01054 break;
01055
01056 case Atand_Intrinsic:
01057 case Datand_Intrinsic:
01058 case Qatand_Intrinsic:
01059 IR_OPR(ir_idx) = Atand_Opr;
01060 break;
01061
01062 case Cot_Intrinsic:
01063 case Dcot_Intrinsic:
01064 case Qcot_Intrinsic:
01065 IR_OPR(ir_idx) = Cot_Opr;
01066 break;
01067
01068 case Exp_Intrinsic:
01069 case Dexp_Intrinsic:
01070 case Qexp_Intrinsic:
01071 case Cexp_Intrinsic:
01072 case Cdexp_Intrinsic:
01073 case Cqexp_Intrinsic:
01074 # ifdef KEY
01075 case Zexp_Intrinsic:
01076 # endif
01077 IR_OPR(ir_idx) = Exp_Opr;
01078 break;
01079
01080 case Sqrt_Intrinsic:
01081 case Dsqrt_Intrinsic:
01082 case Qsqrt_Intrinsic:
01083 case Csqrt_Intrinsic:
01084 case Cdsqrt_Intrinsic:
01085 case Cqsqrt_Intrinsic:
01086 # ifdef KEY
01087 case Zsqrt_Intrinsic:
01088 # endif
01089 if ((IL_FLD(list_idx1) == CN_Tbl_Idx) &&
01090 (arg_info_list[info_idx1].ed.type == Real)) {
01091
01092 if (fold_relationals(IL_IDX(list_idx1),
01093 CN_INTEGER_ZERO_IDX,
01094 Lt_Opr)) {
01095
01096 PRINTMSG(arg_info_list[info_idx1].line, 1062, Error,
01097 arg_info_list[info_idx1].col);
01098 }
01099 }
01100
01101 IR_OPR(ir_idx) = Sqrt_Opr;
01102 break;
01103
01104 default:
01105 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal, IR_COL_NUM(ir_idx),
01106 "sin_intrinsic");
01107 break;
01108 }
01109
01110 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01111 IR_OPND_R(ir_idx) = null_opnd;
01112
01113
01114
01115
01116 # if defined(_USE_FOLD_DOT_f)
01117 if (IR_OPR(ir_idx) != Sqrt_Opr) {
01118 # endif
01119 res_exp_desc->foldable = FALSE;
01120 res_exp_desc->will_fold_later = FALSE;
01121 # if defined(_USE_FOLD_DOT_f)
01122 }
01123 # endif
01124
01125
01126 io_item_must_flatten = TRUE;
01127
01128 TRACE (Func_Exit, "sin_intrinsic", NULL);
01129
01130 }
01131 #ifdef KEY
01132
01133
01134
01135
01136
01137
01138
01139
01140
01141
01142
01143
01144
01145
01146
01147
01148
01149
01150 void erf_intrinsic(opnd_type *result_opnd,
01151 expr_arg_type *res_exp_desc,
01152 int *spec_idx)
01153 {
01154
01155 int info_idx1;
01156 int list_idx1;
01157 int ir_idx;
01158
01159 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
01160 opnd_type opnd;
01161 # endif
01162
01163 TRACE (Func_Entry, "erf_intrinsic", NULL);
01164
01165 ir_idx = OPND_IDX((*result_opnd));
01166 list_idx1 = IR_IDX_R(ir_idx);
01167 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01168 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
01169
01170 conform_check(0,
01171 ir_idx,
01172 res_exp_desc,
01173 spec_idx,
01174 FALSE);
01175
01176 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
01177 #ifdef KEY
01178
01179
01180
01181
01182
01183
01184 if (!defining_stmt_func) {
01185 #endif
01186 COPY_OPND(opnd, IR_OPND_R(ir_idx));
01187 final_arg_work(&opnd, IR_IDX_L(ir_idx), IR_LIST_CNT_R(ir_idx), NULL);
01188 COPY_OPND(IR_OPND_R(ir_idx), opnd);
01189 #ifdef KEY
01190 }
01191 #endif
01192 # endif
01193
01194 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
01195 IR_RANK(ir_idx) = res_exp_desc->rank;
01196
01197 switch (ATP_INTRIN_ENUM(*spec_idx)) {
01198 case Derf_Intrinsic:
01199 case Erf_Intrinsic:
01200 IR_OPR(ir_idx) = Erf_Opr;
01201 break;
01202
01203 case Derfc_Intrinsic:
01204 case Erfc_Intrinsic:
01205 IR_OPR(ir_idx) = Erfc_Opr;
01206 break;
01207
01208 default:
01209 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal, IR_COL_NUM(ir_idx),
01210 "erf_intrinsic");
01211 break;
01212 }
01213
01214 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01215 IR_OPND_R(ir_idx) = null_opnd;
01216
01217
01218
01219
01220 res_exp_desc->foldable = FALSE;
01221 res_exp_desc->will_fold_later = FALSE;
01222
01223
01224 io_item_must_flatten = TRUE;
01225
01226 TRACE (Func_Exit, "erf_intrinsic", NULL);
01227
01228 }
01229 #endif
01230
01231
01232
01233
01234
01235
01236
01237
01238
01239
01240
01241
01242
01243
01244
01245
01246
01247
01248 void abs_intrinsic(opnd_type *result_opnd,
01249 expr_arg_type *res_exp_desc,
01250 int *spec_idx)
01251 {
01252 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
01253 int ir_idx;
01254 int info_idx1;
01255 int list_idx1;
01256 int type_idx;
01257
01258
01259 TRACE (Func_Entry, "abs_intrinsic", NULL);
01260
01261 ir_idx = OPND_IDX((*result_opnd));
01262 list_idx1 = IR_IDX_R(ir_idx);
01263 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01264 type_idx = arg_info_list[info_idx1].ed.type_idx;
01265
01266 if (TYP_TYPE(type_idx) == Complex) {
01267 switch (TYP_LINEAR(type_idx)) {
01268 case Complex_16:
01269 type_idx = Real_16;
01270 break;
01271
01272 case Complex_8:
01273 type_idx = Real_8;
01274 break;
01275
01276 case Complex_4:
01277 type_idx = Real_4;
01278 break;
01279 }
01280 }
01281
01282 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
01283
01284 conform_check(0,
01285 ir_idx,
01286 res_exp_desc,
01287 spec_idx,
01288 FALSE);
01289
01290 IR_TYPE_IDX(ir_idx) = type_idx;
01291 IR_RANK(ir_idx) = res_exp_desc->rank;
01292
01293 res_exp_desc->type_idx = type_idx;
01294 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
01295 res_exp_desc->type = TYP_TYPE(type_idx);
01296
01297 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
01298 arg_info_list[info_idx1].ed.type == Integer &&
01299 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
01300 arg_info_list[info_idx1].ed.type_idx,
01301 NULL,
01302 NULL_IDX,
01303 folded_const,
01304 &type_idx,
01305 IR_LINE_NUM(ir_idx),
01306 IR_COL_NUM(ir_idx),
01307 1,
01308 Abs_Opr)) {
01309
01310 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
01311 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
01312 FALSE,
01313 folded_const);
01314 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
01315 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
01316 res_exp_desc->constant = TRUE;
01317 res_exp_desc->foldable = TRUE;
01318 }
01319 else {
01320 IR_OPR(ir_idx) = Abs_Opr;
01321 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01322 IR_OPND_R(ir_idx) = null_opnd;
01323
01324 if (arg_info_list[info_idx1].ed.type != Integer) {
01325
01326
01327
01328 res_exp_desc->foldable = FALSE;
01329 res_exp_desc->will_fold_later = FALSE;
01330 }
01331 }
01332
01333 TRACE (Func_Exit, "abs_intrinsic", NULL);
01334
01335 }
01336
01337
01338
01339
01340
01341
01342
01343
01344
01345
01346
01347
01348
01349
01350
01351
01352
01353
01354
01355 void atan2_intrinsic(opnd_type *result_opnd,
01356 expr_arg_type *res_exp_desc,
01357 int *spec_idx)
01358 {
01359 int ir_idx;
01360 int info_idx1;
01361 int info_idx2;
01362 int list_idx1;
01363 int list_idx2;
01364
01365
01366 TRACE (Func_Entry, "atan2_intrinsic", NULL);
01367
01368 ir_idx = OPND_IDX((*result_opnd));
01369 list_idx1 = IR_IDX_R(ir_idx);
01370 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
01371 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01372 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
01373 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
01374
01375 conform_check(0,
01376 ir_idx,
01377 res_exp_desc,
01378 spec_idx,
01379 FALSE);
01380
01381 if (arg_info_list[info_idx1].ed.linear_type !=
01382 arg_info_list[info_idx2].ed.linear_type) {
01383 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
01384 arg_info_list[info_idx2].col);
01385 }
01386
01387 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
01388 IR_RANK(ir_idx) = res_exp_desc->rank;
01389
01390 switch (ATP_INTRIN_ENUM(*spec_idx)) {
01391 case Atan2_Intrinsic:
01392 case Datan2_Intrinsic:
01393 case Qatan2_Intrinsic:
01394 IR_OPR(ir_idx) = Atan2_Opr;
01395 break;
01396
01397 case Atan2d_Intrinsic:
01398 case Datan2d_Intrinsic:
01399 case Qatan2d_Intrinsic:
01400 IR_OPR(ir_idx) = Atan2d_Opr;
01401 break;
01402
01403 default:
01404 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal, IR_COL_NUM(ir_idx),
01405 "atan2_intrinsic");
01406 break;
01407 }
01408
01409 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01410 IR_OPND_R(ir_idx) = null_opnd;
01411
01412
01413
01414
01415 res_exp_desc->foldable = FALSE;
01416 res_exp_desc->will_fold_later = FALSE;
01417
01418 TRACE (Func_Exit, "atan2_intrinsic", NULL);
01419
01420 }
01421
01422
01423
01424
01425
01426
01427
01428
01429
01430
01431
01432
01433
01434
01435
01436
01437
01438
01439 void aimag_intrinsic(opnd_type *result_opnd,
01440 expr_arg_type *res_exp_desc,
01441 int *spec_idx)
01442 {
01443 int ir_idx;
01444 #ifdef KEY
01445 int type_idx = 0;
01446 #else
01447 int type_idx;
01448 #endif
01449 int info_idx1;
01450 int list_idx1;
01451
01452
01453 TRACE (Func_Entry, "aimag_intrinsic", NULL);
01454
01455 ir_idx = OPND_IDX((*result_opnd));
01456 list_idx1 = IR_IDX_R(ir_idx);
01457 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01458
01459 switch (arg_info_list[info_idx1].ed.linear_type) {
01460 case Complex_4: type_idx = Real_4; break;
01461 case Complex_8: type_idx = Real_8; break;
01462 case Complex_16: type_idx = Real_16; break;
01463 }
01464
01465 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
01466
01467 conform_check(0,
01468 ir_idx,
01469 res_exp_desc,
01470 spec_idx,
01471 FALSE);
01472
01473 IR_TYPE_IDX(ir_idx) = type_idx;
01474 IR_RANK(ir_idx) = res_exp_desc->rank;
01475
01476 IR_OPR(ir_idx) = Aimag_Opr;
01477 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01478 IR_OPND_R(ir_idx) = null_opnd;
01479
01480
01481
01482
01483 res_exp_desc->foldable = FALSE;
01484 res_exp_desc->will_fold_later = FALSE;
01485
01486 TRACE (Func_Exit, "aimag_intrinsic", NULL);
01487
01488 }
01489
01490
01491
01492
01493
01494
01495
01496
01497
01498
01499
01500
01501
01502
01503
01504
01505
01506
01507
01508
01509
01510
01511
01512
01513
01514
01515
01516
01517
01518
01519
01520
01521
01522
01523
01524
01525
01526
01527
01528
01529 void int_intrinsic(opnd_type *result_opnd,
01530 expr_arg_type *res_exp_desc,
01531 int *spec_idx)
01532 {
01533 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
01534 int ir_idx;
01535 int list_idx1;
01536 int list_idx2;
01537 int info_idx1;
01538 int info_idx2;
01539 opnd_type opnd;
01540 int type_idx;
01541
01542
01543 TRACE (Func_Entry, "int_intrinsic", NULL);
01544
01545 ir_idx = OPND_IDX((*result_opnd));
01546 list_idx1 = IR_IDX_R(ir_idx);
01547 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
01548 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01549
01550 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
01551 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
01552 kind_to_linear_type(&((IL_OPND(list_idx2))),
01553 ATP_RSLT_IDX(*spec_idx),
01554 arg_info_list[info_idx2].ed.kind0seen,
01555 arg_info_list[info_idx2].ed.kind0E0seen,
01556 arg_info_list[info_idx2].ed.kind0D0seen,
01557 ! arg_info_list[info_idx2].ed.kindnotconst);
01558 }
01559 else {
01560 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
01561 }
01562
01563 if (ATP_INTRIN_ENUM(*spec_idx) == Int1_Intrinsic) {
01564 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_1;
01565 }
01566 else if (ATP_INTRIN_ENUM(*spec_idx) == Short_Intrinsic ||
01567 ATP_INTRIN_ENUM(*spec_idx) == Int2_Intrinsic ||
01568 ATP_INTRIN_ENUM(*spec_idx) == Iint_Intrinsic ||
01569 ATP_INTRIN_ENUM(*spec_idx) == Iifix_Intrinsic ||
01570 ATP_INTRIN_ENUM(*spec_idx) == Iidint_Intrinsic ||
01571 ATP_INTRIN_ENUM(*spec_idx) == Iiqint_Intrinsic) {
01572 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_2;
01573 }
01574 else if (ATP_INTRIN_ENUM(*spec_idx) == Long_Intrinsic ||
01575 ATP_INTRIN_ENUM(*spec_idx) == Int4_Intrinsic ||
01576 ATP_INTRIN_ENUM(*spec_idx) == Jint_Intrinsic ||
01577 ATP_INTRIN_ENUM(*spec_idx) == Jifix_Intrinsic ||
01578 ATP_INTRIN_ENUM(*spec_idx) == Jidint_Intrinsic ||
01579 ATP_INTRIN_ENUM(*spec_idx) == Jiqint_Intrinsic) {
01580 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_4;
01581 }
01582 else if (ATP_INTRIN_ENUM(*spec_idx) == Kint_Intrinsic ||
01583 ATP_INTRIN_ENUM(*spec_idx) == Int8_Intrinsic ||
01584 ATP_INTRIN_ENUM(*spec_idx) == Kifix_Intrinsic ||
01585 ATP_INTRIN_ENUM(*spec_idx) == Kidint_Intrinsic ||
01586 ATP_INTRIN_ENUM(*spec_idx) == Kiqint_Intrinsic) {
01587 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
01588 }
01589
01590 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01591
01592 conform_check(0,
01593 ir_idx,
01594 res_exp_desc,
01595 spec_idx,
01596 FALSE);
01597
01598 if (arg_info_list[info_idx1].ed.type == Real) {
01599 COPY_OPND(opnd, IL_OPND(list_idx1));
01600 look_for_real_div(&opnd);
01601 COPY_OPND(IL_OPND(list_idx1), opnd);
01602 }
01603
01604 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01605 IR_RANK(ir_idx) = res_exp_desc->rank;
01606 res_exp_desc->type_idx = type_idx;
01607 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
01608
01609 #ifdef KEY
01610 if (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const) {
01611 typeless_to_type(list_idx1, type_idx);
01612 COPY_OPND(*result_opnd, IL_OPND(list_idx1));
01613 res_exp_desc->constant = TRUE;
01614 res_exp_desc->foldable = TRUE;
01615 }
01616 else
01617 #endif
01618
01619 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
01620 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
01621 arg_info_list[info_idx1].ed.type_idx,
01622 NULL,
01623 NULL_IDX,
01624 folded_const,
01625 &type_idx,
01626 IR_LINE_NUM(ir_idx),
01627 IR_COL_NUM(ir_idx),
01628 1,
01629 Int_Opr)) {
01630
01631 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
01632 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
01633 FALSE,
01634 folded_const);
01635 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
01636 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
01637 res_exp_desc->constant = TRUE;
01638 res_exp_desc->foldable = TRUE;
01639 }
01640 else {
01641 IR_OPR(ir_idx) = Int_Opr;
01642 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01643 IR_OPND_R(ir_idx) = null_opnd;
01644 IR_LIST_CNT_L(ir_idx) = 1;
01645 IL_NEXT_LIST_IDX(IR_IDX_L(ir_idx)) = NULL_IDX;
01646 }
01647
01648 TRACE (Func_Exit, "int_intrinsic", NULL);
01649
01650 }
01651
01652
01653
01654
01655
01656
01657
01658
01659
01660
01661
01662
01663
01664
01665
01666
01667
01668
01669
01670
01671
01672
01673
01674
01675
01676
01677
01678
01679
01680
01681
01682
01683
01684
01685 void iand_intrinsic(opnd_type *result_opnd,
01686 expr_arg_type *res_exp_desc,
01687 int *spec_idx)
01688 {
01689 opnd_type opnd;
01690 int cn_idx;
01691 int cn_idx2;
01692 int typeless_idx;
01693 int minus_idx;
01694 int column;
01695 int info_idx1;
01696 int info_idx2;
01697 int line;
01698 int list_idx1;
01699 int list_idx2;
01700 long num;
01701 int shiftl_idx;
01702 int shiftr_idx;
01703 int first_idx;
01704 int second_idx;
01705 int not_idx;
01706 int ir_idx;
01707 boolean ok = TRUE;
01708 #ifdef KEY
01709 operator_type opr = Null_Opr;
01710 #else
01711 operator_type opr;
01712 #endif
01713 int type_idx;
01714
01715
01716 TRACE (Func_Entry, "iand_intrinsic", NULL);
01717
01718 ir_idx = OPND_IDX((*result_opnd));
01719
01720 list_idx1 = IR_IDX_R(ir_idx);
01721 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
01722 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01723 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
01724
01725 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
01726 (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const ||
01727 arg_info_list[info_idx1].ed.linear_type == Short_Char_Const)) {
01728
01729 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
01730 &line,
01731 &column);
01732
01733 if (arg_info_list[info_idx1].ed.type == Character) {
01734 PRINTMSG(line, 161, Ansi, column);
01735 }
01736
01737 type_idx = arg_info_list[info_idx2].ed.type_idx;
01738
01739 if (arg_info_list[info_idx2].ed.type == Character ||
01740 arg_info_list[info_idx2].ed.type == Typeless) {
01741 type_idx = INTEGER_DEFAULT_TYPE;
01742 }
01743
01744 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
01745 type_idx,
01746 line,
01747 column);
01748
01749 arg_info_list[info_idx1].ed.type_idx = type_idx;
01750 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
01751 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
01752 }
01753
01754 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
01755 (arg_info_list[info_idx2].ed.linear_type == Short_Typeless_Const ||
01756 arg_info_list[info_idx2].ed.linear_type == Short_Char_Const)) {
01757
01758 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx2),
01759 &line,
01760 &column);
01761
01762 if (arg_info_list[info_idx2].ed.type == Character) {
01763 PRINTMSG(line, 161, Ansi, column);
01764 }
01765
01766 type_idx = arg_info_list[info_idx1].ed.type_idx;
01767
01768 if (arg_info_list[info_idx1].ed.type == Character ||
01769 arg_info_list[info_idx1].ed.type == Typeless) {
01770 type_idx = INTEGER_DEFAULT_TYPE;
01771 }
01772
01773 IL_IDX(list_idx2) = cast_typeless_constant(IL_IDX(list_idx2),
01774 type_idx,
01775 line,
01776 column);
01777
01778 arg_info_list[info_idx2].ed.type_idx = type_idx;
01779 arg_info_list[info_idx2].ed.type = TYP_TYPE(type_idx);
01780 arg_info_list[info_idx2].ed.linear_type = TYP_LINEAR(type_idx);
01781 }
01782
01783
01784 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
01785 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
01786 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
01787 if (arg_info_list[info_idx1].ed.type == Integer) {
01788 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
01789 arg_info_list[info_idx1].ed.linear_type;
01790 }
01791 # endif
01792
01793 # ifdef _TARGET32
01794 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
01795 arg_info_list[info_idx1].ed.linear_type == Typeless_8 ||
01796 arg_info_list[info_idx1].ed.linear_type == Real_8) {
01797 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
01798 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
01799 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
01800 # endif
01801 }
01802 # endif
01803
01804 # ifdef _TARGET_OS_MAX
01805 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
01806 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
01807 arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
01808 arg_info_list[info_idx1].ed.linear_type == Typeless_4 ||
01809 arg_info_list[info_idx1].ed.linear_type == Real_4) {
01810 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_4;
01811 }
01812 # endif
01813
01814
01815 if (ATP_INTRIN_ENUM(*spec_idx) == Iand_Intrinsic ||
01816 ATP_INTRIN_ENUM(*spec_idx) == Iiand_Intrinsic ||
01817 ATP_INTRIN_ENUM(*spec_idx) == Jiand_Intrinsic ||
01818 ATP_INTRIN_ENUM(*spec_idx) == Kiand_Intrinsic ||
01819 ATP_INTRIN_ENUM(*spec_idx) == Ior_Intrinsic ||
01820 ATP_INTRIN_ENUM(*spec_idx) == Iior_Intrinsic ||
01821 ATP_INTRIN_ENUM(*spec_idx) == Jior_Intrinsic ||
01822 ATP_INTRIN_ENUM(*spec_idx) == Kior_Intrinsic ||
01823 ATP_INTRIN_ENUM(*spec_idx) == Ieor_Intrinsic ||
01824 ATP_INTRIN_ENUM(*spec_idx) == Iieor_Intrinsic ||
01825 ATP_INTRIN_ENUM(*spec_idx) == Jieor_Intrinsic ||
01826 ATP_INTRIN_ENUM(*spec_idx) == Kieor_Intrinsic) {
01827 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
01828 arg_info_list[info_idx1].ed.type_idx;
01829
01830 if (arg_info_list[info_idx1].ed.type == Typeless ||
01831 arg_info_list[info_idx2].ed.type == Typeless) {
01832 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
01833 arg_info_list[info_idx1].col);
01834
01835 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
01836 }
01837
01838 # ifdef _TARGET32
01839 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
01840 arg_info_list[info_idx1].ed.linear_type == Typeless_8) {
01841 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
01842 }
01843 # endif
01844
01845 if (arg_info_list[info_idx1].ed.linear_type !=
01846 arg_info_list[info_idx2].ed.linear_type) {
01847 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
01848 arg_info_list[info_idx2].col);
01849 ok = FALSE;
01850 }
01851 }
01852
01853
01854
01855 switch (ATP_INTRIN_ENUM(*spec_idx)) {
01856 case Iand_Intrinsic:
01857 case Iiand_Intrinsic:
01858 case Jiand_Intrinsic:
01859 case Kiand_Intrinsic:
01860 opr = Band_Opr;
01861 break;
01862
01863 case Ior_Intrinsic:
01864 case Iior_Intrinsic:
01865 case Jior_Intrinsic:
01866 case Kior_Intrinsic:
01867 opr = Bor_Opr;
01868 break;
01869
01870 case Ieor_Intrinsic:
01871 case Iieor_Intrinsic:
01872 case Jieor_Intrinsic:
01873 case Kieor_Intrinsic:
01874 opr = Bneqv_Opr;
01875 break;
01876
01877 case And_Intrinsic:
01878 opr = Band_Opr;
01879 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01880 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01881 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01882 IR_COL_NUM(ir_idx));
01883 ok = FALSE;
01884 }
01885 else if (arg_info_list[info_idx1].ed.type == Logical &&
01886 arg_info_list[info_idx2].ed.type == Logical) {
01887 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01888 opr = And_Opr;
01889
01890 }
01891 break;
01892
01893 case Or_Intrinsic:
01894 opr = Bor_Opr;
01895 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01896 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01897 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01898 IR_COL_NUM(ir_idx));
01899 ok = FALSE;
01900 }
01901 else if (arg_info_list[info_idx1].ed.type == Logical &&
01902 arg_info_list[info_idx2].ed.type == Logical) {
01903 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01904 opr = Or_Opr;
01905 }
01906 break;
01907
01908 case Xor_Intrinsic:
01909 opr = Bneqv_Opr;
01910 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01911 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01912 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01913 IR_COL_NUM(ir_idx));
01914 ok = FALSE;
01915 }
01916 #ifdef KEY
01917 #else
01918
01919
01920
01921
01922
01923
01924 else if (arg_info_list[info_idx1].ed.type == Logical &&
01925 arg_info_list[info_idx2].ed.type == Logical) {
01926 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01927 opr = Neqv_Opr;
01928 }
01929 #endif
01930 break;
01931
01932 case Neqv_Intrinsic:
01933 opr = Bneqv_Opr;
01934 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01935 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01936 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01937 IR_COL_NUM(ir_idx));
01938 ok = FALSE;
01939 }
01940 else if (arg_info_list[info_idx1].ed.type == Logical &&
01941 arg_info_list[info_idx2].ed.type == Logical) {
01942 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01943 opr = Neqv_Opr;
01944 }
01945 break;
01946
01947 case Eqv_Intrinsic:
01948 opr = Beqv_Opr;
01949 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01950 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01951 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01952 IR_COL_NUM(ir_idx));
01953 ok = FALSE;
01954 }
01955 else if (arg_info_list[info_idx1].ed.type == Logical &&
01956 arg_info_list[info_idx2].ed.type == Logical) {
01957 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01958 opr = Eqv_Opr;
01959 }
01960 break;
01961
01962 default:
01963 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal, IR_COL_NUM(ir_idx),
01964 "iand_intrinsic");
01965 break;
01966 }
01967
01968 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01969
01970 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8 ||
01971 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Typeless_8) {
01972 typeless_idx = Typeless_8;
01973 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
01974 typeless_idx = Integer_8;
01975 # endif
01976 }
01977 else {
01978 typeless_idx = TYPELESS_DEFAULT_TYPE;
01979 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
01980 typeless_idx = INTEGER_DEFAULT_TYPE;
01981 if (arg_info_list[info_idx1].ed.type == Integer) {
01982 typeless_idx = arg_info_list[info_idx1].ed.linear_type;
01983 }
01984 # endif
01985 }
01986
01987 # ifdef _TARGET_OS_MAX
01988 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
01989 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
01990 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Typeless_4 ||
01991 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
01992 typeless_idx = Typeless_4;
01993 }
01994 # endif
01995
01996 conform_check(0,
01997 ir_idx,
01998 res_exp_desc,
01999 spec_idx,
02000 FALSE);
02001
02002 IR_TYPE_IDX(ir_idx) = type_idx;
02003 IR_RANK(ir_idx) = res_exp_desc->rank;
02004 res_exp_desc->type_idx = type_idx;
02005 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02006
02007 if (opr == And_Opr ||
02008 opr == Or_Opr ||
02009 opr == Eqv_Opr ||
02010 opr == Neqv_Opr) {
02011 IR_OPR(ir_idx) = opr;
02012 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02013 IR_OPND_R(ir_idx) = null_opnd;
02014 }
02015 else {
02016
02017
02018 line = IR_LINE_NUM(ir_idx);
02019 column = IR_COL_NUM(ir_idx);
02020
02021 not_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
02022 opr, typeless_idx, line, column,
02023 IL_FLD(list_idx2), IL_IDX(list_idx2));
02024
02025 num=storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
02026
02027 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
02028
02029 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
02030 case Integer_1:
02031 num = BITSIZE_INT1_F90;
02032 break;
02033
02034 case Integer_2:
02035 num = BITSIZE_INT2_F90;
02036 break;
02037
02038 case Integer_4:
02039 case Typeless_4:
02040 num = BITSIZE_INT4_F90;
02041 break;
02042
02043 case Integer_8:
02044 case Typeless_8:
02045 num = BITSIZE_INT8_F90;
02046 break;
02047 }
02048
02049 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
02050
02051 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
02052 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
02053 CN_Tbl_Idx, cn_idx2);
02054
02055
02056 NTR_IR_LIST_TBL(first_idx);
02057 IL_FLD(first_idx) = IR_Tbl_Idx;
02058 IL_IDX(first_idx) = not_idx;
02059 NTR_IR_LIST_TBL(second_idx);
02060 IL_FLD(second_idx) = IR_Tbl_Idx;
02061 IL_IDX(second_idx) = minus_idx;
02062 IL_NEXT_LIST_IDX(first_idx) = second_idx;
02063
02064 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
02065 Shiftl_Opr, typeless_idx, line, column,
02066 NO_Tbl_Idx, NULL_IDX);
02067
02068 NTR_IR_LIST_TBL(first_idx);
02069 IL_FLD(first_idx) = IR_Tbl_Idx;
02070 IL_IDX(first_idx) = shiftl_idx;
02071 NTR_IR_LIST_TBL(second_idx);
02072 IL_FLD(second_idx) = IR_Tbl_Idx;
02073 IL_IDX(second_idx) = minus_idx;
02074 IL_NEXT_LIST_IDX(first_idx) = second_idx;
02075
02076 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
02077 Shiftr_Opr, typeless_idx, line, column,
02078 NO_Tbl_Idx, NULL_IDX);
02079
02080 if (TYP_TYPE(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer) {
02081 IR_OPR(shiftr_idx) = Shifta_Opr;
02082 }
02083
02084 IR_OPR(ir_idx) = Cvrt_Opr;
02085 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02086 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
02087 IR_IDX_L(ir_idx) = shiftr_idx;
02088 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
02089 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
02090 IR_FLD_R(ir_idx) = NO_Tbl_Idx;
02091 IR_IDX_R(ir_idx) = NULL_IDX;
02092
02093 if (ok &&
02094 IL_FLD(list_idx1) == CN_Tbl_Idx &&
02095 IL_FLD(list_idx2) == CN_Tbl_Idx) {
02096 COPY_OPND(opnd, (*result_opnd));
02097 ok = fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
02098 COPY_OPND((*result_opnd), opnd);
02099 }
02100
02101 }
02102
02103 TRACE (Func_Exit, "iand_intrinsic", NULL);
02104
02105 }
02106
02107
02108
02109
02110
02111
02112
02113
02114
02115
02116
02117
02118
02119
02120
02121
02122
02123
02124 void mod_intrinsic(opnd_type *result_opnd,
02125 expr_arg_type *res_exp_desc,
02126 int *spec_idx)
02127 {
02128 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02129 int info_idx1;
02130 int info_idx2;
02131 int list_idx1;
02132 int list_idx2;
02133 int ir_idx;
02134 int type_idx;
02135
02136
02137 TRACE (Func_Entry, "mod_intrinsic", NULL);
02138
02139 ir_idx = OPND_IDX((*result_opnd));
02140
02141 list_idx1 = IR_IDX_R(ir_idx);
02142 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02143 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02144 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02145
02146 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
02147 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02148
02149 conform_check(0,
02150 ir_idx,
02151 res_exp_desc,
02152 spec_idx,
02153 FALSE);
02154
02155 IR_TYPE_IDX(ir_idx) = type_idx;
02156 IR_RANK(ir_idx) = res_exp_desc->rank;
02157 res_exp_desc->type_idx = type_idx;
02158 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02159
02160 if (arg_info_list[info_idx1].ed.linear_type !=
02161 arg_info_list[info_idx2].ed.linear_type) {
02162 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
02163 IR_COL_NUM(ir_idx));
02164 }
02165
02166 if (arg_info_list[info_idx1].ed.type == Integer &&
02167 IL_FLD(list_idx1) == CN_Tbl_Idx &&
02168 IL_FLD(list_idx2) == CN_Tbl_Idx &&
02169 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
02170 arg_info_list[info_idx1].ed.type_idx,
02171 (char *)&CN_CONST(IL_IDX(list_idx2)),
02172 arg_info_list[info_idx2].ed.type_idx,
02173 folded_const,
02174 &type_idx,
02175 IR_LINE_NUM(ir_idx),
02176 IR_COL_NUM(ir_idx),
02177 2,
02178 Mod_Opr)) {
02179 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
02180 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
02181 FALSE,
02182 folded_const);
02183 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
02184 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
02185 res_exp_desc->constant = TRUE;
02186 res_exp_desc->foldable = TRUE;
02187 }
02188 else {
02189 IR_OPR(ir_idx) = Mod_Opr;
02190 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02191 IR_OPND_R(ir_idx) = null_opnd;
02192
02193 if (arg_info_list[info_idx1].ed.type != Integer) {
02194
02195
02196
02197 res_exp_desc->foldable = FALSE;
02198 res_exp_desc->will_fold_later = FALSE;
02199 }
02200 }
02201
02202 TRACE (Func_Exit, "mod_intrinsic", NULL);
02203
02204 }
02205
02206
02207
02208
02209
02210
02211
02212
02213
02214
02215
02216
02217
02218
02219
02220
02221
02222
02223 void free_intrinsic(opnd_type *result_opnd,
02224 expr_arg_type *res_exp_desc,
02225 int *spec_idx)
02226 {
02227 int ir_idx;
02228
02229
02230 TRACE (Func_Entry, "free_intrinsic", NULL);
02231
02232 ir_idx = OPND_IDX((*result_opnd));
02233
02234 conform_check(0,
02235 ir_idx,
02236 res_exp_desc,
02237 spec_idx,
02238 FALSE);
02239
02240 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
02241 IR_RANK(ir_idx) = res_exp_desc->rank;
02242
02243 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
02244 IR_OPR(ir_idx) = Free_Opr;
02245 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02246 IR_OPND_R(ir_idx) = null_opnd;
02247 }
02248
02249
02250
02251
02252 res_exp_desc->foldable = FALSE;
02253 res_exp_desc->will_fold_later = FALSE;
02254
02255 TRACE (Func_Exit, "free_intrinsic", NULL);
02256
02257 }
02258
02259
02260
02261
02262
02263
02264
02265
02266
02267
02268
02269
02270
02271
02272
02273
02274
02275 void malloc_intrinsic(opnd_type *result_opnd,
02276 expr_arg_type *res_exp_desc,
02277 int *spec_idx)
02278 {
02279 int ir_idx;
02280
02281
02282 TRACE (Func_Entry, "malloc_intrinsic", NULL);
02283
02284 ir_idx = OPND_IDX((*result_opnd));
02285
02286 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ptr_8;
02287
02288 conform_check(0,
02289 ir_idx,
02290 res_exp_desc,
02291 spec_idx,
02292 FALSE);
02293
02294 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02295 IR_RANK(ir_idx) = res_exp_desc->rank;
02296 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02297 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
02298
02299 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
02300 IR_OPR(ir_idx) = Malloc_Opr;
02301 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02302 IR_OPND_R(ir_idx) = null_opnd;
02303 }
02304
02305
02306
02307
02308 res_exp_desc->foldable = FALSE;
02309 res_exp_desc->will_fold_later = FALSE;
02310
02311 TRACE (Func_Exit, "malloc_intrinsic", NULL);
02312
02313 }
02314
02315
02316
02317
02318
02319
02320
02321
02322
02323
02324
02325
02326
02327
02328
02329
02330
02331
02332 void null_intrinsic(opnd_type *result_opnd,
02333 expr_arg_type *res_exp_desc,
02334 int *spec_idx)
02335 {
02336 int info_idx1;
02337 int ir_idx;
02338 int line;
02339 int col;
02340 int list_idx1;
02341 int tmp_dv_idx;
02342 int attr_idx;
02343 opnd_type dv_opnd;
02344
02345
02346 TRACE (Func_Entry, "null_intrinsic", NULL);
02347
02348 ir_idx = OPND_IDX((*result_opnd));
02349 list_idx1 = IR_IDX_R(ir_idx);
02350
02351 line = IR_LINE_NUM(ir_idx);
02352 col = IR_COL_NUM(ir_idx);
02353
02354 conform_check(0,
02355 ir_idx,
02356 res_exp_desc,
02357 spec_idx,
02358 FALSE);
02359
02360 if (list_idx1 == NULL_IDX || IL_IDX(list_idx1) == NULL_IDX) {
02361 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
02362 ATD_POINTER(ATP_RSLT_IDX(*spec_idx)) = TRUE;
02363 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02364 IR_RANK(ir_idx) = res_exp_desc->rank;
02365 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02366 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
02367 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
02368 res_exp_desc->pointer = TRUE;
02369
02370 IR_OPR(ir_idx) = Null_Intrinsic_Opr;
02371 IR_OPND_R(ir_idx) = null_opnd;
02372 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
02373 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
02374 IR_OPND_R(ir_idx) = null_opnd;
02375 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
02376 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
02377
02378 res_exp_desc->foldable = FALSE;
02379 res_exp_desc->will_fold_later = FALSE;
02380 }
02381 else {
02382 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02383
02384 if (TYP_TYPE(arg_info_list[info_idx1].ed.type_idx) == Character) {
02385 COPY_OPND((res_exp_desc->char_len),
02386 (arg_info_list[info_idx1].ed.char_len));
02387 }
02388
02389 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
02390
02391 if (IL_FLD(list_idx1) == CN_Tbl_Idx || !ATD_POINTER(attr_idx)) {
02392 PRINTMSG(arg_info_list[info_idx1].line, 1574, Error,
02393 arg_info_list[info_idx1].col);
02394 res_exp_desc->foldable = FALSE;
02395 res_exp_desc->will_fold_later = FALSE;
02396 }
02397
02398 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
02399 arg_info_list[info_idx1].ed.type_idx;
02400 ATD_POINTER(ATP_RSLT_IDX(*spec_idx)) = TRUE;
02401
02402 tmp_dv_idx = gen_compiler_tmp(line, col, Priv, TRUE);
02403 ATD_TYPE_IDX(tmp_dv_idx) = ATD_TYPE_IDX(attr_idx);
02404 ATD_STOR_BLK_IDX(tmp_dv_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
02405 AT_SEMANTICS_DONE(tmp_dv_idx) = TRUE;
02406 ATD_ARRAY_IDX(tmp_dv_idx) = ATD_ARRAY_IDX(attr_idx);
02407 ATD_POINTER(tmp_dv_idx) = TRUE;
02408 ATD_IM_A_DOPE(tmp_dv_idx) = TRUE;
02409
02410 gen_opnd(&dv_opnd, tmp_dv_idx, AT_Tbl_Idx, line, col);
02411 gen_dv_whole_def_init(&dv_opnd,
02412 tmp_dv_idx,
02413 Before);
02414
02415 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02416 IR_RANK(ir_idx) = res_exp_desc->rank;
02417 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02418 res_exp_desc->type =
02419 TYP_TYPE(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
02420 res_exp_desc->linear_type =
02421 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
02422 res_exp_desc->pointer = TRUE;
02423 res_exp_desc->tmp_reference = TRUE;
02424
02425 gen_opnd(&dv_opnd,
02426 gen_ir(AT_Tbl_Idx,
02427 tmp_dv_idx,
02428 Dv_Deref_Opr,
02429 res_exp_desc->type_idx,
02430 line,
02431 col,
02432 NO_Tbl_Idx,
02433 NULL_IDX),
02434 IR_Tbl_Idx,
02435 line,
02436 col);
02437
02438 if (res_exp_desc->rank > 0) {
02439 gen_whole_subscript(&dv_opnd, res_exp_desc);
02440 }
02441
02442 OPND_IDX((*result_opnd)) = OPND_IDX(dv_opnd);
02443 OPND_FLD((*result_opnd)) = OPND_FLD(dv_opnd);
02444 }
02445
02446 TRACE (Func_Exit, "null_intrinsic", NULL);
02447
02448 }
02449
02450
02451
02452
02453
02454
02455
02456
02457
02458
02459
02460
02461
02462
02463
02464
02465
02466
02467
02468 void anint_intrinsic(opnd_type *result_opnd,
02469 expr_arg_type *res_exp_desc,
02470 int *spec_idx)
02471 {
02472 int info_idx1;
02473 int info_idx2;
02474 int ir_idx;
02475 int list_idx1;
02476 int list_idx2;
02477
02478
02479 TRACE (Func_Entry, "anint_intrinsic", NULL);
02480
02481 ir_idx = OPND_IDX((*result_opnd));
02482 list_idx1 = IR_IDX_R(ir_idx);
02483 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02484 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02485
02486 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
02487 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02488 kind_to_linear_type(&((IL_OPND(list_idx2))),
02489 ATP_RSLT_IDX(*spec_idx),
02490 arg_info_list[info_idx2].ed.kind0seen,
02491 arg_info_list[info_idx2].ed.kind0E0seen,
02492 arg_info_list[info_idx2].ed.kind0D0seen,
02493 ! arg_info_list[info_idx2].ed.kindnotconst);
02494 }
02495 else {
02496 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
02497 arg_info_list[info_idx1].ed.type_idx;
02498 }
02499
02500 conform_check(0,
02501 ir_idx,
02502 res_exp_desc,
02503 spec_idx,
02504 FALSE);
02505
02506 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02507 IR_RANK(ir_idx) = res_exp_desc->rank;
02508 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02509 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
02510
02511 IR_OPR(ir_idx) = Anint_Opr;
02512 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02513 IR_OPND_R(ir_idx) = null_opnd;
02514 IR_LIST_CNT_L(ir_idx) = 1;
02515 IL_NEXT_LIST_IDX(IR_IDX_L(ir_idx)) = NULL_IDX;
02516
02517
02518
02519
02520 res_exp_desc->foldable = FALSE;
02521 res_exp_desc->will_fold_later = FALSE;
02522
02523 TRACE (Func_Exit, "anint_intrinsic", NULL);
02524
02525 }
02526
02527
02528
02529
02530
02531
02532
02533
02534
02535
02536
02537
02538
02539
02540
02541
02542
02543
02544
02545
02546
02547 void nint_intrinsic(opnd_type *result_opnd,
02548 expr_arg_type *res_exp_desc,
02549 int *spec_idx)
02550 {
02551 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02552 int info_idx1;
02553 int info_idx2;
02554 int ir_idx;
02555 int list_idx1;
02556 int list_idx2;
02557 int type_idx;
02558
02559
02560 TRACE (Func_Entry, "nint_intrinsic", NULL);
02561
02562 ir_idx = OPND_IDX((*result_opnd));
02563 list_idx1 = IR_IDX_R(ir_idx);
02564 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02565 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02566
02567 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
02568 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02569 kind_to_linear_type(&((IL_OPND(list_idx2))),
02570 ATP_RSLT_IDX(*spec_idx),
02571 arg_info_list[info_idx2].ed.kind0seen,
02572 arg_info_list[info_idx2].ed.kind0E0seen,
02573 arg_info_list[info_idx2].ed.kind0D0seen,
02574 ! arg_info_list[info_idx2].ed.kindnotconst);
02575 }
02576 else {
02577 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
02578 }
02579
02580 if (ATP_INTRIN_ENUM(*spec_idx) == Inint_Intrinsic) {
02581 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_2;
02582 }
02583 else if (ATP_INTRIN_ENUM(*spec_idx) == Jnint_Intrinsic) {
02584 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_4;
02585 }
02586 else if (ATP_INTRIN_ENUM(*spec_idx) == Knint_Intrinsic) {
02587 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
02588 }
02589
02590 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02591
02592 conform_check(0,
02593 ir_idx,
02594 res_exp_desc,
02595 spec_idx,
02596 FALSE);
02597
02598 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02599 IR_RANK(ir_idx) = res_exp_desc->rank;
02600 res_exp_desc->type_idx = type_idx;
02601 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02602
02603 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
02604 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
02605 arg_info_list[info_idx1].ed.type_idx,
02606 NULL,
02607 NULL_IDX,
02608 folded_const,
02609 &type_idx,
02610 IR_LINE_NUM(ir_idx),
02611 IR_COL_NUM(ir_idx),
02612 1,
02613 Nint_Opr)) {
02614
02615 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
02616 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
02617 FALSE,
02618 folded_const);
02619 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
02620 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
02621 res_exp_desc->constant = TRUE;
02622 res_exp_desc->foldable = TRUE;
02623 }
02624 else {
02625 IR_OPR(ir_idx) = Nint_Opr;
02626 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02627 IR_OPND_R(ir_idx) = null_opnd;
02628 IR_LIST_CNT_L(ir_idx) = 1;
02629 IL_NEXT_LIST_IDX(IR_IDX_L(ir_idx)) = NULL_IDX;
02630 }
02631
02632 TRACE (Func_Exit, "nint_intrinsic", NULL);
02633
02634 }
02635
02636
02637
02638
02639
02640
02641
02642
02643
02644
02645
02646
02647
02648
02649
02650
02651
02652
02653
02654
02655
02656
02657
02658
02659 void sign_intrinsic(opnd_type *result_opnd,
02660 expr_arg_type *res_exp_desc,
02661 int *spec_idx)
02662 {
02663 int list_idx1;
02664 int list_idx2;
02665 int info_idx1;
02666 int info_idx2;
02667 int ir_idx;
02668 int type_idx;
02669 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02670
02671
02672 TRACE (Func_Entry, "sign_intrinsic", NULL);
02673
02674 ir_idx = OPND_IDX((*result_opnd));
02675 list_idx1 = IR_IDX_R(ir_idx);
02676 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02677 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02678 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02679
02680 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
02681 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02682
02683 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
02684 if (arg_info_list[info_idx1].ed.linear_type == Real_16) {
02685 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
02686 }
02687 else {
02688 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
02689 }
02690 # endif
02691
02692 conform_check(0,
02693 ir_idx,
02694 res_exp_desc,
02695 spec_idx,
02696 FALSE);
02697
02698 IR_TYPE_IDX(ir_idx) = type_idx;
02699 IR_RANK(ir_idx) = res_exp_desc->rank;
02700 res_exp_desc->type_idx = type_idx;
02701 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02702
02703 if (arg_info_list[info_idx1].ed.linear_type !=
02704 arg_info_list[info_idx2].ed.linear_type) {
02705 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
02706 IR_COL_NUM(ir_idx));
02707 }
02708
02709 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
02710 if (arg_info_list[info_idx1].ed.type == Integer &&
02711 IL_FLD(list_idx1) == CN_Tbl_Idx &&
02712 IL_FLD(list_idx2) == CN_Tbl_Idx &&
02713 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
02714 arg_info_list[info_idx1].ed.type_idx,
02715 (char *)&CN_CONST(IL_IDX(list_idx2)),
02716 arg_info_list[info_idx2].ed.type_idx,
02717 folded_const,
02718 &type_idx,
02719 IR_LINE_NUM(ir_idx),
02720 IR_COL_NUM(ir_idx),
02721 2,
02722 Sign_Opr)) {
02723
02724 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
02725 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
02726 FALSE,
02727 folded_const);
02728 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
02729 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
02730 res_exp_desc->constant = TRUE;
02731 res_exp_desc->foldable = TRUE;
02732 }
02733 else {
02734 IR_OPR(ir_idx) = Sign_Opr;
02735 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
02736 if (on_off_flags.recognize_minus_zero &&
02737 arg_info_list[info_idx1].ed.type == Real) {
02738 IR_OPR(ir_idx) = Ieee_Copy_Sign_Opr;
02739 }
02740 # endif
02741 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02742 IR_OPND_R(ir_idx) = null_opnd;
02743
02744 if (arg_info_list[info_idx1].ed.type != Integer) {
02745
02746
02747
02748 res_exp_desc->foldable = FALSE;
02749 res_exp_desc->will_fold_later = FALSE;
02750 }
02751 }
02752 }
02753 else {
02754
02755
02756
02757 res_exp_desc->foldable = FALSE;
02758 res_exp_desc->will_fold_later = FALSE;
02759 }
02760
02761 TRACE (Func_Exit, "sign_intrinsic", NULL);
02762
02763 }
02764
02765
02766
02767
02768
02769
02770
02771
02772
02773
02774
02775
02776
02777
02778
02779
02780
02781
02782 void modulo_intrinsic(opnd_type *result_opnd,
02783 expr_arg_type *res_exp_desc,
02784 int *spec_idx)
02785 {
02786 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02787 int ir_idx;
02788 int info_idx1;
02789 int info_idx2;
02790 int list_idx1;
02791 int list_idx2;
02792 int type_idx;
02793
02794
02795 TRACE (Func_Entry, "modulo_intrinsic", NULL);
02796
02797 ir_idx = OPND_IDX((*result_opnd));
02798 list_idx1 = IR_IDX_R(ir_idx);
02799 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02800 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02801 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02802
02803 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
02804 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02805
02806 conform_check(0,
02807 ir_idx,
02808 res_exp_desc,
02809 spec_idx,
02810 FALSE);
02811
02812 IR_TYPE_IDX(ir_idx) = type_idx;
02813 IR_RANK(ir_idx) = res_exp_desc->rank;
02814 res_exp_desc->type_idx = type_idx;
02815 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02816
02817 if (arg_info_list[info_idx1].ed.linear_type !=
02818 arg_info_list[info_idx2].ed.linear_type) {
02819 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
02820 IR_COL_NUM(ir_idx));
02821 }
02822
02823 if (arg_info_list[info_idx1].ed.type == Integer &&
02824 IL_FLD(list_idx1) == CN_Tbl_Idx &&
02825 IL_FLD(list_idx2) == CN_Tbl_Idx &&
02826 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
02827 arg_info_list[info_idx1].ed.type_idx,
02828 (char *)&CN_CONST(IL_IDX(list_idx2)),
02829 arg_info_list[info_idx2].ed.type_idx,
02830 folded_const,
02831 &type_idx,
02832 IR_LINE_NUM(ir_idx),
02833 IR_COL_NUM(ir_idx),
02834 2,
02835 Modulo_Opr)) {
02836 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
02837 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
02838 FALSE,
02839 folded_const);
02840 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
02841 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
02842 res_exp_desc->constant = TRUE;
02843 res_exp_desc->foldable = TRUE;
02844 }
02845 else {
02846 IR_OPR(ir_idx) = Modulo_Opr;
02847 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02848 IR_OPND_R(ir_idx) = null_opnd;
02849
02850 if (arg_info_list[info_idx1].ed.type != Integer) {
02851
02852
02853
02854 res_exp_desc->foldable = FALSE;
02855 res_exp_desc->will_fold_later = FALSE;
02856 }
02857 }
02858
02859 TRACE (Func_Exit, "modulo_intrinsic", NULL);
02860
02861 }
02862
02863
02864
02865
02866
02867
02868
02869
02870
02871
02872
02873
02874
02875
02876
02877
02878
02879
02880
02881
02882
02883
02884
02885 void shift_intrinsic(opnd_type *result_opnd,
02886 expr_arg_type *res_exp_desc,
02887 int *spec_idx)
02888 {
02889 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02890 int list_idx1;
02891 int list_idx2;
02892 #ifdef KEY
02893 long num = 0;
02894 #else
02895 long num;
02896 #endif
02897 int info_idx1;
02898 int info_idx2;
02899 int ir_idx;
02900 #ifdef KEY
02901 operator_type opr = Null_Opr;
02902 #else
02903 operator_type opr;
02904 #endif
02905 int type_idx;
02906 int cn_idx;
02907 int line;
02908 int column;
02909
02910
02911 TRACE (Func_Entry, "shift_intrinsic", NULL);
02912
02913 ir_idx = OPND_IDX((*result_opnd));
02914 list_idx1 = IR_IDX_R(ir_idx);
02915 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02916 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02917 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02918
02919 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
02920 (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const ||
02921 arg_info_list[info_idx1].ed.linear_type == Short_Char_Const)) {
02922
02923 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
02924 &line,
02925 &column);
02926
02927 if (arg_info_list[info_idx1].ed.type == Character) {
02928 PRINTMSG(line, 161, Ansi, column);
02929 }
02930
02931 type_idx = INTEGER_DEFAULT_TYPE;
02932
02933 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
02934 type_idx,
02935 line,
02936 column);
02937
02938 arg_info_list[info_idx1].ed.type_idx = type_idx;
02939 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
02940 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
02941 }
02942
02943
02944 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
02945 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
02946 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
02947 if (arg_info_list[info_idx1].ed.type == Integer) {
02948 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
02949 arg_info_list[info_idx1].ed.linear_type;
02950 }
02951 # endif
02952
02953
02954 # ifdef _TARGET32
02955 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
02956 arg_info_list[info_idx1].ed.linear_type == Typeless_8 ||
02957 arg_info_list[info_idx1].ed.linear_type == Real_8) {
02958 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
02959 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
02960 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
02961 # endif
02962 }
02963 # endif
02964
02965
02966 # ifdef _TARGET_OS_MAX
02967 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
02968 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
02969 arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
02970 arg_info_list[info_idx1].ed.linear_type == Typeless_4 ||
02971 arg_info_list[info_idx1].ed.linear_type == Real_4) {
02972 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_4;
02973 }
02974 # endif
02975
02976 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02977
02978 switch (ATP_INTRIN_ENUM(*spec_idx)) {
02979 case Shift_Intrinsic:
02980 opr = Shift_Opr;
02981 break;
02982
02983 case Shifta_Intrinsic:
02984 opr = Shifta_Opr;
02985 break;
02986
02987 case Lshift_Intrinsic:
02988 case Shiftl_Intrinsic:
02989 opr = Shiftl_Opr;
02990 break;
02991
02992 case Rshift_Intrinsic:
02993 case Shiftr_Intrinsic:
02994 opr = Shiftr_Opr;
02995 break;
02996
02997 default:
02998 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal,
02999 IR_COL_NUM(ir_idx),
03000 "shift_intrinsic");
03001 break;
03002 }
03003
03004 conform_check(0,
03005 ir_idx,
03006 res_exp_desc,
03007 spec_idx,
03008 FALSE);
03009
03010 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
03011 case Integer_1:
03012 case Typeless_1:
03013 num = BITSIZE_INT1_F90;
03014 break;
03015
03016 case Integer_2:
03017 case Typeless_2:
03018 num = BITSIZE_INT2_F90;
03019 break;
03020
03021 case Integer_4:
03022 case Typeless_4:
03023 case Real_4:
03024 num = BITSIZE_INT4_F90;
03025 break;
03026
03027 case Integer_8:
03028 case Typeless_8:
03029 case Real_8:
03030 num = BITSIZE_INT8_F90;
03031 break;
03032
03033 default:
03034 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal,
03035 IR_COL_NUM(ir_idx),
03036 "shift_intrinsic");
03037 break;
03038 }
03039
03040 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
03041 if (compare_cn_and_value(IL_IDX(list_idx2), num, Gt_Opr) ||
03042 compare_cn_and_value(IL_IDX(list_idx2), 0, Lt_Opr)) {
03043 PRINTMSG(arg_info_list[info_idx2].line, 1062, Error,
03044 arg_info_list[info_idx2].col);
03045 }
03046 }
03047
03048 IR_RANK(ir_idx) = res_exp_desc->rank;
03049 IR_TYPE_IDX(ir_idx) = type_idx;
03050 res_exp_desc->type_idx = type_idx;
03051 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
03052
03053 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
03054 IL_FLD(list_idx2) == CN_Tbl_Idx &&
03055 arg_info_list[info_idx1].ed.type != Real) {
03056
03057 if (opr == Shifta_Opr) {
03058 if (CN_INT_TO_C(IL_IDX(list_idx2)) == 8 &&
03059 (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
03060 (arg_info_list[info_idx1].ed.type == Typeless &&
03061 TYP_BIT_LEN(arg_info_list[info_idx1].ed.type_idx) == 8) ||
03062 arg_info_list[info_idx1].ed.linear_type == Typeless_1)) {
03063
03064 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, 7);
03065 IL_IDX(list_idx2) = cn_idx;
03066 }
03067
03068 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == 16 &&
03069 (arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
03070 (arg_info_list[info_idx1].ed.type == Typeless &&
03071 TYP_BIT_LEN(arg_info_list[info_idx1].ed.type_idx) == 16) ||
03072 arg_info_list[info_idx1].ed.linear_type == Typeless_2)) {
03073
03074 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, 15);
03075
03076 IL_IDX(list_idx2) = cn_idx;
03077 }
03078
03079 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == 32 &&
03080 (arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
03081 (arg_info_list[info_idx1].ed.type == Typeless &&
03082 TYP_BIT_LEN(arg_info_list[info_idx1].ed.type_idx) == 32) ||
03083 arg_info_list[info_idx1].ed.linear_type == Typeless_4)) {
03084
03085 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, 31);
03086
03087 IL_IDX(list_idx2) = cn_idx;
03088 }
03089
03090 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == 64 &&
03091 (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
03092 (arg_info_list[info_idx1].ed.type == Typeless &&
03093 TYP_BIT_LEN(arg_info_list[info_idx1].ed.type_idx) == 64) ||
03094 arg_info_list[info_idx1].ed.linear_type == Typeless_8)) {
03095
03096 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, 63);
03097
03098 IL_IDX(list_idx2) = cn_idx;
03099 }
03100 }
03101
03102 if (folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
03103 arg_info_list[info_idx1].ed.type_idx,
03104 (char *)&CN_CONST(IL_IDX(list_idx2)),
03105 arg_info_list[info_idx2].ed.type_idx,
03106 folded_const,
03107 &type_idx,
03108 IR_LINE_NUM(ir_idx),
03109 IR_COL_NUM(ir_idx),
03110 2,
03111 opr)) {
03112
03113 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
03114 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
03115 FALSE,
03116 folded_const);
03117 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
03118 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
03119 res_exp_desc->constant = TRUE;
03120 res_exp_desc->foldable = TRUE;
03121 }
03122 }
03123 else {
03124 IR_OPR(ir_idx) = opr;
03125 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
03126 IR_OPND_R(ir_idx) = null_opnd;
03127
03128 if (arg_info_list[info_idx1].ed.type == Real) {
03129
03130
03131
03132 res_exp_desc->foldable = FALSE;
03133 res_exp_desc->will_fold_later = FALSE;
03134 }
03135 }
03136
03137 TRACE (Func_Exit, "shift_intrinsic", NULL);
03138
03139 }
03140
03141
03142
03143
03144
03145
03146
03147
03148
03149
03150
03151
03152
03153
03154
03155
03156
03157
03158
03159
03160
03161 void num_images_intrinsic(opnd_type *result_opnd,
03162 expr_arg_type *res_exp_desc,
03163 int *spec_idx)
03164 {
03165 int line;
03166 int column;
03167 int ir_idx;
03168 int cn_idx;
03169 int plus_idx;
03170 int power_idx;
03171 int div_idx;
03172 int info_idx1;
03173 int int_idx;
03174 int mod_idx;
03175 int list_idx1;
03176 int list_idx2;
03177 opnd_type opnd;
03178 int opnd_line;
03179 int opnd_col;
03180 int l_log10_idx;
03181 int r_log10_idx;
03182 float point_five;
03183 float f_two;
03184 int sn_idx;
03185 int attr_idx;
03186 expr_arg_type loc_exp_desc;
03187
03188
03189 TRACE (Func_Entry, "num_images_intrinsic", NULL);
03190
03191 ir_idx = OPND_IDX((*result_opnd));
03192 line = IR_LINE_NUM(ir_idx);
03193 column = IR_COL_NUM(ir_idx);
03194
03195 if (ATP_INTRIN_ENUM(*spec_idx) != Sync_Images_Intrinsic) {
03196 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
03197 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03198 }
03199 else {
03200 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
03201 }
03202
03203 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
03204
03205 conform_check(0,
03206 ir_idx,
03207 res_exp_desc,
03208 spec_idx,
03209 FALSE);
03210
03211 IR_RANK(ir_idx) = res_exp_desc->rank;
03212
03213 if (ATP_INTRIN_ENUM(*spec_idx) == Rem_Images_Intrinsic) {
03214 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
03215 point_five = 0.5;
03216
03217
03218
03219
03220
03221
03222 cn_idx = ntr_const_tbl(REAL_DEFAULT_TYPE, FALSE,(long_type *)&point_five);
03223 OPND_FLD(opnd) = IR_Tbl_Idx;
03224 OPND_IDX(opnd) = ir_idx;
03225 copy_subtree(&opnd, &opnd);
03226 plus_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
03227 Plus_Opr, REAL_DEFAULT_TYPE, line, column,
03228 CN_Tbl_Idx, cn_idx);
03229
03230 f_two = 2.0;
03231 cn_idx = ntr_const_tbl(REAL_DEFAULT_TYPE, FALSE, (long_type *)&f_two);
03232
03233 r_log10_idx = gen_ir(CN_Tbl_Idx, cn_idx,
03234 Log_10_Opr, REAL_DEFAULT_TYPE, line, column,
03235 NO_Tbl_Idx, NULL_IDX);
03236
03237 l_log10_idx = gen_ir(IR_Tbl_Idx, plus_idx,
03238 Log_10_Opr, REAL_DEFAULT_TYPE, line, column,
03239 NO_Tbl_Idx, NULL_IDX);
03240
03241
03242 div_idx = gen_ir(IR_Tbl_Idx, l_log10_idx,
03243 Div_Opr, REAL_DEFAULT_TYPE, line, column,
03244 IR_Tbl_Idx, r_log10_idx);
03245
03246 int_idx = gen_ir(IR_Tbl_Idx, div_idx,
03247 Int_Opr, INTEGER_DEFAULT_TYPE, line, column,
03248 NO_Tbl_Idx, NULL_IDX);
03249
03250 cn_idx = CN_INTEGER_TWO_IDX;
03251
03252 power_idx = gen_ir(CN_Tbl_Idx, cn_idx,
03253 Power_Opr, INTEGER_DEFAULT_TYPE, line, column,
03254 IR_Tbl_Idx, int_idx);
03255
03256 OPND_FLD(opnd) = IR_Tbl_Idx;
03257 OPND_IDX(opnd) = ir_idx;
03258 copy_subtree(&opnd, &opnd);
03259 mod_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
03260 Mod_Opr, INTEGER_DEFAULT_TYPE, line, column,
03261 IR_Tbl_Idx, power_idx);
03262
03263 IR_IDX_L(ir_idx) = mod_idx;
03264 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03265 IR_OPND_R(ir_idx) = null_opnd;
03266 IR_OPR(ir_idx) = Int_Opr;
03267 }
03268 else if (ATP_INTRIN_ENUM(*spec_idx) == Log2_Images_Intrinsic) {
03269 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
03270 point_five = 0.5;
03271 cn_idx = ntr_const_tbl(REAL_DEFAULT_TYPE, FALSE,(long_type *)&point_five);
03272
03273 OPND_FLD(opnd) = IR_Tbl_Idx;
03274 OPND_IDX(opnd) = ir_idx;
03275 copy_subtree(&opnd, &opnd);
03276 plus_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
03277 Plus_Opr, REAL_DEFAULT_TYPE, line, column,
03278 CN_Tbl_Idx, cn_idx);
03279
03280 f_two = 2.0;
03281 cn_idx = ntr_const_tbl(REAL_DEFAULT_TYPE, FALSE, (long_type *)&f_two);
03282
03283 r_log10_idx = gen_ir(CN_Tbl_Idx, cn_idx,
03284 Log_10_Opr, REAL_DEFAULT_TYPE, line, column,
03285 NO_Tbl_Idx, NULL_IDX);
03286
03287 l_log10_idx = gen_ir(IR_Tbl_Idx, plus_idx,
03288 Log_10_Opr, REAL_DEFAULT_TYPE, line, column,
03289 NO_Tbl_Idx, NULL_IDX);
03290
03291 div_idx = gen_ir(IR_Tbl_Idx, l_log10_idx,
03292 Div_Opr, REAL_DEFAULT_TYPE, line, column,
03293 IR_Tbl_Idx, r_log10_idx);
03294
03295 IR_IDX_L(ir_idx) = div_idx;
03296 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03297 IR_OPND_R(ir_idx) = null_opnd;
03298 IR_OPR(ir_idx) = Int_Opr;
03299 }
03300 else if (ATP_INTRIN_ENUM(*spec_idx) == This_Image_Intrinsic) {
03301
03302 if (IR_LIST_CNT_R(ir_idx) > 0) {
03303
03304 list_idx1 = IR_IDX_R(ir_idx);
03305 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03306
03307 if (IR_LIST_CNT_R(ir_idx) == 2) {
03308 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
03309 }
03310
03311 if (arg_info_list[info_idx1].ed.reference) {
03312 attr_idx = find_base_attr(&IL_OPND(list_idx1),
03313 &opnd_line, &opnd_col);
03314
03315 if (AT_DCL_ERR(attr_idx)) {
03316 goto EXIT;
03317 }
03318
03319 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
03320 ATD_PE_ARRAY_IDX(attr_idx) != NULL_IDX &&
03321 IR_LIST_CNT_R(ir_idx) == 1 &&
03322 BD_RANK(ATD_PE_ARRAY_IDX(attr_idx)) == 1) {
03323
03324
03325
03326 sn_idx = ATI_FIRST_SPECIFIC_IDX(ATP_INTERFACE_IDX(*spec_idx));
03327
03328 while (sn_idx) {
03329 if (ATP_NUM_DARGS(SN_ATTR_IDX(sn_idx)) == 2) {
03330 break;
03331 }
03332 sn_idx = SN_SIBLING_LINK(sn_idx);
03333 }
03334
03335 if (sn_idx != NULL_IDX) {
03336 IR_IDX_L(ir_idx) = SN_ATTR_IDX(sn_idx);
03337 *spec_idx = SN_ATTR_IDX(sn_idx);
03338 ATP_EXTERNAL_INTRIN((*spec_idx)) = TRUE;
03339 ATD_TYPE_IDX(ATP_RSLT_IDX((*spec_idx))) =
03340 INTEGER_DEFAULT_TYPE;
03341
03342 NTR_IR_LIST_TBL(list_idx2);
03343 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
03344 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
03345 IR_LIST_CNT_R(ir_idx) += 1;
03346
03347 IL_FLD(list_idx2) = CN_Tbl_Idx;
03348 IL_IDX(list_idx2) = CN_INTEGER_ONE_IDX;
03349 IL_LINE_NUM(list_idx2) = line;
03350 IL_COL_NUM(list_idx2) = column;
03351
03352 arg_info_list_base = arg_info_list_top;
03353 arg_info_list_top = arg_info_list_base + 1;
03354
03355 if (arg_info_list_top >= arg_info_list_size) {
03356 enlarge_info_list_table();
03357 }
03358
03359 IL_ARG_DESC_IDX(list_idx2) = arg_info_list_top;
03360 arg_info_list[arg_info_list_top] = init_arg_info;
03361 arg_info_list[arg_info_list_top].ed.constant = TRUE;
03362 arg_info_list[arg_info_list_top].ed.foldable = TRUE;
03363 arg_info_list[arg_info_list_top].ed.type = Integer;
03364 arg_info_list[arg_info_list_top].ed.type_idx =
03365 CG_INTEGER_DEFAULT_TYPE;
03366 arg_info_list[arg_info_list_top].ed.linear_type =
03367 CG_INTEGER_DEFAULT_TYPE;
03368 arg_info_list[arg_info_list_top].line = line;
03369 arg_info_list[arg_info_list_top].col = column;
03370 }
03371 }
03372 }
03373
03374 if (! arg_info_list[info_idx1].ed.reference) {
03375
03376 find_opnd_line_and_column(&IL_OPND(list_idx1),
03377 &opnd_line, &opnd_col);
03378 PRINTMSG(opnd_line, 1575, Error, opnd_col);
03379 }
03380 else {
03381 attr_idx = find_base_attr(&IL_OPND(list_idx1),
03382 &opnd_line, &opnd_col);
03383
03384 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
03385 ATD_PE_ARRAY_IDX(attr_idx) == NULL_IDX) {
03386
03387 PRINTMSG(opnd_line, 1575, Error, opnd_col);
03388 }
03389 else {
03390
03391 if (ATD_ALLOCATABLE(attr_idx)) {
03392 attr_idx = ATD_VARIABLE_TMP_IDX(attr_idx);
03393 }
03394
03395 COPY_OPND(opnd, IL_OPND(list_idx1));
03396 generate_bounds_list(ATD_PE_ARRAY_IDX(attr_idx),
03397 &opnd,
03398 &loc_exp_desc);
03399 COPY_OPND(IL_OPND(list_idx1), opnd);
03400 arg_info_list[info_idx1].ed = loc_exp_desc;
03401
03402 }
03403 }
03404 }
03405 }
03406
03407 EXIT:
03408
03409
03410
03411
03412 res_exp_desc->foldable = FALSE;
03413 res_exp_desc->will_fold_later = FALSE;
03414
03415 TRACE (Func_Exit, "num_images_intrinsic", NULL);
03416
03417 }
03418
03419
03420
03421
03422
03423
03424
03425
03426
03427
03428
03429
03430
03431
03432
03433
03434
03435
03436
03437
03438 void leadz_intrinsic(opnd_type *result_opnd,
03439 expr_arg_type *res_exp_desc,
03440 int *spec_idx)
03441 {
03442 int ir_idx;
03443 int list_idx1;
03444 int info_idx1;
03445
03446
03447 TRACE (Func_Entry, "leadz_intrinsic", NULL);
03448
03449 ir_idx = OPND_IDX((*result_opnd));
03450 list_idx1 = IR_IDX_R(ir_idx);
03451 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03452
03453 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
03454
03455 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] > 64) {
03456 PRINTMSG(arg_info_list[info_idx1].line, 774, Error,
03457 arg_info_list[info_idx1].col);
03458 }
03459
03460 conform_check(0,
03461 ir_idx,
03462 res_exp_desc,
03463 spec_idx,
03464 FALSE);
03465
03466 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03467 IR_RANK(ir_idx) = res_exp_desc->rank;
03468
03469 if (ATP_INTRIN_ENUM(*spec_idx) == Popcnt_Intrinsic) {
03470 IR_OPR(ir_idx) = Popcnt_Opr;
03471 }
03472 else if (ATP_INTRIN_ENUM(*spec_idx) == Poppar_Intrinsic) {
03473 IR_OPR(ir_idx) = Poppar_Opr;
03474 }
03475 else {
03476 IR_OPR(ir_idx) = Leadz_Opr;
03477 }
03478
03479 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
03480 IR_OPND_R(ir_idx) = null_opnd;
03481
03482
03483
03484
03485 res_exp_desc->foldable = FALSE;
03486 res_exp_desc->will_fold_later = FALSE;
03487
03488 TRACE (Func_Exit, "leadz_intrinsic", NULL);
03489
03490 }
03491
03492
03493
03494
03495
03496
03497
03498
03499
03500
03501
03502
03503
03504
03505
03506
03507
03508
03509
03510
03511
03512
03513 void not_intrinsic(opnd_type *result_opnd,
03514 expr_arg_type *res_exp_desc,
03515 int *spec_idx)
03516 {
03517 opnd_type opnd;
03518 int info_idx1;
03519 int ir_idx;
03520 int list_idx1;
03521 long num;
03522 operator_type opr;
03523 int first_idx;
03524 int cn_idx;
03525 int cn_idx2;
03526 int typeless_idx;
03527 int second_idx;
03528 int minus_idx;
03529 int type_idx;
03530 int not_idx;
03531 int shiftl_idx;
03532 int shiftr_idx;
03533 int line;
03534 int column;
03535
03536
03537 TRACE (Func_Entry, "not_intrinsic", NULL);
03538
03539 ir_idx = OPND_IDX((*result_opnd));
03540 list_idx1 = IR_IDX_R(ir_idx);
03541 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03542
03543 if (arg_info_list[info_idx1].ed.type == Logical) {
03544 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
03545 opr = Not_Opr;
03546 }
03547 else {
03548 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
03549 (arg_info_list[info_idx1].ed.linear_type ==
03550 Short_Typeless_Const ||
03551 arg_info_list[info_idx1].ed.linear_type ==
03552 Short_Char_Const)) {
03553
03554 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
03555 &line,
03556 &column);
03557
03558 if (arg_info_list[info_idx1].ed.type == Character) {
03559 PRINTMSG(line, 161, Ansi, column);
03560 }
03561
03562 type_idx = INTEGER_DEFAULT_TYPE;
03563
03564 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
03565 type_idx,
03566 line,
03567 column);
03568
03569 arg_info_list[info_idx1].ed.type_idx = type_idx;
03570 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
03571 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
03572 }
03573
03574 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
03575 arg_info_list[info_idx1].ed.type_idx;
03576
03577 if (ATP_INTRIN_ENUM(*spec_idx) == Compl_Intrinsic) {
03578 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
03579 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
03580 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
03581 if (arg_info_list[info_idx1].ed.type == Integer) {
03582 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
03583 arg_info_list[info_idx1].ed.linear_type;
03584 }
03585 # endif
03586
03587
03588 # ifdef _TARGET32
03589 if ((arg_info_list[info_idx1].ed.linear_type == Integer_8) ||
03590 (arg_info_list[info_idx1].ed.linear_type == Typeless_8) ||
03591 (arg_info_list[info_idx1].ed.linear_type == Real_8)) {
03592 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
03593 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
03594 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
03595 # endif
03596 }
03597 # endif
03598
03599 # ifdef _TARGET_OS_MAX
03600 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
03601 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
03602 arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
03603 arg_info_list[info_idx1].ed.linear_type == Typeless_4 ||
03604 arg_info_list[info_idx1].ed.linear_type == Real_4) {
03605 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_4;
03606 }
03607 # endif
03608 }
03609 opr = Bnot_Opr;
03610 }
03611
03612 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8 ||
03613 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Typeless_8) {
03614 typeless_idx = Typeless_8;
03615 }
03616 else {
03617 typeless_idx = TYPELESS_DEFAULT_TYPE;
03618 }
03619
03620 # ifdef _TARGET_OS_MAX
03621 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
03622 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
03623 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Typeless_4 ||
03624 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
03625 typeless_idx = Typeless_4;
03626 }
03627 # endif
03628
03629 conform_check(0,
03630 ir_idx,
03631 res_exp_desc,
03632 spec_idx,
03633 FALSE);
03634
03635 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03636 IR_RANK(ir_idx) = res_exp_desc->rank;
03637 res_exp_desc->type_idx = IR_TYPE_IDX(ir_idx);
03638 res_exp_desc->linear_type = TYP_LINEAR(IR_TYPE_IDX(ir_idx));
03639
03640 if (opr == Not_Opr) {
03641 IR_OPR(ir_idx) = opr;
03642 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
03643 IR_OPND_R(ir_idx) = null_opnd;
03644 }
03645 else {
03646
03647 line = IR_LINE_NUM(ir_idx);
03648 column = IR_COL_NUM(ir_idx);
03649
03650 not_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
03651 opr, typeless_idx, line, column,
03652 NO_Tbl_Idx, NULL_IDX);
03653 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
03654 ATP_RSLT_IDX(*spec_idx)))];
03655
03656 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
03657
03658 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
03659 case Integer_1:
03660 num = BITSIZE_INT1_F90;
03661 break;
03662
03663 case Integer_2:
03664 num = BITSIZE_INT2_F90;
03665 break;
03666
03667 case Integer_4:
03668 case Typeless_4:
03669 num = BITSIZE_INT4_F90;
03670 break;
03671
03672 case Integer_8:
03673 case Typeless_8:
03674 num = BITSIZE_INT8_F90;
03675 break;
03676 }
03677
03678 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
03679
03680 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
03681 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
03682 CN_Tbl_Idx, cn_idx2);
03683
03684 NTR_IR_LIST_TBL(first_idx);
03685 IL_FLD(first_idx) = IR_Tbl_Idx;
03686 IL_IDX(first_idx) = not_idx;
03687 NTR_IR_LIST_TBL(second_idx);
03688 IL_FLD(second_idx) = IR_Tbl_Idx;
03689 IL_IDX(second_idx) = minus_idx;
03690 IL_NEXT_LIST_IDX(first_idx) = second_idx;
03691
03692 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
03693 Shiftl_Opr, typeless_idx, line, column,
03694 NO_Tbl_Idx, NULL_IDX);
03695
03696 NTR_IR_LIST_TBL(first_idx);
03697 IL_FLD(first_idx) = IR_Tbl_Idx;
03698 IL_IDX(first_idx) = shiftl_idx;
03699 NTR_IR_LIST_TBL(second_idx);
03700 IL_FLD(second_idx) = IR_Tbl_Idx;
03701 IL_IDX(second_idx) = minus_idx;
03702 IL_NEXT_LIST_IDX(first_idx) = second_idx;
03703
03704 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
03705 Shiftr_Opr, typeless_idx, line, column,
03706 NO_Tbl_Idx, NULL_IDX);
03707
03708 if (TYP_TYPE(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer) {
03709 IR_OPR(shiftr_idx) = Shifta_Opr;
03710 }
03711
03712 IR_OPR(ir_idx) = Cvrt_Opr;
03713 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03714 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03715 IR_IDX_L(ir_idx) = shiftr_idx;
03716 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
03717 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
03718 IR_OPND_R(ir_idx) = null_opnd;
03719
03720 if (IL_FLD(list_idx1) == CN_Tbl_Idx) {
03721 COPY_OPND(opnd, (*result_opnd));
03722 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
03723 COPY_OPND((*result_opnd), opnd);
03724 }
03725 }
03726
03727 TRACE (Func_Exit, "not_intrinsic", NULL);
03728
03729 }
03730
03731
03732
03733
03734
03735
03736
03737
03738
03739
03740
03741
03742
03743
03744
03745
03746
03747
03748 void aint_intrinsic(opnd_type *result_opnd,
03749 expr_arg_type *res_exp_desc,
03750 int *spec_idx)
03751 {
03752 int info_idx1;
03753 int info_idx2;
03754 int list_idx1;
03755 int list_idx2;
03756 int ir_idx;
03757
03758
03759 TRACE (Func_Entry, "aint_intrinsic", NULL);
03760
03761 ir_idx = OPND_IDX((*result_opnd));
03762 list_idx1 = IR_IDX_R(ir_idx);
03763 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
03764 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03765
03766 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
03767 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
03768 kind_to_linear_type(&((IL_OPND(list_idx2))),
03769 ATP_RSLT_IDX(*spec_idx),
03770 arg_info_list[info_idx2].ed.kind0seen,
03771 arg_info_list[info_idx2].ed.kind0E0seen,
03772 arg_info_list[info_idx2].ed.kind0D0seen,
03773 ! arg_info_list[info_idx2].ed.kindnotconst);
03774 }
03775 else {
03776 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
03777 arg_info_list[info_idx1].ed.type_idx;
03778 }
03779
03780 conform_check(0,
03781 ir_idx,
03782 res_exp_desc,
03783 spec_idx,
03784 FALSE);
03785
03786 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03787 IR_RANK(ir_idx) = res_exp_desc->rank;
03788 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03789 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
03790
03791 IR_OPR(ir_idx) = Aint_Opr;
03792 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
03793 IR_OPND_R(ir_idx) = null_opnd;
03794 IR_LIST_CNT_L(ir_idx) = 1;
03795 IL_NEXT_LIST_IDX(IR_IDX_L(ir_idx)) = NULL_IDX;
03796
03797
03798
03799
03800 res_exp_desc->foldable = FALSE;
03801 res_exp_desc->will_fold_later = FALSE;
03802
03803 TRACE (Func_Exit, "aint_intrinsic", NULL);
03804
03805 }
03806
03807
03808
03809
03810
03811
03812
03813
03814
03815
03816
03817
03818
03819
03820
03821
03822
03823
03824
03825 void ilen_intrinsic(opnd_type *result_opnd,
03826 expr_arg_type *res_exp_desc,
03827 int *spec_idx)
03828 {
03829 int info_idx1;
03830 int ir_idx;
03831 int list_idx1;
03832
03833
03834 TRACE (Func_Entry, "ilen_intrinsic", NULL);
03835
03836 ir_idx = OPND_IDX((*result_opnd));
03837 list_idx1 = IR_IDX_R(ir_idx);
03838 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03839 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
03840
03841 conform_check(0,
03842 ir_idx,
03843 res_exp_desc,
03844 spec_idx,
03845 FALSE);
03846
03847 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03848 IR_RANK(ir_idx) = res_exp_desc->rank;
03849 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03850 res_exp_desc->linear_type =
03851 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
03852
03853 res_exp_desc->foldable = FALSE;
03854 res_exp_desc->will_fold_later = FALSE;
03855
03856
03857 io_item_must_flatten = TRUE;
03858
03859 TRACE (Func_Exit, "ilen_intrinsic", NULL);
03860
03861 }
03862
03863
03864
03865
03866
03867
03868
03869
03870
03871
03872
03873
03874
03875
03876
03877
03878
03879
03880
03881
03882 void dim_intrinsic(opnd_type *result_opnd,
03883 expr_arg_type *res_exp_desc,
03884 int *spec_idx)
03885 {
03886 int info_idx1;
03887 int info_idx2;
03888 int arg1;
03889 int arg2;
03890 int arg3;
03891 int ir_idx;
03892 int gt_idx;
03893 int type_idx;
03894 int zero_idx;
03895 int minus_idx;
03896 int select_idx;
03897 int list_idx1;
03898 int list_idx2;
03899 int line;
03900 int column;
03901 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
03902
03903
03904 TRACE (Func_Entry, "dim_intrinsic", NULL);
03905
03906 ir_idx = OPND_IDX((*result_opnd));
03907 list_idx1 = IR_IDX_R(ir_idx);
03908 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
03909 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03910 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
03911 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
03912 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03913
03914 conform_check(0,
03915 ir_idx,
03916 res_exp_desc,
03917 spec_idx,
03918 FALSE);
03919
03920 IR_TYPE_IDX(ir_idx) = type_idx;
03921 IR_RANK(ir_idx) = res_exp_desc->rank;
03922 res_exp_desc->type_idx = type_idx;
03923 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
03924
03925 if (arg_info_list[info_idx1].ed.linear_type !=
03926 arg_info_list[info_idx2].ed.linear_type) {
03927 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
03928 IR_COL_NUM(ir_idx));
03929 }
03930
03931 if (arg_info_list[info_idx1].ed.type == Integer &&
03932 IL_FLD(list_idx1) == CN_Tbl_Idx &&
03933 IL_FLD(list_idx2) == CN_Tbl_Idx &&
03934 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
03935 arg_info_list[info_idx1].ed.type_idx,
03936 (char *)&CN_CONST(IL_IDX(list_idx2)),
03937 arg_info_list[info_idx2].ed.type_idx,
03938 folded_const,
03939 &type_idx,
03940 IR_LINE_NUM(ir_idx),
03941 IR_COL_NUM(ir_idx),
03942 2,
03943 Dim_Opr)) {
03944 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
03945 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
03946 FALSE,
03947 folded_const);
03948 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
03949 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
03950 res_exp_desc->constant = TRUE;
03951 res_exp_desc->foldable = TRUE;
03952 }
03953 else {
03954 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
03955 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
03956 &line,
03957 &column);
03958
03959 gt_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
03960 Gt_Opr, LOGICAL_DEFAULT_TYPE, line, column,
03961 IL_FLD(list_idx2), IL_IDX(list_idx2));
03962
03963 minus_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
03964 Minus_Opr, arg_info_list[info_idx1].ed.type_idx,
03965 line, column,
03966 IL_FLD(list_idx2), IL_IDX(list_idx2));
03967
03968 zero_idx = (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) ==
03969 CG_INTEGER_DEFAULT_TYPE) ? CN_INTEGER_ZERO_IDX :
03970 C_INT_TO_CN(arg_info_list[info_idx1].ed.type_idx, 0);
03971
03972 NTR_IR_LIST_TBL(arg1);
03973 IL_ARG_DESC_VARIANT(arg1) = TRUE;
03974 NTR_IR_LIST_TBL(arg2);
03975 IL_ARG_DESC_VARIANT(arg2) = TRUE;
03976 NTR_IR_LIST_TBL(arg3);
03977 IL_ARG_DESC_VARIANT(arg3) = TRUE;
03978
03979
03980 IL_NEXT_LIST_IDX(arg1) = arg2;
03981 IL_NEXT_LIST_IDX(arg2) = arg3;
03982
03983 IL_IDX(arg1) = minus_idx;
03984 IL_FLD(arg1) = IR_Tbl_Idx;
03985 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
03986 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
03987 IL_IDX(arg2) = zero_idx;
03988 IL_FLD(arg2) = CN_Tbl_Idx;
03989 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
03990 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
03991 IL_IDX(arg3) = gt_idx;
03992 IL_FLD(arg3) = IR_Tbl_Idx;
03993 IL_LINE_NUM(arg3) = IR_LINE_NUM(ir_idx);
03994 IL_COL_NUM(arg3) = IR_COL_NUM(ir_idx);
03995
03996 select_idx = gen_ir(IL_Tbl_Idx, arg1,
03997 Cvmgt_Opr,
03998 arg_info_list[info_idx1].ed.type_idx,
03999 IR_LINE_NUM(ir_idx),
04000 IR_COL_NUM(ir_idx),
04001 NO_Tbl_Idx, NULL_IDX);
04002
04003
04004 io_item_must_flatten = TRUE;
04005
04006 IR_LIST_CNT_L(select_idx) = 3;
04007
04008 IR_OPR(ir_idx) = Cvrt_Opr;
04009 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04010 IR_IDX_L(ir_idx) = select_idx;
04011 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
04012 IR_OPND_R(ir_idx) = null_opnd;
04013 }
04014
04015 if (arg_info_list[info_idx1].ed.type != Integer) {
04016
04017
04018
04019 res_exp_desc->foldable = FALSE;
04020 res_exp_desc->will_fold_later = FALSE;
04021 }
04022 }
04023
04024 TRACE (Func_Exit, "dim_intrinsic", NULL);
04025
04026 }
04027
04028
04029
04030
04031
04032
04033
04034
04035
04036
04037
04038
04039
04040
04041
04042
04043
04044
04045
04046 void max_intrinsic(opnd_type *result_opnd,
04047 expr_arg_type *res_exp_desc,
04048 int *spec_idx)
04049 {
04050 int col = 0;
04051 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
04052 boolean fold_it;
04053 boolean casting_needed= FALSE;
04054 int info_idx1;
04055 int largest_linear_type;
04056 int ir_idx;
04057 int line = 0;
04058 int n_idx;
04059 operator_type opr;
04060 opnd_type opnd;
04061 int t_idx;
04062 int tmp_idx;
04063 int type_idx;
04064
04065
04066 TRACE (Func_Entry, "max_intrinsic", NULL);
04067
04068 ir_idx = OPND_IDX((*result_opnd));
04069 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
04070
04071 conform_check(3,
04072 ir_idx,
04073 res_exp_desc,
04074 spec_idx,
04075 FALSE);
04076
04077
04078 t_idx = IR_IDX_R(ir_idx);
04079 n_idx = IL_NEXT_LIST_IDX(t_idx);
04080 #ifdef KEY
04081 int first_il_idx = t_idx;
04082 #endif
04083
04084 largest_linear_type = arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.linear_type;
04085
04086 fold_it = (IL_FLD(t_idx) == CN_Tbl_Idx);
04087
04088 while ((n_idx != NULL_IDX) && (IL_IDX(n_idx) != NULL_IDX)) {
04089 if (arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.type !=
04090 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.type) {
04091 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
04092 IR_COL_NUM(ir_idx));
04093 fold_it = FALSE;
04094 break;
04095 }
04096
04097 if ((opt_flags.set_fastint_option ||
04098 opt_flags.set_allfastint_option) &&
04099 (arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.type == Integer)) {
04100 if (opt_flags.set_allfastint_option ||
04101 (TYP_DESC(arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.type_idx) ==
04102 Default_Typed)) {
04103 casting_needed = TRUE;
04104 }
04105
04106 if (opt_flags.set_allfastint_option ||
04107 (TYP_DESC(arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.type_idx) ==
04108 Default_Typed)) {
04109 casting_needed = TRUE;
04110 }
04111 }
04112
04113 if (arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.linear_type !=
04114 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.linear_type) {
04115 PRINTMSG(arg_info_list[IL_ARG_DESC_IDX(n_idx)].line, 1323, Ansi,
04116 arg_info_list[IL_ARG_DESC_IDX(n_idx)].col);
04117
04118 casting_needed = TRUE;
04119 if (largest_linear_type <
04120 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.linear_type) {
04121 largest_linear_type =
04122 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.linear_type;
04123 }
04124 }
04125
04126 fold_it = fold_it && (IL_FLD(n_idx) == CN_Tbl_Idx);
04127
04128 t_idx = n_idx;
04129 n_idx = IL_NEXT_LIST_IDX(n_idx);
04130 }
04131
04132 if (casting_needed) {
04133 t_idx = IR_IDX_R(ir_idx);
04134
04135 while ((t_idx != NULL_IDX) && (IL_IDX(t_idx) != NULL_IDX)) {
04136 COPY_OPND(opnd, IL_OPND(t_idx));
04137 cast_to_type_idx(&opnd,
04138 &arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed,
04139 largest_linear_type);
04140 COPY_OPND(IL_OPND(t_idx), opnd);
04141
04142 t_idx = IL_NEXT_LIST_IDX(t_idx);
04143 }
04144 }
04145
04146 #ifdef KEY
04147
04148
04149
04150
04151
04152 int count = 0;
04153 for (t_idx = IR_IDX_R(ir_idx); t_idx != NULL_IDX;
04154 t_idx = IL_NEXT_LIST_IDX(t_idx)) {
04155 if (++count > 2 && NULL_IDX != is_optional_dummy(t_idx)) {
04156 pass_dummy_or_default(t_idx, IL_FLD(first_il_idx), IL_IDX(first_il_idx),
04157 largest_linear_type, FALSE);
04158 }
04159 }
04160 #endif
04161
04162 if ((ATP_INTRIN_ENUM(*spec_idx) == Amax0_Intrinsic) ||
04163 (ATP_INTRIN_ENUM(*spec_idx) == Amin0_Intrinsic)) {
04164 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = REAL_DEFAULT_TYPE;
04165 }
04166 else if ((ATP_INTRIN_ENUM(*spec_idx) == Max1_Intrinsic) ||
04167 (ATP_INTRIN_ENUM(*spec_idx) == Min1_Intrinsic)) {
04168 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
04169 }
04170 else {
04171 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = largest_linear_type;
04172 }
04173
04174 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04175 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
04176 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
04177 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04178 IR_RANK(ir_idx) = res_exp_desc->rank;
04179 type_idx = res_exp_desc->type_idx;
04180
04181 if (ATP_INTRIN_ENUM(*spec_idx) == Max_Intrinsic ||
04182 ATP_INTRIN_ENUM(*spec_idx) == Amax0_Intrinsic ||
04183 ATP_INTRIN_ENUM(*spec_idx) == Amax1_Intrinsic ||
04184 ATP_INTRIN_ENUM(*spec_idx) == Dmax1_Intrinsic ||
04185 ATP_INTRIN_ENUM(*spec_idx) == Max0_Intrinsic ||
04186 ATP_INTRIN_ENUM(*spec_idx) == Max1_Intrinsic) {
04187 IR_OPR(ir_idx) = Lt_Opr;
04188 opr = Max_Opr;
04189 }
04190 else {
04191 IR_OPR(ir_idx) = Gt_Opr;
04192 opr = Min_Opr;
04193 }
04194
04195 if (fold_it &&
04196 res_exp_desc->type == Integer &&
04197 arg_info_list[info_idx1].ed.type == Integer) {
04198 t_idx = IR_IDX_R(ir_idx);
04199 n_idx = IL_NEXT_LIST_IDX(t_idx);
04200
04201 while ((n_idx != NULL_IDX) && (IL_IDX(n_idx) != NULL_IDX)) {
04202 fold_it = folder_driver((char *)&CN_CONST(IL_IDX(t_idx)),
04203 arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.type_idx,
04204 (char *)&CN_CONST(IL_IDX(n_idx)),
04205 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.type_idx,
04206 folded_const,
04207 &type_idx,
04208 line,
04209 col,
04210 2,
04211 IR_OPR(ir_idx));
04212
04213 if (THIS_IS_TRUE(folded_const, type_idx)) {
04214 t_idx = n_idx;
04215 }
04216
04217
04218 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
04219 OPND_IDX((*result_opnd)) = ntr_const_tbl(res_exp_desc->type_idx,
04220 FALSE,
04221 &CN_CONST(IL_IDX(t_idx)));
04222 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
04223 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
04224 res_exp_desc->constant = TRUE;
04225 res_exp_desc->foldable = TRUE;
04226
04227 n_idx = IL_NEXT_LIST_IDX(n_idx);
04228 }
04229 }
04230 else {
04231 tmp_idx = gen_ir(IR_FLD_R(ir_idx), IR_IDX_R(ir_idx),
04232 opr, IR_TYPE_IDX(ir_idx), IR_LINE_NUM(ir_idx),
04233 IR_COL_NUM(ir_idx),
04234 NO_Tbl_Idx, NULL_IDX);
04235
04236 IR_OPR(ir_idx) = Cvrt_Opr;
04237 IR_IDX_L(ir_idx) = tmp_idx;
04238 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
04239 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
04240 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
04241 IR_OPND_R(ir_idx) = null_opnd;
04242
04243 if (res_exp_desc->type != Integer) {
04244
04245
04246
04247 res_exp_desc->foldable = FALSE;
04248 res_exp_desc->will_fold_later = FALSE;
04249 }
04250 }
04251
04252 TRACE (Func_Exit, "max_intrinsic", NULL);
04253
04254 }
04255
04256
04257
04258
04259
04260
04261
04262
04263
04264
04265
04266
04267
04268
04269
04270
04271
04272
04273
04274
04275 void ranget_intrinsic(opnd_type *result_opnd,
04276 expr_arg_type *res_exp_desc,
04277 int *spec_idx)
04278 {
04279 int info_idx1;
04280 int ir_idx;
04281 int list_idx1;
04282 int tmp_attr;
04283 int unused1 = NULL_IDX;
04284 int unused2 = NULL_IDX;
04285 opnd_type old_opnd;
04286 opnd_type base_opnd;
04287
04288
04289 TRACE (Func_Entry, "ranget_intrinsic", NULL);
04290
04291 ir_idx = OPND_IDX((*result_opnd));
04292 list_idx1 = IR_IDX_R(ir_idx);
04293 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04294 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
04295
04296 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04297 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
04298 # endif
04299
04300 conform_check(0,
04301 ir_idx,
04302 res_exp_desc,
04303 spec_idx,
04304 FALSE);
04305
04306 if (IL_IDX(list_idx1) == NULL_IDX) {
04307
04308 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04309 IR_RANK(ir_idx) = res_exp_desc->rank;
04310
04311 tmp_attr = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
04312 IR_COL_NUM(ir_idx),
04313 Priv, TRUE);
04314 ATD_STOR_BLK_IDX(tmp_attr) = SCP_SB_STACK_IDX(curr_scp_idx);
04315 ATD_TYPE_IDX(tmp_attr) = INTEGER_DEFAULT_TYPE;
04316 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04317 ATD_TYPE_IDX(tmp_attr) = Integer_8;
04318 # endif
04319 AT_SEMANTICS_DONE(tmp_attr) = TRUE;
04320
04321 IL_FLD(list_idx1) = AT_Tbl_Idx;
04322 IL_IDX(list_idx1) = tmp_attr;
04323 IL_LINE_NUM(list_idx1) = IR_LINE_NUM(ir_idx);
04324 IL_COL_NUM(list_idx1) = IR_COL_NUM(ir_idx);
04325 }
04326 else {
04327 COPY_OPND(old_opnd, IL_OPND(list_idx1));
04328
04329 if (! arg_info_list[info_idx1].ed.reference &&
04330 ! arg_info_list[info_idx1].ed.tmp_reference) {
04331
04332 tmp_attr = create_tmp_asg(&old_opnd,
04333 (expr_arg_type *)&(arg_info_list[info_idx1].ed),
04334 &base_opnd,
04335 Intent_In,
04336 TRUE,
04337 FALSE);
04338
04339 COPY_OPND(old_opnd, base_opnd);
04340 }
04341
04342 if (arg_info_list[info_idx1].ed.rank > 0) {
04343 make_base_subtree(&old_opnd, &base_opnd, &unused1, &unused2);
04344 COPY_OPND(IL_OPND(list_idx1), base_opnd);
04345 }
04346 else {
04347 COPY_OPND(IL_OPND(list_idx1), old_opnd);
04348 }
04349 }
04350
04351 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04352 COPY_OPND(old_opnd, IL_OPND(list_idx1));
04353 cast_to_type_idx(&old_opnd, &arg_info_list[info_idx1].ed, Integer_8);
04354 COPY_OPND(IL_OPND(list_idx1), old_opnd);
04355 # else
04356 COPY_OPND(old_opnd, IL_OPND(list_idx1));
04357 cast_to_cg_default(&old_opnd, &(arg_info_list[info_idx1].ed));
04358 COPY_OPND(IL_OPND(list_idx1), old_opnd);
04359 # endif
04360
04361 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04362 IR_RANK(ir_idx) = res_exp_desc->rank;
04363 if (ATP_INTRIN_ENUM(*spec_idx) == Ranget_Intrinsic) {
04364 IR_OPR(ir_idx) = Ranget_Opr;
04365 }
04366 else {
04367 IR_OPR(ir_idx) = Ranset_Opr;
04368 }
04369 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04370 IR_OPND_R(ir_idx) = null_opnd;
04371
04372
04373
04374
04375 res_exp_desc->foldable = FALSE;
04376 res_exp_desc->will_fold_later = FALSE;
04377
04378 TRACE (Func_Exit, "ranget_intrinsic", NULL);
04379
04380 }
04381
04382
04383
04384
04385
04386
04387
04388
04389
04390
04391
04392
04393
04394
04395
04396
04397
04398
04399 void ranf_intrinsic(opnd_type *result_opnd,
04400 expr_arg_type *res_exp_desc,
04401 int *spec_idx)
04402 {
04403 int ir_idx;
04404
04405
04406 TRACE (Func_Entry, "ranf_intrinsic", NULL);
04407
04408 ir_idx = OPND_IDX((*result_opnd));
04409 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_8;
04410
04411 conform_check(0,
04412 ir_idx,
04413 res_exp_desc,
04414 spec_idx,
04415 FALSE);
04416
04417 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04418 IR_RANK(ir_idx) = res_exp_desc->rank;
04419 IR_OPR(ir_idx) = Ranf_Opr;
04420
04421 IR_OPND_L(ir_idx) = null_opnd;
04422 IR_OPND_R(ir_idx) = null_opnd;
04423
04424
04425
04426
04427 res_exp_desc->foldable = FALSE;
04428 res_exp_desc->will_fold_later = FALSE;
04429 tree_has_ranf = TRUE;
04430
04431 TRACE (Func_Exit, "ranf_intrinsic", NULL);
04432
04433 }
04434
04435
04436
04437
04438
04439
04440
04441
04442
04443
04444
04445
04446
04447
04448
04449
04450
04451
04452
04453
04454
04455
04456
04457
04458
04459
04460
04461
04462
04463
04464
04465
04466
04467
04468
04469
04470 void real_intrinsic(opnd_type *result_opnd,
04471 expr_arg_type *res_exp_desc,
04472 int *spec_idx)
04473 {
04474 int list_idx1;
04475 int list_idx2;
04476 int ir_idx;
04477 int info_idx1;
04478 int info_idx2;
04479
04480
04481 TRACE (Func_Entry, "real_intrinsic", NULL);
04482
04483 ir_idx = OPND_IDX((*result_opnd));
04484 list_idx1 = IR_IDX_R(ir_idx);
04485 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
04486 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04487
04488 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
04489 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
04490 kind_to_linear_type(&((IL_OPND(list_idx2))),
04491 ATP_RSLT_IDX(*spec_idx),
04492 arg_info_list[info_idx2].ed.kind0seen,
04493 arg_info_list[info_idx2].ed.kind0E0seen,
04494 arg_info_list[info_idx2].ed.kind0D0seen,
04495 ! arg_info_list[info_idx2].ed.kindnotconst);
04496 }
04497 else {
04498 switch (arg_info_list[info_idx1].ed.type) {
04499 case Integer:
04500 case Typeless:
04501 case Real:
04502 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = REAL_DEFAULT_TYPE;
04503 break;
04504
04505 case Complex:
04506 switch (arg_info_list[info_idx1].ed.linear_type) {
04507 case Complex_4:
04508 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_4;
04509 break;
04510 case Complex_8:
04511 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_8;
04512 break;
04513 case Complex_16:
04514 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_16;
04515 break;
04516 }
04517 break;
04518 }
04519 }
04520
04521 if (ATP_INTRIN_ENUM(*spec_idx) == Dfloat_Intrinsic ||
04522 ATP_INTRIN_ENUM(*spec_idx) == Dreal_Intrinsic ||
04523 ATP_INTRIN_ENUM(*spec_idx) == Dble_Intrinsic ||
04524 ATP_INTRIN_ENUM(*spec_idx) == Dbleq_Intrinsic ||
04525 ATP_INTRIN_ENUM(*spec_idx) == Dfloati_Intrinsic ||
04526 ATP_INTRIN_ENUM(*spec_idx) == Dfloatj_Intrinsic ||
04527 ATP_INTRIN_ENUM(*spec_idx) == Dfloatk_Intrinsic) {
04528 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = DOUBLE_DEFAULT_TYPE;
04529 }
04530
04531 if (ATP_INTRIN_ENUM(*spec_idx) == Qfloat_Intrinsic ||
04532 ATP_INTRIN_ENUM(*spec_idx) == Qext_Intrinsic ||
04533 ATP_INTRIN_ENUM(*spec_idx) == Qreal_Intrinsic ||
04534 ATP_INTRIN_ENUM(*spec_idx) == Qfloati_Intrinsic ||
04535 ATP_INTRIN_ENUM(*spec_idx) == Qfloatj_Intrinsic ||
04536 ATP_INTRIN_ENUM(*spec_idx) == Qfloatk_Intrinsic) {
04537 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_16;
04538 }
04539
04540 conform_check(0,
04541 ir_idx,
04542 res_exp_desc,
04543 spec_idx,
04544 FALSE);
04545
04546 #ifdef KEY
04547 if (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const) {
04548 typeless_to_type(list_idx1, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
04549 }
04550 #endif
04551
04552 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04553 IR_RANK(ir_idx) = res_exp_desc->rank;
04554 IR_OPR(ir_idx) = Real_Opr;
04555
04556 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04557 IR_OPND_R(ir_idx) = null_opnd;
04558 IR_LIST_CNT_L(ir_idx) = 1;
04559 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
04560
04561
04562
04563
04564 res_exp_desc->foldable = FALSE;
04565 res_exp_desc->will_fold_later = FALSE;
04566
04567 TRACE (Func_Exit, "real_intrinsic", NULL);
04568
04569 }
04570
04571
04572
04573
04574
04575
04576
04577
04578
04579
04580
04581
04582
04583
04584
04585
04586
04587
04588 void mask_intrinsic(opnd_type *result_opnd,
04589 expr_arg_type *res_exp_desc,
04590 int *spec_idx)
04591 {
04592 int info_idx1;
04593 int ir_idx;
04594 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
04595 int list_idx1;
04596 int type_idx;
04597
04598
04599 TRACE (Func_Entry, "mask_intrinsic", NULL);
04600
04601 ir_idx = OPND_IDX((*result_opnd));
04602 list_idx1 = IR_IDX_R(ir_idx);
04603 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04604 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
04605 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04606 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
04607 if (arg_info_list[info_idx1].ed.type == Integer) {
04608 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
04609 arg_info_list[info_idx1].ed.linear_type;
04610 }
04611 # endif
04612
04613 IR_RANK(ir_idx) = res_exp_desc->rank;
04614
04615 # ifdef _TARGET32
04616 if (arg_info_list[info_idx1].ed.linear_type == Integer_8) {
04617 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
04618 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04619 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
04620 # endif
04621 }
04622 # endif
04623
04624 # ifdef _TARGET_OS_MAX
04625 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
04626 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
04627 arg_info_list[info_idx1].ed.linear_type == Integer_4) {
04628 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_4;
04629 }
04630 # endif
04631
04632 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04633
04634 conform_check(0,
04635 ir_idx,
04636 res_exp_desc,
04637 spec_idx,
04638 FALSE);
04639
04640 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04641 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
04642 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
04643 arg_info_list[info_idx1].ed.type_idx,
04644 NULL,
04645 NULL_IDX,
04646 folded_const,
04647 &type_idx,
04648 IR_LINE_NUM(ir_idx),
04649 IR_COL_NUM(ir_idx),
04650 1,
04651 Mask_Opr)) {
04652 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
04653 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
04654 FALSE,
04655 folded_const);
04656 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
04657 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
04658 res_exp_desc->constant = TRUE;
04659 res_exp_desc->foldable = TRUE;
04660 }
04661 else {
04662 IR_OPR(ir_idx) = Mask_Opr;
04663 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04664 IR_OPND_R(ir_idx) = null_opnd;
04665 }
04666
04667 TRACE (Func_Exit, "mask_intrinsic", NULL);
04668
04669 }
04670
04671
04672
04673
04674
04675
04676
04677
04678
04679
04680
04681
04682
04683
04684
04685
04686
04687
04688 void conjg_intrinsic(opnd_type *result_opnd,
04689 expr_arg_type *res_exp_desc,
04690 int *spec_idx)
04691 {
04692 int ir_idx;
04693 int list_idx1;
04694 int info_idx1;
04695
04696
04697 TRACE (Func_Entry, "conjg_intrinsic", NULL);
04698
04699 ir_idx = OPND_IDX((*result_opnd));
04700 list_idx1 = IR_IDX_R(ir_idx);
04701 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04702 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
04703
04704 conform_check(0,
04705 ir_idx,
04706 res_exp_desc,
04707 spec_idx,
04708 FALSE);
04709
04710 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04711 IR_RANK(ir_idx) = res_exp_desc->rank;
04712 IR_OPR(ir_idx) = Conjg_Opr;
04713
04714 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04715 IR_OPND_R(ir_idx) = null_opnd;
04716
04717
04718
04719
04720 res_exp_desc->foldable = FALSE;
04721 res_exp_desc->will_fold_later = FALSE;
04722
04723 TRACE (Func_Exit, "conjg_intrinsic", NULL);
04724
04725 }
04726
04727
04728
04729
04730
04731
04732
04733
04734
04735
04736
04737
04738
04739
04740
04741
04742
04743
04744 void dprod_intrinsic(opnd_type *result_opnd,
04745 expr_arg_type *res_exp_desc,
04746 int *spec_idx)
04747 {
04748 int ir_idx;
04749 int list_idx1;
04750 int list_idx2;
04751 int info_idx1;
04752 int info_idx2;
04753 opnd_type opnd;
04754
04755
04756 TRACE (Func_Entry, "dprod_intrinsic", NULL);
04757
04758 ir_idx = OPND_IDX((*result_opnd));
04759 list_idx1 = IR_IDX_R(ir_idx);
04760 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
04761 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04762 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
04763 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = DOUBLE_DEFAULT_TYPE;
04764
04765 if (ATP_INTRIN_ENUM(*spec_idx) == Qprod_Intrinsic) {
04766 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_16;
04767 }
04768
04769 if ((TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) != REAL_DEFAULT_TYPE) ||
04770 (TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx) != REAL_DEFAULT_TYPE)) {
04771 PRINTMSG(IR_LINE_NUM(ir_idx), 361, Error,
04772 IR_COL_NUM(ir_idx));
04773 }
04774
04775 conform_check(0,
04776 ir_idx,
04777 res_exp_desc,
04778 spec_idx,
04779 FALSE);
04780
04781 COPY_OPND(opnd, IL_OPND(list_idx1));
04782 cast_to_type_idx(&opnd,
04783 &arg_info_list[info_idx1].ed,
04784 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
04785 COPY_OPND(IL_OPND(list_idx1), opnd);
04786
04787 COPY_OPND(opnd, IL_OPND(list_idx2));
04788 cast_to_type_idx(&opnd,
04789 &arg_info_list[info_idx2].ed,
04790 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
04791 COPY_OPND(IL_OPND(list_idx2), opnd);
04792
04793
04794 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04795 IR_RANK(ir_idx) = res_exp_desc->rank;
04796 IR_OPR(ir_idx) = Dprod_Opr;
04797
04798 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04799 IR_OPND_R(ir_idx) = null_opnd;
04800
04801
04802
04803
04804 res_exp_desc->foldable = FALSE;
04805 res_exp_desc->will_fold_later = FALSE;
04806
04807 TRACE (Func_Exit, "dprod_intrinsic", NULL);
04808
04809 }
04810
04811
04812
04813
04814
04815
04816
04817
04818
04819
04820
04821
04822
04823
04824
04825
04826
04827
04828 void length_intrinsic(opnd_type *result_opnd,
04829 expr_arg_type *res_exp_desc,
04830 int *spec_idx)
04831 {
04832 int ir_idx;
04833
04834 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04835 opnd_type opnd;
04836 # endif
04837
04838
04839 TRACE (Func_Entry, "length_intrinsic", NULL);
04840
04841 ir_idx = OPND_IDX((*result_opnd));
04842 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
04843
04844 conform_check(0,
04845 ir_idx,
04846 res_exp_desc,
04847 spec_idx,
04848 FALSE);
04849
04850 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04851 #ifdef KEY
04852
04853 if (!defining_stmt_func) {
04854 #endif
04855 COPY_OPND(opnd, IR_OPND_R(ir_idx));
04856 final_arg_work(&opnd, IR_IDX_L(ir_idx), IR_LIST_CNT_R(ir_idx), NULL);
04857 COPY_OPND(IR_OPND_R(ir_idx), opnd);
04858 #ifdef KEY
04859 }
04860 #endif
04861
04862 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04863 IR_RANK(ir_idx) = res_exp_desc->rank;
04864 IR_OPR(ir_idx) = Length_Opr;
04865
04866 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04867 IR_OPND_R(ir_idx) = null_opnd;
04868 # else
04869 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04870 IR_RANK(ir_idx) = res_exp_desc->rank;
04871 IR_OPR(ir_idx) = Length_Opr;
04872
04873 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04874 IR_OPND_R(ir_idx) = null_opnd;
04875 # endif
04876
04877
04878
04879
04880 res_exp_desc->foldable = FALSE;
04881 res_exp_desc->will_fold_later = FALSE;
04882
04883 TRACE (Func_Exit, "length_intrinsic", NULL);
04884
04885 }
04886
04887
04888
04889
04890
04891
04892
04893
04894
04895
04896
04897
04898
04899
04900
04901
04902
04903
04904 void getpos_intrinsic(opnd_type *result_opnd,
04905 expr_arg_type *res_exp_desc,
04906 int *spec_idx)
04907 {
04908 int ir_idx;
04909
04910
04911 TRACE (Func_Entry, "getpos_intrinsic", NULL);
04912
04913 ir_idx = OPND_IDX((*result_opnd));
04914 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
04915
04916 conform_check(0,
04917 ir_idx,
04918 res_exp_desc,
04919 spec_idx,
04920 FALSE);
04921
04922 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04923 IR_RANK(ir_idx) = res_exp_desc->rank;
04924 IR_OPR(ir_idx) = Getpos_Opr;
04925
04926 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04927 IR_OPND_R(ir_idx) = null_opnd;
04928
04929
04930
04931
04932 res_exp_desc->foldable = FALSE;
04933 res_exp_desc->will_fold_later = FALSE;
04934
04935 TRACE (Func_Exit, "getpos_intrinsic", NULL);
04936
04937 }
04938
04939
04940
04941
04942
04943
04944
04945
04946
04947
04948
04949
04950
04951
04952
04953
04954
04955
04956 void unit_intrinsic(opnd_type *result_opnd,
04957 expr_arg_type *res_exp_desc,
04958 int *spec_idx)
04959 {
04960 int ir_idx;
04961
04962 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04963 opnd_type opnd;
04964 # endif
04965
04966
04967 TRACE (Func_Entry, "unit_intrinsic", NULL);
04968
04969 ir_idx = OPND_IDX((*result_opnd));
04970 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = REAL_DEFAULT_TYPE;
04971
04972 conform_check(0,
04973 ir_idx,
04974 res_exp_desc,
04975 spec_idx,
04976 FALSE);
04977
04978 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04979 #ifdef KEY
04980
04981 if (!defining_stmt_func) {
04982 #endif
04983 COPY_OPND(opnd, IR_OPND_R(ir_idx));
04984 final_arg_work(&opnd, IR_IDX_L(ir_idx), IR_LIST_CNT_R(ir_idx), NULL);
04985 COPY_OPND(IR_OPND_R(ir_idx), opnd);
04986 #ifdef KEY
04987 }
04988 #endif
04989
04990 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04991 IR_RANK(ir_idx) = res_exp_desc->rank;
04992 IR_OPR(ir_idx) = Unit_Opr;
04993
04994 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04995 IR_OPND_R(ir_idx) = null_opnd;
04996 # else
04997 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04998 IR_RANK(ir_idx) = res_exp_desc->rank;
04999 IR_OPR(ir_idx) = Unit_Opr;
05000
05001 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05002 IR_OPND_R(ir_idx) = null_opnd;
05003 # endif
05004
05005
05006
05007
05008 res_exp_desc->foldable = FALSE;
05009 res_exp_desc->will_fold_later = FALSE;
05010
05011 TRACE (Func_Exit, "unit_intrinsic", NULL);
05012
05013 }
05014
05015
05016
05017
05018
05019
05020
05021
05022
05023
05024
05025
05026
05027
05028
05029
05030
05031
05032 void cmplx_intrinsic(opnd_type *result_opnd,
05033 expr_arg_type *res_exp_desc,
05034 int *spec_idx)
05035 {
05036 int column;
05037 int line;
05038 int list_idx1;
05039 int list_idx2;
05040 int list_idx3;
05041 int info_idx1;
05042 int info_idx2;
05043 int info_idx3;
05044 int ir_idx;
05045 int list_idx;
05046 operator_type opr;
05047 #ifdef KEY
05048 int type_idx = 0;
05049 #else
05050 int type_idx;
05051 #endif
05052 opnd_type opnd;
05053
05054
05055 TRACE (Func_Entry, "cmplx_intrinsic", NULL);
05056
05057 ir_idx = OPND_IDX((*result_opnd));
05058 list_idx1 = IR_IDX_R(ir_idx);
05059 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
05060 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
05061 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05062 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
05063 opr = Cmplx_Opr;
05064
05065 if ((list_idx3 != NULL_IDX) && (IL_IDX(list_idx3) != NULL_IDX)) {
05066 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
05067 kind_to_linear_type(&((IL_OPND(list_idx3))),
05068 ATP_RSLT_IDX(*spec_idx),
05069 arg_info_list[info_idx3].ed.kind0seen,
05070 arg_info_list[info_idx3].ed.kind0E0seen,
05071 arg_info_list[info_idx3].ed.kind0D0seen,
05072 ! arg_info_list[info_idx3].ed.kindnotconst);
05073 }
05074 else {
05075 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = COMPLEX_DEFAULT_TYPE;
05076 }
05077
05078 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
05079 case Complex_4:
05080 type_idx = Real_4;
05081 break;
05082
05083 case Complex_8:
05084 type_idx = Real_8;
05085 break;
05086
05087 case Complex_16:
05088 type_idx = Real_16;
05089 break;
05090 }
05091
05092 if ((ATP_INTRIN_ENUM(*spec_idx) == Dcmplx_Intrinsic) &&
05093 (on_off_flags.enable_double_precision)) {
05094 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = DOUBLE_COMPLEX_DEFAULT_TYPE;
05095 }
05096
05097 if (ATP_INTRIN_ENUM(*spec_idx) == Qcmplx_Intrinsic) {
05098 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Complex_16;
05099 }
05100
05101 conform_check(2,
05102 ir_idx,
05103 res_exp_desc,
05104 spec_idx,
05105 FALSE);
05106
05107 #ifdef KEY
05108 if (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const) {
05109 typeless_to_type(list_idx1, type_idx);
05110 }
05111 if (list_idx2 != NULL_IDX &&
05112 arg_info_list[info_idx2].ed.linear_type == Short_Typeless_Const) {
05113 typeless_to_type(list_idx2, type_idx);
05114 }
05115 #endif
05116
05117 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05118 IR_RANK(ir_idx) = res_exp_desc->rank;
05119
05120 if (arg_info_list[info_idx1].ed.type == Integer) {
05121 COPY_OPND(opnd, IL_OPND(list_idx1));
05122 cast_to_type_idx(&opnd, &arg_info_list[info_idx1].ed, type_idx);
05123 COPY_OPND(IL_OPND(list_idx1), opnd);
05124 }
05125
05126 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
05127 if (arg_info_list[info_idx2].ed.type == Integer) {
05128 COPY_OPND(opnd, IL_OPND(list_idx2));
05129 cast_to_type_idx(&opnd, &arg_info_list[info_idx2].ed, type_idx);
05130 COPY_OPND(IL_OPND(list_idx2), opnd);
05131 }
05132
05133 if (arg_info_list[info_idx1].ed.type == Complex) {
05134 find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx2),
05135 &line,
05136 &column);
05137 PRINTMSG(line, 738, Error, column);
05138 }
05139 }
05140 else {
05141
05142 if (arg_info_list[info_idx1].ed.type == Complex) {
05143 opr = Cvrt_Opr;
05144 }
05145 else {
05146 IL_FLD(list_idx2) = CN_Tbl_Idx;
05147 IL_IDX(list_idx2) = cvrt_str_to_cn("0.0",
05148 REAL_DEFAULT_TYPE);
05149 IL_LINE_NUM(list_idx2) = IR_LINE_NUM(ir_idx);
05150 IL_COL_NUM(list_idx2) = IR_COL_NUM(ir_idx);
05151 }
05152 }
05153
05154 IR_OPR(ir_idx) = opr;
05155 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05156 IR_OPND_R(ir_idx) = null_opnd;
05157
05158 if (opr == Cvrt_Opr) {
05159 IR_LIST_CNT_L(ir_idx) = 1;
05160 list_idx = IR_IDX_L(ir_idx);
05161 IL_NEXT_LIST_IDX(list_idx) = NULL_IDX;
05162 }
05163 else {
05164 IR_LIST_CNT_L(ir_idx) = 2;
05165 list_idx = IR_IDX_L(ir_idx);
05166 list_idx = IL_NEXT_LIST_IDX(list_idx);
05167 IL_NEXT_LIST_IDX(list_idx) = NULL_IDX;
05168 }
05169
05170
05171
05172
05173
05174 res_exp_desc->foldable = FALSE;
05175 res_exp_desc->will_fold_later = FALSE;
05176
05177 TRACE (Func_Exit, "cmplx_intrinsic", NULL);
05178
05179 }
05180
05181
05182
05183
05184
05185
05186
05187
05188
05189
05190
05191
05192
05193
05194
05195
05196
05197
05198 void len_intrinsic(opnd_type *result_opnd,
05199 expr_arg_type *res_exp_desc,
05200 int *spec_idx)
05201 {
05202 int unused_idx;
05203 int ir_idx;
05204 int line;
05205 int col;
05206
05207
05208 TRACE (Func_Entry, "len_intrinsic", NULL);
05209
05210 ir_idx = OPND_IDX((*result_opnd));
05211 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
05212
05213 conform_check(0,
05214 ir_idx,
05215 res_exp_desc,
05216 spec_idx,
05217 TRUE);
05218
05219 if (cmd_line_flags.runtime_substring &&
05220 IR_OPR(IL_IDX(IR_IDX_R(ir_idx))) == Substring_Opr) {
05221 gen_runtime_substring(IL_IDX(IR_IDX_R(ir_idx)));
05222 }
05223
05224 res_exp_desc->rank = 0;
05225
05226 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05227 IR_RANK(ir_idx) = res_exp_desc->rank;
05228 IR_OPR(ir_idx) = Clen_Opr;
05229
05230 unused_idx = find_base_attr(&IL_OPND(IR_IDX_R(ir_idx)), &line, &col);
05231
05232 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(IR_IDX_R(ir_idx)));
05233 IR_OPND_R(ir_idx) = null_opnd;
05234
05235 fold_clen_opr(result_opnd, res_exp_desc);
05236
05237 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
05238 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05239 res_exp_desc->linear_type =
05240 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
05241
05242
05243
05244
05245 res_exp_desc->will_fold_later = FALSE;
05246
05247 TRACE (Func_Exit, "len_intrinsic", NULL);
05248
05249 }
05250
05251
05252
05253
05254
05255
05256
05257
05258
05259
05260
05261
05262
05263
05264
05265
05266
05267
05268 void ichar_intrinsic(opnd_type *result_opnd,
05269 expr_arg_type *res_exp_desc,
05270 int *spec_idx)
05271 {
05272 int ir_idx;
05273 int info_idx1;
05274 int list_idx1;
05275 long_type cnst[MAX_WORDS_FOR_NUMERIC];
05276 int type_idx;
05277
05278
05279 TRACE (Func_Entry, "ichar_intrinsic", NULL);
05280
05281 ir_idx = OPND_IDX((*result_opnd));
05282 list_idx1 = IR_IDX_R(ir_idx);
05283 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05284 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
05285 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05286
05287 conform_check(0,
05288 ir_idx,
05289 res_exp_desc,
05290 spec_idx,
05291 FALSE);
05292
05293 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05294 IR_RANK(ir_idx) = res_exp_desc->rank;
05295 res_exp_desc->type_idx = type_idx;
05296 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05297
05298 if ((OPND_FLD(arg_info_list[info_idx1].ed.char_len) == CN_Tbl_Idx) &&
05299 (CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx1].ed.char_len)) != 1)) {
05300 PRINTMSG(IR_LINE_NUM(ir_idx), 327, Ansi,
05301 IR_COL_NUM(ir_idx));
05302 }
05303
05304 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
05305 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
05306 arg_info_list[info_idx1].ed.type_idx,
05307 NULL,
05308 NULL_IDX,
05309 cnst,
05310 &type_idx,
05311 IR_LINE_NUM(ir_idx),
05312 IR_COL_NUM(ir_idx),
05313 1,
05314 Ichar_Opr)) {
05315 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05316 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
05317 FALSE,
05318 cnst);
05319 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05320 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05321 res_exp_desc->constant = TRUE;
05322 res_exp_desc->foldable = TRUE;
05323 }
05324 else {
05325 IR_OPR(ir_idx) = Ichar_Opr;
05326 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05327 IR_OPND_R(ir_idx) = null_opnd;
05328 }
05329
05330 TRACE (Func_Exit, "ichar_intrinsic", NULL);
05331
05332 }
05333
05334
05335
05336
05337
05338
05339
05340
05341
05342
05343
05344
05345
05346
05347
05348
05349
05350
05351 void char_intrinsic(opnd_type *result_opnd,
05352 expr_arg_type *res_exp_desc,
05353 int *spec_idx)
05354 {
05355 int list_idx1;
05356 int list_idx2;
05357 long_type cnst[MAX_WORDS_FOR_NUMERIC];
05358 int ir_idx;
05359 int info_idx1;
05360 int info_idx2;
05361 int type_idx;
05362
05363
05364 TRACE (Func_Entry, "char_intrinsic", NULL);
05365
05366 ir_idx = OPND_IDX((*result_opnd));
05367 list_idx1 = IR_IDX_R(ir_idx);
05368 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
05369 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05370
05371 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
05372 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
05373 kind_to_linear_type(&((IL_OPND(list_idx2))),
05374 ATP_RSLT_IDX(*spec_idx),
05375 arg_info_list[info_idx2].ed.kind0seen,
05376 arg_info_list[info_idx2].ed.kind0E0seen,
05377 arg_info_list[info_idx2].ed.kind0D0seen,
05378 ! arg_info_list[info_idx2].ed.kindnotconst);
05379 }
05380 else {
05381 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Character_1;
05382 }
05383
05384 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05385
05386 conform_check(0,
05387 ir_idx,
05388 res_exp_desc,
05389 spec_idx,
05390 FALSE);
05391
05392 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05393 IR_RANK(ir_idx) = res_exp_desc->rank;
05394
05395 res_exp_desc->char_len.fld = CN_Tbl_Idx;
05396 res_exp_desc->char_len.idx = CN_INTEGER_ONE_IDX;
05397 res_exp_desc->type_idx = type_idx;
05398 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05399
05400 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
05401 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
05402 arg_info_list[info_idx1].ed.type_idx,
05403 NULL,
05404 NULL_IDX,
05405 cnst,
05406 &type_idx,
05407 IR_LINE_NUM(ir_idx),
05408 IR_COL_NUM(ir_idx),
05409 1,
05410 Char_Opr)) {
05411 if (compare_cn_and_value(IL_IDX(list_idx1), 255, Gt_Opr) ||
05412 compare_cn_and_value(IL_IDX(list_idx1), 0, Lt_Opr)) {
05413 PRINTMSG(arg_info_list[info_idx1].line, 999, Error,
05414 arg_info_list[info_idx1].col);
05415 }
05416
05417 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05418 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
05419 FALSE,
05420 cnst);
05421 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05422 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05423 res_exp_desc->constant = TRUE;
05424 res_exp_desc->foldable = TRUE;
05425 }
05426 else {
05427 IR_OPR(ir_idx) = Char_Opr;
05428 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05429 IR_OPND_R(ir_idx) = null_opnd;
05430
05431 IR_LIST_CNT_L(ir_idx) = 1;
05432 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
05433
05434
05435 io_item_must_flatten = TRUE;
05436 }
05437
05438
05439 TRACE (Func_Exit, "char_intrinsic", NULL);
05440
05441 }
05442
05443
05444
05445
05446
05447
05448
05449
05450
05451
05452
05453
05454 void newline_intrinsic(opnd_type *result_opnd,
05455 expr_arg_type *res_exp_desc,
05456 int *spec_idx)
05457 {
05458 int list_idx1;
05459 long_type cnst[MAX_WORDS_FOR_NUMERIC];
05460 int ir_idx;
05461 int type_idx;
05462
05463
05464 TRACE (Func_Entry, "char_intrinsic", NULL);
05465
05466 ir_idx = OPND_IDX((*result_opnd));
05467 list_idx1 = IR_IDX_R(ir_idx);
05468
05469 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CHARACTER_DEFAULT_TYPE;
05470
05471 conform_check(0,
05472 ir_idx,
05473 res_exp_desc,
05474 spec_idx,
05475 FALSE);
05476
05477 IR_TYPE_IDX(ir_idx) = type_idx;
05478 IR_RANK(ir_idx) = res_exp_desc->rank;
05479
05480 res_exp_desc->char_len.fld = CN_Tbl_Idx;
05481 res_exp_desc->char_len.idx = CN_INTEGER_ONE_IDX;
05482 res_exp_desc->type_idx = type_idx;
05483 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05484
05485 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05486 * (char *) cnst = '\n';
05487 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx, FALSE, cnst);
05488 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05489 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05490 res_exp_desc->constant = TRUE;
05491 res_exp_desc->foldable = TRUE;
05492
05493 TRACE (Func_Exit, "newline_intrinsic", NULL);
05494
05495 }
05496
05497
05498
05499
05500
05501
05502
05503
05504
05505
05506
05507
05508
05509
05510
05511
05512
05513
05514
05515 void index_intrinsic(opnd_type *result_opnd,
05516 expr_arg_type *res_exp_desc,
05517 int *spec_idx)
05518 {
05519 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
05520 int cn_idx;
05521 long_type cnst[MAX_WORDS_FOR_NUMERIC];
05522 int ir_idx;
05523 int info_idx1;
05524 int info_idx2;
05525 int info_idx3;
05526 int list_idx1;
05527 int list_idx2;
05528 int list_idx3;
05529 int type_idx;
05530 operator_type opr;
05531 opnd_type opnd;
05532
05533
05534 TRACE (Func_Entry, "index_intrinsic", NULL);
05535
05536 ir_idx = OPND_IDX((*result_opnd));
05537 list_idx1 = IR_IDX_R(ir_idx);
05538 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
05539 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
05540 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05541 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
05542 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
05543
05544 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05545
05546 conform_check(3,
05547 ir_idx,
05548 res_exp_desc,
05549 spec_idx,
05550 FALSE);
05551
05552 IR_TYPE_IDX(ir_idx) = type_idx;
05553 IR_RANK(ir_idx) = res_exp_desc->rank;
05554 res_exp_desc->type_idx = type_idx;
05555 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05556
05557 if (IL_IDX(list_idx3) == NULL_IDX) {
05558 cn_idx = set_up_logical_constant(cnst,
05559 CG_LOGICAL_DEFAULT_TYPE,
05560 FALSE_VALUE,
05561 TRUE);
05562
05563 IL_FLD(list_idx3) = CN_Tbl_Idx;
05564 IL_IDX(list_idx3) = cn_idx;
05565 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
05566 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
05567
05568 arg_info_list_base = arg_info_list_top;
05569 arg_info_list_top = arg_info_list_base + 1;
05570
05571 if (arg_info_list_top >= arg_info_list_size) {
05572 enlarge_info_list_table();
05573 }
05574
05575 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
05576 arg_info_list[arg_info_list_top] = init_arg_info;
05577 arg_info_list[arg_info_list_top].ed.type_idx = CG_LOGICAL_DEFAULT_TYPE;
05578 arg_info_list[arg_info_list_top].ed.type = Logical;
05579 arg_info_list[arg_info_list_top].ed.linear_type= CG_LOGICAL_DEFAULT_TYPE;
05580 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
05581 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
05582 }
05583 #ifdef KEY
05584 else if (NULL_IDX != is_optional_dummy(list_idx3)) {
05585 pass_dummy_or_default_const(list_idx3,
05586 set_up_logical_constant(cnst, CG_LOGICAL_DEFAULT_TYPE, FALSE_VALUE,
05587 TRUE),
05588 FALSE);
05589 }
05590 #endif
05591
05592 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
05593
05594 if (ATP_INTRIN_ENUM(*spec_idx) == Index_Intrinsic) {
05595 opr = Index_Opr;
05596 }
05597 else if (ATP_INTRIN_ENUM(*spec_idx) == Verify_Intrinsic) {
05598 opr = Verify_Opr;
05599 }
05600 else {
05601 opr = Scan_Opr;
05602 # ifdef _TARGET_OS_MAX
05603 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
05604 # endif
05605 }
05606
05607 if ((list_idx3 != NULL_IDX) && (IL_IDX(list_idx3) != NULL_IDX)) {
05608 COPY_OPND(opnd, IL_OPND(list_idx3));
05609 cast_to_cg_default(&opnd, &(arg_info_list[info_idx3].ed));
05610 COPY_OPND(IL_OPND(list_idx3), opnd);
05611 }
05612
05613 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
05614 IL_FLD(list_idx2) == CN_Tbl_Idx &&
05615 IL_FLD(list_idx3) == CN_Tbl_Idx &&
05616 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
05617 arg_info_list[info_idx1].ed.type_idx,
05618 (char *)&CN_CONST(IL_IDX(list_idx2)),
05619 arg_info_list[info_idx2].ed.type_idx,
05620 folded_const,
05621 &type_idx,
05622 IR_LINE_NUM(ir_idx),
05623 IR_COL_NUM(ir_idx),
05624 3,
05625 opr,
05626 (char *)&CN_CONST(IL_IDX(list_idx3)),
05627 (long)arg_info_list[info_idx3].ed.type_idx)) {
05628 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05629 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
05630 FALSE,
05631 folded_const);
05632 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05633 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05634 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
05635 res_exp_desc->constant = TRUE;
05636 res_exp_desc->foldable = TRUE;
05637 }
05638 else {
05639 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
05640 IR_OPR(ir_idx) = opr;
05641 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05642 IR_OPND_R(ir_idx) = null_opnd;
05643 }
05644 }
05645
05646 TRACE (Func_Exit, "index_intrinsic", NULL);
05647
05648 }
05649
05650
05651
05652
05653
05654
05655
05656
05657
05658
05659
05660
05661
05662
05663
05664
05665
05666
05667
05668
05669
05670 void lge_intrinsic(opnd_type *result_opnd,
05671 expr_arg_type *res_exp_desc,
05672 int *spec_idx)
05673 {
05674 int ir_idx;
05675 int list_idx1;
05676 int list_idx2;
05677 int info_idx1;
05678 int info_idx2;
05679 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
05680 int type_idx;
05681
05682
05683 TRACE (Func_Entry, "lge_intrinsic", NULL);
05684
05685 ir_idx = OPND_IDX((*result_opnd));
05686 list_idx1 = IR_IDX_R(ir_idx);
05687 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
05688 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05689 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
05690
05691 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
05692 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05693
05694 conform_check(0,
05695 ir_idx,
05696 res_exp_desc,
05697 spec_idx,
05698 FALSE);
05699
05700 IR_TYPE_IDX(ir_idx) = type_idx;
05701 IR_RANK(ir_idx) = res_exp_desc->rank;
05702 res_exp_desc->type_idx = type_idx;
05703 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05704
05705 if (ATP_INTRIN_ENUM(*spec_idx) == Lge_Intrinsic) {
05706 IR_OPR(ir_idx) = Ge_Opr;
05707 }
05708 else if (ATP_INTRIN_ENUM(*spec_idx) == Llt_Intrinsic) {
05709 IR_OPR(ir_idx) = Lt_Opr;
05710 }
05711 else if (ATP_INTRIN_ENUM(*spec_idx) == Lle_Intrinsic) {
05712 IR_OPR(ir_idx) = Le_Opr;
05713 }
05714 else {
05715 IR_OPR(ir_idx) = Gt_Opr;
05716 }
05717
05718 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
05719 IL_FLD(list_idx2) == CN_Tbl_Idx &&
05720 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
05721 arg_info_list[info_idx1].ed.type_idx,
05722 (char *)&CN_CONST(IL_IDX(list_idx2)),
05723 arg_info_list[info_idx2].ed.type_idx,
05724 folded_const,
05725 &type_idx,
05726 IR_LINE_NUM(ir_idx),
05727 IR_COL_NUM(ir_idx),
05728 2,
05729 IR_OPR(ir_idx))) {
05730 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05731 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
05732 FALSE,
05733 folded_const);
05734 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05735 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05736 res_exp_desc->constant = TRUE;
05737 res_exp_desc->foldable = TRUE;
05738 }
05739 else {
05740 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05741 IR_OPND_R(ir_idx) = null_opnd;
05742 }
05743
05744 TRACE (Func_Exit, "lge_intrinsic", NULL);
05745
05746 }
05747
05748
05749 #ifdef KEY
05750
05751
05752
05753
05754
05755
05756
05757
05758 static int
05759 c_loc_iso_arg_check(intrinsic_type which_intrinsic, int attr_idx,
05760 int info_idx) {
05761 int found_error = 0;
05762 if (which_intrinsic == C_Funloc_Intrinsic &&
05763 (AT_OBJ_CLASS(attr_idx) != Pgm_Unit ||
05764 (ATP_PGM_UNIT(attr_idx) != Subroutine &&
05765 ATP_PGM_UNIT(attr_idx) != Function &&
05766 ATP_PGM_UNIT(attr_idx) != Pgm_Unknown) ||
05767 !AT_BIND_ATTR(attr_idx))) {
05768 found_error = 700;
05769 }
05770 else if (which_intrinsic == C_Loc_Iso_Intrinsic) {
05771 if (AT_OBJ_CLASS(attr_idx) != Data_Obj) {
05772 found_error = 700;
05773 }
05774 else {
05775 int allocatable = arg_info_list[info_idx].ed.allocatable;
05776 int pointer = arg_info_list[info_idx].ed.pointer;
05777 int target = arg_info_list[info_idx].ed.target;
05778 int rank = arg_info_list[info_idx].ed.rank;
05779 found_error = (target || pointer) ? 1692 : 418;
05780
05781 if ((target && interoperable_variable(attr_idx)) ||
05782 (allocatable && target &&
05783 check_interoperable_type(attr_idx, TRUE, FALSE)) ||
05784 (rank == 0 && pointer &&
05785 check_interoperable_type(attr_idx, TRUE, FALSE))) {
05786 found_error = 0;
05787 }
05788
05789 if (found_error && rank == 0 && no_length_type_param(attr_idx)) {
05790 if (((!allocatable) && (!pointer) && target) ||
05791 (allocatable && target) ||
05792 pointer) {
05793 found_error = 0;
05794 }
05795 }
05796 }
05797 }
05798 return found_error;
05799 }
05800 #endif
05801
05802
05803
05804
05805
05806
05807
05808
05809
05810
05811
05812
05813
05814
05815
05816
05817
05818
05819
05820
05821
05822 void loc_intrinsic(opnd_type *result_opnd,
05823 expr_arg_type *res_exp_desc,
05824 int *spec_idx)
05825 {
05826 opnd_type base_opnd;
05827 int ir_idx;
05828 int attr_idx;
05829 int info_idx1;
05830 int list_idx1;
05831 opnd_type old_opnd;
05832 int unused1 = NULL_IDX;
05833 int unused2 = NULL_IDX;
05834
05835
05836 TRACE (Func_Entry, "loc_intrinsic", NULL);
05837
05838 ir_idx = OPND_IDX((*result_opnd));
05839 list_idx1 = IR_IDX_R(ir_idx);
05840 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05841 #ifdef KEY
05842 intrinsic_type which = ATP_INTRIN_ENUM(*spec_idx);
05843 if (which == C_Loc_Iso_Intrinsic || which == C_Funloc_Intrinsic) {
05844
05845 }
05846 else
05847 #endif
05848 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ptr_8;
05849
05850 if (ATP_INTRIN_ENUM(*spec_idx) == Cloc_Intrinsic) {
05851 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ch_Ptr_8;
05852 }
05853
05854 if (ATP_INTRIN_ENUM(*spec_idx) == C_Loc_Intrinsic &&
05855 arg_info_list[info_idx1].ed.type == Character) {
05856 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ch_Ptr_8;
05857 }
05858
05859 if ((strcmp(AT_OBJ_NAME_PTR(*spec_idx), "LOC@") == 0) &&
05860 arg_info_list[info_idx1].ed.type == Character) {
05861 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ch_Ptr_8;
05862 }
05863
05864 conform_check(0,
05865 ir_idx,
05866 res_exp_desc,
05867 spec_idx,
05868 TRUE);
05869
05870 res_exp_desc->rank = 0;
05871
05872 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05873 IR_RANK(ir_idx) = res_exp_desc->rank;
05874
05875
05876 # ifdef _TARGET32
05877 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
05878 arg_info_list[info_idx1].ed.linear_type == Real_8 ||
05879 arg_info_list[info_idx1].ed.linear_type == Logical_8) {
05880
05881 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
05882 TYP_TYPE(TYP_WORK_IDX) = CRI_Ptr;
05883 TYP_LINEAR(TYP_WORK_IDX) = CRI_Ptr_8;
05884 TYP_PTR_INCREMENT(TYP_WORK_IDX) = 64;
05885 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = ntr_type_tbl();
05886 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05887 }
05888 # endif
05889
05890 # ifdef _TARGET_OS_MAX
05891 if (arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
05892 arg_info_list[info_idx1].ed.linear_type == Real_4 ||
05893 arg_info_list[info_idx1].ed.linear_type == Logical_4) {
05894
05895 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
05896 TYP_TYPE(TYP_WORK_IDX) = CRI_Ptr;
05897 TYP_LINEAR(TYP_WORK_IDX) = CRI_Ptr_8;
05898 TYP_PTR_INCREMENT(TYP_WORK_IDX) = 32;
05899 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = ntr_type_tbl();
05900 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05901 }
05902 # endif
05903
05904
05905 res_exp_desc->type_idx = IR_TYPE_IDX(ir_idx);
05906 res_exp_desc->type = TYP_TYPE(IR_TYPE_IDX(ir_idx));
05907 res_exp_desc->linear_type = TYP_LINEAR(IR_TYPE_IDX(ir_idx));
05908
05909 if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
05910 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
05911 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
05912 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr ||
05913 IR_OPR(IL_IDX(list_idx1)) == Struct_Opr ||
05914 IR_OPR(IL_IDX(list_idx1)) == Dv_Deref_Opr ||
05915 IR_OPR(IL_IDX(list_idx1)) == Subscript_Opr ||
05916 IR_OPR(IL_IDX(list_idx1)) == Substring_Opr ||
05917 IR_OPR(IL_IDX(list_idx1)) == Section_Subscript_Opr))) {
05918 attr_idx = find_base_attr(&IL_OPND(list_idx1), &unused1, &unused2);
05919
05920 #ifdef KEY
05921 intrinsic_type which_intrinsic = ATP_INTRIN_ENUM(*spec_idx);
05922 if (which_intrinsic == C_Loc_Iso_Intrinsic ||
05923 which_intrinsic == C_Funloc_Intrinsic) {
05924 int found_error = (which_intrinsic == C_Loc_Iso_Intrinsic) ?
05925 c_loc_iso_arg_check(which_intrinsic, attr_idx, info_idx1) :
05926 (AT_BIND_ATTR(attr_idx) ? 0 : 1692);
05927 if (found_error) {
05928 PRINTMSG(arg_info_list[info_idx1].line, found_error, Error,
05929 arg_info_list[info_idx1].col, AT_OBJ_NAME_PTR(*spec_idx));
05930 }
05931
05932
05933
05934 goto EXIT;
05935 }
05936 #endif
05937
05938 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) {
05939 PRINTMSG(arg_info_list[info_idx1].line, 779, Error,
05940 arg_info_list[info_idx1].col, AT_OBJ_NAME_PTR(attr_idx));
05941 goto EXIT;
05942 }
05943
05944
05945 if ((AT_OBJ_CLASS(attr_idx) == Data_Obj) && ATD_AUXILIARY(attr_idx)) {
05946 PRINTMSG(arg_info_list[info_idx1].line, 990, Error,
05947 arg_info_list[info_idx1].col);
05948 goto EXIT;
05949 }
05950 }
05951 else {
05952 PRINTMSG(arg_info_list[info_idx1].line, 779, Error,
05953 arg_info_list[info_idx1].col);
05954 goto EXIT;
05955 }
05956
05957 IR_OPR(ir_idx) = Loc_Opr;
05958
05959 COPY_OPND(old_opnd, IL_OPND(IR_IDX_R(ir_idx)));
05960
05961 unused1 = 0;
05962 unused2 = 0;
05963
05964 make_base_subtree(&old_opnd, &base_opnd, &unused1, &unused2);
05965
05966 COPY_OPND(IR_OPND_L(ir_idx), base_opnd);
05967
05968 IR_OPND_R(ir_idx) = null_opnd;
05969
05970 EXIT:
05971
05972
05973
05974
05975 res_exp_desc->foldable = FALSE;
05976 res_exp_desc->will_fold_later = FALSE;
05977
05978 TRACE (Func_Exit, "loc_intrinsic", NULL);
05979
05980 }
05981 #ifdef KEY
05982
05983
05984
05985
05986
05987
05988
05989 static boolean
05990 compare_length(opnd_type shape, int rank2) {
05991 if (OPND_FLD(shape) != CN_Tbl_Idx) {
05992 return TRUE;
05993 }
05994 return compare_cn_and_value(OPND_IDX(shape), rank2, Eq_Opr);
05995 }
05996
05997
05998
05999
06000
06001
06002
06003
06004
06005
06006
06007
06008
06009
06010
06011
06012
06013 void c_f_pointer_intrinsic(opnd_type *result_opnd,
06014 expr_arg_type *res_exp_desc,
06015 int *spec_idx)
06016 {
06017 int attr_idx = NULL_IDX;
06018 int unused1 = NULL_IDX;
06019 int unused2 = NULL_IDX;
06020
06021 TRACE (Func_Entry, "c_f_pointer_intrinsic", NULL);
06022
06023 int ir_idx = OPND_IDX((*result_opnd));
06024 boolean has_shape_arg = IR_LIST_CNT_R(ir_idx) == 3;
06025 int list_idx1 = IR_IDX_R(ir_idx);
06026 int list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
06027 int list_idx3 = has_shape_arg ? IL_NEXT_LIST_IDX(list_idx2) : 0;
06028 int info_idx1 = IL_ARG_DESC_IDX(list_idx1);
06029 int info_idx2 = IL_ARG_DESC_IDX(list_idx2);
06030 int info_idx3 = has_shape_arg ? IL_ARG_DESC_IDX(list_idx3) : 0;
06031 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ptr_8;
06032 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
06033
06034 conform_check(0,
06035 ir_idx,
06036 res_exp_desc,
06037 spec_idx,
06038 TRUE);
06039
06040 res_exp_desc->rank = 0;
06041
06042 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06043 IR_RANK(ir_idx) = res_exp_desc->rank;
06044
06045 res_exp_desc->type_idx = IR_TYPE_IDX(ir_idx);
06046 res_exp_desc->type = TYP_TYPE(IR_TYPE_IDX(ir_idx));
06047 res_exp_desc->linear_type = TYP_LINEAR(IR_TYPE_IDX(ir_idx));
06048
06049 if (IL_FLD(list_idx2) == AT_Tbl_Idx ||
06050 (IL_FLD(list_idx2) == IR_Tbl_Idx &&
06051 (IR_OPR(IL_IDX(list_idx2)) == Whole_Subscript_Opr ||
06052 IR_OPR(IL_IDX(list_idx2)) == Whole_Substring_Opr ||
06053 IR_OPR(IL_IDX(list_idx2)) == Struct_Opr ||
06054 IR_OPR(IL_IDX(list_idx2)) == Dv_Deref_Opr ||
06055 IR_OPR(IL_IDX(list_idx2)) == Subscript_Opr ||
06056 IR_OPR(IL_IDX(list_idx2)) == Substring_Opr ||
06057 IR_OPR(IL_IDX(list_idx2)) == Section_Subscript_Opr))) {
06058 attr_idx = find_base_attr(&IL_OPND(list_idx2), &unused1, &unused2);
06059
06060 if (ATP_INTRIN_ENUM(*spec_idx) == C_F_Pointer_Intrinsic &&
06061 (AT_OBJ_CLASS(attr_idx) != Data_Obj || !ATD_POINTER(attr_idx))) {
06062 PRINTMSG(arg_info_list[info_idx2].line, 700, Error,
06063 arg_info_list[info_idx2].col, AT_OBJ_NAME_PTR(*spec_idx));
06064 }
06065 else if (ATP_INTRIN_ENUM(*spec_idx) == C_F_Procpointer_Intrinsic) {
06066
06067 }
06068 }
06069
06070 int shape_error = FALSE;
06071 int rank2 = arg_info_list[info_idx2].ed.rank;
06072
06073
06074 if (rank2) {
06075 if ((!has_shape_arg) || list_idx3 == NULL_IDX ||
06076 IL_IDX(list_idx3) == NULL_IDX) {
06077 shape_error = TRUE;
06078 }
06079 else if (arg_info_list[info_idx3].ed.assumed_size) {
06080
06081 }
06082 else if (arg_info_list[info_idx3].ed.rank != 1 ||
06083 !compare_length(arg_info_list[info_idx3].ed.shape[0], rank2)) {
06084 shape_error = TRUE;
06085 }
06086 } else {
06087 shape_error = has_shape_arg ||
06088 (list_idx3 != NULL_IDX && IL_IDX(list_idx3) != NULL_IDX);
06089 }
06090 if (shape_error) {
06091 PRINTMSG(arg_info_list[info_idx2].line, 1698, Error,
06092 arg_info_list[info_idx2].col);
06093 }
06094
06095 res_exp_desc->foldable = FALSE;
06096 res_exp_desc->will_fold_later = FALSE;
06097
06098 TRACE (Func_Exit, "c_f_pointer_intrinsic", NULL);
06099
06100 }
06101 #endif
06102
06103
06104
06105
06106
06107
06108
06109
06110
06111
06112
06113
06114
06115
06116
06117
06118
06119
06120 void fcd_intrinsic(opnd_type *result_opnd,
06121 expr_arg_type *res_exp_desc,
06122 int *spec_idx)
06123 {
06124 int ir_idx;
06125
06126
06127 TRACE (Func_Entry, "fcd_intrinsic", NULL);
06128
06129 ir_idx = OPND_IDX((*result_opnd));
06130 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ch_Ptr_8;
06131
06132 conform_check(0,
06133 ir_idx,
06134 res_exp_desc,
06135 spec_idx,
06136 FALSE);
06137
06138 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06139 IR_RANK(ir_idx) = res_exp_desc->rank;
06140 IR_OPR(ir_idx) = Fcd_Opr;
06141
06142 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
06143 IR_OPND_R(ir_idx) = null_opnd;
06144
06145
06146
06147
06148 res_exp_desc->foldable = FALSE;
06149 res_exp_desc->will_fold_later = FALSE;
06150
06151 TRACE (Func_Exit, "fcd_intrinsic", NULL);
06152
06153 }
06154
06155
06156
06157
06158
06159
06160
06161
06162
06163
06164
06165
06166
06167
06168
06169
06170
06171
06172
06173
06174
06175
06176
06177
06178
06179
06180
06181
06182
06183
06184
06185 void fetch_and_add_intrinsic(opnd_type *result_opnd,
06186 expr_arg_type *res_exp_desc,
06187 int *spec_idx)
06188 {
06189 int ir_idx;
06190 int list_idx1;
06191 int info_idx1;
06192
06193
06194 TRACE (Func_Entry, "fetch_and_add_intrinsic", NULL);
06195
06196 ir_idx = OPND_IDX((*result_opnd));
06197
06198 list_idx1 = IR_IDX_R(ir_idx);
06199 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
06200
06201 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
06202
06203 conform_check(0,
06204 ir_idx,
06205 res_exp_desc,
06206 spec_idx,
06207 FALSE);
06208
06209 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06210 IR_RANK(ir_idx) = res_exp_desc->rank;
06211
06212 io_item_must_flatten = TRUE;
06213
06214 if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Add_Intrinsic) {
06215 IR_OPR(ir_idx) = Fetch_And_Add_Opr;
06216 }
06217 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_And_Intrinsic) {
06218 IR_OPR(ir_idx) = Fetch_And_And_Opr;
06219 }
06220 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Nand_Intrinsic) {
06221 IR_OPR(ir_idx) = Fetch_And_Nand_Opr;
06222 }
06223 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Or_Intrinsic) {
06224 IR_OPR(ir_idx) = Fetch_And_Or_Opr;
06225 }
06226 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Xor_Intrinsic) {
06227 IR_OPR(ir_idx) = Fetch_And_Xor_Opr;
06228 }
06229 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Sub_Intrinsic) {
06230 IR_OPR(ir_idx) = Fetch_And_Sub_Opr;
06231 }
06232 else if (ATP_INTRIN_ENUM(*spec_idx) == Add_And_Fetch_Intrinsic) {
06233 IR_OPR(ir_idx) = Add_And_Fetch_Opr;
06234 }
06235 else if (ATP_INTRIN_ENUM(*spec_idx) == And_And_Fetch_Intrinsic) {
06236 IR_OPR(ir_idx) = And_And_Fetch_Opr;
06237 }
06238 else if (ATP_INTRIN_ENUM(*spec_idx) == Nand_And_Fetch_Intrinsic) {
06239 IR_OPR(ir_idx) = Nand_And_Fetch_Opr;
06240 }
06241 else if (ATP_INTRIN_ENUM(*spec_idx) == Or_And_Fetch_Intrinsic) {
06242 IR_OPR(ir_idx) = Or_And_Fetch_Opr;
06243 }
06244 else if (ATP_INTRIN_ENUM(*spec_idx) == Sub_And_Fetch_Intrinsic) {
06245 IR_OPR(ir_idx) = Sub_And_Fetch_Opr;
06246 }
06247 else if (ATP_INTRIN_ENUM(*spec_idx) == Xor_And_Fetch_Intrinsic) {
06248 IR_OPR(ir_idx) = Xor_And_Fetch_Opr;
06249 }
06250 else if (ATP_INTRIN_ENUM(*spec_idx) == Lock_Test_And_Set_Intrinsic) {
06251 IR_OPR(ir_idx) = Lock_Test_And_Set_Opr;
06252 }
06253
06254 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
06255 IR_OPND_R(ir_idx) = null_opnd;
06256
06257
06258
06259
06260 res_exp_desc->foldable = FALSE;
06261 res_exp_desc->will_fold_later = FALSE;
06262
06263 TRACE (Func_Exit, "fetch_and_add_intrinsic", NULL);
06264
06265 }
06266
06267
06268
06269
06270
06271
06272
06273
06274
06275
06276
06277
06278
06279
06280
06281
06282
06283
06284
06285 void numarg_intrinsic(opnd_type *result_opnd,
06286 expr_arg_type *res_exp_desc,
06287 int *spec_idx)
06288 {
06289 int ir_idx;
06290
06291
06292 TRACE (Func_Entry, "numarg_intrinsic", NULL);
06293
06294 ir_idx = OPND_IDX((*result_opnd));
06295 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
06296
06297 conform_check(0,
06298 ir_idx,
06299 res_exp_desc,
06300 spec_idx,
06301 FALSE);
06302
06303 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06304 IR_RANK(ir_idx) = res_exp_desc->rank;
06305 IR_OPR(ir_idx) = Numarg_Opr;
06306
06307 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
06308 IR_OPND_R(ir_idx) = null_opnd;
06309
06310
06311
06312
06313 res_exp_desc->foldable = FALSE;
06314 res_exp_desc->will_fold_later = FALSE;
06315
06316 TRACE (Func_Exit, "numarg_intrinsic", NULL);
06317
06318 }
06319
06320
06321
06322
06323
06324
06325
06326
06327
06328
06329
06330
06331
06332
06333
06334
06335
06336
06337
06338 void readsm_intrinsic(opnd_type *result_opnd,
06339 expr_arg_type *res_exp_desc,
06340 int *spec_idx)
06341 {
06342 int ir_idx;
06343
06344 TRACE (Func_Entry, "readsm_intrinsic", NULL);
06345
06346 ir_idx = OPND_IDX((*result_opnd));
06347 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
06348
06349 conform_check(0,
06350 ir_idx,
06351 res_exp_desc,
06352 spec_idx,
06353 FALSE);
06354
06355 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06356 IR_RANK(ir_idx) = res_exp_desc->rank;
06357 IR_OPR(ir_idx) = Readsm_Opr;
06358
06359 IR_OPND_L(ir_idx) = null_opnd;
06360 IR_OPND_R(ir_idx) = null_opnd;
06361
06362
06363
06364
06365 res_exp_desc->foldable = FALSE;
06366 res_exp_desc->will_fold_later = FALSE;
06367
06368 TRACE (Func_Exit, "readsm_intrinsic", NULL);
06369
06370 }
06371
06372
06373
06374
06375
06376
06377
06378
06379
06380
06381
06382
06383
06384
06385
06386
06387
06388
06389
06390 void memory_barrier_intrinsic(opnd_type *result_opnd,
06391 expr_arg_type *res_exp_desc,
06392 int *spec_idx)
06393 {
06394 int ir_idx;
06395
06396
06397 TRACE (Func_Entry, "memory_barrier_intrinsic", NULL);
06398
06399 ir_idx = OPND_IDX((*result_opnd));
06400
06401 conform_check(0,
06402 ir_idx,
06403 res_exp_desc,
06404 spec_idx,
06405 FALSE);
06406
06407 IR_RANK(ir_idx) = res_exp_desc->rank;
06408 IR_OPR(ir_idx) = Memory_Barrier_Opr;
06409
06410 IR_OPND_L(ir_idx) = null_opnd;
06411 IR_OPND_R(ir_idx) = null_opnd;
06412
06413
06414
06415
06416 res_exp_desc->foldable = FALSE;
06417 res_exp_desc->will_fold_later = FALSE;
06418
06419 TRACE (Func_Exit, "memory_barrier_intrinsic", NULL);
06420
06421 }
06422
06423
06424
06425
06426
06427
06428
06429
06430
06431
06432
06433
06434
06435
06436
06437
06438
06439
06440
06441 void remote_write_barrier_intrinsic(opnd_type *result_opnd,
06442 expr_arg_type *res_exp_desc,
06443 int *spec_idx)
06444 {
06445 int ir_idx;
06446
06447
06448 TRACE (Func_Entry, "remote_write_barrier_intrinsic", NULL);
06449
06450 ir_idx = OPND_IDX((*result_opnd));
06451
06452 conform_check(0,
06453 ir_idx,
06454 res_exp_desc,
06455 spec_idx,
06456 FALSE);
06457
06458 IR_RANK(ir_idx) = res_exp_desc->rank;
06459 IR_OPR(ir_idx) = Remote_Write_Barrier_Opr;
06460
06461 IR_OPND_L(ir_idx) = null_opnd;
06462 IR_OPND_R(ir_idx) = null_opnd;
06463
06464
06465
06466
06467 res_exp_desc->foldable = FALSE;
06468 res_exp_desc->will_fold_later = FALSE;
06469
06470 TRACE (Func_Exit, "remote_write_barrier_intrinsic", NULL);
06471
06472 }
06473
06474
06475
06476
06477
06478
06479
06480
06481
06482
06483
06484
06485
06486
06487
06488
06489
06490 void write_memory_barrier_intrinsic(opnd_type *result_opnd,
06491 expr_arg_type *res_exp_desc,
06492 int *spec_idx)
06493 {
06494 int ir_idx;
06495
06496
06497 TRACE (Func_Entry, "write_memory_barrier_intrinsic", NULL);
06498
06499 ir_idx = OPND_IDX((*result_opnd));
06500
06501 conform_check(0,
06502 ir_idx,
06503 res_exp_desc,
06504 spec_idx,
06505 FALSE);
06506
06507 IR_RANK(ir_idx) = res_exp_desc->rank;
06508 IR_OPR(ir_idx) = Write_Memory_Barrier_Opr;
06509
06510 IR_OPND_L(ir_idx) = null_opnd;
06511 IR_OPND_R(ir_idx) = null_opnd;
06512
06513
06514
06515
06516 res_exp_desc->foldable = FALSE;
06517 res_exp_desc->will_fold_later = FALSE;
06518
06519 TRACE (Func_Exit, "write_memory_barrier_intrinsic", NULL);
06520
06521 }
06522
06523
06524
06525
06526
06527
06528
06529
06530
06531
06532
06533
06534
06535
06536
06537
06538 void synchronize_intrinsic(opnd_type *result_opnd,
06539 expr_arg_type *res_exp_desc,
06540 int *spec_idx)
06541 {
06542 int ir_idx;
06543
06544
06545 TRACE (Func_Entry, "synchronize_intrinsic", NULL);
06546
06547 ir_idx = OPND_IDX((*result_opnd));
06548
06549 conform_check(0,
06550 ir_idx,
06551 res_exp_desc,
06552 spec_idx,
06553 FALSE);
06554
06555 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
06556 IR_RANK(ir_idx) = res_exp_desc->rank;
06557 IR_OPR(ir_idx) = Synchronize_Opr;
06558
06559 IR_OPND_L(ir_idx) = null_opnd;
06560 IR_OPND_R(ir_idx) = null_opnd;
06561
06562 io_item_must_flatten = TRUE;
06563
06564
06565
06566
06567 res_exp_desc->foldable = FALSE;
06568 res_exp_desc->will_fold_later = FALSE;
06569
06570 TRACE (Func_Exit, "synchronize_intrinsic", NULL);
06571
06572 }
06573
06574
06575
06576
06577
06578
06579
06580
06581
06582
06583
06584
06585
06586
06587
06588
06589
06590
06591
06592
06593
06594 void rtc_intrinsic(opnd_type *result_opnd,
06595 expr_arg_type *res_exp_desc,
06596 int *spec_idx)
06597 {
06598 int ir_idx;
06599
06600
06601 TRACE (Func_Entry, "rtc_intrinsic", NULL);
06602
06603 ir_idx = OPND_IDX((*result_opnd));
06604 if (ATP_INTRIN_ENUM(*spec_idx) == Irtc_Intrinsic) {
06605 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
06606 }
06607 else {
06608 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_8;
06609 }
06610
06611 conform_check(0,
06612 ir_idx,
06613 res_exp_desc,
06614 spec_idx,
06615 FALSE);
06616
06617 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06618 IR_RANK(ir_idx) = res_exp_desc->rank;
06619 IR_OPR(ir_idx) = Rtc_Opr;
06620
06621 IR_OPND_L(ir_idx) = null_opnd;
06622 IR_OPND_R(ir_idx) = null_opnd;
06623
06624
06625
06626
06627 res_exp_desc->foldable = FALSE;
06628 res_exp_desc->will_fold_later = FALSE;
06629
06630 TRACE (Func_Exit, "rtc_intrinsic", NULL);
06631
06632 }
06633
06634
06635
06636
06637
06638
06639
06640
06641
06642
06643
06644
06645
06646
06647
06648
06649
06650
06651 void my_pe_intrinsic(opnd_type *result_opnd,
06652 expr_arg_type *res_exp_desc,
06653 int *spec_idx)
06654 {
06655 int ir_idx;
06656
06657
06658 TRACE (Func_Entry, "my_pe_intrinsic", NULL);
06659
06660 ir_idx = OPND_IDX((*result_opnd));
06661 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
06662
06663 conform_check(0,
06664 ir_idx,
06665 res_exp_desc,
06666 spec_idx,
06667 FALSE);
06668
06669 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06670 IR_RANK(ir_idx) = res_exp_desc->rank;
06671 IR_OPR(ir_idx) = My_Pe_Opr;
06672
06673 IR_OPND_L(ir_idx) = null_opnd;
06674 IR_OPND_R(ir_idx) = null_opnd;
06675
06676
06677
06678
06679 res_exp_desc->foldable = FALSE;
06680 res_exp_desc->will_fold_later = FALSE;
06681
06682
06683
06684
06685
06686
06687 io_item_must_flatten = TRUE;
06688
06689 TRACE (Func_Exit, "my_pe_intrinsic", NULL);
06690
06691 }
06692
06693
06694
06695
06696
06697
06698
06699
06700
06701
06702
06703
06704
06705
06706
06707
06708
06709
06710
06711
06712
06713 void cvmgp_intrinsic(opnd_type *result_opnd,
06714 expr_arg_type *res_exp_desc,
06715 int *spec_idx)
06716 {
06717 int column;
06718 int info_idx1;
06719 int info_idx2;
06720 int info_idx3;
06721 int ir_idx;
06722 int line;
06723 int list_idx1;
06724 int list_idx2;
06725 int list_idx3;
06726 int new_idx;
06727 #ifdef KEY
06728 operator_type opr1 = Null_Opr;
06729 #else
06730 operator_type opr1;
06731 #endif
06732 int type_idx;
06733
06734
06735 TRACE (Func_Entry, "cvmgp_intrinsic", NULL);
06736
06737 ir_idx = OPND_IDX((*result_opnd));
06738 list_idx1 = IR_IDX_R(ir_idx);
06739 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
06740 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
06741 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
06742 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
06743 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
06744
06745 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
06746 (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const ||
06747 arg_info_list[info_idx1].ed.linear_type == Short_Char_Const)) {
06748
06749 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
06750 &line,
06751 &column);
06752
06753 type_idx = arg_info_list[info_idx2].ed.type_idx;
06754
06755 if (arg_info_list[info_idx2].ed.type == Character ||
06756 arg_info_list[info_idx2].ed.type == Typeless) {
06757 type_idx = INTEGER_DEFAULT_TYPE;
06758 }
06759
06760 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
06761 type_idx,
06762 line,
06763 column);
06764
06765 arg_info_list[info_idx1].ed.type_idx = type_idx;
06766 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
06767 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
06768 }
06769
06770
06771 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
06772 (arg_info_list[info_idx2].ed.linear_type == Short_Typeless_Const ||
06773 arg_info_list[info_idx2].ed.linear_type == Short_Char_Const)) {
06774
06775 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx2),
06776 &line,
06777 &column);
06778
06779 type_idx = arg_info_list[info_idx1].ed.type_idx;
06780
06781 if (arg_info_list[info_idx1].ed.type == Character ||
06782 arg_info_list[info_idx1].ed.type == Typeless) {
06783 type_idx = INTEGER_DEFAULT_TYPE;
06784 }
06785
06786 IL_IDX(list_idx2) = cast_typeless_constant(IL_IDX(list_idx2),
06787 type_idx,
06788 line,
06789 column);
06790
06791 arg_info_list[info_idx2].ed.type_idx = type_idx;
06792 arg_info_list[info_idx2].ed.type = TYP_TYPE(type_idx);
06793 arg_info_list[info_idx2].ed.linear_type = TYP_LINEAR(type_idx);
06794 }
06795
06796 if (IL_FLD(list_idx3) == CN_Tbl_Idx &&
06797 (arg_info_list[info_idx3].ed.linear_type == Short_Typeless_Const ||
06798 arg_info_list[info_idx3].ed.linear_type == Short_Char_Const)) {
06799
06800 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx3),
06801 &line,
06802 &column);
06803
06804 type_idx = INTEGER_DEFAULT_TYPE;
06805
06806 IL_IDX(list_idx3) = cast_typeless_constant(IL_IDX(list_idx3),
06807 type_idx,
06808 line,
06809 column);
06810
06811 arg_info_list[info_idx3].ed.type_idx = type_idx;
06812 arg_info_list[info_idx3].ed.type = TYP_TYPE(type_idx);
06813 arg_info_list[info_idx3].ed.linear_type = TYP_LINEAR(type_idx);
06814 }
06815
06816
06817
06818 if (arg_info_list[info_idx1].ed.type == Logical) {
06819 type_idx = LOGICAL_DEFAULT_TYPE;
06820 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
06821 if (arg_info_list[info_idx1].ed.type == Logical) {
06822 type_idx = arg_info_list[info_idx1].ed.linear_type;
06823 }
06824 # endif
06825 }
06826 else {
06827 type_idx = TYPELESS_DEFAULT_TYPE;
06828 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
06829 type_idx = INTEGER_DEFAULT_TYPE;
06830 if (arg_info_list[info_idx1].ed.type == Integer) {
06831 type_idx = arg_info_list[info_idx1].ed.linear_type;
06832 }
06833 # endif
06834
06835
06836 # ifdef _TARGET32
06837 if ((arg_info_list[info_idx1].ed.linear_type == Integer_8) ||
06838 (arg_info_list[info_idx1].ed.linear_type == Typeless_8) ||
06839 (arg_info_list[info_idx1].ed.linear_type == Real_8) ||
06840 (arg_info_list[info_idx2].ed.linear_type == Integer_8) ||
06841 (arg_info_list[info_idx2].ed.linear_type == Typeless_8) ||
06842 (arg_info_list[info_idx2].ed.linear_type == Real_8)) {
06843 type_idx = Typeless_8;
06844 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
06845 type_idx = Integer_8;
06846 # endif
06847 }
06848
06849 if (arg_info_list[info_idx1].ed.type == Real &&
06850 arg_info_list[info_idx2].ed.type == Real) {
06851 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
06852 type_idx = arg_info_list[info_idx1].ed.linear_type;
06853 # endif
06854 }
06855
06856 # endif
06857 }
06858
06859 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
06860
06861 conform_check(0,
06862 ir_idx,
06863 res_exp_desc,
06864 spec_idx,
06865 FALSE);
06866
06867 switch (ATP_INTRIN_ENUM(*spec_idx)) {
06868 case Cvmgp_Intrinsic:
06869 opr1 = Ge_Opr;
06870 break;
06871
06872 case Cvmgm_Intrinsic:
06873 opr1 = Lt_Opr;
06874 break;
06875
06876 case Cvmgz_Intrinsic:
06877 opr1 = Eq_Opr;
06878 break;
06879
06880 case Cvmgn_Intrinsic:
06881 opr1 = Ne_Opr;
06882 break;
06883 }
06884
06885 if (ATP_INTRIN_ENUM(*spec_idx) != Cvmgt_Intrinsic) {
06886
06887 new_idx = gen_ir(IL_FLD(list_idx3), IL_IDX(list_idx3),
06888 opr1, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
06889 IR_COL_NUM(ir_idx),
06890 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
06891
06892 IL_FLD(list_idx3) = IR_Tbl_Idx;
06893 IL_IDX(list_idx3) = new_idx;
06894 }
06895
06896 IR_TYPE_IDX(ir_idx) = type_idx;
06897 IR_RANK(ir_idx) = res_exp_desc->rank;
06898 IR_OPR(ir_idx) = Cvmgt_Opr;
06899
06900
06901 io_item_must_flatten = TRUE;
06902
06903 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
06904 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
06905 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
06906 IR_COL_NUM(ir_idx));
06907 }
06908
06909 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
06910 IR_OPND_R(ir_idx) = null_opnd;
06911
06912 TRACE (Func_Exit, "cvmgp_intrinsic", NULL);
06913
06914 }
06915
06916
06917
06918
06919
06920
06921
06922
06923
06924
06925
06926
06927
06928
06929
06930
06931
06932
06933 void compare_and_swap_intrinsic(opnd_type *result_opnd,
06934 expr_arg_type *res_exp_desc,
06935 int *spec_idx)
06936 {
06937 int ir_idx;
06938
06939
06940 TRACE (Func_Entry, "compare_and_swap_intrinsic", NULL);
06941
06942 ir_idx = OPND_IDX((*result_opnd));
06943
06944 conform_check(0, ir_idx,
06945 res_exp_desc,
06946 spec_idx,
06947 FALSE);
06948
06949 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06950 IR_RANK(ir_idx) = res_exp_desc->rank;
06951
06952 IR_OPR(ir_idx) = Compare_And_Swap_Opr;
06953 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
06954 IR_OPND_R(ir_idx) = null_opnd;
06955
06956 io_item_must_flatten = TRUE;
06957
06958
06959
06960
06961 res_exp_desc->foldable = FALSE;
06962 res_exp_desc->will_fold_later = FALSE;
06963
06964 TRACE (Func_Exit, "compare_and_swap_intrinsic", NULL);
06965
06966 }
06967
06968
06969
06970
06971
06972
06973
06974
06975
06976
06977
06978
06979
06980
06981
06982
06983
06984
06985 void csmg_intrinsic(opnd_type *result_opnd,
06986 expr_arg_type *res_exp_desc,
06987 int *spec_idx)
06988 {
06989 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
06990 int info_idx1;
06991 int info_idx2;
06992 int info_idx3;
06993 int ir_idx;
06994 int line;
06995 int column;
06996 int list_idx1;
06997 int list_idx2;
06998 int list_idx3;
06999 int type_idx;
07000
07001
07002 TRACE (Func_Entry, "csmg_intrinsic", NULL);
07003
07004 ir_idx = OPND_IDX((*result_opnd));
07005
07006 list_idx1 = IR_IDX_R(ir_idx);
07007 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07008 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
07009 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
07010 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
07011 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
07012
07013 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
07014 (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const ||
07015 arg_info_list[info_idx1].ed.linear_type == Short_Char_Const)) {
07016
07017 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
07018 &line,
07019 &column);
07020
07021 type_idx = arg_info_list[info_idx2].ed.type_idx;
07022
07023 if (arg_info_list[info_idx2].ed.type == Character ||
07024 arg_info_list[info_idx2].ed.type == Typeless) {
07025 type_idx = INTEGER_DEFAULT_TYPE;
07026 }
07027
07028 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
07029 type_idx,
07030 line,
07031 column);
07032
07033 arg_info_list[info_idx1].ed.type_idx = type_idx;
07034 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
07035 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
07036 }
07037
07038 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
07039 (arg_info_list[info_idx2].ed.linear_type == Short_Typeless_Const ||
07040 arg_info_list[info_idx2].ed.linear_type == Short_Char_Const)) {
07041
07042 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx2),
07043 &line,
07044 &column);
07045
07046 type_idx = arg_info_list[info_idx1].ed.type_idx;
07047
07048 if (arg_info_list[info_idx1].ed.type == Character ||
07049 arg_info_list[info_idx1].ed.type == Typeless) {
07050 type_idx = INTEGER_DEFAULT_TYPE;
07051 }
07052
07053 IL_IDX(list_idx2) = cast_typeless_constant(IL_IDX(list_idx2),
07054 type_idx,
07055 line,
07056 column);
07057
07058 arg_info_list[info_idx2].ed.type_idx = type_idx;
07059 arg_info_list[info_idx2].ed.type = TYP_TYPE(type_idx);
07060 arg_info_list[info_idx2].ed.linear_type = TYP_LINEAR(type_idx);
07061 }
07062
07063
07064
07065 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
07066 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
07067 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07068 if (arg_info_list[info_idx1].ed.type == Integer) {
07069 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
07070 arg_info_list[info_idx1].ed.linear_type;
07071 }
07072 # endif
07073
07074
07075 # ifdef _TARGET32
07076 if ((arg_info_list[info_idx1].ed.linear_type == Integer_8) ||
07077 (arg_info_list[info_idx1].ed.linear_type == Typeless_8) ||
07078 (arg_info_list[info_idx1].ed.linear_type == Real_8) ||
07079 (arg_info_list[info_idx2].ed.linear_type == Integer_8) ||
07080 (arg_info_list[info_idx2].ed.linear_type == Typeless_8) ||
07081 (arg_info_list[info_idx2].ed.linear_type == Real_8) ||
07082 (arg_info_list[info_idx3].ed.linear_type == Integer_8) ||
07083 (arg_info_list[info_idx3].ed.linear_type == Typeless_8) ||
07084 (arg_info_list[info_idx3].ed.linear_type == Real_8)) {
07085 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
07086 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
07087 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
07088 # endif
07089 }
07090 # endif
07091
07092 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07093
07094 conform_check(0,
07095 ir_idx,
07096 res_exp_desc,
07097 spec_idx,
07098 FALSE);
07099
07100 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07101 IR_RANK(ir_idx) = res_exp_desc->rank;
07102 res_exp_desc->type_idx = type_idx;
07103 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
07104
07105 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
07106 IL_FLD(list_idx2) == CN_Tbl_Idx &&
07107 IL_FLD(list_idx3) == CN_Tbl_Idx &&
07108 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
07109 arg_info_list[info_idx1].ed.type_idx,
07110 (char *)&CN_CONST(IL_IDX(list_idx2)),
07111 arg_info_list[info_idx2].ed.type_idx,
07112 folded_const,
07113 &type_idx,
07114 IR_LINE_NUM(ir_idx),
07115 IR_COL_NUM(ir_idx),
07116 3,
07117 Csmg_Opr,
07118 (char *)&CN_CONST(IL_IDX(list_idx3)),
07119 (long)arg_info_list[info_idx3].ed.type_idx)) {
07120 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07121 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
07122 FALSE,
07123 folded_const);
07124 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07125 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07126 res_exp_desc->constant = TRUE;
07127 res_exp_desc->foldable = TRUE;
07128 }
07129 else {
07130 IR_OPR(ir_idx) = Csmg_Opr;
07131 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07132 IR_OPND_R(ir_idx) = null_opnd;
07133 }
07134
07135 TRACE (Func_Exit, "csmg_intrinsic", NULL);
07136
07137 }
07138
07139
07140
07141
07142
07143
07144
07145
07146
07147
07148
07149
07150
07151
07152
07153
07154
07155
07156 void mergee_intrinsic(opnd_type *result_opnd,
07157 expr_arg_type *res_exp_desc,
07158 int *spec_idx)
07159 {
07160 int list_idx1;
07161 int list_idx2;
07162 int info_idx1;
07163 int info_idx2;
07164 int ir_idx;
07165 int type_idx;
07166 int type_idx2;
07167 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
07168
07169
07170 TRACE (Func_Entry, "mergee_intrinsic", NULL);
07171
07172 ir_idx = OPND_IDX((*result_opnd));
07173 list_idx1 = IR_IDX_R(ir_idx);
07174 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07175 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
07176 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
07177 type_idx = arg_info_list[info_idx1].ed.type_idx;
07178 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
07179
07180 if (arg_info_list[info_idx1].ed.linear_type !=
07181 arg_info_list[info_idx2].ed.linear_type) {
07182
07183 if (arg_info_list[info_idx1].ed.type == Character &&
07184 arg_info_list[info_idx2].ed.type == Character) {
07185
07186 }
07187 else {
07188 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
07189 arg_info_list[info_idx2].col);
07190 }
07191 }
07192
07193 type_idx2 = CG_LOGICAL_DEFAULT_TYPE;
07194 if (arg_info_list[info_idx1].ed.type == Character &&
07195 arg_info_list[info_idx2].ed.type == Character &&
07196 arg_info_list[info_idx2].ed.char_len.fld == CN_Tbl_Idx &&
07197 arg_info_list[info_idx1].ed.char_len.fld == CN_Tbl_Idx &&
07198 folder_driver(
07199 (char *)&CN_CONST(arg_info_list[info_idx2].ed.char_len.idx),
07200 arg_info_list[info_idx2].ed.type_idx,
07201 (char *)&CN_CONST(arg_info_list[info_idx1].ed.char_len.idx),
07202 arg_info_list[info_idx1].ed.type_idx,
07203 folded_const,
07204 &type_idx2,
07205 IR_LINE_NUM(ir_idx),
07206 IR_COL_NUM(ir_idx),
07207 2,
07208 Ne_Opr)) {
07209
07210 if (THIS_IS_TRUE(folded_const, type_idx2)) {
07211 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
07212 arg_info_list[info_idx2].col);
07213 }
07214 }
07215
07216 conform_check(0,
07217 ir_idx,
07218 res_exp_desc,
07219 spec_idx,
07220 FALSE);
07221
07222 IR_TYPE_IDX(ir_idx) = type_idx;
07223 IR_RANK(ir_idx) = res_exp_desc->rank;
07224
07225 if (TYP_TYPE(type_idx) == Character) {
07226 COPY_OPND((res_exp_desc->char_len),
07227 (arg_info_list[info_idx1].ed.char_len));
07228 }
07229
07230 IR_OPR(ir_idx) = Cvmgt_Opr;
07231 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07232 IR_OPND_R(ir_idx) = null_opnd;
07233
07234
07235 io_item_must_flatten = TRUE;
07236
07237 TRACE (Func_Exit, "mergee_intrinsic", NULL);
07238
07239 }
07240
07241
07242
07243
07244
07245
07246
07247
07248
07249
07250
07251
07252
07253
07254
07255
07256
07257
07258
07259 void adjustl_intrinsic(opnd_type *result_opnd,
07260 expr_arg_type *res_exp_desc,
07261 int *spec_idx)
07262 {
07263 expr_arg_type exp_desc;
07264 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
07265 int info_idx1;
07266 int ir_idx;
07267 opnd_type l_opnd;
07268 int list_idx1;
07269 int new_idx;
07270 boolean ok;
07271 operator_type opr;
07272 opnd_type opnd;
07273 opnd_type opnd2;
07274 int unused;
07275 int type_idx;
07276
07277
07278 TRACE (Func_Entry, "adjustl_intrinsic", NULL);
07279
07280 ir_idx = OPND_IDX((*result_opnd));
07281 list_idx1 = IR_IDX_R(ir_idx);
07282 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
07283 type_idx = arg_info_list[info_idx1].ed.type_idx;
07284 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
07285
07286 conform_check(0,
07287 ir_idx,
07288 res_exp_desc,
07289 spec_idx,
07290 FALSE);
07291
07292 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
07293 res_exp_desc->type_idx = type_idx;
07294 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
07295 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
07296
07297 if (ATP_INTRIN_ENUM(*spec_idx) == Adjustl_Intrinsic) {
07298 opr = Adjustl_Opr;
07299 }
07300 else {
07301 opr = Adjustr_Opr;
07302 }
07303
07304 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
07305 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
07306 arg_info_list[info_idx1].ed.type_idx,
07307 NULL,
07308 NULL_IDX,
07309 folded_const,
07310 &type_idx,
07311 IR_LINE_NUM(ir_idx),
07312 IR_COL_NUM(ir_idx),
07313 1,
07314 opr)) {
07315 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07316 OPND_IDX((*result_opnd)) = folded_const[0];
07317 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07318 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07319 IR_TYPE_IDX(ir_idx) = type_idx;
07320 res_exp_desc->constant = TRUE;
07321 res_exp_desc->foldable = TRUE;
07322 }
07323 else {
07324 io_item_must_flatten = TRUE;
07325 COPY_OPND(opnd2, IR_OPND_R(ir_idx));
07326 ok = final_arg_work(&opnd2,
07327 IR_IDX_L(ir_idx),
07328 IR_LIST_CNT_R(ir_idx),
07329 NULL);
07330 COPY_OPND(IR_OPND_R(ir_idx), opnd2);
07331
07332 new_idx = gen_ir(IR_FLD_R(ir_idx), IR_IDX_R(ir_idx),
07333 opr, res_exp_desc->type_idx,
07334 IR_LINE_NUM(ir_idx), IR_COL_NUM(ir_idx),
07335 NO_Tbl_Idx, NULL_IDX);
07336
07337 OPND_FLD(opnd) = IR_Tbl_Idx;
07338 OPND_IDX(opnd) = new_idx;
07339
07340 if (IL_FLD(list_idx1) == IR_Tbl_Idx &&
07341 IR_OPR(IL_IDX(list_idx1)) == Aloc_Opr) {
07342 COPY_OPND(IL_OPND(list_idx1), IR_OPND_L(IL_IDX(list_idx1)));
07343 }
07344
07345 if (IL_FLD(list_idx1) == AT_Tbl_Idx &&
07346 AT_OBJ_CLASS(IL_IDX(list_idx1)) == Data_Obj &&
07347 ATD_ARRAY_IDX(IL_IDX(list_idx1)) != NULL_IDX) {
07348 COPY_OPND(opnd2, IL_OPND(list_idx1));
07349 ok = gen_whole_subscript(&opnd2, &exp_desc);
07350 COPY_OPND(IL_OPND(list_idx1), opnd2);
07351 }
07352
07353 unused = create_tmp_asg(&opnd,
07354 res_exp_desc,
07355 &l_opnd,
07356 Intent_In,
07357 TRUE,
07358 FALSE);
07359
07360 COPY_OPND((*result_opnd), l_opnd);
07361
07362
07363
07364
07365 res_exp_desc->foldable = FALSE;
07366 res_exp_desc->will_fold_later = FALSE;
07367 }
07368
07369 TRACE (Func_Exit, "adjustl_intrinsic", NULL);
07370
07371 }
07372
07373
07374
07375
07376
07377
07378
07379
07380
07381
07382
07383
07384
07385
07386
07387
07388
07389
07390 void ceiling_intrinsic(opnd_type *result_opnd,
07391 expr_arg_type *res_exp_desc,
07392 int *spec_idx)
07393 {
07394 int info_idx2;
07395 int ir_idx;
07396 int list_idx1;
07397 int list_idx2;
07398
07399
07400 TRACE (Func_Entry, "ceiling_intrinsic", NULL);
07401
07402 ir_idx = OPND_IDX((*result_opnd));
07403 list_idx1 = IR_IDX_R(ir_idx);
07404 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07405 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07406
07407 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
07408 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
07409 kind_to_linear_type(&((IL_OPND(list_idx2))),
07410 ATP_RSLT_IDX(*spec_idx),
07411 arg_info_list[info_idx2].ed.kind0seen,
07412 arg_info_list[info_idx2].ed.kind0E0seen,
07413 arg_info_list[info_idx2].ed.kind0D0seen,
07414 ! arg_info_list[info_idx2].ed.kindnotconst);
07415 }
07416
07417 conform_check(0,
07418 ir_idx,
07419 res_exp_desc,
07420 spec_idx,
07421 FALSE);
07422
07423 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07424 IR_RANK(ir_idx) = res_exp_desc->rank;
07425 IR_OPR(ir_idx) = Ceiling_Opr;
07426
07427 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07428 IR_OPND_R(ir_idx) = null_opnd;
07429 IR_LIST_CNT_L(ir_idx) = 1;
07430 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
07431
07432
07433
07434
07435 res_exp_desc->foldable = FALSE;
07436 res_exp_desc->will_fold_later = FALSE;
07437
07438 TRACE (Func_Exit, "ceiling_intrinsic", NULL);
07439
07440 }
07441
07442
07443
07444
07445
07446
07447
07448
07449
07450
07451
07452
07453
07454
07455
07456
07457
07458
07459 void digits_intrinsic(opnd_type *result_opnd,
07460 expr_arg_type *res_exp_desc,
07461 int *spec_idx)
07462 {
07463 int cn_idx;
07464 #ifdef KEY
07465 long num = 0;
07466 #else
07467 long num;
07468 #endif
07469 int info_idx1;
07470 int ir_idx;
07471
07472
07473 TRACE (Func_Entry, "digits_intrinsic", NULL);
07474
07475 ir_idx = OPND_IDX((*result_opnd));
07476 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
07477 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07478
07479 conform_check(0,
07480 ir_idx,
07481 res_exp_desc,
07482 spec_idx,
07483 TRUE);
07484
07485 res_exp_desc->rank = 0;
07486 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07487 IR_RANK(ir_idx) = res_exp_desc->rank;
07488
07489 switch (arg_info_list[info_idx1].ed.linear_type) {
07490 case Real_4:
07491 num = DIGITS_REAL4_F90;
07492 break;
07493
07494 case Real_8:
07495 num = DIGITS_REAL8_F90;
07496 break;
07497
07498 case Real_16:
07499 num = DIGITS_REAL16_F90;
07500 break;
07501
07502 case Integer_1:
07503 num = DIGITS_INT1_F90;
07504 break;
07505
07506 case Integer_2:
07507 num = DIGITS_INT2_F90;
07508 break;
07509
07510 case Integer_4:
07511 num = DIGITS_INT4_F90;
07512 break;
07513
07514 case Integer_8:
07515 num = DIGITS_INT8_F90;
07516
07517 # ifdef _TARGET_HAS_FAST_INTEGER
07518 if (opt_flags.set_allfastint_option ||
07519 (opt_flags.set_fastint_option &&
07520 (TYP_DESC(arg_info_list[info_idx1].ed.type_idx) ==
07521 Default_Typed))) {
07522 num = 46;
07523 }
07524 # endif
07525
07526 break;
07527 }
07528
07529 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
07530
07531 OPND_IDX((*result_opnd)) = cn_idx;
07532 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07533 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07534 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07535 res_exp_desc->constant = TRUE;
07536 res_exp_desc->foldable = TRUE;
07537
07538 TRACE (Func_Exit, "digits_intrinsic", NULL);
07539
07540 }
07541
07542
07543
07544
07545
07546
07547
07548
07549
07550
07551
07552
07553
07554
07555
07556
07557
07558
07559 void epsilon_intrinsic(opnd_type *result_opnd,
07560 expr_arg_type *res_exp_desc,
07561 int *spec_idx)
07562 {
07563 #ifdef KEY
07564 int cn_idx = 0;
07565 #else
07566 int cn_idx;
07567 #endif
07568 int info_idx1;
07569 int ir_idx;
07570
07571
07572 TRACE (Func_Entry, "epsilon_intrinsic", NULL);
07573
07574 ir_idx = OPND_IDX((*result_opnd));
07575 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
07576 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
07577
07578 conform_check(0,
07579 ir_idx,
07580 res_exp_desc,
07581 spec_idx,
07582 TRUE);
07583
07584 res_exp_desc->rank = 0;
07585 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
07586 IR_RANK(ir_idx) = res_exp_desc->rank;
07587
07588 switch (arg_info_list[info_idx1].ed.linear_type) {
07589 case Real_4:
07590 cn_idx = cvrt_str_to_cn(EPSILON_REAL4_F90,
07591 arg_info_list[info_idx1].ed.linear_type);
07592 break;
07593
07594 case Real_8:
07595 cn_idx = cvrt_str_to_cn(EPSILON_REAL8_F90,
07596 arg_info_list[info_idx1].ed.linear_type);
07597 break;
07598
07599 case Real_16:
07600 cn_idx = cvrt_str_to_cn(EPSILON_REAL16_F90,
07601 arg_info_list[info_idx1].ed.linear_type);
07602 break;
07603 }
07604
07605
07606 OPND_IDX((*result_opnd)) = cn_idx;
07607 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07608 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07609 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07610 res_exp_desc->constant = TRUE;
07611 res_exp_desc->foldable = TRUE;
07612
07613 TRACE (Func_Exit, "epsilon_intrinsic", NULL);
07614
07615 }
07616
07617
07618
07619
07620
07621
07622
07623
07624
07625
07626
07627
07628
07629
07630
07631
07632
07633
07634 void exponent_intrinsic(opnd_type *result_opnd,
07635 expr_arg_type *res_exp_desc,
07636 int *spec_idx)
07637 {
07638 int ir_idx;
07639
07640
07641 TRACE (Func_Entry, "exponent_intrinsic", NULL);
07642
07643 ir_idx = OPND_IDX((*result_opnd));
07644 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07645
07646 conform_check(0,
07647 ir_idx,
07648 res_exp_desc,
07649 spec_idx,
07650 FALSE);
07651
07652 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07653 IR_RANK(ir_idx) = res_exp_desc->rank;
07654 IR_OPR(ir_idx) = Exponent_Opr;
07655 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07656 IR_OPND_R(ir_idx) = null_opnd;
07657
07658
07659
07660
07661 res_exp_desc->foldable = FALSE;
07662 res_exp_desc->will_fold_later = FALSE;
07663
07664 TRACE (Func_Exit, "exponent_intrinsic", NULL);
07665
07666 }
07667
07668
07669
07670
07671
07672
07673
07674
07675
07676
07677
07678
07679
07680
07681
07682
07683
07684
07685 void floor_intrinsic(opnd_type *result_opnd,
07686 expr_arg_type *res_exp_desc,
07687 int *spec_idx)
07688 {
07689 int info_idx2;
07690 int ir_idx;
07691 int list_idx1;
07692 int list_idx2;
07693
07694
07695 TRACE (Func_Entry, "floor_intrinsic", NULL);
07696
07697 ir_idx = OPND_IDX((*result_opnd));
07698 list_idx1 = IR_IDX_R(ir_idx);
07699 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07700 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07701
07702 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
07703 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
07704 kind_to_linear_type(&((IL_OPND(list_idx2))),
07705 ATP_RSLT_IDX(*spec_idx),
07706 arg_info_list[info_idx2].ed.kind0seen,
07707 arg_info_list[info_idx2].ed.kind0E0seen,
07708 arg_info_list[info_idx2].ed.kind0D0seen,
07709 ! arg_info_list[info_idx2].ed.kindnotconst);
07710 }
07711
07712 conform_check(0,
07713 ir_idx,
07714 res_exp_desc,
07715 spec_idx,
07716 FALSE);
07717
07718 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07719 IR_RANK(ir_idx) = res_exp_desc->rank;
07720 IR_OPR(ir_idx) = Floor_Opr;
07721
07722 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07723 IR_OPND_R(ir_idx) = null_opnd;
07724 IR_LIST_CNT_L(ir_idx) = 1;
07725 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
07726
07727
07728
07729
07730 res_exp_desc->foldable = FALSE;
07731 res_exp_desc->will_fold_later = FALSE;
07732
07733 TRACE (Func_Exit, "floor_intrinsic", NULL);
07734
07735 }
07736
07737
07738
07739
07740
07741
07742
07743
07744
07745
07746
07747
07748
07749
07750
07751
07752
07753
07754 void fraction_intrinsic(opnd_type *result_opnd,
07755 expr_arg_type *res_exp_desc,
07756 int *spec_idx)
07757 {
07758 int ir_idx;
07759 int info_idx1;
07760
07761 TRACE (Func_Entry, "fraction_intrinsic", NULL);
07762
07763 ir_idx = OPND_IDX((*result_opnd));
07764 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
07765 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
07766
07767 conform_check(0,
07768 ir_idx,
07769 res_exp_desc,
07770 spec_idx,
07771 FALSE);
07772
07773 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07774 IR_RANK(ir_idx) = res_exp_desc->rank;
07775 IR_OPR(ir_idx) = Fraction_Opr;
07776 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07777 IR_OPND_R(ir_idx) = null_opnd;
07778
07779
07780
07781
07782 res_exp_desc->foldable = FALSE;
07783 res_exp_desc->will_fold_later = FALSE;
07784
07785 TRACE (Func_Exit, "fraction_intrinsic", NULL);
07786
07787 }
07788
07789
07790
07791
07792
07793
07794
07795
07796
07797
07798
07799
07800
07801
07802
07803
07804
07805
07806 void huge_intrinsic(opnd_type *result_opnd,
07807 expr_arg_type *res_exp_desc,
07808 int *spec_idx)
07809 {
07810 #ifdef KEY
07811 int cn_idx = 0;
07812 #else
07813 int cn_idx;
07814 #endif
07815 int info_idx1;
07816 int ir_idx;
07817
07818
07819 TRACE (Func_Entry, "huge_intrinsic", NULL);
07820
07821 ir_idx = OPND_IDX((*result_opnd));
07822 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
07823 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
07824
07825 conform_check(0,
07826 ir_idx,
07827 res_exp_desc,
07828 spec_idx,
07829 TRUE);
07830
07831 res_exp_desc->rank = 0;
07832 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
07833 IR_RANK(ir_idx) = res_exp_desc->rank;
07834
07835 switch (arg_info_list[info_idx1].ed.linear_type) {
07836 case Real_4:
07837 cn_idx = cvrt_str_to_cn(HUGE_REAL4_F90,
07838 arg_info_list[info_idx1].ed.linear_type);
07839 break;
07840
07841 case Real_8:
07842 cn_idx = cvrt_str_to_cn(HUGE_REAL8_F90,
07843 arg_info_list[info_idx1].ed.linear_type);
07844 break;
07845
07846 case Real_16:
07847 cn_idx = cvrt_str_to_cn(HUGE_REAL16_F90,
07848 arg_info_list[info_idx1].ed.linear_type);
07849 break;
07850
07851 case Integer_1:
07852 cn_idx = cvrt_str_to_cn(HUGE_INT1_F90,
07853 arg_info_list[info_idx1].ed.linear_type);
07854 break;
07855
07856 case Integer_2:
07857 cn_idx = cvrt_str_to_cn(HUGE_INT2_F90,
07858 arg_info_list[info_idx1].ed.linear_type);
07859 break;
07860
07861 case Integer_4:
07862 cn_idx = cvrt_str_to_cn(HUGE_INT4_F90,
07863 arg_info_list[info_idx1].ed.linear_type);
07864 break;
07865
07866 case Integer_8:
07867 cn_idx = cvrt_str_to_cn(HUGE_INT8_F90,
07868 arg_info_list[info_idx1].ed.linear_type);
07869
07870 # ifdef _TARGET_HAS_FAST_INTEGER
07871 if (opt_flags.set_allfastint_option ||
07872 (opt_flags.set_fastint_option &&
07873 (TYP_DESC(arg_info_list[info_idx1].ed.type_idx) ==
07874 Default_Typed))) {
07875 cn_idx = C_INT_TO_CN(IR_TYPE_IDX(ir_idx), 70368744177663L);
07876 }
07877 # endif
07878 break;
07879 }
07880
07881
07882 OPND_IDX((*result_opnd)) = cn_idx;
07883 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07884 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07885 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07886 res_exp_desc->constant = TRUE;
07887 res_exp_desc->foldable = TRUE;
07888
07889 TRACE (Func_Exit, "huge_intrinsic", NULL);
07890
07891 }
07892
07893
07894
07895
07896
07897
07898
07899
07900
07901
07902
07903
07904
07905
07906
07907
07908
07909
07910
07911
07912
07913
07914 void ibits_intrinsic(opnd_type *result_opnd,
07915 expr_arg_type *res_exp_desc,
07916 int *spec_idx)
07917 {
07918 boolean fold_it = FALSE;
07919 int ir_idx;
07920 int info_idx1;
07921 int list_idx1;
07922 int list_idx2;
07923 int list_idx3;
07924 opnd_type opnd;
07925 int typeless_idx;
07926
07927 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
07928 int cn_idx;
07929 int cn_idx2;
07930 long num;
07931 int shiftl_idx;
07932 int shiftr_idx;
07933 int shifta_idx;
07934 int first_idx;
07935 int second_idx;
07936 int mask_idx;
07937 int band_idx;
07938 int minus_idx;
07939 int line;
07940 int column;
07941 # endif
07942
07943
07944 TRACE (Func_Entry, "ibits_intrinsic", NULL);
07945
07946 ir_idx = OPND_IDX((*result_opnd));
07947 list_idx1 = IR_IDX_R(ir_idx);
07948 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07949 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
07950 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
07951 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
07952
07953 if (arg_info_list[info_idx1].ed.type == Typeless) {
07954 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
07955 arg_info_list[info_idx1].col);
07956
07957 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07958 }
07959
07960 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8) {
07961 typeless_idx = Typeless_8;
07962 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
07963 typeless_idx = Integer_8;
07964 # endif
07965
07966 }
07967 else {
07968 typeless_idx = TYPELESS_DEFAULT_TYPE;
07969 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
07970 typeless_idx = INTEGER_DEFAULT_TYPE;
07971 if (arg_info_list[info_idx1].ed.type == Integer) {
07972 typeless_idx = arg_info_list[info_idx1].ed.linear_type;
07973 }
07974 # endif
07975
07976 }
07977
07978 # ifdef _TARGET_OS_MAX
07979 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
07980 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
07981 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
07982 typeless_idx = Typeless_4;
07983 }
07984 # endif
07985
07986 conform_check(0,
07987 ir_idx,
07988 res_exp_desc,
07989 spec_idx,
07990 FALSE);
07991
07992 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07993 IR_RANK(ir_idx) = res_exp_desc->rank;
07994
07995 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
07996 IL_FLD(list_idx2) == CN_Tbl_Idx &&
07997 IL_FLD(list_idx3) == CN_Tbl_Idx) {
07998 fold_it = TRUE;
07999 }
08000
08001 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
08002
08003 IR_OPR(ir_idx) = Ibits_Opr;
08004 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
08005 IR_OPND_R(ir_idx) = null_opnd;
08006
08007 # else
08008
08009 line = IR_LINE_NUM(ir_idx);
08010 column = IR_COL_NUM(ir_idx);
08011
08012 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
08013 ATP_RSLT_IDX(*spec_idx)))] * 2;
08014
08015 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
08016
08017 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08018 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), line, column,
08019 IL_FLD(list_idx3), IL_IDX(list_idx3));
08020
08021 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
08022 Mask_Opr, typeless_idx, line, column,
08023 NO_Tbl_Idx, NULL_IDX);
08024
08025 NTR_IR_LIST_TBL(first_idx);
08026 IL_FLD(first_idx) = IR_Tbl_Idx;
08027 IL_IDX(first_idx) = mask_idx;
08028 NTR_IR_LIST_TBL(second_idx);
08029 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
08030 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08031
08032 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08033 Shiftl_Opr, typeless_idx, line, column,
08034 NO_Tbl_Idx, NULL_IDX);
08035
08036 COPY_OPND(opnd, IL_OPND(list_idx1));
08037 cast_opnd_to_type_idx(&opnd, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08038 COPY_OPND(IL_OPND(list_idx1), opnd);
08039
08040 band_idx = gen_ir(IR_Tbl_Idx, shiftl_idx,
08041 Band_Opr, typeless_idx, line, column,
08042 IL_FLD(list_idx1), IL_IDX(list_idx1));
08043
08044 NTR_IR_LIST_TBL(first_idx);
08045 IL_FLD(first_idx) = IR_Tbl_Idx;
08046 IL_IDX(first_idx) = band_idx;
08047 NTR_IR_LIST_TBL(second_idx);
08048 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
08049 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08050
08051 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
08052 Shiftr_Opr, typeless_idx, line, column,
08053 NO_Tbl_Idx, NULL_IDX);
08054
08055 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
08056
08057 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
08058
08059 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
08060 case Integer_1:
08061 num = BITSIZE_INT1_F90;
08062 break;
08063
08064 case Integer_2:
08065 num = BITSIZE_INT2_F90;
08066 break;
08067
08068 case Integer_4:
08069 num = BITSIZE_INT4_F90;
08070 break;
08071
08072 case Integer_8:
08073 num = BITSIZE_INT8_F90;
08074 break;
08075 }
08076
08077 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
08078
08079 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08080 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
08081 CN_Tbl_Idx, cn_idx2);
08082
08083 NTR_IR_LIST_TBL(first_idx);
08084 IL_FLD(first_idx) = IR_Tbl_Idx;
08085 IL_IDX(first_idx) = shiftr_idx;
08086 NTR_IR_LIST_TBL(second_idx);
08087 IL_FLD(second_idx) = IR_Tbl_Idx;
08088 IL_IDX(second_idx) = minus_idx;
08089 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08090
08091 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08092 Shiftl_Opr, typeless_idx, line, column,
08093 NO_Tbl_Idx, NULL_IDX);
08094
08095 NTR_IR_LIST_TBL(first_idx);
08096 IL_FLD(first_idx) = IR_Tbl_Idx;
08097 IL_IDX(first_idx) = shiftl_idx;
08098 NTR_IR_LIST_TBL(second_idx);
08099 IL_FLD(second_idx) = IR_Tbl_Idx;
08100 IL_IDX(second_idx) = minus_idx;
08101 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08102
08103 shifta_idx = gen_ir(IL_Tbl_Idx, first_idx,
08104 Shifta_Opr, typeless_idx, line, column,
08105 NO_Tbl_Idx, NULL_IDX);
08106
08107 IR_OPR(ir_idx) = Cvrt_Opr;
08108 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08109 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
08110 IR_IDX_L(ir_idx) = shifta_idx;
08111 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
08112 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
08113 IR_OPND_R(ir_idx) = null_opnd;
08114
08115 # endif
08116
08117 if (fold_it) {
08118 COPY_OPND(opnd, (*result_opnd));
08119 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
08120 COPY_OPND((*result_opnd), opnd);
08121 }
08122
08123 TRACE (Func_Exit, "ibits_intrinsic", NULL);
08124
08125 }
08126
08127
08128
08129
08130
08131
08132
08133
08134
08135
08136
08137
08138
08139
08140
08141
08142
08143
08144
08145
08146
08147 void btest_intrinsic(opnd_type *result_opnd,
08148 expr_arg_type *res_exp_desc,
08149 int *spec_idx)
08150 {
08151 int ir_idx;
08152 int cn_idx;
08153 int minus_idx;
08154 int shiftl_idx;
08155 int typeless_idx;
08156 int first_idx;
08157 int second_idx;
08158 int shiftr_idx;
08159 int info_idx1;
08160 int list_idx1;
08161 int list_idx2;
08162 int type_idx;
08163 int line;
08164 int column;
08165 long num;
08166
08167
08168 TRACE (Func_Entry, "btest_intrinsic", NULL);
08169
08170 ir_idx = OPND_IDX((*result_opnd));
08171 list_idx1 = IR_IDX_R(ir_idx);
08172 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
08173 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
08174 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
08175
08176 if (ATP_INTRIN_ENUM(*spec_idx) == Bitest_Intrinsic) {
08177 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Logical_2;
08178 }
08179 else if (ATP_INTRIN_ENUM(*spec_idx) == Bjtest_Intrinsic) {
08180 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Logical_4;
08181 }
08182 else if (ATP_INTRIN_ENUM(*spec_idx) == Bktest_Intrinsic) {
08183 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Logical_8;
08184 }
08185
08186 if (arg_info_list[info_idx1].ed.linear_type == Integer_8) {
08187 typeless_idx = Typeless_8;
08188 }
08189 else {
08190 typeless_idx = TYPELESS_DEFAULT_TYPE;
08191 }
08192
08193 # ifdef _TARGET_OS_MAX
08194 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
08195 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
08196 arg_info_list[info_idx1].ed.linear_type == Integer_4) {
08197 typeless_idx = Typeless_4;
08198 }
08199 # endif
08200
08201 conform_check(0,
08202 ir_idx,
08203 res_exp_desc,
08204 spec_idx,
08205 FALSE);
08206
08207 type_idx = INTEGER_DEFAULT_TYPE;
08208
08209 # ifdef _TARGET32
08210 if (arg_info_list[info_idx1].ed.linear_type == Integer_8) {
08211 type_idx = Integer_8;
08212 }
08213 # endif
08214
08215 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08216 IR_RANK(ir_idx) = res_exp_desc->rank;
08217 num = storage_bit_size_tbl[TYP_LINEAR(typeless_idx)] - 1;
08218
08219 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
08220
08221 line = IR_LINE_NUM(ir_idx);
08222 column = IR_COL_NUM(ir_idx);
08223
08224 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08225 Minus_Opr, type_idx, line, column,
08226 IL_FLD(list_idx2), IL_IDX(list_idx2));
08227
08228 NTR_IR_LIST_TBL(first_idx);
08229 COPY_OPND(IL_OPND(first_idx), IL_OPND(list_idx1));
08230 NTR_IR_LIST_TBL(second_idx);
08231 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08232 IL_FLD(second_idx) = IR_Tbl_Idx;
08233 IL_IDX(second_idx) = minus_idx;
08234
08235 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08236 Shiftl_Opr, typeless_idx, line, column,
08237 NO_Tbl_Idx, NULL_IDX);
08238
08239 NTR_IR_LIST_TBL(first_idx);
08240 IL_FLD(first_idx) = IR_Tbl_Idx;
08241 IL_IDX(first_idx) = shiftl_idx;
08242 NTR_IR_LIST_TBL(second_idx);
08243 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08244 IL_FLD(second_idx) = CN_Tbl_Idx;
08245 IL_IDX(second_idx) = cn_idx;
08246 IL_LINE_NUM(second_idx) = IR_LINE_NUM(ir_idx);
08247 IL_COL_NUM(second_idx) = IR_COL_NUM(ir_idx);
08248
08249 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
08250 Shifta_Opr, typeless_idx, line, column,
08251 NO_Tbl_Idx, NULL_IDX);
08252
08253 if (target_ieee) {
08254 IR_OPR(shiftr_idx) = Shiftr_Opr;
08255 }
08256
08257
08258 IR_OPR(ir_idx) = Cvrt_Opr;
08259 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
08260 IR_IDX_L(ir_idx) = shiftr_idx;
08261 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
08262 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
08263 IR_OPND_R(ir_idx) = null_opnd;
08264
08265
08266
08267
08268 res_exp_desc->foldable = FALSE;
08269 res_exp_desc->will_fold_later = FALSE;
08270
08271 TRACE (Func_Exit, "btest_intrinsic", NULL);
08272
08273 }
08274
08275
08276
08277
08278
08279
08280
08281
08282
08283
08284
08285
08286
08287
08288
08289
08290
08291
08292
08293
08294
08295
08296
08297
08298
08299
08300
08301
08302
08303 void ibset_intrinsic(opnd_type *result_opnd,
08304 expr_arg_type *res_exp_desc,
08305 int *spec_idx)
08306 {
08307 int ir_idx;
08308 int cn_idx;
08309 int cn_idx2;
08310 int info_idx1;
08311 int info_idx2;
08312 int list_idx1;
08313 int list_idx2;
08314 #ifdef KEY
08315 long num1 = 0;
08316 long num2 = 0;
08317 #else
08318 long num1;
08319 long num2;
08320 #endif
08321 int shiftl_idx;
08322 int shifta_idx;
08323 int csmg_idx;
08324 int minus_idx;
08325 int first_idx;
08326 int second_idx;
08327 int third_idx;
08328 int bor_idx;
08329 int band_idx;
08330 int bnot_idx;
08331 int bnot_idx1;
08332 #ifdef KEY
08333 int typeless_idx = 0;
08334 #else
08335 int typeless_idx;
08336 #endif
08337 opnd_type opnd;
08338 boolean fold_it = FALSE;
08339 int line;
08340 int column;
08341
08342
08343 TRACE (Func_Entry, "ibset_intrinsic", NULL);
08344
08345 ir_idx = OPND_IDX((*result_opnd));
08346 list_idx1 = IR_IDX_R(ir_idx);
08347 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
08348 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
08349 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
08350
08351 if (arg_info_list[info_idx1].ed.type == Typeless) {
08352 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
08353 arg_info_list[info_idx1].col);
08354 }
08355
08356 switch (arg_info_list[info_idx1].ed.linear_type) {
08357 case Typeless_1:
08358 case Integer_1:
08359 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_1;
08360 typeless_idx = Typeless_1;
08361 # ifdef _TARGET_OS_MAX
08362 typeless_idx = Typeless_4;
08363 # endif
08364 # ifdef _TARGET_OS_UNICOS
08365 typeless_idx = Typeless_8;
08366 # endif
08367 num1 = BITSIZE_INT1_F90 - 1;
08368 num2 = BITSIZE_INT1_F90;
08369 break;
08370
08371 case Typeless_2:
08372 case Integer_2:
08373 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_2;
08374 typeless_idx = Typeless_2;
08375 # ifdef _TARGET_OS_MAX
08376 typeless_idx = Typeless_4;
08377 # endif
08378 # ifdef _TARGET_OS_UNICOS
08379 typeless_idx = Typeless_8;
08380 # endif
08381 num1 = BITSIZE_INT2_F90 - 1;
08382 num2 = BITSIZE_INT2_F90;
08383 break;
08384
08385 case Typeless_4:
08386 case Integer_4:
08387 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_4;
08388 typeless_idx = Typeless_4;
08389 # ifdef _TARGET_OS_UNICOS
08390 typeless_idx = Typeless_8;
08391 # endif
08392 num1 = BITSIZE_INT4_F90 - 1;
08393 num2 = BITSIZE_INT4_F90;
08394 break;
08395
08396 case Typeless_8:
08397 case Integer_8:
08398 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
08399 typeless_idx = Typeless_8;
08400 num1 = BITSIZE_INT8_F90 - 1;
08401 num2 = BITSIZE_INT8_F90;
08402 break;
08403
08404 default:
08405 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal,
08406 IR_COL_NUM(ir_idx),
08407 "ibset_intrinsic");
08408 break;
08409 }
08410
08411 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
08412 if (compare_cn_and_value(IL_IDX(list_idx2), 0, Lt_Opr) ||
08413 compare_cn_and_value(IL_IDX(list_idx2), num1, Gt_Opr)) {
08414 PRINTMSG(arg_info_list[info_idx2].line, 1062, Error,
08415 arg_info_list[info_idx2].col);
08416 }
08417 }
08418
08419 conform_check(0,
08420 ir_idx,
08421 res_exp_desc,
08422 spec_idx,
08423 FALSE);
08424
08425 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08426 IR_RANK(ir_idx) = res_exp_desc->rank;
08427
08428 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
08429 IL_FLD(list_idx2) == CN_Tbl_Idx) {
08430 fold_it = TRUE;
08431 }
08432
08433 line = IR_LINE_NUM(ir_idx);
08434 column = IR_COL_NUM(ir_idx);
08435 cn_idx = (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) ==
08436 CG_INTEGER_DEFAULT_TYPE) ?
08437 CN_INTEGER_ONE_IDX :
08438 C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), 1);
08439
08440 NTR_IR_LIST_TBL(first_idx);
08441 IL_FLD(first_idx) = CN_Tbl_Idx;
08442 IL_IDX(first_idx) = cn_idx;
08443 IL_LINE_NUM(first_idx) = line;
08444 IL_COL_NUM(first_idx) = column;
08445
08446 NTR_IR_LIST_TBL(second_idx);
08447 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
08448 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08449
08450 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08451 Shiftl_Opr,
08452 typeless_idx,
08453 line, column,
08454 NO_Tbl_Idx, NULL_IDX);
08455
08456 COPY_OPND(opnd, IL_OPND(list_idx1));
08457 cast_opnd_to_type_idx(&opnd, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08458 COPY_OPND(IL_OPND(list_idx1), opnd);
08459
08460 num1=storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
08461
08462 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08463 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num2);
08464
08465 switch (ATP_INTRIN_ENUM(*spec_idx)) {
08466 case Ibset_Intrinsic:
08467 case Iibset_Intrinsic:
08468 case Jibset_Intrinsic:
08469 case Kibset_Intrinsic:
08470 bor_idx = gen_ir(IR_Tbl_Idx, shiftl_idx,
08471 Bor_Opr,
08472 typeless_idx,
08473 line, column,
08474 IL_FLD(list_idx1), IL_IDX(list_idx1));
08475
08476 NTR_IR_LIST_TBL(first_idx);
08477 IL_FLD(first_idx) = IR_Tbl_Idx;
08478 IL_IDX(first_idx) = bor_idx;
08479 break;
08480
08481
08482 case Ibclr_Intrinsic:
08483 case Iibclr_Intrinsic:
08484 case Jibclr_Intrinsic:
08485 case Kibclr_Intrinsic:
08486 bnot_idx = gen_ir(IR_Tbl_Idx, shiftl_idx,
08487 Bnot_Opr,
08488 typeless_idx,
08489 line, column,
08490 NO_Tbl_Idx, NULL_IDX);
08491
08492 band_idx = gen_ir(IR_Tbl_Idx, bnot_idx,
08493 Band_Opr,
08494 typeless_idx,
08495 line, column,
08496 IL_FLD(list_idx1), IL_IDX(list_idx1));
08497
08498 NTR_IR_LIST_TBL(first_idx);
08499 IL_FLD(first_idx) = IR_Tbl_Idx;
08500 IL_IDX(first_idx) = band_idx;
08501 break;
08502
08503
08504 case Ibchng_Intrinsic:
08505 case Iibchng_Intrinsic:
08506 case Jibchng_Intrinsic:
08507 case Kibchng_Intrinsic:
08508 bnot_idx = gen_ir(IR_Tbl_Idx, shiftl_idx,
08509 Bnot_Opr,
08510 typeless_idx,
08511 line, column,
08512 NO_Tbl_Idx, NULL_IDX);
08513
08514 COPY_OPND(opnd, IL_OPND(list_idx1));
08515 copy_subtree(&opnd, &opnd);
08516 bnot_idx1 = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
08517 Bnot_Opr,
08518 typeless_idx,
08519 line, column,
08520 NO_Tbl_Idx, NULL_IDX);
08521
08522 NTR_IR_LIST_TBL(first_idx);
08523 COPY_OPND(opnd, IL_OPND(list_idx1));
08524 copy_subtree(&opnd, &opnd);
08525 COPY_OPND(IL_OPND(first_idx), opnd);
08526
08527 NTR_IR_LIST_TBL(second_idx);
08528 IL_FLD(second_idx) = IR_Tbl_Idx;
08529 IL_IDX(second_idx) = bnot_idx1;
08530
08531 NTR_IR_LIST_TBL(third_idx);
08532 IL_FLD(third_idx) = IR_Tbl_Idx;
08533 IL_IDX(third_idx) = bnot_idx;
08534
08535 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08536 IL_NEXT_LIST_IDX(second_idx) = third_idx;
08537
08538 csmg_idx = gen_ir(IL_Tbl_Idx, first_idx,
08539 Csmg_Opr,
08540 typeless_idx,
08541 line, column,
08542 NO_Tbl_Idx, NULL_IDX);
08543
08544
08545 NTR_IR_LIST_TBL(first_idx);
08546 IL_FLD(first_idx) = IR_Tbl_Idx;
08547 IL_IDX(first_idx) = csmg_idx;
08548 break;
08549
08550
08551 default:
08552 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal,
08553 IR_COL_NUM(ir_idx),
08554 "ibset_intrinsic");
08555 break;
08556 }
08557
08558 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08559 Minus_Opr,
08560 CG_INTEGER_DEFAULT_TYPE,
08561 line, column,
08562 CN_Tbl_Idx, cn_idx2);
08563
08564 NTR_IR_LIST_TBL(second_idx);
08565 IL_FLD(second_idx) = IR_Tbl_Idx;
08566 IL_IDX(second_idx) = minus_idx;
08567 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08568
08569 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08570 Shiftl_Opr,
08571 typeless_idx,
08572 line, column,
08573 NO_Tbl_Idx, NULL_IDX);
08574
08575 NTR_IR_LIST_TBL(first_idx);
08576 IL_FLD(first_idx) = IR_Tbl_Idx;
08577 IL_IDX(first_idx) = shiftl_idx;
08578
08579 NTR_IR_LIST_TBL(second_idx);
08580 IL_FLD(second_idx) = IR_Tbl_Idx;
08581 IL_IDX(second_idx) = minus_idx;
08582 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08583
08584 shifta_idx = gen_ir(IL_Tbl_Idx, first_idx,
08585 Shifta_Opr,
08586 typeless_idx,
08587 line, column,
08588 NO_Tbl_Idx, NULL_IDX);
08589
08590 IR_OPR(ir_idx) = Cvrt_Opr;
08591 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08592 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
08593 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
08594 IR_IDX_L(ir_idx) = shifta_idx;
08595 IR_OPND_R(ir_idx) = null_opnd;
08596
08597 if (fold_it) {
08598 COPY_OPND(opnd, (*result_opnd));
08599 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
08600 COPY_OPND((*result_opnd), opnd);
08601 }
08602
08603 TRACE (Func_Exit, "ibset_intrinsic", NULL);
08604
08605 }
08606
08607
08608
08609
08610
08611
08612
08613
08614
08615
08616
08617
08618
08619
08620
08621
08622
08623
08624
08625
08626 void ishft_intrinsic(opnd_type *result_opnd,
08627 expr_arg_type *res_exp_desc,
08628 int *spec_idx)
08629 {
08630 int ir_idx;
08631 int gt_idx;
08632 int list_idx1;
08633 int list_idx2;
08634 int info_idx1;
08635 int info_idx2;
08636 int minus_idx;
08637 int first_idx;
08638 int second_idx;
08639 int third_idx;
08640 int shiftl_idx;
08641 int shiftr_idx;
08642 int shifta_idx;
08643 int shiftr_idx2;
08644 int cvmgt_idx;
08645 int typeless_idx;
08646 int cn_idx;
08647 operator_type opr;
08648 int cn_idx2;
08649 opnd_type opnd;
08650 boolean fold_it = FALSE;
08651 int line;
08652 int column;
08653 #ifdef KEY
08654 long num1 = 0;
08655 long num2 = 0;
08656 #else
08657 long num1;
08658 long num2;
08659 #endif
08660
08661
08662 TRACE (Func_Entry, "ishft_intrinsic", NULL);
08663
08664 ir_idx = OPND_IDX((*result_opnd));
08665 list_idx1 = IR_IDX_R(ir_idx);
08666 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
08667 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
08668 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
08669 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
08670
08671 if (ATP_INTRIN_ENUM(*spec_idx) == Isha_Intrinsic ||
08672 ATP_INTRIN_ENUM(*spec_idx) == Iisha_Intrinsic ||
08673 ATP_INTRIN_ENUM(*spec_idx) == Jisha_Intrinsic ||
08674 ATP_INTRIN_ENUM(*spec_idx) == Kisha_Intrinsic) {
08675 opr = Shifta_Opr;
08676 }
08677 else {
08678 opr = Shiftr_Opr;
08679 }
08680
08681 line = IR_LINE_NUM(ir_idx);
08682 column = IR_COL_NUM(ir_idx);
08683
08684 if (arg_info_list[info_idx1].ed.type == Typeless) {
08685 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
08686 arg_info_list[info_idx1].col);
08687
08688 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
08689 }
08690
08691 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8) {
08692 typeless_idx = Typeless_8;
08693 }
08694 else {
08695 typeless_idx = TYPELESS_DEFAULT_TYPE;
08696 }
08697
08698 # ifdef _TARGET_OS_MAX
08699 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
08700 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
08701 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
08702 typeless_idx = Typeless_4;
08703 }
08704 # endif
08705
08706 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
08707 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
08708 case Integer_1:
08709 num1 = BITSIZE_INT1_F90;
08710 num2 = -BITSIZE_INT1_F90;
08711 break;
08712
08713 case Integer_2:
08714 num1 = BITSIZE_INT2_F90;
08715 num2 = -BITSIZE_INT2_F90;
08716 break;
08717
08718 case Integer_4:
08719 num1 = BITSIZE_INT4_F90;
08720 num2 = -BITSIZE_INT4_F90;
08721 break;
08722
08723 case Integer_8:
08724 num1 = BITSIZE_INT8_F90;
08725 num2 = -BITSIZE_INT8_F90;
08726 break;
08727 }
08728
08729 if (compare_cn_and_value(IL_IDX(list_idx2), num1, Gt_Opr) ||
08730 compare_cn_and_value(IL_IDX(list_idx2), num2, Lt_Opr)) {
08731 PRINTMSG(arg_info_list[info_idx2].line, 1062, Error,
08732 arg_info_list[info_idx2].col);
08733 }
08734 }
08735
08736 conform_check(0,
08737 ir_idx,
08738 res_exp_desc,
08739 spec_idx,
08740 FALSE);
08741
08742 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08743 IR_RANK(ir_idx) = res_exp_desc->rank;
08744
08745 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
08746 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx)) {
08747
08748
08749
08750 COPY_OPND(opnd, IL_OPND(list_idx1));
08751 cast_to_type_idx(&opnd,
08752 &arg_info_list[info_idx1].ed,
08753 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08754 COPY_OPND(IL_OPND(list_idx1), opnd);
08755
08756 }
08757
08758 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
08759 TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx)) {
08760
08761
08762
08763 COPY_OPND(opnd, IL_OPND(list_idx2));
08764 cast_to_type_idx(&opnd,
08765 &arg_info_list[info_idx2].ed,
08766 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08767 COPY_OPND(IL_OPND(list_idx2), opnd);
08768
08769 }
08770
08771 if (opr == Shifta_Opr &&
08772 IL_FLD(list_idx2) == CN_Tbl_Idx) {
08773
08774 if (CN_INT_TO_C(IL_IDX(list_idx2)) == -8 &&
08775 arg_info_list[info_idx1].ed.linear_type == Integer_1) {
08776 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, -7);
08777 IL_IDX(list_idx2) = cn_idx;
08778 }
08779
08780 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == -16 &&
08781 arg_info_list[info_idx1].ed.linear_type == Integer_2) {
08782 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, -15);
08783 IL_IDX(list_idx2) = cn_idx;
08784 }
08785
08786 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == -32 &&
08787 arg_info_list[info_idx1].ed.linear_type == Integer_4) {
08788 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, -31);
08789 IL_IDX(list_idx2) = cn_idx;
08790 }
08791
08792 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == -64 &&
08793 arg_info_list[info_idx1].ed.linear_type == Integer_8) {
08794 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, -63);
08795 IL_IDX(list_idx2) = cn_idx;
08796 }
08797 }
08798
08799 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
08800 IL_FLD(list_idx2) == CN_Tbl_Idx) {
08801 fold_it = TRUE;
08802 }
08803
08804 num1 = register_bit_size_tbl[
08805 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
08806
08807 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08808
08809 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
08810 case Integer_1:
08811 num1 = BITSIZE_INT1_F90;
08812 break;
08813
08814 case Integer_2:
08815 num1 = BITSIZE_INT2_F90;
08816 break;
08817
08818 case Integer_4:
08819 num1 = BITSIZE_INT4_F90;
08820 break;
08821
08822 case Integer_8:
08823 num1 = BITSIZE_INT8_F90;
08824 break;
08825 }
08826
08827 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08828
08829 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08830 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
08831 CN_Tbl_Idx, cn_idx2);
08832
08833 NTR_IR_LIST_TBL(first_idx);
08834 COPY_OPND(IL_OPND(first_idx), IL_OPND(list_idx1));
08835 NTR_IR_LIST_TBL(second_idx);
08836 IL_FLD(second_idx) = IR_Tbl_Idx;
08837 IL_IDX(second_idx) = minus_idx;
08838 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08839
08840 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08841 Shiftl_Opr, typeless_idx, line, column,
08842 NO_Tbl_Idx, NULL_IDX);
08843
08844 NTR_IR_LIST_TBL(first_idx);
08845 IL_FLD(first_idx) = IR_Tbl_Idx;
08846 IL_IDX(first_idx) = shiftl_idx;
08847 NTR_IR_LIST_TBL(second_idx);
08848 IL_FLD(second_idx) = IR_Tbl_Idx;
08849 IL_IDX(second_idx) = minus_idx;
08850 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08851
08852 shiftr_idx2 = gen_ir(IL_Tbl_Idx, first_idx,
08853 opr, typeless_idx, line, column,
08854 NO_Tbl_Idx, NULL_IDX);
08855
08856
08857 NTR_IR_LIST_TBL(first_idx);
08858 IL_FLD(first_idx) = IR_Tbl_Idx;
08859 IL_IDX(first_idx) = shiftr_idx2;
08860 NTR_IR_LIST_TBL(second_idx);
08861 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
08862 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08863
08864 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08865 Shiftl_Opr, typeless_idx, line, column,
08866 NO_Tbl_Idx, NULL_IDX);
08867
08868
08869
08870 COPY_OPND(opnd, IL_OPND(list_idx2));
08871 copy_subtree(&opnd, &opnd);
08872
08873 minus_idx = gen_ir(CN_Tbl_Idx, CN_INTEGER_ZERO_IDX,
08874 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
08875 OPND_FLD(opnd), OPND_IDX(opnd));
08876
08877 NTR_IR_LIST_TBL(first_idx);
08878 IL_FLD(first_idx) = IR_Tbl_Idx;
08879 IL_IDX(first_idx) = shiftr_idx2;
08880 NTR_IR_LIST_TBL(second_idx);
08881 IL_FLD(second_idx) = IR_Tbl_Idx;
08882 IL_IDX(second_idx) = minus_idx;
08883 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08884
08885 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
08886 opr, typeless_idx, line, column,
08887 NO_Tbl_Idx, NULL_IDX);
08888
08889
08890
08891 COPY_OPND(opnd, IL_OPND(list_idx2));
08892 copy_subtree(&opnd, &opnd);
08893
08894 gt_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
08895 Gt_Opr, LOGICAL_DEFAULT_TYPE, line, column,
08896 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
08897
08898
08899 NTR_IR_LIST_TBL(first_idx);
08900 IL_ARG_DESC_VARIANT(first_idx) = TRUE;
08901 IL_FLD(first_idx) = IR_Tbl_Idx;
08902 IL_IDX(first_idx) = shiftl_idx;
08903
08904 NTR_IR_LIST_TBL(second_idx);
08905 IL_ARG_DESC_VARIANT(second_idx) = TRUE;
08906 IL_FLD(second_idx) = IR_Tbl_Idx;
08907 IL_IDX(second_idx) = shiftr_idx;
08908
08909 NTR_IR_LIST_TBL(third_idx);
08910 IL_ARG_DESC_VARIANT(third_idx) = TRUE;
08911 IL_FLD(third_idx) = IR_Tbl_Idx;
08912 IL_IDX(third_idx) = gt_idx;
08913
08914 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08915 IL_NEXT_LIST_IDX(second_idx) = third_idx;
08916
08917 cvmgt_idx = gen_ir(IL_Tbl_Idx, first_idx,
08918 Cvmgt_Opr, typeless_idx, line, column,
08919 NO_Tbl_Idx, NULL_IDX);
08920
08921
08922 io_item_must_flatten = TRUE;
08923
08924 if (fold_it) {
08925 if (compare_cn_and_value(IL_IDX(list_idx2), 0, Gt_Opr)) {
08926 cvmgt_idx = shiftl_idx;
08927 }
08928 else {
08929 cvmgt_idx = shiftr_idx;
08930 }
08931 }
08932
08933 num1 = register_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
08934 ATP_RSLT_IDX(*spec_idx)))];
08935
08936 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08937
08938 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
08939 case Integer_1:
08940 num1 = BITSIZE_INT1_F90;
08941 break;
08942
08943 case Integer_2:
08944 num1 = BITSIZE_INT2_F90;
08945 break;
08946
08947 case Integer_4:
08948 num1 = BITSIZE_INT4_F90;
08949 break;
08950
08951 case Integer_8:
08952 num1 = BITSIZE_INT8_F90;
08953 break;
08954 }
08955
08956 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08957
08958 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08959 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
08960 CN_Tbl_Idx, cn_idx2);
08961
08962 NTR_IR_LIST_TBL(first_idx);
08963 IL_FLD(first_idx) = IR_Tbl_Idx;
08964 IL_IDX(first_idx) = cvmgt_idx;
08965 NTR_IR_LIST_TBL(second_idx);
08966 IL_FLD(second_idx) = IR_Tbl_Idx;
08967 IL_IDX(second_idx) = minus_idx;
08968 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08969
08970 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08971 Shiftl_Opr, typeless_idx, line, column,
08972 NO_Tbl_Idx, NULL_IDX);
08973
08974 NTR_IR_LIST_TBL(first_idx);
08975 IL_FLD(first_idx) = IR_Tbl_Idx;
08976 IL_IDX(first_idx) = shiftl_idx;
08977 NTR_IR_LIST_TBL(second_idx);
08978 IL_FLD(second_idx) = IR_Tbl_Idx;
08979 IL_IDX(second_idx) = minus_idx;
08980 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08981
08982 shifta_idx = gen_ir(IL_Tbl_Idx, first_idx,
08983 Shifta_Opr, typeless_idx, line, column,
08984 NO_Tbl_Idx, NULL_IDX);
08985
08986 #ifdef KEY
08987
08988
08989
08990
08991
08992
08993
08994
08995
08996
08997 int abs_width_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd), Abs_Opr,
08998 arg_info_list[info_idx2].ed.type_idx, line, column, NO_Tbl_Idx,
08999 NULL_IDX);
09000 int ge_width_idx = gen_ir(IR_Tbl_Idx, abs_width_idx, Ge_Opr,
09001 LOGICAL_DEFAULT_TYPE, line, column, CN_Tbl_Idx, cn_idx2);
09002
09003 int zero_idx = CN_INTEGER_ZERO_IDX;
09004 int minusone_idx = CN_INTEGER_NEG_ONE_IDX;
09005 fld_type zero_fld = CN_Tbl_Idx;
09006 fld_type minusone_fld = CN_Tbl_Idx;
09007 if (arg_info_list[info_idx1].ed.type_idx != Integer_4) {
09008 zero_idx = gen_ir(CN_Tbl_Idx, zero_idx, Cvrt_Opr,
09009 arg_info_list[info_idx1].ed.type_idx, line, column,
09010 NO_Tbl_Idx, NULL_IDX);
09011 minusone_idx = gen_ir(CN_Tbl_Idx, minusone_idx, Cvrt_Opr,
09012 arg_info_list[info_idx1].ed.type_idx, line, column,
09013 NO_Tbl_Idx, NULL_IDX);
09014 zero_fld = IR_Tbl_Idx;
09015 minusone_fld = IR_Tbl_Idx;
09016 }
09017
09018 NTR_IR_LIST_TBL(first_idx);
09019 IL_ARG_DESC_VARIANT(first_idx) = TRUE;
09020 IL_FLD(first_idx) = zero_fld;
09021 IL_IDX(first_idx) = zero_idx;
09022 IL_LINE_NUM(first_idx) = line;
09023 IL_COL_NUM(first_idx) = column;
09024
09025 NTR_IR_LIST_TBL(second_idx);
09026 IL_ARG_DESC_VARIANT(second_idx) = TRUE;
09027 IL_FLD(second_idx) = minusone_fld;
09028 IL_IDX(second_idx) = minusone_idx;
09029 IL_LINE_NUM(second_idx) = line;
09030 IL_COL_NUM(second_idx) = column;
09031
09032 NTR_IR_LIST_TBL(third_idx);
09033 IL_ARG_DESC_VARIANT(third_idx) = TRUE;
09034 IL_FLD(third_idx) = IR_Tbl_Idx;
09035 IL_IDX(third_idx) = ge_width_idx;
09036
09037 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09038 IL_NEXT_LIST_IDX(second_idx) = third_idx;
09039
09040 int cmove_idx = gen_ir(IL_Tbl_Idx, first_idx, Cvmgt_Opr, typeless_idx, line,
09041 column, NO_Tbl_Idx, NULL_IDX);
09042
09043 shifta_idx = gen_ir(IR_Tbl_Idx, cmove_idx, Band_Opr, typeless_idx, line,
09044 column, IR_Tbl_Idx, shifta_idx);
09045 #endif
09046
09047 IR_OPR(ir_idx) = Cvrt_Opr;
09048 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
09049 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
09050 IR_IDX_L(ir_idx) = shifta_idx;
09051 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
09052 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
09053 IR_FLD_R(ir_idx) = NO_Tbl_Idx;
09054 IR_IDX_R(ir_idx) = NULL_IDX;
09055
09056 if (fold_it) {
09057 COPY_OPND(opnd, (*result_opnd));
09058 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
09059 COPY_OPND((*result_opnd), opnd);
09060 }
09061
09062 TRACE (Func_Exit, "ishft_intrinsic", NULL);
09063
09064 }
09065
09066
09067
09068
09069
09070
09071
09072
09073
09074
09075
09076
09077
09078
09079
09080
09081
09082
09083
09084 void ishftc_intrinsic(opnd_type *result_opnd,
09085 expr_arg_type *res_exp_desc,
09086 int *spec_idx)
09087 {
09088
09089 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
09090 int ishft2_idx;
09091 int minus_idx;
09092 int uminus_idx;
09093 int shift_idx;
09094 int shiftl_idx;
09095 int shifta_idx;
09096 int mask_idx;
09097 int sign_idx;
09098 int csmg_idx;
09099 int abs_idx;
09100 int ior_idx;
09101 int plus_idx;
09102 int band_idx;
09103 int band1_idx;
09104 int first_idx;
09105 int second_idx;
09106 int third_idx;
09107 int cn_idx2;
09108 opnd_type save_opnd;
09109 int line;
09110 int column;
09111 int ishft1_idx;
09112 # endif
09113
09114 int cn_idx;
09115 boolean fold_it = FALSE;
09116 int ir_idx;
09117 int list_idx1;
09118 int list_idx2;
09119 int list_idx3;
09120 int info_idx1;
09121 int info_idx2;
09122 #ifdef KEY
09123 int info_idx3 = 0;
09124 long num = 0;
09125 #else
09126 int info_idx3;
09127 long num;
09128 #endif
09129 opnd_type opnd;
09130 int typeless_idx;
09131
09132
09133 TRACE (Func_Entry, "ishftc_intrinsic", NULL);
09134
09135 ir_idx = OPND_IDX((*result_opnd));
09136 list_idx1 = IR_IDX_R(ir_idx);
09137 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
09138 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
09139 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
09140 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
09141 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
09142
09143 if (arg_info_list[info_idx1].ed.type == Typeless) {
09144 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
09145 arg_info_list[info_idx1].col);
09146
09147 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
09148 }
09149
09150 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8) {
09151 typeless_idx = Typeless_8;
09152 }
09153 else {
09154 typeless_idx = TYPELESS_DEFAULT_TYPE;
09155 }
09156
09157 # ifdef _TARGET_OS_MAX
09158 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
09159 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
09160 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
09161 typeless_idx = Typeless_4;
09162 }
09163 # endif
09164
09165 conform_check(3,
09166 ir_idx,
09167 res_exp_desc,
09168 spec_idx,
09169 FALSE);
09170
09171 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
09172 IR_RANK(ir_idx) = res_exp_desc->rank;
09173
09174 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
09175 case Integer_1:
09176 num = BITSIZE_INT1_F90;
09177 break;
09178
09179 case Integer_2:
09180 num = BITSIZE_INT2_F90;
09181 break;
09182
09183 case Integer_4:
09184 num = BITSIZE_INT4_F90;
09185 break;
09186
09187 case Integer_8:
09188 num = BITSIZE_INT8_F90;
09189 break;
09190 }
09191
09192 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
09193
09194 if (ATP_INTRIN_ENUM(*spec_idx) != Ishc_Intrinsic &&
09195 ATP_INTRIN_ENUM(*spec_idx) != Iishc_Intrinsic &&
09196 ATP_INTRIN_ENUM(*spec_idx) != Jishc_Intrinsic &&
09197 ATP_INTRIN_ENUM(*spec_idx) != Kishc_Intrinsic) {
09198 if (IL_IDX(list_idx3) == NULL_IDX) {
09199 IL_FLD(list_idx3) = CN_Tbl_Idx;
09200 IL_IDX(list_idx3) = cn_idx;
09201 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
09202 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
09203
09204 arg_info_list_base = arg_info_list_top;
09205 arg_info_list_top = arg_info_list_base + 1;
09206
09207 if (arg_info_list_top >= arg_info_list_size) {
09208 enlarge_info_list_table();
09209 }
09210
09211 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
09212 arg_info_list[arg_info_list_top] = init_arg_info;
09213 arg_info_list[arg_info_list_top].ed.type_idx =
09214 CG_INTEGER_DEFAULT_TYPE;
09215 arg_info_list[arg_info_list_top].ed.type = Integer;
09216 arg_info_list[arg_info_list_top].ed.linear_type =
09217 CG_INTEGER_DEFAULT_TYPE;
09218 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
09219 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
09220
09221 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
09222 }
09223 else {
09224 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
09225 #ifdef KEY
09226 if (NULL_IDX != is_optional_dummy(list_idx3)) {
09227 pass_dummy_or_default_const(list_idx3, cn_idx, FALSE);
09228 }
09229 #endif
09230 }
09231 }
09232 else {
09233 NTR_IR_LIST_TBL(list_idx3);
09234 IL_FLD(list_idx3) = CN_Tbl_Idx;
09235 IL_IDX(list_idx3) = cn_idx;
09236 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
09237 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
09238 IL_NEXT_LIST_IDX(list_idx2) = list_idx3;
09239 IR_LIST_CNT_R(ir_idx) = 3;
09240 }
09241
09242 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
09243 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx)) {
09244
09245
09246
09247 COPY_OPND(opnd, IL_OPND(list_idx1));
09248 cast_to_type_idx(&opnd,
09249 &arg_info_list[info_idx1].ed,
09250 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
09251 COPY_OPND(IL_OPND(list_idx1), opnd);
09252 }
09253
09254 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
09255 TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx)) {
09256
09257
09258
09259 COPY_OPND(opnd, IL_OPND(list_idx2));
09260 cast_to_type_idx(&opnd,
09261 &arg_info_list[info_idx2].ed,
09262 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
09263 COPY_OPND(IL_OPND(list_idx2), opnd);
09264 }
09265
09266 if (ATP_INTRIN_ENUM(*spec_idx) != Ishc_Intrinsic &&
09267 ATP_INTRIN_ENUM(*spec_idx) != Iishc_Intrinsic &&
09268 ATP_INTRIN_ENUM(*spec_idx) != Jishc_Intrinsic &&
09269 ATP_INTRIN_ENUM(*spec_idx) != Kishc_Intrinsic) {
09270 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
09271 TYP_LINEAR(arg_info_list[info_idx3].ed.type_idx)) {
09272
09273
09274
09275 COPY_OPND(opnd, IL_OPND(list_idx3));
09276 cast_to_type_idx(&opnd,
09277 &arg_info_list[info_idx3].ed,
09278 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
09279 COPY_OPND(IL_OPND(list_idx3), opnd);
09280 }
09281
09282 if (IL_FLD(list_idx3) == CN_Tbl_Idx) {
09283 if (compare_cn_and_value(IL_IDX(list_idx3), num, Gt_Opr)) {
09284 PRINTMSG(arg_info_list[info_idx3].line, 1062, Error,
09285 arg_info_list[info_idx3].col);
09286 }
09287 }
09288 }
09289
09290 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
09291 IL_FLD(list_idx2) == CN_Tbl_Idx &&
09292 IL_FLD(list_idx3) == CN_Tbl_Idx) {
09293 fold_it = TRUE;
09294 }
09295
09296 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
09297
09298 IR_OPR(ir_idx) = Ishftc_Opr;
09299 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
09300 IR_OPND_R(ir_idx) = null_opnd;
09301
09302 # else
09303
09304 line = IR_LINE_NUM(ir_idx);
09305 column = IR_COL_NUM(ir_idx);
09306
09307
09308
09309 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
09310 ATP_RSLT_IDX(*spec_idx)))] * 2;
09311 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09312
09313 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09314 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09315 IL_FLD(list_idx3), IL_IDX(list_idx3));
09316
09317 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
09318 Mask_Opr, typeless_idx, line, column,
09319 NO_Tbl_Idx, NULL_IDX);
09320
09321 COPY_OPND(opnd, IL_OPND(list_idx1));
09322 cast_opnd_to_type_idx(&opnd, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
09323 COPY_OPND(IL_OPND(list_idx1), opnd);
09324
09325 band1_idx = gen_ir(IR_Tbl_Idx, mask_idx,
09326 Band_Opr, typeless_idx, line, column,
09327 IL_FLD(list_idx1), IL_IDX(list_idx1));
09328
09329
09330
09331 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
09332
09333 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09334
09335 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09336 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09337 IL_FLD(list_idx2), IL_IDX(list_idx2));
09338
09339 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
09340 Mask_Opr, typeless_idx, line, column,
09341 NO_Tbl_Idx, NULL_IDX);
09342
09343 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
09344
09345 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09346
09347 COPY_OPND(opnd, IL_OPND(list_idx2));
09348 copy_subtree(&opnd, &opnd);
09349
09350 plus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09351 Plus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09352 OPND_FLD(opnd), OPND_IDX(opnd));
09353
09354 num = storage_bit_size_tbl[TYP_LINEAR(
09355 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))] - 1;
09356
09357 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09358
09359 band_idx = gen_ir(IR_Tbl_Idx, plus_idx,
09360 Band_Opr, typeless_idx, line, column,
09361 CN_Tbl_Idx, cn_idx);
09362
09363 NTR_IR_LIST_TBL(first_idx);
09364 IL_FLD(first_idx) = IR_Tbl_Idx;
09365 IL_IDX(first_idx) = band1_idx;
09366 NTR_IR_LIST_TBL(second_idx);
09367 IL_FLD(second_idx) = IR_Tbl_Idx;
09368 IL_IDX(second_idx) = band_idx;
09369 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09370
09371 shift_idx = gen_ir(IL_Tbl_Idx, first_idx,
09372 Shift_Opr, typeless_idx, line, column,
09373 NO_Tbl_Idx, NULL_IDX);
09374
09375 ishft1_idx = gen_ir(IR_Tbl_Idx, shift_idx,
09376 Band_Opr, typeless_idx, line, column,
09377 IR_Tbl_Idx, mask_idx);
09378
09379
09380
09381 COPY_OPND(opnd, IL_OPND(list_idx2));
09382 copy_subtree(&opnd, &opnd);
09383
09384 abs_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
09385 Abs_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09386 NO_Tbl_Idx, NULL_IDX);
09387
09388 COPY_OPND(opnd, IL_OPND(list_idx3));
09389 copy_subtree(&opnd, &opnd);
09390
09391 minus_idx = gen_ir(IR_Tbl_Idx, abs_idx,
09392 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09393 OPND_FLD(opnd), OPND_IDX(opnd));
09394
09395 NTR_IR_LIST_TBL(first_idx);
09396 IL_FLD(first_idx) = IR_Tbl_Idx;
09397 IL_IDX(first_idx) = minus_idx;
09398 NTR_IR_LIST_TBL(second_idx);
09399
09400 COPY_OPND(opnd, IL_OPND(list_idx2));
09401 copy_subtree(&opnd, &opnd);
09402
09403 COPY_OPND(IL_OPND(second_idx), opnd);
09404 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09405
09406 sign_idx = gen_ir(IL_Tbl_Idx, first_idx,
09407 Sign_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09408 NO_Tbl_Idx, NULL_IDX);
09409
09410 uminus_idx = gen_ir(IR_Tbl_Idx, sign_idx,
09411 Uminus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09412 NO_Tbl_Idx, NULL_IDX);
09413
09414
09415
09416 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
09417
09418 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09419
09420 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09421 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09422 IR_Tbl_Idx, uminus_idx);
09423
09424 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
09425 Mask_Opr, typeless_idx, line, column,
09426 NO_Tbl_Idx, NULL_IDX);
09427
09428 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
09429 ATP_RSLT_IDX(*spec_idx)))];
09430
09431 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09432
09433 plus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09434 Plus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09435 IR_Tbl_Idx, uminus_idx);
09436
09437 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
09438 ATP_RSLT_IDX(*spec_idx)))] - 1;
09439
09440 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09441
09442 band_idx = gen_ir(IR_Tbl_Idx, plus_idx,
09443 Band_Opr, typeless_idx, line, column,
09444 CN_Tbl_Idx, cn_idx);
09445
09446 NTR_IR_LIST_TBL(first_idx);
09447 IL_FLD(first_idx) = IR_Tbl_Idx;
09448 IL_IDX(first_idx) = band1_idx;
09449 NTR_IR_LIST_TBL(second_idx);
09450 IL_FLD(second_idx) = IR_Tbl_Idx;
09451 IL_IDX(second_idx) = band_idx;
09452 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09453
09454 shift_idx = gen_ir(IL_Tbl_Idx, first_idx,
09455 Shift_Opr, typeless_idx, line, column,
09456 NO_Tbl_Idx, NULL_IDX);
09457
09458 ishft2_idx = gen_ir(IR_Tbl_Idx, shift_idx,
09459 Band_Opr, typeless_idx, line, column,
09460 IR_Tbl_Idx, mask_idx);
09461
09462
09463
09464 ior_idx = gen_ir(IR_Tbl_Idx, ishft1_idx,
09465 Bor_Opr, typeless_idx, line, column,
09466 IR_Tbl_Idx, ishft2_idx);
09467
09468
09469
09470 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
09471
09472 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09473
09474 COPY_OPND(opnd, IL_OPND(list_idx3));
09475 copy_subtree(&opnd, &opnd);
09476
09477 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09478 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09479 OPND_FLD(opnd), OPND_IDX(opnd));
09480
09481 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
09482 Mask_Opr, typeless_idx, line, column,
09483 NO_Tbl_Idx, NULL_IDX);
09484
09485
09486
09487 NTR_IR_LIST_TBL(first_idx);
09488 IL_ARG_DESC_VARIANT(first_idx) = TRUE;
09489 COPY_OPND(opnd, IL_OPND(list_idx1));
09490 copy_subtree(&opnd, &opnd);
09491 COPY_OPND(IL_OPND(first_idx), opnd);
09492
09493 NTR_IR_LIST_TBL(second_idx);
09494 IL_ARG_DESC_VARIANT(second_idx) = TRUE;
09495 IL_FLD(second_idx) = IR_Tbl_Idx;
09496 IL_IDX(second_idx) = ior_idx;
09497
09498 NTR_IR_LIST_TBL(third_idx);
09499 IL_ARG_DESC_VARIANT(third_idx) = TRUE;
09500 IL_FLD(third_idx) = IR_Tbl_Idx;
09501 IL_IDX(third_idx) = mask_idx;
09502
09503 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09504 IL_NEXT_LIST_IDX(second_idx) = third_idx;
09505
09506 csmg_idx = gen_ir(IL_Tbl_Idx, first_idx,
09507 Csmg_Opr, typeless_idx, line, column,
09508 NO_Tbl_Idx, NULL_IDX);
09509
09510 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
09511 ATP_RSLT_IDX(*spec_idx)))];
09512
09513 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09514
09515 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
09516 case Integer_1:
09517 num = BITSIZE_INT1_F90;
09518 break;
09519
09520 case Integer_2:
09521 num = BITSIZE_INT2_F90;
09522 break;
09523
09524 case Integer_4:
09525 num = BITSIZE_INT4_F90;
09526 break;
09527
09528 case Integer_8:
09529 num = BITSIZE_INT8_F90;
09530 break;
09531 }
09532
09533 cn_idx2 = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09534
09535 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09536 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09537 CN_Tbl_Idx, cn_idx2);
09538
09539 NTR_IR_LIST_TBL(first_idx);
09540 IL_FLD(first_idx) = IR_Tbl_Idx;
09541 IL_IDX(first_idx) = csmg_idx;
09542 NTR_IR_LIST_TBL(second_idx);
09543 IL_FLD(second_idx) = IR_Tbl_Idx;
09544 IL_IDX(second_idx) = minus_idx;
09545 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09546
09547 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
09548 Shiftl_Opr, typeless_idx, line, column,
09549 NO_Tbl_Idx, NULL_IDX);
09550
09551 NTR_IR_LIST_TBL(first_idx);
09552 IL_FLD(first_idx) = IR_Tbl_Idx;
09553 IL_IDX(first_idx) = shiftl_idx;
09554 NTR_IR_LIST_TBL(second_idx);
09555 IL_FLD(second_idx) = IR_Tbl_Idx;
09556 IL_IDX(second_idx) = minus_idx;
09557 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09558
09559 shifta_idx = gen_ir(IL_Tbl_Idx, first_idx,
09560 Shifta_Opr, typeless_idx, line, column,
09561 NO_Tbl_Idx, NULL_IDX);
09562
09563 IR_OPR(ir_idx) = Cvrt_Opr;
09564 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
09565 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
09566 IR_IDX_L(ir_idx) = shifta_idx;
09567 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
09568 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
09569 IR_OPND_R(ir_idx) = null_opnd;
09570
09571 # endif
09572
09573 if (fold_it) {
09574 COPY_OPND(opnd, (*result_opnd));
09575 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
09576 COPY_OPND((*result_opnd), opnd);
09577 }
09578
09579 TRACE (Func_Exit, "ishftc_intrinsic", NULL);
09580
09581 }
09582
09583
09584
09585
09586
09587
09588
09589
09590
09591
09592
09593
09594
09595
09596
09597
09598
09599
09600
09601
09602
09603 void mvbits_intrinsic(opnd_type *result_opnd,
09604 expr_arg_type *res_exp_desc,
09605 int *spec_idx)
09606 {
09607 int info_idx1;
09608 int info_idx2;
09609 int info_idx3;
09610 int info_idx4;
09611 int info_idx5;
09612 int ir_idx;
09613 int list_idx1;
09614 int list_idx2;
09615 int list_idx3;
09616 int list_idx4;
09617 int list_idx5;
09618 int mask_idx;
09619 int minus_idx;
09620 int shiftr_idx;
09621 int shiftl_idx;
09622 int shiftl1_idx;
09623 int shiftl2_idx;
09624 int csmg_idx;
09625 int band_idx;
09626 int first_idx;
09627 int second_idx;
09628 int third_idx;
09629 int cn_idx;
09630 int u_idx;
09631 int type_idx;
09632 int typeless_idx;
09633 opnd_type opnd;
09634 opnd_type left_hand_side_opnd;
09635 int line;
09636 int column;
09637 long num;
09638
09639
09640 TRACE (Func_Entry, "mvbits_intrinsic", NULL);
09641
09642 ir_idx = OPND_IDX((*result_opnd));
09643
09644 conform_check(0,
09645 ir_idx,
09646 res_exp_desc,
09647 spec_idx,
09648 FALSE);
09649
09650 list_idx1 = IR_IDX_R(ir_idx);
09651 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
09652 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
09653 list_idx4 = IL_NEXT_LIST_IDX(list_idx3);
09654 list_idx5 = IL_NEXT_LIST_IDX(list_idx4);
09655
09656 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
09657 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
09658 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
09659 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
09660 info_idx5 = IL_ARG_DESC_IDX(list_idx5);
09661
09662 if (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) !=
09663 TYP_LINEAR(arg_info_list[info_idx4].ed.type_idx)) {
09664 PRINTMSG(arg_info_list[info_idx1].line, 727, Error,
09665 arg_info_list[info_idx1].col);
09666 }
09667
09668 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
09669 arg_info_list[info_idx4].ed.linear_type == Integer_8) {
09670 type_idx = Integer_8;
09671 }
09672 else {
09673 type_idx = INTEGER_DEFAULT_TYPE;
09674 }
09675
09676 if (TYP_LINEAR(type_idx) == Integer_8) {
09677 typeless_idx = Typeless_8;
09678 }
09679 else {
09680 typeless_idx = TYPELESS_DEFAULT_TYPE;
09681 }
09682
09683 # ifdef _TARGET_OS_MAX
09684 if (TYP_LINEAR(type_idx) == Integer_1 ||
09685 TYP_LINEAR(type_idx) == Integer_2 ||
09686 TYP_LINEAR(type_idx) == Integer_4) {
09687 typeless_idx = Typeless_4;
09688 }
09689 # endif
09690
09691 if (res_exp_desc->rank != arg_info_list[info_idx4].ed.rank) {
09692 PRINTMSG(arg_info_list[info_idx4].line, 1093, Error,
09693 arg_info_list[info_idx4].col);
09694 }
09695
09696 if (TYP_LINEAR(type_idx) !=
09697 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx)) {
09698
09699
09700
09701 COPY_OPND(opnd, IL_OPND(list_idx1));
09702 cast_to_type_idx(&opnd,
09703 &arg_info_list[info_idx1].ed,
09704 type_idx);
09705 COPY_OPND(IL_OPND(list_idx1), opnd);
09706
09707 }
09708
09709 if (TYP_LINEAR(type_idx) !=
09710 TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx)) {
09711
09712
09713
09714 COPY_OPND(opnd, IL_OPND(list_idx2));
09715 cast_to_type_idx(&opnd,
09716 &arg_info_list[info_idx2].ed,
09717 type_idx);
09718 COPY_OPND(IL_OPND(list_idx2), opnd);
09719
09720 }
09721
09722 if (TYP_LINEAR(type_idx) !=
09723 TYP_LINEAR(arg_info_list[info_idx3].ed.type_idx)) {
09724
09725
09726
09727 COPY_OPND(opnd, IL_OPND(list_idx3));
09728 cast_to_type_idx(&opnd,
09729 &arg_info_list[info_idx3].ed,
09730 type_idx);
09731 COPY_OPND(IL_OPND(list_idx3), opnd);
09732
09733 }
09734
09735
09736
09737 COPY_OPND(left_hand_side_opnd, IL_OPND(list_idx4));
09738
09739 if (TYP_LINEAR(type_idx) !=
09740 TYP_LINEAR(arg_info_list[info_idx4].ed.type_idx)) {
09741
09742
09743
09744 COPY_OPND(opnd, IL_OPND(list_idx4));
09745 cast_to_type_idx(&opnd,
09746 &arg_info_list[info_idx4].ed,
09747 type_idx);
09748 COPY_OPND(IL_OPND(list_idx4), opnd);
09749
09750 }
09751
09752 if (TYP_LINEAR(type_idx) !=
09753 TYP_LINEAR(arg_info_list[info_idx5].ed.type_idx)) {
09754
09755
09756
09757 COPY_OPND(opnd, IL_OPND(list_idx5));
09758 cast_to_type_idx(&opnd,
09759 &arg_info_list[info_idx5].ed,
09760 type_idx);
09761 COPY_OPND(IL_OPND(list_idx5), opnd);
09762
09763 }
09764
09765 line = IR_LINE_NUM(ir_idx);
09766 column = IR_COL_NUM(ir_idx);
09767
09768
09769
09770 num = storage_bit_size_tbl[TYP_LINEAR(typeless_idx)] * 2;
09771 cn_idx = C_INT_TO_CN(type_idx, num);
09772
09773 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09774 Minus_Opr, type_idx, line, column,
09775 IL_FLD(list_idx3), IL_IDX(list_idx3));
09776
09777 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
09778 Mask_Opr, typeless_idx, line, column,
09779 NO_Tbl_Idx, NULL_IDX);
09780
09781 NTR_IR_LIST_TBL(first_idx);
09782 IL_FLD(first_idx) = IR_Tbl_Idx;
09783 IL_IDX(first_idx) = mask_idx;
09784 NTR_IR_LIST_TBL(second_idx);
09785 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx5));
09786 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09787
09788 shiftl1_idx = gen_ir(IL_Tbl_Idx, first_idx,
09789 Shiftl_Opr, typeless_idx, line, column,
09790 NO_Tbl_Idx, NULL_IDX);
09791
09792
09793 NTR_IR_LIST_TBL(first_idx);
09794 IL_FLD(first_idx) = IR_Tbl_Idx;
09795 IL_IDX(first_idx) = mask_idx;
09796 NTR_IR_LIST_TBL(second_idx);
09797 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
09798 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09799
09800 shiftl2_idx = gen_ir(IL_Tbl_Idx, first_idx,
09801 Shiftl_Opr, typeless_idx, line, column,
09802 NO_Tbl_Idx, NULL_IDX);
09803
09804 band_idx = gen_ir(IR_Tbl_Idx, shiftl2_idx,
09805 Band_Opr, typeless_idx, line, column,
09806 IL_FLD(list_idx1), IL_IDX(list_idx1));
09807
09808 NTR_IR_LIST_TBL(first_idx);
09809 IL_FLD(first_idx) = IR_Tbl_Idx;
09810 IL_IDX(first_idx) = band_idx;
09811 NTR_IR_LIST_TBL(second_idx);
09812 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
09813 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09814
09815 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
09816 Shiftr_Opr, typeless_idx, line, column,
09817 NO_Tbl_Idx, NULL_IDX);
09818
09819 NTR_IR_LIST_TBL(first_idx);
09820 IL_FLD(first_idx) = IR_Tbl_Idx;
09821 IL_IDX(first_idx) = shiftr_idx;
09822 NTR_IR_LIST_TBL(second_idx);
09823 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx5));
09824 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09825
09826 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
09827 Shiftl_Opr, typeless_idx, line, column,
09828 NO_Tbl_Idx, NULL_IDX);
09829
09830
09831
09832 NTR_IR_LIST_TBL(first_idx);
09833 IL_ARG_DESC_VARIANT(first_idx) = TRUE;
09834 IL_FLD(first_idx) = IR_Tbl_Idx;
09835 IL_IDX(first_idx) = shiftl_idx;
09836
09837 NTR_IR_LIST_TBL(second_idx);
09838 IL_ARG_DESC_VARIANT(second_idx) = TRUE;
09839 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx4));
09840
09841 NTR_IR_LIST_TBL(third_idx);
09842 IL_ARG_DESC_VARIANT(third_idx) = TRUE;
09843 IL_FLD(third_idx) = IR_Tbl_Idx;
09844 IL_IDX(third_idx) = shiftl1_idx;
09845
09846 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09847 IL_NEXT_LIST_IDX(second_idx) = third_idx;
09848
09849 csmg_idx = gen_ir(IL_Tbl_Idx, first_idx,
09850 Csmg_Opr, typeless_idx, line, column,
09851 NO_Tbl_Idx, NULL_IDX);
09852
09853 u_idx = gen_ir(IR_Tbl_Idx, csmg_idx,
09854 Cvrt_Unsigned_Opr, type_idx, line, column,
09855 NO_Tbl_Idx, NULL_IDX);
09856
09857 IR_OPR(ir_idx) = Asg_Opr;
09858 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
09859 IR_OPR(ir_idx) = Mvbits_Opr;
09860 # else
09861 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
09862 IR_IDX_R(ir_idx) = u_idx;
09863 # endif
09864
09865 IR_TYPE_IDX(ir_idx) = type_idx;
09866 COPY_OPND(IR_OPND_L(ir_idx), left_hand_side_opnd);
09867
09868
09869
09870
09871 res_exp_desc->foldable = FALSE;
09872 res_exp_desc->will_fold_later = FALSE;
09873
09874 TRACE (Func_Exit, "mvbits_intrinsic", NULL);
09875
09876 }
09877
09878
09879
09880
09881
09882
09883
09884
09885
09886
09887
09888
09889
09890
09891
09892
09893
09894
09895 void exit_intrinsic(opnd_type *result_opnd,
09896 expr_arg_type *res_exp_desc,
09897 int *spec_idx)
09898 {
09899 int ir_idx;
09900
09901
09902 TRACE (Func_Entry, "exit_intrinsic", NULL);
09903
09904 ir_idx = OPND_IDX((*result_opnd));
09905 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
09906
09907
09908
09909
09910 res_exp_desc->foldable = FALSE;
09911 res_exp_desc->will_fold_later = FALSE;
09912
09913 TRACE (Func_Exit, "exit_intrinsic", NULL);
09914
09915 }
09916
09917
09918
09919
09920
09921
09922
09923
09924
09925
09926
09927
09928
09929
09930
09931
09932
09933
09934
09935 void system_clock_intrinsic(opnd_type *result_opnd,
09936 expr_arg_type *res_exp_desc,
09937 int *spec_idx)
09938 {
09939 int ir_idx;
09940 int info_idx1;
09941 int info_idx2;
09942 int info_idx3;
09943 int list_idx1;
09944 int list_idx2;
09945 int list_idx3;
09946
09947
09948 TRACE (Func_Entry, "system_clock_intrinsic", NULL);
09949
09950 ir_idx = OPND_IDX((*result_opnd));
09951 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
09952
09953 list_idx1 = IR_IDX_R(ir_idx);
09954 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
09955 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
09956
09957 #ifdef KEY
09958
09959
09960
09961
09962
09963
09964
09965
09966
09967
09968
09969
09970
09971
09972
09973
09974
09975
09976
09977
09978
09979
09980
09981
09982 #else
09983 if ((list_idx3 != NULL_IDX) && (IL_IDX(list_idx3) != NULL_IDX)) {
09984 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
09985 if (arg_info_list[info_idx3].ed.type_idx != INTEGER_DEFAULT_TYPE) {
09986 PRINTMSG(arg_info_list[info_idx3].line, 1533, Error,
09987 arg_info_list[info_idx3].col);
09988 }
09989 }
09990
09991 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
09992 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
09993 if (arg_info_list[info_idx2].ed.type_idx != INTEGER_DEFAULT_TYPE) {
09994 PRINTMSG(arg_info_list[info_idx2].line, 1533, Error,
09995 arg_info_list[info_idx2].col);
09996 }
09997 }
09998
09999 if ((list_idx1 != NULL_IDX) && (IL_IDX(list_idx1) != NULL_IDX)) {
10000 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10001 if (arg_info_list[info_idx1].ed.type_idx != INTEGER_DEFAULT_TYPE) {
10002 PRINTMSG(arg_info_list[info_idx1].line, 1533, Error,
10003 arg_info_list[info_idx1].col);
10004 }
10005 }
10006 #endif
10007
10008
10009
10010
10011 res_exp_desc->foldable = FALSE;
10012 res_exp_desc->will_fold_later = FALSE;
10013
10014 TRACE (Func_Exit, "system_clock_intrinsic", NULL);
10015
10016 }
10017
10018
10019
10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
10032
10033
10034
10035
10036 void idate_intrinsic(opnd_type *result_opnd,
10037 expr_arg_type *res_exp_desc,
10038 int *spec_idx)
10039 {
10040 int ir_idx;
10041 int info_idx1;
10042 int info_idx2;
10043 int info_idx3;
10044 int list_idx1;
10045 int list_idx2;
10046 int list_idx3;
10047
10048 TRACE (Func_Entry, "idate_intrinsic", NULL);
10049
10050 ir_idx = OPND_IDX((*result_opnd));
10051
10052 list_idx1 = IR_IDX_R(ir_idx);
10053 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
10054 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
10055 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10056 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
10057 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
10058
10059 if (IL_FLD(list_idx1) == CN_Tbl_Idx) {
10060 PRINTMSG(arg_info_list[info_idx1].line, 1650, Error,
10061 arg_info_list[info_idx1].col);
10062 }
10063
10064 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
10065 PRINTMSG(arg_info_list[info_idx2].line, 1650, Error,
10066 arg_info_list[info_idx2].col);
10067 }
10068
10069 if (IL_FLD(list_idx3) == CN_Tbl_Idx) {
10070 PRINTMSG(arg_info_list[info_idx3].line, 1650, Error,
10071 arg_info_list[info_idx3].col);
10072 }
10073
10074
10075
10076
10077
10078 res_exp_desc->foldable = FALSE;
10079 res_exp_desc->will_fold_later = FALSE;
10080
10081 TRACE (Func_Exit, "idate_intrinsic", NULL);
10082
10083 }
10084
10085
10086
10087
10088
10089
10090
10091
10092
10093
10094
10095
10096
10097
10098
10099
10100
10101
10102
10103 void random_seed_intrinsic(opnd_type *result_opnd,
10104 expr_arg_type *res_exp_desc,
10105 int *spec_idx)
10106 {
10107 int ir_idx;
10108 int cn_idx;
10109 int info_idx1;
10110 int info_idx2;
10111 int info_idx3;
10112 int list_idx1;
10113 int list_idx2;
10114 int list_idx3;
10115 int loc_idx;
10116 int ranget_idx;
10117 int ranset_idx;
10118 int ranf_idx;
10119 int tmp_attr;
10120 int unused1 = NULL_IDX;
10121 int unused2 = NULL_IDX;
10122 opnd_type old_opnd;
10123 opnd_type base_opnd;
10124 int line;
10125 int column;
10126
10127
10128 TRACE (Func_Entry, "random_seed_intrinsic", NULL);
10129
10130 ir_idx = OPND_IDX((*result_opnd));
10131 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
10132
10133 line = IR_LINE_NUM(ir_idx);
10134 column = IR_COL_NUM(ir_idx);
10135
10136 #ifdef KEY
10137 int args[3];
10138 args[0] = list_idx1 = IR_IDX_R(ir_idx);
10139 args[1] = list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
10140 args[2] = list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
10141
10142
10143
10144
10145
10146 int nargs = 0;
10147 for (int i = 0; i < (sizeof(args) / sizeof(*args)); i += 1) {
10148 nargs += NULL_IDX != IL_IDX(args[i]) &&
10149 NULL_IDX == is_optional_dummy(args[i]);
10150 }
10151 if (nargs > 1)
10152 #else
10153 list_idx1 = IR_IDX_R(ir_idx);
10154 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
10155 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
10156
10157 if (((IL_IDX(list_idx1) != NULL_IDX) &&
10158 (IL_IDX(list_idx2) != NULL_IDX)) ||
10159 ((IL_IDX(list_idx1) != NULL_IDX) &&
10160 (IL_IDX(list_idx3) != NULL_IDX)) ||
10161 ((IL_IDX(list_idx2) != NULL_IDX) &&
10162 (IL_IDX(list_idx3) != NULL_IDX)))
10163 #endif
10164 {
10165 PRINTMSG(IR_LINE_NUM(ir_idx), 830, Error,
10166 IR_COL_NUM(ir_idx));
10167 }
10168
10169
10170 if ((list_idx3 != NULL_IDX) && (IL_IDX(list_idx3) != NULL_IDX)) {
10171
10172 COPY_OPND(old_opnd, IL_OPND(list_idx3));
10173 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
10174
10175 if (IL_FLD(list_idx3) == CN_Tbl_Idx) {
10176 PRINTMSG(arg_info_list[info_idx3].line, 1214, Error,
10177 arg_info_list[info_idx3].col);
10178 }
10179
10180 if (! arg_info_list[info_idx3].ed.reference &&
10181 ! arg_info_list[info_idx3].ed.tmp_reference) {
10182
10183 tmp_attr = create_tmp_asg(&old_opnd,
10184 (expr_arg_type *)&(arg_info_list[info_idx3].ed),
10185 &base_opnd,
10186 Intent_In,
10187 TRUE,
10188 FALSE);
10189
10190 COPY_OPND(old_opnd, base_opnd);
10191 }
10192
10193 if (arg_info_list[info_idx3].ed.rank > 0) {
10194 make_base_subtree(&old_opnd, &base_opnd, &unused1, &unused2);
10195 }
10196 else {
10197 COPY_OPND(base_opnd, old_opnd);
10198 }
10199
10200 loc_idx = gen_ir(OPND_FLD(base_opnd), OPND_IDX(base_opnd),
10201 Aloc_Opr, CRI_Ptr_8, line, column,
10202 NO_Tbl_Idx, NULL_IDX);
10203
10204 ranget_idx = gen_ir(IR_Tbl_Idx, loc_idx,
10205 Ranget_Opr, TYPELESS_DEFAULT_TYPE, line, column,
10206 NO_Tbl_Idx, NULL_IDX);
10207
10208 IR_OPR(ir_idx) = Asg_Opr;
10209 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_L(loc_idx));
10210 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10211 IR_IDX_R(ir_idx) = ranget_idx;
10212 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
10213 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
10214 }
10215 else if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10216
10217 COPY_OPND(old_opnd, IL_OPND(list_idx2));
10218 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
10219
10220 if (! arg_info_list[info_idx2].ed.reference &&
10221 ! arg_info_list[info_idx2].ed.tmp_reference) {
10222 tmp_attr = create_tmp_asg(&old_opnd,
10223 (expr_arg_type *)&(arg_info_list[info_idx2].ed),
10224 &base_opnd,
10225 Intent_In,
10226 TRUE,
10227 FALSE);
10228
10229 COPY_OPND(old_opnd, base_opnd);
10230 }
10231
10232 if (arg_info_list[info_idx2].ed.rank > 0) {
10233 make_base_subtree(&old_opnd, &base_opnd, &unused1, &unused2);
10234 }
10235 else {
10236 COPY_OPND(base_opnd, old_opnd);
10237 }
10238
10239 ranset_idx = gen_ir(OPND_FLD(base_opnd), OPND_IDX(base_opnd),
10240 Ranset_Opr, TYPELESS_DEFAULT_TYPE, line, column,
10241 NO_Tbl_Idx, NULL_IDX);
10242
10243 IR_OPR(ir_idx) = Asg_Opr;
10244 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_L(ranset_idx));
10245 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10246 IR_IDX_R(ir_idx) = ranset_idx;
10247 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
10248 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
10249 }
10250 else if ((list_idx1 != NULL_IDX) && (IL_IDX(list_idx1) != NULL_IDX)) {
10251 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10252
10253 if (IL_FLD(list_idx1) == CN_Tbl_Idx) {
10254 PRINTMSG(arg_info_list[info_idx1].line, 1214, Error,
10255 arg_info_list[info_idx1].col);
10256 }
10257
10258
10259 # if (defined(KEY))
10260 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 32);
10261 # elif (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
10262 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 64);
10263 # else
10264 cn_idx = CN_INTEGER_ONE_IDX;
10265 # endif
10266
10267 IR_OPR(ir_idx) = Asg_Opr;
10268 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10269 IR_FLD_R(ir_idx) = CN_Tbl_Idx;
10270 IR_IDX_R(ir_idx) = cn_idx;
10271 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
10272 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
10273 }
10274 else {
10275
10276 ranf_idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10277 Ranf_Opr, REAL_DEFAULT_TYPE, line, column,
10278 NO_Tbl_Idx, NULL_IDX);
10279
10280 tree_has_ranf = TRUE;
10281
10282 tmp_attr = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
10283 IR_COL_NUM(ir_idx),
10284 Priv, TRUE);
10285 ATD_STOR_BLK_IDX(tmp_attr) = SCP_SB_STACK_IDX(curr_scp_idx);
10286 ATD_TYPE_IDX(tmp_attr) = REAL_DEFAULT_TYPE;
10287 AT_SEMANTICS_DONE(tmp_attr) = TRUE;
10288
10289 IR_OPR(ir_idx) = Asg_Opr;
10290 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
10291 IR_IDX_L(ir_idx) = tmp_attr;
10292 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10293 IR_IDX_R(ir_idx) = ranf_idx;
10294 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
10295 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
10296 }
10297
10298
10299
10300
10301 res_exp_desc->foldable = FALSE;
10302 res_exp_desc->will_fold_later = FALSE;
10303
10304 TRACE (Func_Exit, "random_seed_intrinsic", NULL);
10305
10306 }
10307
10308
10309
10310
10311
10312
10313
10314
10315
10316
10317
10318
10319
10320
10321
10322
10323
10324
10325
10326
10327
10328
10329
10330
10331
10332 void get_ieee_status_intrinsic(opnd_type *result_opnd,
10333 expr_arg_type *res_exp_desc,
10334 int *spec_idx)
10335 {
10336 int idx;
10337 int idx1;
10338 int ir_idx;
10339 int info_idx1;
10340 int list_idx1;
10341 int line;
10342 int column;
10343
10344
10345 TRACE (Func_Entry, "get_ieee_status_intrinsic", NULL);
10346
10347 ir_idx = OPND_IDX((*result_opnd));
10348 list_idx1 = IR_IDX_R(ir_idx);
10349 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10350
10351 line = IR_LINE_NUM(ir_idx);
10352 column = IR_COL_NUM(ir_idx);
10353
10354 conform_check(0,
10355 ir_idx,
10356 res_exp_desc,
10357 spec_idx,
10358 FALSE);
10359
10360 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10361
10362 case Get_Ieee_Status_Intrinsic:
10363 IR_OPR(ir_idx) = Asg_Opr;
10364 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10365
10366 NTR_IR_LIST_TBL(idx1);
10367 IL_FLD(idx1) = CN_Tbl_Idx;
10368 IL_IDX(idx1) = CN_INTEGER_ZERO_IDX;
10369 IL_LINE_NUM(idx1) = IR_LINE_NUM(ir_idx);
10370 IL_COL_NUM(idx1) = IR_COL_NUM(ir_idx);
10371
10372 idx = gen_ir(IL_Tbl_Idx, idx1,
10373 Get_Ieee_Status_Opr, arg_info_list[info_idx1].ed.type_idx,
10374 line, column,
10375 NO_Tbl_Idx, NULL_IDX);
10376
10377 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10378 IR_IDX_R(ir_idx) = idx;
10379 break;
10380
10381 case Set_Ieee_Status_Intrinsic:
10382 IR_OPR(ir_idx) = Set_Ieee_Status_Opr;
10383 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10384 IR_IDX_R(ir_idx) = NULL_IDX;
10385 IR_FLD_R(ir_idx) = NO_Tbl_Idx;
10386 break;
10387
10388 case Get_Ieee_Exceptions_Intrinsic:
10389 IR_OPR(ir_idx) = Asg_Opr;
10390 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10391
10392 idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10393 Get_Ieee_Exceptions_Opr, arg_info_list[info_idx1].ed.type_idx,
10394 line, column,
10395 NO_Tbl_Idx, NULL_IDX);
10396
10397 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10398 IR_IDX_R(ir_idx) = idx;
10399 break;
10400
10401 case Set_Ieee_Exceptions_Intrinsic:
10402 IR_OPR(ir_idx) = Set_Ieee_Exceptions_Opr;
10403 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10404 IR_OPND_R(ir_idx) = null_opnd;
10405 break;
10406
10407 case Get_Ieee_Interrupts_Intrinsic:
10408 IR_OPR(ir_idx) = Asg_Opr;
10409 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10410
10411 idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10412 Get_Ieee_Interrupts_Opr, arg_info_list[info_idx1].ed.type_idx,
10413 line, column,
10414 NO_Tbl_Idx, NULL_IDX);
10415
10416 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10417 IR_IDX_R(ir_idx) = idx;
10418 break;
10419
10420 case Set_Ieee_Interrupts_Intrinsic:
10421 IR_OPR(ir_idx) = Set_Ieee_Interrupts_Opr;
10422 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10423 IR_OPND_R(ir_idx) = null_opnd;
10424 break;
10425
10426 case Get_Ieee_Rounding_Mode_Intrinsic:
10427 IR_OPR(ir_idx) = Asg_Opr;
10428 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10429
10430 idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10431 Get_Ieee_Rounding_Mode_Opr,
10432 arg_info_list[info_idx1].ed.type_idx, line, column,
10433 NO_Tbl_Idx, NULL_IDX);
10434
10435 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10436 IR_IDX_R(ir_idx) = idx;
10437 break;
10438
10439 case Set_Ieee_Rounding_Mode_Intrinsic:
10440 IR_OPR(ir_idx) = Set_Ieee_Rounding_Mode_Opr;
10441 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10442 IR_OPND_R(ir_idx) = null_opnd;
10443 break;
10444 }
10445
10446 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
10447 IR_RANK(ir_idx) = res_exp_desc->rank;
10448
10449
10450
10451
10452 res_exp_desc->foldable = FALSE;
10453 res_exp_desc->will_fold_later = FALSE;
10454
10455 TRACE (Func_Exit, "get_ieee_status_intrinsic", NULL);
10456
10457 }
10458
10459
10460
10461
10462
10463
10464
10465
10466
10467
10468
10469
10470
10471
10472
10473
10474
10475
10476
10477 void test_ieee_interrupt_intrinsic(opnd_type *result_opnd,
10478 expr_arg_type *res_exp_desc,
10479 int *spec_idx)
10480 {
10481 int ir_idx;
10482
10483
10484 TRACE (Func_Entry, "test_ieee_interrupt_intrinsic", NULL);
10485
10486 ir_idx = OPND_IDX((*result_opnd));
10487 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
10488
10489 conform_check(0,
10490 ir_idx,
10491 res_exp_desc,
10492 spec_idx,
10493 FALSE);
10494
10495 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10496
10497 case Test_Ieee_Interrupt_Intrinsic:
10498 IR_OPR(ir_idx) = Test_Ieee_Interrupt_Opr;
10499 break;
10500
10501 case Test_Ieee_Exception_Intrinsic:
10502 IR_OPR(ir_idx) = Test_Ieee_Exception_Opr;
10503 break;
10504 }
10505
10506 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10507 IR_RANK(ir_idx) = res_exp_desc->rank;
10508
10509 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10510 IR_OPND_R(ir_idx) = null_opnd;
10511
10512
10513
10514
10515 res_exp_desc->foldable = FALSE;
10516 res_exp_desc->will_fold_later = FALSE;
10517
10518 TRACE (Func_Exit, "test_ieee_interrupt_intrinsic", NULL);
10519
10520 }
10521
10522
10523
10524
10525
10526
10527
10528
10529
10530
10531
10532
10533
10534
10535
10536
10537
10538
10539
10540
10541
10542 void set_ieee_exception_intrinsic(opnd_type *result_opnd,
10543 expr_arg_type *res_exp_desc,
10544 int *spec_idx)
10545 {
10546 int ir_idx;
10547 int idx;
10548 int info_idx1;
10549 int list_idx1;
10550
10551 TRACE (Func_Entry, "set_ieee_exception_intrinsic", NULL);
10552
10553 ir_idx = OPND_IDX((*result_opnd));
10554 list_idx1 = IR_IDX_R(ir_idx);
10555 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10556
10557 conform_check(0,
10558 ir_idx,
10559 res_exp_desc,
10560 spec_idx,
10561 FALSE);
10562
10563 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10564
10565 case Set_Ieee_Exception_Intrinsic:
10566 IR_OPR(ir_idx) = Set_Ieee_Exception_Opr;
10567
10568 NTR_IR_LIST_TBL(idx);
10569 IL_NEXT_LIST_IDX(list_idx1) = idx;
10570 IL_FLD(idx) = CN_Tbl_Idx;
10571 IL_IDX(idx) = CN_INTEGER_ONE_IDX;
10572 IL_LINE_NUM(idx) = IR_LINE_NUM(ir_idx);
10573 IL_COL_NUM(idx) = IR_COL_NUM(ir_idx);
10574 IR_LIST_CNT_R(ir_idx) = 2;
10575 break;
10576
10577 case Clear_Ieee_Exception_Intrinsic:
10578 IR_OPR(ir_idx) = Clear_Ieee_Exception_Opr;
10579
10580 NTR_IR_LIST_TBL(idx);
10581 IL_NEXT_LIST_IDX(list_idx1) = idx;
10582 IL_FLD(idx) = CN_Tbl_Idx;
10583 IL_IDX(idx) = CN_INTEGER_ZERO_IDX;
10584 IL_LINE_NUM(idx) = IR_LINE_NUM(ir_idx);
10585 IL_COL_NUM(idx) = IR_COL_NUM(ir_idx);
10586 IR_LIST_CNT_R(ir_idx) = 2;
10587 break;
10588
10589 case Enable_Ieee_Interrupt_Intrinsic:
10590 IR_OPR(ir_idx) = Enable_Ieee_Interrupt_Opr;
10591 break;
10592
10593 case Disable_Ieee_Interrupt_Intrinsic:
10594 IR_OPR(ir_idx) = Disable_Ieee_Interrupt_Opr;
10595 break;
10596 }
10597
10598 if (arg_info_list[info_idx1].ed.rank > 1) {
10599 PRINTMSG(arg_info_list[info_idx1].line, 654, Error,
10600 arg_info_list[info_idx1].col);
10601 }
10602
10603 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
10604 IR_RANK(ir_idx) = res_exp_desc->rank;
10605
10606 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10607 IR_OPND_R(ir_idx) = null_opnd;
10608
10609
10610
10611
10612 res_exp_desc->foldable = FALSE;
10613 res_exp_desc->will_fold_later = FALSE;
10614
10615 TRACE (Func_Exit, "set_ieee_exception_intrinsic", NULL);
10616
10617 }
10618
10619
10620
10621
10622
10623
10624
10625
10626
10627
10628
10629
10630
10631
10632
10633
10634
10635
10636
10637
10638
10639
10640
10641
10642
10643
10644 void ieee_real_intrinsic(opnd_type *result_opnd,
10645 expr_arg_type *res_exp_desc,
10646 int *spec_idx)
10647 {
10648 int ir_idx;
10649 int list_idx1;
10650 int list_idx2;
10651 int info_idx1;
10652 #ifdef KEY
10653 int info_idx2 = 0;
10654 #else
10655 int info_idx2;
10656 #endif
10657 opnd_type opnd;
10658
10659
10660 TRACE (Func_Entry, "ieee_real_intrinsic", NULL);
10661
10662 ir_idx = OPND_IDX((*result_opnd));
10663 list_idx1 = IR_IDX_R(ir_idx);
10664 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
10665 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10666 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10667 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
10668 }
10669
10670 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10671 case Ieee_Int_Intrinsic:
10672 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10673
10674 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10675 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10676 arg_info_list[info_idx2].ed.type_idx;
10677 }
10678
10679 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
10680 IR_LIST_CNT_R(ir_idx) = 1;
10681 IR_OPR(ir_idx) = Ieee_Int_Opr;
10682 break;
10683
10684 case Ieee_Real_Intrinsic:
10685 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = REAL_DEFAULT_TYPE;
10686
10687 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10688 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10689 arg_info_list[info_idx2].ed.type_idx;
10690 }
10691
10692 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
10693 IR_LIST_CNT_R(ir_idx) = 1;
10694 IR_OPR(ir_idx) = Ieee_Real_Opr;
10695 break;
10696
10697 case Int_Mult_Upper_Intrinsic:
10698 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10699 arg_info_list[info_idx1].ed.type_idx;
10700
10701 if (arg_info_list[info_idx1].ed.type == Typeless) {
10702 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10703
10704 COPY_OPND(opnd, IL_OPND(list_idx1));
10705 cast_opnd_to_type_idx(&opnd, INTEGER_DEFAULT_TYPE);
10706 COPY_OPND(IL_OPND(list_idx1), opnd);
10707
10708 COPY_OPND(opnd, IL_OPND(list_idx2));
10709 cast_opnd_to_type_idx(&opnd, INTEGER_DEFAULT_TYPE);
10710 COPY_OPND(IL_OPND(list_idx2), opnd);
10711 }
10712
10713 IR_OPR(ir_idx) = Int_Mult_Upper_Opr;
10714 break;
10715
10716 case Ieee_Exponent_Intrinsic:
10717 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10718
10719 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10720 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10721 arg_info_list[info_idx2].ed.type_idx;
10722
10723 if (arg_info_list[info_idx2].ed.rank != 0) {
10724 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
10725 arg_info_list[info_idx2].col);
10726 }
10727 }
10728
10729 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
10730 IR_LIST_CNT_R(ir_idx) = 1;
10731 IR_OPR(ir_idx) = Ieee_Exponent_Opr;
10732 break;
10733
10734 case Ieee_Remainder_Intrinsic:
10735 if (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) >
10736 TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx)) {
10737 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10738 arg_info_list[info_idx1].ed.type_idx;
10739 }
10740 else {
10741 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10742 arg_info_list[info_idx2].ed.type_idx;
10743 }
10744 IR_OPR(ir_idx) = Ieee_Remainder_Opr;
10745 break;
10746
10747 case Ieee_Unordered_Intrinsic:
10748 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
10749 IR_OPR(ir_idx) = Ieee_Unordered_Opr;
10750 break;
10751
10752 case Ieee_Binary_Scale_Intrinsic:
10753 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10754 arg_info_list[info_idx1].ed.type_idx;
10755 IR_OPR(ir_idx) = Ieee_Binary_Scale_Opr;
10756 break;
10757
10758 case Ieee_Next_After_Intrinsic:
10759 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10760 arg_info_list[info_idx1].ed.type_idx;
10761 IR_OPR(ir_idx) = Ieee_Next_After_Opr;
10762 break;
10763
10764 case Ieee_Copy_Sign_Intrinsic:
10765 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10766 arg_info_list[info_idx1].ed.type_idx;
10767 IR_OPR(ir_idx) = Ieee_Copy_Sign_Opr;
10768 break;
10769 }
10770
10771 conform_check(0,
10772 ir_idx,
10773 res_exp_desc,
10774 spec_idx,
10775 FALSE);
10776
10777 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10778 IR_RANK(ir_idx) = res_exp_desc->rank;
10779
10780 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10781 IR_OPND_R(ir_idx) = null_opnd;
10782
10783
10784
10785
10786 res_exp_desc->foldable = FALSE;
10787 res_exp_desc->will_fold_later = FALSE;
10788
10789 TRACE (Func_Exit, "ieee_real_intrinsic", NULL);
10790
10791 }
10792
10793
10794
10795
10796
10797
10798
10799
10800
10801
10802
10803
10804
10805
10806
10807
10808
10809
10810
10811
10812
10813
10814
10815 void ieee_finite_intrinsic(opnd_type *result_opnd,
10816 expr_arg_type *res_exp_desc,
10817 int *spec_idx)
10818 {
10819 int ir_idx;
10820
10821
10822 TRACE (Func_Entry, "ieee_finite_intrinsic", NULL);
10823
10824 ir_idx = OPND_IDX((*result_opnd));
10825
10826 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10827
10828 case Ieee_Finite_Intrinsic:
10829 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
10830 IR_OPR(ir_idx) = Ieee_Finite_Opr;
10831 break;
10832
10833 case Ieee_Is_Nan_Intrinsic:
10834 case Isnan_Intrinsic:
10835 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
10836 IR_OPR(ir_idx) = Ieee_Is_Nan_Opr;
10837 break;
10838
10839 case Ieee_Class_Intrinsic:
10840 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10841 IR_OPR(ir_idx) = Ieee_Class_Opr;
10842 break;
10843
10844 case Fp_Class_Intrinsic:
10845 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10846 break;
10847 }
10848
10849 conform_check(0,
10850 ir_idx,
10851 res_exp_desc,
10852 spec_idx,
10853 FALSE);
10854
10855 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10856 IR_RANK(ir_idx) = res_exp_desc->rank;
10857
10858 if (ATP_INTRIN_ENUM(*spec_idx) != Fp_Class_Intrinsic) {
10859 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10860 IR_OPND_R(ir_idx) = null_opnd;
10861 }
10862
10863
10864
10865
10866 res_exp_desc->foldable = FALSE;
10867 res_exp_desc->will_fold_later = FALSE;
10868
10869 TRACE (Func_Exit, "ieee_finite_intrinsic", NULL);
10870
10871 }
10872
10873
10874
10875
10876
10877
10878
10879
10880
10881
10882
10883
10884
10885
10886
10887
10888
10889
10890 void lock_release_intrinsic(opnd_type *result_opnd,
10891 expr_arg_type *res_exp_desc,
10892 int *spec_idx)
10893 {
10894 int ir_idx;
10895
10896
10897 TRACE (Func_Entry, "lock_release_intrinsic", NULL);
10898
10899 ir_idx = OPND_IDX((*result_opnd));
10900 IR_TYPE_IDX(ir_idx) = REAL_DEFAULT_TYPE;
10901
10902 IR_OPR(ir_idx) = Lock_Release_Opr;
10903 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10904 IR_OPND_R(ir_idx) = null_opnd;
10905
10906 io_item_must_flatten = TRUE;
10907
10908
10909
10910
10911 res_exp_desc->foldable = FALSE;
10912 res_exp_desc->will_fold_later = FALSE;
10913
10914 TRACE (Func_Exit, "lock_release_intrinsic", NULL);
10915
10916 }
10917
10918
10919
10920
10921
10922
10923
10924
10925
10926
10927
10928
10929
10930
10931
10932
10933
10934
10935
10936 void random_number_intrinsic(opnd_type *result_opnd,
10937 expr_arg_type *res_exp_desc,
10938 int *spec_idx)
10939 {
10940 int ir_idx;
10941 int list_idx1;
10942 int info_idx1;
10943 int ranf_idx;
10944 int attr_idx;
10945 int line;
10946 int col;
10947
10948
10949 TRACE (Func_Entry, "random_number_intrinsic", NULL);
10950
10951 ir_idx = OPND_IDX((*result_opnd));
10952 IR_TYPE_IDX(ir_idx) = REAL_DEFAULT_TYPE;
10953 list_idx1 = IR_IDX_R(ir_idx);
10954 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10955 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
10956
10957 if (arg_info_list[info_idx1].ed.reference) {
10958 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
10959 AT_DEFINED(attr_idx) = TRUE;
10960
10961 if ((AT_OBJ_CLASS(attr_idx) == Data_Obj) &&
10962 (ATD_CLASS(attr_idx) == Function_Result) &&
10963 (ATD_FUNC_IDX(attr_idx) != NULL_IDX)) {
10964 AT_DEFINED(ATD_FUNC_IDX(attr_idx)) = TRUE;
10965 }
10966 }
10967
10968 if (IL_FLD(list_idx1) == CN_Tbl_Idx) {
10969 PRINTMSG(arg_info_list[info_idx1].line, 1214, Error,
10970 arg_info_list[info_idx1].col);
10971 }
10972
10973 ranf_idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10974 Ranf_Opr, IR_TYPE_IDX(ir_idx), IR_LINE_NUM(ir_idx),
10975 IR_COL_NUM(ir_idx),
10976 NO_Tbl_Idx, NULL_IDX);
10977
10978 IR_OPR(ir_idx) = Asg_Opr;
10979 IR_FLD_L(ir_idx) = IL_FLD(list_idx1);
10980 IR_IDX_L(ir_idx) = IL_IDX(list_idx1);
10981 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10982 IR_IDX_R(ir_idx) = ranf_idx;
10983 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
10984 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
10985 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
10986 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
10987
10988
10989
10990
10991 res_exp_desc->foldable = FALSE;
10992 res_exp_desc->will_fold_later = FALSE;
10993
10994 TRACE (Func_Exit, "random_number_intrinsic", NULL);
10995
10996 }
10997
10998
10999
11000
11001
11002
11003
11004
11005
11006
11007
11008
11009
11010
11011
11012
11013
11014
11015
11016
11017 void all_intrinsic(opnd_type *result_opnd,
11018 expr_arg_type *res_exp_desc,
11019 int *spec_idx)
11020 {
11021 int list_idx1;
11022 int list_idx2;
11023 int info_idx1;
11024 int info_idx2;
11025 int attr_idx;
11026 int ir_idx;
11027 int i;
11028 int j;
11029 int line;
11030 int col;
11031 opnd_type opnd;
11032
11033
11034 TRACE (Func_Entry, "all_intrinsic", NULL);
11035
11036 ir_idx = OPND_IDX((*result_opnd));
11037 list_idx1 = IR_IDX_R(ir_idx);
11038 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
11039 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
11040 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
11041
11042 if (ATP_INTRIN_ENUM(*spec_idx) == Count_Intrinsic) {
11043 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11044 }
11045 else {
11046 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
11047 arg_info_list[info_idx1].ed.type_idx;
11048 }
11049
11050 if (arg_info_list[info_idx1].ed.rank < 1) {
11051 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
11052 arg_info_list[info_idx1].col);
11053 }
11054
11055 conform_check(0,
11056 ir_idx,
11057 res_exp_desc,
11058 spec_idx,
11059 FALSE);
11060
11061 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
11062 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
11063
11064 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
11065 if (compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr) ||
11066 compare_cn_and_value(IL_IDX(list_idx2),
11067 (long) arg_info_list[info_idx1].ed.rank,
11068 Gt_Opr)) {
11069
11070 PRINTMSG(arg_info_list[info_idx2].line, 881, Error,
11071 arg_info_list[info_idx2].col);
11072 }
11073
11074 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11075 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
11076 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
11077 j = 1;
11078 for (i = 1; i < 8; i++) {
11079 if (i == CN_INT_TO_C(IL_IDX(list_idx2))) {
11080 j = j + 1;
11081 }
11082
11083 COPY_OPND(res_exp_desc->shape[i-1],
11084 arg_info_list[info_idx1].ed.shape[j-1]);
11085 j = j + 1;
11086 }
11087
11088 # ifdef _INLINE_INTRINSICS
11089 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
11090 # endif
11091 }
11092 else {
11093 if (arg_info_list[info_idx2].ed.reference) {
11094 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
11095
11096 if ((AT_OPTIONAL(attr_idx)) &&
11097 (arg_info_list[info_idx2].line != 0)) {
11098 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
11099 arg_info_list[info_idx2].col);
11100 }
11101 }
11102 }
11103
11104 COPY_OPND(opnd, IL_OPND(list_idx2));
11105 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
11106 COPY_OPND(IL_OPND(list_idx2), opnd);
11107
11108 res_exp_desc->rank = arg_info_list[info_idx1].ed.rank - 1;
11109 }
11110 else {
11111 res_exp_desc->rank = 0;
11112 NTR_IR_LIST_TBL(list_idx2);
11113 IL_INTRIN_PLACE_HOLDER(list_idx2) = TRUE;
11114 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
11115 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
11116 IR_LIST_CNT_R(ir_idx) = 2;
11117 # ifdef _INLINE_INTRINSICS
11118 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
11119 # endif
11120 }
11121
11122 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
11123 io_item_must_flatten = TRUE;
11124 if (ATP_INTRIN_ENUM(*spec_idx) == Any_Intrinsic) {
11125 IR_OPR(ir_idx) = Any_Opr;
11126 }
11127 else if (ATP_INTRIN_ENUM(*spec_idx) == All_Intrinsic) {
11128 IR_OPR(ir_idx) = All_Opr;
11129 }
11130 else {
11131 IR_OPR(ir_idx) = Count_Opr;
11132 }
11133
11134 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
11135 IR_OPND_R(ir_idx) = null_opnd;
11136 IR_LIST_CNT_L(ir_idx) = IR_LIST_CNT_R(ir_idx);
11137 }
11138
11139 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11140 IR_RANK(ir_idx) = res_exp_desc->rank;
11141
11142
11143
11144
11145 res_exp_desc->foldable = FALSE;
11146 res_exp_desc->will_fold_later = FALSE;
11147
11148 TRACE (Func_Exit, "all_intrinsic", NULL);
11149
11150 }
11151
11152
11153
11154
11155
11156
11157
11158
11159
11160
11161
11162
11163
11164
11165
11166
11167
11168
11169 void tiny_intrinsic(opnd_type *result_opnd,
11170 expr_arg_type *res_exp_desc,
11171 int *spec_idx)
11172 {
11173 #ifdef KEY
11174 int cn_idx = 0;
11175 #else
11176 int cn_idx;
11177 #endif
11178 int info_idx1;
11179 int ir_idx;
11180
11181
11182 TRACE (Func_Entry, "tiny_intrinsic", NULL);
11183
11184 ir_idx = OPND_IDX((*result_opnd));
11185 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
11186 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
11187
11188 conform_check(0,
11189 ir_idx,
11190 res_exp_desc,
11191 spec_idx,
11192 FALSE);
11193
11194 res_exp_desc->rank = 0;
11195 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11196 IR_RANK(ir_idx) = res_exp_desc->rank;
11197
11198 switch (arg_info_list[info_idx1].ed.linear_type) {
11199 case Real_4:
11200 cn_idx = cvrt_str_to_cn(TINY_REAL4_F90,
11201 arg_info_list[info_idx1].ed.linear_type);
11202 break;
11203
11204 case Real_8:
11205 cn_idx = cvrt_str_to_cn(TINY_REAL8_F90,
11206 arg_info_list[info_idx1].ed.linear_type);
11207 break;
11208
11209 case Real_16:
11210 cn_idx = cvrt_str_to_cn(TINY_REAL16_F90,
11211 arg_info_list[info_idx1].ed.linear_type);
11212 break;
11213 }
11214
11215
11216 OPND_IDX((*result_opnd)) = cn_idx;
11217 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
11218 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
11219 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
11220 res_exp_desc->constant = TRUE;
11221 res_exp_desc->foldable = TRUE;
11222
11223 TRACE (Func_Exit, "tiny_intrinsic", NULL);
11224
11225 }
11226
11227
11228
11229
11230
11231
11232
11233
11234
11235
11236
11237
11238
11239
11240
11241
11242
11243
11244 void spacing_intrinsic(opnd_type *result_opnd,
11245 expr_arg_type *res_exp_desc,
11246 int *spec_idx)
11247 {
11248 int ir_idx;
11249 int cn_idx;
11250 int info_idx1;
11251 int list_idx1;
11252 int list_idx2;
11253 #ifdef KEY
11254 long num = 0;
11255 #else
11256 long num;
11257 #endif
11258
11259
11260 TRACE (Func_Entry, "spacing_intrinsic", NULL);
11261
11262 ir_idx = OPND_IDX((*result_opnd));
11263 list_idx1 = IR_IDX_R(ir_idx);
11264 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
11265 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
11266
11267 conform_check(0,
11268 ir_idx,
11269 res_exp_desc,
11270 spec_idx,
11271 FALSE);
11272
11273 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11274 IR_RANK(ir_idx) = res_exp_desc->rank;
11275 IR_OPR(ir_idx) = Spacing_Opr;
11276 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
11277 IR_LIST_CNT_L(ir_idx) = 2;
11278
11279 switch (arg_info_list[info_idx1].ed.linear_type) {
11280 case Real_4:
11281 num = DIGITS_REAL4_F90;
11282 break;
11283
11284 case Real_8:
11285 num = DIGITS_REAL8_F90;
11286 break;
11287
11288 case Real_16:
11289 num = DIGITS_REAL16_F90;
11290 break;
11291 }
11292
11293 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
11294
11295 NTR_IR_LIST_TBL(list_idx2);
11296 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
11297
11298
11299 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
11300
11301 IL_IDX(list_idx2) = cn_idx;
11302 IL_FLD(list_idx2) = CN_Tbl_Idx;
11303
11304 IL_LINE_NUM(list_idx2) = IL_LINE_NUM(list_idx1);
11305 IL_COL_NUM(list_idx2) = IL_COL_NUM(list_idx1);
11306
11307 IR_OPND_R(ir_idx) = null_opnd;
11308
11309
11310
11311 res_exp_desc->foldable = FALSE;
11312 res_exp_desc->will_fold_later = FALSE;
11313
11314 TRACE (Func_Exit, "spacing_intrinsic", NULL);
11315
11316 }
11317
11318
11319
11320
11321
11322
11323
11324
11325
11326
11327
11328
11329
11330
11331
11332
11333
11334
11335 void cshift_intrinsic(opnd_type *result_opnd,
11336 expr_arg_type *res_exp_desc,
11337 int *spec_idx)
11338 {
11339 int ir_idx;
11340 int cn_idx;
11341 int list_idx1;
11342 int list_idx2;
11343 int list_idx3;
11344 int info_idx1;
11345 int info_idx2;
11346 int info_idx3;
11347 int type_idx;
11348 opnd_type opnd;
11349
11350
11351 TRACE (Func_Entry, "cshift_intrinsic", NULL);
11352
11353 # ifdef _INLINE_INTRINSICS
11354 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
11355 # endif
11356
11357 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
11358 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
11359 # endif
11360
11361 ir_idx = OPND_IDX((*result_opnd));
11362 list_idx1 = IR_IDX_R(ir_idx);
11363 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
11364 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
11365 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
11366 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
11367 type_idx = arg_info_list[info_idx1].ed.type_idx;
11368
11369 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
11370
11371 if ((arg_info_list[info_idx1].ed.rank == 1) &&
11372 (arg_info_list[info_idx2].ed.rank != 0)) {
11373 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
11374 arg_info_list[info_idx2].col);
11375 }
11376 else if ((arg_info_list[info_idx2].ed.rank != 0) &&
11377 (arg_info_list[info_idx2].ed.rank !=
11378 (arg_info_list[info_idx1].ed.rank - 1))) {
11379 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
11380 arg_info_list[info_idx2].col);
11381 }
11382
11383 if (list_idx3 != NULL_IDX && IL_IDX(list_idx3) != NULL_IDX) {
11384 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11385
11386 if (arg_info_list[info_idx3].ed.rank != 0) {
11387 PRINTMSG(arg_info_list[info_idx3].line, 654, Error,
11388 arg_info_list[info_idx3].col);
11389 }
11390
11391 if (IL_FLD(list_idx3) == CN_Tbl_Idx) {
11392 if (compare_cn_and_value(IL_IDX(list_idx3),
11393 (long) arg_info_list[info_idx1].ed.rank,
11394 Gt_Opr) ||
11395 compare_cn_and_value(IL_IDX(list_idx3), 1, Lt_Opr)) {
11396
11397 PRINTMSG(arg_info_list[info_idx3].line, 1017, Error,
11398 arg_info_list[info_idx3].col);
11399 }
11400 }
11401 #ifdef KEY
11402 else if (NULL_IDX != is_optional_dummy(list_idx3)) {
11403 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
11404 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
11405 pass_dummy_or_default_const(list_idx3, cn_idx, TRUE);
11406 }
11407 #endif
11408 }
11409 else {
11410
11411 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
11412 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
11413 IL_FLD(list_idx3) = CN_Tbl_Idx;
11414 IL_IDX(list_idx3) = cn_idx;
11415 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11416 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11417
11418 arg_info_list_base = arg_info_list_top;
11419 arg_info_list_top = arg_info_list_base + 1;
11420
11421 if (arg_info_list_top >= arg_info_list_size) {
11422 enlarge_info_list_table();
11423 }
11424
11425 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11426 arg_info_list[arg_info_list_top] = init_arg_info;
11427 arg_info_list[arg_info_list_top].ed.type_idx = INTEGER_DEFAULT_TYPE;
11428 arg_info_list[arg_info_list_top].ed.type = Integer;
11429 arg_info_list[arg_info_list_top].ed.linear_type = INTEGER_DEFAULT_TYPE;
11430 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11431 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11432
11433 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11434 }
11435
11436 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
11437 if (list_idx3 != NULL_IDX &&
11438 IL_IDX(list_idx3) != NULL_IDX &&
11439 IL_FLD(list_idx3) == CN_Tbl_Idx) {
11440 # ifdef _INLINE_INTRINSICS
11441 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
11442 # endif
11443 }
11444 # endif
11445
11446 COPY_OPND(opnd, IL_OPND(list_idx3));
11447 cast_to_cg_default(&opnd, &(arg_info_list[info_idx3].ed));
11448 COPY_OPND(IL_OPND(list_idx3), opnd);
11449
11450
11451 conform_check(0,
11452 ir_idx,
11453 res_exp_desc,
11454 spec_idx,
11455 FALSE);
11456
11457 COPY_OPND(res_exp_desc->shape[0], arg_info_list[info_idx1].ed.shape[0]);
11458 COPY_OPND(res_exp_desc->shape[1], arg_info_list[info_idx1].ed.shape[1]);
11459 COPY_OPND(res_exp_desc->shape[2], arg_info_list[info_idx1].ed.shape[2]);
11460 COPY_OPND(res_exp_desc->shape[3], arg_info_list[info_idx1].ed.shape[3]);
11461 COPY_OPND(res_exp_desc->shape[4], arg_info_list[info_idx1].ed.shape[4]);
11462 COPY_OPND(res_exp_desc->shape[5], arg_info_list[info_idx1].ed.shape[5]);
11463 COPY_OPND(res_exp_desc->shape[6], arg_info_list[info_idx1].ed.shape[6]);
11464
11465 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
11466
11467 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11468 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
11469 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
11470
11471 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
11472 io_item_must_flatten = TRUE;
11473 IR_OPR(ir_idx) = Cshift_Opr;
11474 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
11475 IR_OPND_R(ir_idx) = null_opnd;
11476 }
11477
11478 IR_TYPE_IDX(ir_idx) = type_idx;
11479 IR_RANK(ir_idx) = res_exp_desc->rank;
11480
11481
11482
11483
11484 res_exp_desc->foldable = FALSE;
11485 res_exp_desc->will_fold_later = FALSE;
11486
11487 TRACE (Func_Exit, "cshift_intrinsic", NULL);
11488
11489 }
11490
11491
11492
11493
11494
11495
11496
11497
11498
11499
11500
11501
11502
11503
11504
11505
11506
11507
11508 void eoshift_intrinsic(opnd_type *result_opnd,
11509 expr_arg_type *res_exp_desc,
11510 int *spec_idx)
11511 {
11512 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
11513 long_type cnst[MAX_WORDS_FOR_INTEGER];
11514 int ir_idx;
11515 int list_idx1;
11516 int list_idx2;
11517 int list_idx3;
11518 int list_idx4;
11519 int info_idx1;
11520 int info_idx2;
11521 int info_idx3;
11522 int info_idx4;
11523 int input_type_idx;
11524 int output_type_idx;
11525 int cn_idx;
11526 opnd_type opnd;
11527
11528
11529 TRACE (Func_Entry, "eoshift_intrinsic", NULL);
11530
11531 # ifdef _INLINE_INTRINSICS
11532 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
11533 # endif
11534
11535 ir_idx = OPND_IDX((*result_opnd));
11536 list_idx1 = IR_IDX_R(ir_idx);
11537 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
11538 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
11539 list_idx4 = IL_NEXT_LIST_IDX(list_idx3);
11540 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
11541 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
11542 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
11543
11544 if ((arg_info_list[info_idx1].ed.rank == 1) &&
11545 (arg_info_list[info_idx2].ed.rank != 0)) {
11546 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
11547 arg_info_list[info_idx2].col);
11548 }
11549 else {
11550 if ((arg_info_list[info_idx2].ed.rank != 0) &&
11551 (arg_info_list[info_idx2].ed.rank !=
11552 (arg_info_list[info_idx1].ed.rank - 1))) {
11553 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
11554 arg_info_list[info_idx2].col);
11555 }
11556 }
11557
11558 conform_check(0,
11559 ir_idx,
11560 res_exp_desc,
11561 spec_idx,
11562 FALSE);
11563
11564
11565 if (list_idx3 != NULL_IDX && IL_IDX(list_idx3) != NULL_IDX) {
11566 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11567
11568 if (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) !=
11569 TYP_LINEAR(arg_info_list[info_idx3].ed.type_idx)) {
11570 PRINTMSG(arg_info_list[info_idx3].line, 727, Error,
11571 arg_info_list[info_idx3].col);
11572 }
11573
11574 if ((arg_info_list[info_idx1].ed.rank == 1) &&
11575 (arg_info_list[info_idx3].ed.rank != 0)) {
11576 PRINTMSG(arg_info_list[info_idx3].line, 654, Error,
11577 arg_info_list[info_idx3].col);
11578 }
11579 else {
11580 if ((arg_info_list[info_idx3].ed.rank != 0) &&
11581 (arg_info_list[info_idx3].ed.rank !=
11582 (arg_info_list[info_idx1].ed.rank - 1))) {
11583 PRINTMSG(arg_info_list[info_idx3].line, 654, Error,
11584 arg_info_list[info_idx3].col);
11585 }
11586 }
11587 #ifdef KEY
11588 if (NULL_IDX != is_optional_dummy(list_idx3)) {
11589 int idx3_type_idx = arg_info_list[info_idx3].ed.type_idx;
11590 basic_type_type idx3_type = arg_info_list[info_idx3].ed.type;
11591
11592
11593
11594
11595
11596
11597 switch (idx3_type) {
11598 case Integer:
11599 case Real:
11600 case Complex:
11601 case Logical: {
11602 long_type constant[MAX_WORDS_FOR_NUMERIC];
11603 memset(constant, 0, MAX_WORDS_FOR_NUMERIC * TARGET_BYTES_PER_WORD);
11604 cn_idx = ntr_const_tbl(idx3_type_idx, TRUE, constant);
11605 pass_dummy_or_default_const(list_idx3, cn_idx, TRUE);
11606 }
11607 break;
11608 case Character: {
11609 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
11610
11611
11612
11613
11614
11615
11616 }
11617 break;
11618 }
11619 }
11620 #endif
11621 }
11622 else {
11623 switch (arg_info_list[info_idx1].ed.type) {
11624 case Structure :
11625 PRINTMSG(arg_info_list[info_idx1].line, 888, Error,
11626 arg_info_list[info_idx1].col);
11627 break;
11628
11629 case Integer :
11630
11631 cn_idx = (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) ==
11632 CG_INTEGER_DEFAULT_TYPE) ? CN_INTEGER_ZERO_IDX :
11633 C_INT_TO_CN(arg_info_list[info_idx1].ed.type_idx, 0);
11634
11635 IL_FLD(list_idx3) = CN_Tbl_Idx;
11636 IL_IDX(list_idx3) = cn_idx;
11637 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11638 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11639
11640 arg_info_list_base = arg_info_list_top;
11641 arg_info_list_top = arg_info_list_base + 1;
11642
11643 if (arg_info_list_top >= arg_info_list_size) {
11644 enlarge_info_list_table();
11645 }
11646
11647 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11648 arg_info_list[arg_info_list_top] = init_arg_info;
11649 arg_info_list[arg_info_list_top].ed.type_idx =
11650 arg_info_list[info_idx1].ed.type_idx;
11651 arg_info_list[arg_info_list_top].ed.type = Integer;
11652 arg_info_list[arg_info_list_top].ed.linear_type =
11653 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx);
11654 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11655 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11656
11657 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11658 break;
11659
11660 case Real :
11661 output_type_idx = arg_info_list[info_idx1].ed.type_idx;
11662 input_type_idx = CG_INTEGER_DEFAULT_TYPE;
11663
11664 if (folder_driver((char *)&CN_CONST(CN_INTEGER_ZERO_IDX),
11665 input_type_idx,
11666 NULL,
11667 NULL_IDX,
11668 folded_const,
11669 &output_type_idx,
11670 IR_LINE_NUM(ir_idx),
11671 IR_COL_NUM(ir_idx),
11672 1,
11673 Cvrt_Opr)) {
11674 }
11675
11676 cn_idx = ntr_const_tbl(output_type_idx,
11677 FALSE,
11678 folded_const);
11679
11680 IL_FLD(list_idx3) = CN_Tbl_Idx;
11681 IL_IDX(list_idx3) = cn_idx;
11682 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11683 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11684
11685 arg_info_list_base = arg_info_list_top;
11686 arg_info_list_top = arg_info_list_base + 1;
11687
11688 if (arg_info_list_top >= arg_info_list_size) {
11689 enlarge_info_list_table();
11690 }
11691
11692 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11693 arg_info_list[arg_info_list_top] = init_arg_info;
11694 arg_info_list[arg_info_list_top].ed.type_idx =
11695 arg_info_list[info_idx1].ed.type_idx;
11696 arg_info_list[arg_info_list_top].ed.type = Real;
11697 arg_info_list[arg_info_list_top].ed.linear_type =
11698 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx);
11699 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11700 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11701 break;
11702
11703 case Complex :
11704 output_type_idx = arg_info_list[info_idx1].ed.type_idx;
11705 input_type_idx = CG_INTEGER_DEFAULT_TYPE;
11706
11707 if (folder_driver((char *)&CN_CONST(CN_INTEGER_ZERO_IDX),
11708 input_type_idx,
11709 NULL,
11710 NULL_IDX,
11711 folded_const,
11712 &output_type_idx,
11713 IR_LINE_NUM(ir_idx),
11714 IR_COL_NUM(ir_idx),
11715 1,
11716 Cvrt_Opr)) {
11717 }
11718
11719 cn_idx = ntr_const_tbl(output_type_idx,
11720 FALSE,
11721 folded_const);
11722
11723 IL_FLD(list_idx3) = CN_Tbl_Idx;
11724 IL_IDX(list_idx3) = cn_idx;
11725 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11726 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11727
11728 arg_info_list_base = arg_info_list_top;
11729 arg_info_list_top = arg_info_list_base + 1;
11730
11731 if (arg_info_list_top >= arg_info_list_size) {
11732 enlarge_info_list_table();
11733 }
11734
11735 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11736 arg_info_list[arg_info_list_top] = init_arg_info;
11737 arg_info_list[arg_info_list_top].ed.type_idx =
11738 arg_info_list[info_idx1].ed.type_idx;
11739 arg_info_list[arg_info_list_top].ed.type = Complex;
11740 arg_info_list[arg_info_list_top].ed.linear_type =
11741 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx);
11742 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11743 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11744 break;
11745
11746 case Logical :
11747 cn_idx = set_up_logical_constant(cnst,
11748 arg_info_list[info_idx1].ed.type_idx,
11749 FALSE_VALUE,
11750 TRUE);
11751 IL_FLD(list_idx3) = CN_Tbl_Idx;
11752 IL_IDX(list_idx3) = cn_idx;
11753 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11754 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11755
11756 arg_info_list_base = arg_info_list_top;
11757 arg_info_list_top = arg_info_list_base + 1;
11758
11759 if (arg_info_list_top >= arg_info_list_size) {
11760 enlarge_info_list_table();
11761 }
11762
11763 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11764 arg_info_list[arg_info_list_top] = init_arg_info;
11765 arg_info_list[arg_info_list_top].ed.type_idx =
11766 arg_info_list[info_idx1].ed.type_idx;
11767 arg_info_list[arg_info_list_top].ed.type = Logical;
11768 arg_info_list[arg_info_list_top].ed.linear_type =
11769 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx);
11770 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11771 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11772
11773 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11774 break;
11775
11776 case Character :
11777 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
11778 break;
11779 }
11780 }
11781
11782 if (list_idx4 != NULL_IDX && IL_IDX(list_idx4) != NULL_IDX) {
11783 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
11784
11785 if (arg_info_list[info_idx4].ed.rank != 0) {
11786 PRINTMSG(arg_info_list[info_idx4].line, 654, Error,
11787 arg_info_list[info_idx4].col);
11788 }
11789
11790 if (IL_FLD(list_idx4) == CN_Tbl_Idx) {
11791 if (compare_cn_and_value(IL_IDX(list_idx4),
11792 (long) arg_info_list[info_idx1].ed.rank,
11793 Gt_Opr) ||
11794 compare_cn_and_value(IL_IDX(list_idx4), 1, Lt_Opr)) {
11795
11796 PRINTMSG(arg_info_list[info_idx4].line, 1017, Error,
11797 arg_info_list[info_idx4].col);
11798 }
11799 }
11800 #ifdef KEY
11801 else if (NULL_IDX != is_optional_dummy(list_idx4)) {
11802 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
11803 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
11804 pass_dummy_or_default_const(list_idx4, cn_idx, TRUE);
11805 }
11806 #endif
11807 }
11808 else {
11809
11810 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
11811 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
11812 IL_FLD(list_idx4) = CN_Tbl_Idx;
11813 IL_IDX(list_idx4) = cn_idx;
11814 IL_LINE_NUM(list_idx4) = IR_LINE_NUM(ir_idx);
11815 IL_COL_NUM(list_idx4) = IR_COL_NUM(ir_idx);
11816
11817 arg_info_list_base = arg_info_list_top;
11818 arg_info_list_top = arg_info_list_base + 1;
11819
11820 if (arg_info_list_top >= arg_info_list_size) {
11821 enlarge_info_list_table();
11822 }
11823
11824 IL_ARG_DESC_IDX(list_idx4) = arg_info_list_top;
11825 arg_info_list[arg_info_list_top] = init_arg_info;
11826 arg_info_list[arg_info_list_top].ed.type_idx = INTEGER_DEFAULT_TYPE;
11827 arg_info_list[arg_info_list_top].ed.type = Integer;
11828 arg_info_list[arg_info_list_top].ed.linear_type = INTEGER_DEFAULT_TYPE;
11829 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11830 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11831
11832 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
11833 }
11834
11835 if (IL_FLD(list_idx4) != CN_Tbl_Idx) {
11836 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
11837 }
11838
11839 COPY_OPND(opnd, IL_OPND(list_idx4));
11840 cast_to_cg_default(&opnd, &(arg_info_list[info_idx4].ed));
11841 COPY_OPND(IL_OPND(list_idx4), opnd);
11842
11843 COPY_OPND(res_exp_desc->shape[0], arg_info_list[info_idx1].ed.shape[0]);
11844 COPY_OPND(res_exp_desc->shape[1], arg_info_list[info_idx1].ed.shape[1]);
11845 COPY_OPND(res_exp_desc->shape[2], arg_info_list[info_idx1].ed.shape[2]);
11846 COPY_OPND(res_exp_desc->shape[3], arg_info_list[info_idx1].ed.shape[3]);
11847 COPY_OPND(res_exp_desc->shape[4], arg_info_list[info_idx1].ed.shape[4]);
11848 COPY_OPND(res_exp_desc->shape[5], arg_info_list[info_idx1].ed.shape[5]);
11849 COPY_OPND(res_exp_desc->shape[6], arg_info_list[info_idx1].ed.shape[6]);
11850
11851 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
11852
11853 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11854 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
11855 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
11856
11857 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
11858 io_item_must_flatten = TRUE;
11859 IR_OPR(ir_idx) = Eoshift_Opr;
11860 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
11861 IR_OPND_R(ir_idx) = null_opnd;
11862 }
11863
11864 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11865 IR_RANK(ir_idx) = res_exp_desc->rank;
11866
11867
11868
11869
11870 res_exp_desc->foldable = FALSE;
11871 res_exp_desc->will_fold_later = FALSE;
11872
11873 TRACE (Func_Exit, "eoshift_intrinsic", NULL);
11874
11875 }
11876
11877
11878
11879
11880
11881
11882
11883
11884
11885
11886
11887
11888
11889
11890
11891
11892
11893
11894 void minexponent_intrinsic(opnd_type *result_opnd,
11895 expr_arg_type *res_exp_desc,
11896 int *spec_idx)
11897 {
11898 int ir_idx;
11899 #ifdef KEY
11900 long num = 0;
11901 #else
11902 long num;
11903 #endif
11904 int info_idx1;
11905 int cn_idx;
11906
11907
11908 TRACE (Func_Entry, "minexponent_intrinsic", NULL);
11909
11910 ir_idx = OPND_IDX((*result_opnd));
11911 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
11912 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11913
11914 conform_check(0,
11915 ir_idx,
11916 res_exp_desc,
11917 spec_idx,
11918 TRUE);
11919
11920 res_exp_desc->rank = 0;
11921 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11922 IR_RANK(ir_idx) = res_exp_desc->rank;
11923
11924 switch (arg_info_list[info_idx1].ed.linear_type) {
11925 case Real_4:
11926 num = MINEXPONENT_REAL4_F90;
11927 break;
11928
11929 case Real_8:
11930 num = MINEXPONENT_REAL8_F90;
11931 break;
11932
11933 case Real_16:
11934 num = MINEXPONENT_REAL16_F90;
11935 break;
11936 }
11937
11938 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
11939
11940 OPND_IDX((*result_opnd)) = cn_idx;
11941 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
11942 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
11943 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
11944 res_exp_desc->constant = TRUE;
11945 res_exp_desc->foldable = TRUE;
11946
11947 TRACE (Func_Exit, "minexponent_intrinsic", NULL);
11948
11949 }
11950
11951
11952
11953
11954
11955
11956
11957
11958
11959
11960
11961
11962
11963
11964
11965
11966
11967
11968 void maxexponent_intrinsic(opnd_type *result_opnd,
11969 expr_arg_type *res_exp_desc,
11970 int *spec_idx)
11971 {
11972 int ir_idx;
11973 int info_idx1;
11974 int cn_idx;
11975 #ifdef KEY
11976 long num = 0;
11977 #else
11978 long num;
11979 #endif
11980
11981
11982 TRACE (Func_Entry, "maxexponent_intrinsic", NULL);
11983
11984 ir_idx = OPND_IDX((*result_opnd));
11985 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
11986 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11987
11988 conform_check(0,
11989 ir_idx,
11990 res_exp_desc,
11991 spec_idx,
11992 TRUE);
11993
11994 res_exp_desc->rank = 0;
11995 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11996 IR_RANK(ir_idx) = res_exp_desc->rank;
11997
11998 switch (arg_info_list[info_idx1].ed.linear_type) {
11999 case Real_4:
12000 num = MAXEXPONENT_REAL4_F90;
12001 break;
12002
12003 case Real_8:
12004 num = MAXEXPONENT_REAL8_F90;
12005 break;
12006
12007 case Real_16:
12008 num = MAXEXPONENT_REAL16_F90;
12009 break;
12010 }
12011
12012 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
12013
12014 OPND_IDX((*result_opnd)) = cn_idx;
12015 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12016 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12017 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12018 res_exp_desc->constant = TRUE;
12019 res_exp_desc->foldable = TRUE;
12020
12021 TRACE (Func_Exit, "maxexponent_intrinsic", NULL);
12022
12023 }
12024
12025
12026
12027
12028
12029
12030
12031
12032
12033
12034
12035
12036
12037
12038
12039
12040
12041
12042 void radix_intrinsic(opnd_type *result_opnd,
12043 expr_arg_type *res_exp_desc,
12044 int *spec_idx)
12045 {
12046 int ir_idx;
12047 int cn_idx;
12048
12049
12050 TRACE (Func_Entry, "radix_intrinsic", NULL);
12051
12052 ir_idx = OPND_IDX((*result_opnd));
12053 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
12054
12055 conform_check(0,
12056 ir_idx,
12057 res_exp_desc,
12058 spec_idx,
12059 TRUE);
12060
12061 res_exp_desc->rank = 0;
12062 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12063 IR_RANK(ir_idx) = res_exp_desc->rank;
12064
12065 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, RADIX_F90);
12066
12067 OPND_IDX((*result_opnd)) = cn_idx;
12068 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12069 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12070 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12071 res_exp_desc->constant = TRUE;
12072 res_exp_desc->foldable = TRUE;
12073
12074 TRACE (Func_Exit, "radix_intrinsic", NULL);
12075
12076 }
12077
12078
12079
12080
12081
12082
12083
12084
12085
12086
12087
12088
12089
12090
12091
12092
12093
12094
12095 void range_intrinsic(opnd_type *result_opnd,
12096 expr_arg_type *res_exp_desc,
12097 int *spec_idx)
12098 {
12099 int ir_idx;
12100 int cn_idx;
12101 int info_idx1;
12102 #ifdef KEY
12103 long num = 0;
12104 #else
12105 long num;
12106 #endif
12107
12108
12109 TRACE (Func_Entry, "range_intrinsic", NULL);
12110
12111 ir_idx = OPND_IDX((*result_opnd));
12112 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
12113 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
12114
12115 conform_check(0,
12116 ir_idx,
12117 res_exp_desc,
12118 spec_idx,
12119 TRUE);
12120
12121 res_exp_desc->rank = 0;
12122 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12123 IR_RANK(ir_idx) = res_exp_desc->rank;
12124
12125 switch (arg_info_list[info_idx1].ed.linear_type) {
12126 case Complex_4:
12127 num = RANGE_REAL4_F90;
12128 break;
12129
12130 case Complex_8:
12131 num = RANGE_REAL8_F90;
12132 break;
12133
12134 case Complex_16:
12135 num = RANGE_REAL16_F90;
12136 break;
12137
12138 case Real_4:
12139 num = RANGE_REAL4_F90;
12140 break;
12141
12142 case Real_8:
12143 num = RANGE_REAL8_F90;
12144 break;
12145
12146 case Real_16:
12147 num = RANGE_REAL16_F90;
12148 break;
12149
12150 case Integer_1:
12151 num = RANGE_INT1_F90;
12152 break;
12153
12154 case Integer_2:
12155 num = RANGE_INT2_F90;
12156 break;
12157
12158 case Integer_4:
12159 num = RANGE_INT4_F90;
12160 break;
12161
12162 case Integer_8:
12163 num = RANGE_INT8_F90;
12164
12165 # ifdef _TARGET_HAS_FAST_INTEGER
12166 if (opt_flags.set_allfastint_option ||
12167 (opt_flags.set_fastint_option &&
12168 (TYP_DESC(arg_info_list[info_idx1].ed.type_idx) ==
12169 Default_Typed))) {
12170 num = 13;
12171 }
12172 # endif
12173
12174 break;
12175 }
12176
12177
12178 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
12179
12180 OPND_IDX((*result_opnd)) = cn_idx;
12181 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12182 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12183 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12184 res_exp_desc->constant = TRUE;
12185 res_exp_desc->foldable = TRUE;
12186
12187 TRACE (Func_Exit, "range_intrinsic", NULL);
12188
12189 }
12190
12191
12192
12193
12194
12195
12196
12197
12198
12199
12200
12201
12202
12203
12204
12205
12206
12207
12208 void precision_intrinsic(opnd_type *result_opnd,
12209 expr_arg_type *res_exp_desc,
12210 int *spec_idx)
12211 {
12212 int ir_idx;
12213 int cn_idx;
12214 int info_idx1;
12215 #ifdef KEY
12216 long num = 0;
12217 #else
12218 long num;
12219 #endif
12220
12221
12222 TRACE (Func_Entry, "precision_intrinsic", NULL);
12223
12224 ir_idx = OPND_IDX((*result_opnd));
12225 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
12226 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
12227
12228 conform_check(0,
12229 ir_idx,
12230 res_exp_desc,
12231 spec_idx,
12232 TRUE);
12233
12234 res_exp_desc->rank = 0;
12235 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12236 IR_RANK(ir_idx) = res_exp_desc->rank;
12237
12238 switch (arg_info_list[info_idx1].ed.linear_type) {
12239 case Complex_4:
12240 num = PRECISION_REAL4_F90;
12241 break;
12242
12243 case Complex_8:
12244 num = PRECISION_REAL8_F90;
12245 break;
12246
12247 case Complex_16:
12248 num = PRECISION_REAL16_F90;
12249 break;
12250
12251 case Real_4:
12252 num = PRECISION_REAL4_F90;
12253 break;
12254
12255 case Real_8:
12256 num = PRECISION_REAL8_F90;
12257 break;
12258
12259 case Real_16:
12260 num = PRECISION_REAL16_F90;
12261 break;
12262 }
12263
12264 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
12265
12266 OPND_IDX((*result_opnd)) = cn_idx;
12267 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12268 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12269 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12270 res_exp_desc->constant = TRUE;
12271 res_exp_desc->foldable = TRUE;
12272
12273 TRACE (Func_Exit, "precision_intrinsic", NULL);
12274
12275 }
12276
12277
12278
12279
12280
12281
12282
12283
12284
12285
12286
12287
12288
12289
12290
12291
12292
12293
12294 void kind_intrinsic(opnd_type *result_opnd,
12295 expr_arg_type *res_exp_desc,
12296 int *spec_idx)
12297 {
12298 int ir_idx;
12299 int cn_idx;
12300 int list_idx1;
12301 int info_idx1;
12302 #ifdef KEY
12303 long num = 0;
12304 #else
12305 long num;
12306 #endif
12307
12308
12309 TRACE (Func_Entry, "kind_intrinsic", NULL);
12310
12311 ir_idx = OPND_IDX((*result_opnd));
12312 list_idx1 = IR_IDX_R(ir_idx);
12313 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
12314
12315 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
12316 AT_ARG_TO_KIND(IL_IDX(list_idx1)) = TRUE;
12317 }
12318 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
12319
12320 conform_check(0,
12321 ir_idx,
12322 res_exp_desc,
12323 spec_idx,
12324 TRUE);
12325
12326 res_exp_desc->rank = 0;
12327 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12328 IR_RANK(ir_idx) = res_exp_desc->rank;
12329
12330 switch (arg_info_list[info_idx1].ed.linear_type) {
12331 case Complex_4:
12332 num = 4;
12333 break;
12334
12335 case Complex_8:
12336 num = 8;
12337 break;
12338
12339 case Complex_16:
12340 num = 16;
12341 break;
12342
12343 case Real_4:
12344 num = 4;
12345 break;
12346
12347 case Real_8:
12348 num = 8;
12349 break;
12350
12351 case Real_16:
12352 num = 16;
12353 break;
12354
12355 case Integer_1:
12356 num = 1;
12357 break;
12358
12359 case Integer_2:
12360 num = 2;
12361 break;
12362
12363 case Integer_4:
12364 num = 4;
12365 break;
12366
12367 case Integer_8:
12368 num = 8;
12369 break;
12370
12371 case Logical_1:
12372 num = 1;
12373 break;
12374
12375 case Logical_2:
12376 num = 2;
12377 break;
12378
12379 case Logical_4:
12380 num = 4;
12381 break;
12382
12383 case Logical_8:
12384 num = 8;
12385 break;
12386
12387 case Short_Char_Const:
12388 num = 1;
12389 break;
12390
12391 case Character_1:
12392 num = 1;
12393 break;
12394
12395 case Character_2:
12396 num = 2;
12397 break;
12398
12399 case Character_4:
12400 num = 4;
12401 break;
12402 }
12403
12404 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
12405
12406 OPND_IDX((*result_opnd)) = cn_idx;
12407 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12408 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12409 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12410 res_exp_desc->constant = TRUE;
12411 res_exp_desc->foldable = TRUE;
12412
12413 if (TYP_DESC(arg_info_list[info_idx1].ed.type_idx) == Default_Typed) {
12414
12415 if (arg_info_list[info_idx1].ed.linear_type ==
12416 init_default_linear_type[Fortran_Double] ||
12417 (TYP_DP_HIT_ME(arg_info_list[info_idx1].ed.type_idx) &&
12418 arg_info_list[info_idx1].ed.linear_type ==
12419 half_linear_type[Fortran_Double])) {
12420
12421 res_exp_desc->kind0D0seen = TRUE;
12422 }
12423 else if (arg_info_list[info_idx1].ed.linear_type == REAL_DEFAULT_TYPE &&
12424 ! TYP_DP_HIT_ME(arg_info_list[info_idx1].ed.type_idx)) {
12425
12426 res_exp_desc->kind0E0seen = TRUE;
12427 }
12428 else if (arg_info_list[info_idx1].ed.linear_type ==
12429 INTEGER_DEFAULT_TYPE ||
12430 arg_info_list[info_idx1].ed.linear_type ==
12431 LOGICAL_DEFAULT_TYPE) {
12432
12433 res_exp_desc->kind0seen = TRUE;
12434 }
12435 else {
12436 res_exp_desc->kindnotconst = TRUE;
12437 }
12438 }
12439
12440
12441
12442 TRACE (Func_Exit, "kind_intrinsic", NULL);
12443
12444 }
12445
12446
12447
12448
12449
12450
12451
12452
12453
12454
12455
12456
12457
12458
12459
12460
12461
12462
12463 void bit_size_intrinsic(opnd_type *result_opnd,
12464 expr_arg_type *res_exp_desc,
12465 int *spec_idx)
12466 {
12467 int ir_idx;
12468 int cn_idx;
12469 int info_idx1;
12470 #ifdef KEY
12471 long num = 0;
12472 #else
12473 long num;
12474 #endif
12475
12476
12477 TRACE (Func_Entry, "bit_size_intrinsic", NULL);
12478
12479 ir_idx = OPND_IDX((*result_opnd));
12480 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
12481 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
12482
12483 conform_check(0,
12484 ir_idx,
12485 res_exp_desc,
12486 spec_idx,
12487 TRUE);
12488
12489 res_exp_desc->rank = 0;
12490 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12491 IR_RANK(ir_idx) = res_exp_desc->rank;
12492
12493 switch (arg_info_list[info_idx1].ed.linear_type) {
12494 case Integer_1:
12495 num = BITSIZE_INT1_F90;
12496 break;
12497
12498 case Integer_2:
12499 num = BITSIZE_INT2_F90;
12500 break;
12501
12502 case Integer_4:
12503 num = BITSIZE_INT4_F90;
12504 break;
12505
12506 case Integer_8:
12507 num = BITSIZE_INT8_F90;
12508 break;
12509 }
12510
12511 cn_idx = C_INT_TO_CN(arg_info_list[info_idx1].ed.type_idx, num);
12512
12513 OPND_IDX((*result_opnd)) = cn_idx;
12514 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12515 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12516 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12517 res_exp_desc->constant = TRUE;
12518 res_exp_desc->foldable = TRUE;
12519
12520 TRACE (Func_Exit, "bit_size_intrinsic", NULL);
12521
12522 }
12523
12524
12525
12526
12527
12528
12529
12530
12531
12532
12533
12534
12535
12536
12537
12538
12539
12540 void lbound_intrinsic(opnd_type *result_opnd,
12541 expr_arg_type *res_exp_desc,
12542 int *spec_idx)
12543 {
12544 #ifdef KEY
12545 int select = 0;
12546 #else
12547 int select;
12548 #endif
12549 int asg_idx;
12550 int attr_idx = NULL_IDX;
12551 int subscript_idx;
12552 long64 bit_length;
12553 int constant_type_idx;
12554 long dim;
12555 int arg1;
12556 int arg2;
12557 int arg3;
12558 int ir_idx;
12559 int il_idx;
12560 int le_idx;
12561 int eq_idx;
12562 int array_attr;
12563 boolean ok;
12564 int i;
12565 int idx;
12566 int idx2;
12567 int bd_idx;
12568 int new_idx;
12569 int cn_idx;
12570 opnd_type opnd;
12571 opnd_type base_opnd;
12572 int info_idx1;
12573 int info_idx2;
12574 int list_idx1;
12575 int list_idx2;
12576 int line;
12577 int col;
12578 boolean make_const_tmp = FALSE;
12579 int the_cn_idx;
12580 #ifdef KEY
12581 int tmp_idx = 0;
12582 #else
12583 int tmp_idx;
12584 #endif
12585 expr_arg_type loc_exp_desc;
12586 int expr_IDX[MAX_NUM_DIMS];
12587 fld_type expr_FLD[MAX_NUM_DIMS];
12588 int save_arg3;
12589 # ifdef _WHIRL_HOST64_TARGET64
12590 int const_array[MAX_NUM_DIMS];
12591 # else
12592 long_type const_array[MAX_NUM_DIMS];
12593 # endif
12594 long64 host_array[MAX_NUM_DIMS];
12595
12596
12597 TRACE (Func_Entry, "lbound_intrinsic", NULL);
12598
12599 for (i = 0; i < MAX_NUM_DIMS; i++) {
12600 expr_IDX[i] = NULL_IDX;
12601 expr_FLD[i] = NO_Tbl_Idx;
12602 host_array[i] = 0;
12603 }
12604
12605 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
12606
12607 ir_idx = OPND_IDX((*result_opnd));
12608 list_idx1 = IR_IDX_R(ir_idx);
12609 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
12610 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
12611 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
12612
12613 if (arg_info_list[info_idx1].ed.reference) {
12614 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
12615 }
12616
12617 conform_check(0,
12618 ir_idx,
12619 res_exp_desc,
12620 spec_idx,
12621 TRUE);
12622
12623
12624
12625 res_exp_desc->foldable = FALSE;
12626 res_exp_desc->will_fold_later = FALSE;
12627
12628 if (arg_info_list[info_idx1].ed.rank == 0) {
12629 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
12630 arg_info_list[info_idx1].col);
12631 }
12632
12633 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
12634 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
12635
12636 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
12637 (compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr) ||
12638 compare_cn_and_value(IL_IDX(list_idx2),
12639 (long) arg_info_list[info_idx1].ed.rank,
12640 Gt_Opr))) {
12641
12642 find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx2),
12643 &line,
12644 &col);
12645 PRINTMSG(line, 1012, Error, col);
12646 goto EXIT;
12647 }
12648
12649 if (arg_info_list[info_idx2].ed.rank != 0) {
12650 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
12651 arg_info_list[info_idx2].col);
12652 goto EXIT;
12653 }
12654
12655 res_exp_desc->rank = 0;
12656
12657 if (arg_info_list[info_idx2].ed.reference) {
12658 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
12659
12660 if (AT_OPTIONAL(attr_idx)) {
12661 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
12662 arg_info_list[info_idx2].col);
12663 }
12664 }
12665
12666 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
12667
12668 dim = (long) CN_INT_TO_C(IL_IDX(list_idx2));
12669
12670 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12671 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
12672 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12673 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
12674 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
12675
12676 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12677
12678 COPY_OPND(opnd, IL_OPND(list_idx1));
12679 array_attr = find_base_attr(&opnd, &line, &col);
12680
12681 bd_idx = ATD_ARRAY_IDX(array_attr);
12682
12683
12684
12685
12686 idx = IL_IDX(list_idx1);
12687
12688 if (IR_OPR(idx) == Whole_Substring_Opr) {
12689 idx = IR_IDX_L(idx);
12690 }
12691
12692 idx = IR_IDX_R(idx);
12693
12694 for (i = 1; i < dim; i++) {
12695 idx = IL_NEXT_LIST_IDX(idx);
12696 }
12697 idx = IL_IDX(idx);
12698 idx = IR_IDX_L(idx);
12699
12700 if (arg_info_list[info_idx1].ed.shape[dim-1].fld == CN_Tbl_Idx) {
12701
12702 if (compare_cn_and_value(
12703 arg_info_list[info_idx1].ed.shape[dim-1].idx, 0, Le_Opr)) {
12704
12705
12706
12707 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
12708 CN_INTEGER_ONE_IDX :
12709 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
12710
12711 OPND_IDX((*result_opnd)) = cn_idx;
12712 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12713 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12714 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12715 }
12716 else {
12717
12718 COPY_OPND((*result_opnd), IL_OPND(idx));
12719 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
12720 res_exp_desc->type_idx =
12721 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12722 res_exp_desc->linear_type =
12723 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
12724 }
12725
12726 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
12727 res_exp_desc->constant = TRUE;
12728 res_exp_desc->foldable = TRUE;
12729 }
12730 }
12731 else {
12732
12733
12734
12735 NTR_IR_LIST_TBL(arg1);
12736 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12737
12738 NTR_IR_LIST_TBL(arg2);
12739 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12740
12741 NTR_IR_LIST_TBL(arg3);
12742 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12743
12744
12745 IL_NEXT_LIST_IDX(arg1) = arg2;
12746 IL_NEXT_LIST_IDX(arg2) = arg3;
12747
12748 IR_OPR(ir_idx) = Cvmgt_Opr;
12749 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
12750 IR_IDX_L(ir_idx) = arg1;
12751 IR_LIST_CNT_L(ir_idx) = 3;
12752
12753
12754 io_item_must_flatten = TRUE;
12755
12756
12757 IR_OPND_R(ir_idx) = null_opnd;
12758
12759 IL_FLD(arg1) = CN_Tbl_Idx;
12760 IL_IDX(arg1) = CN_INTEGER_ONE_IDX;
12761 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
12762 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
12763
12764 COPY_OPND(IL_OPND(arg2), IL_OPND(idx));
12765
12766 le_idx=gen_ir(OPND_FLD(arg_info_list[info_idx1].ed.shape[dim-1]),
12767 OPND_IDX(arg_info_list[info_idx1].ed.shape[dim-1]),
12768 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12769 IR_COL_NUM(ir_idx),
12770 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
12771
12772 IL_FLD(arg3) = IR_Tbl_Idx;
12773 IL_IDX(arg3) = le_idx;
12774 IL_LINE_NUM(arg3) = IR_LINE_NUM(ir_idx);
12775 IL_COL_NUM(arg3) = IR_COL_NUM(ir_idx);
12776 }
12777 }
12778 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
12779 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
12780 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12781 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
12782
12783
12784
12785
12786 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
12787 attr_idx = IL_IDX(list_idx1);
12788 }
12789 else {
12790 attr_idx = IR_IDX_L(IL_IDX(list_idx1));
12791 }
12792
12793 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12794 bd_idx = ATD_ARRAY_IDX(attr_idx);
12795
12796 if (dim == BD_RANK(bd_idx)) {
12797 OPND_IDX((*result_opnd)) = BD_LB_IDX(bd_idx, dim);
12798 OPND_FLD((*result_opnd)) = BD_LB_FLD(bd_idx, dim);
12799 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12800 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12801
12802 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
12803 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12804 res_exp_desc->linear_type =
12805 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
12806
12807 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
12808 res_exp_desc->constant = TRUE;
12809 res_exp_desc->foldable = TRUE;
12810 }
12811 }
12812 else if (BD_XT_FLD(bd_idx, dim) == CN_Tbl_Idx) {
12813
12814 if (compare_cn_and_value(BD_XT_IDX(bd_idx, dim), 0, Le_Opr)) {
12815
12816
12817
12818 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
12819 CN_INTEGER_ONE_IDX :
12820 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
12821
12822 OPND_IDX((*result_opnd)) = cn_idx;
12823 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12824 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12825 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12826 }
12827 else {
12828 OPND_IDX((*result_opnd)) = BD_LB_IDX(bd_idx, dim);
12829 OPND_FLD((*result_opnd)) = BD_LB_FLD(bd_idx, dim);
12830 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12831 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12832 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
12833 res_exp_desc->type_idx =
12834 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12835 res_exp_desc->linear_type =
12836 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
12837 }
12838
12839 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
12840 res_exp_desc->constant = TRUE;
12841 res_exp_desc->foldable = TRUE;
12842 }
12843 }
12844 else {
12845
12846
12847
12848 NTR_IR_LIST_TBL(arg1);
12849 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12850
12851 NTR_IR_LIST_TBL(arg2);
12852 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12853
12854 NTR_IR_LIST_TBL(arg3);
12855 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12856
12857
12858 IL_NEXT_LIST_IDX(arg1) = arg2;
12859 IL_NEXT_LIST_IDX(arg2) = arg3;
12860
12861 IR_OPR(ir_idx) = Cvmgt_Opr;
12862 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
12863 IR_IDX_L(ir_idx) = arg1;
12864 IR_LIST_CNT_L(ir_idx) = 3;
12865
12866
12867 io_item_must_flatten = TRUE;
12868
12869
12870 IR_OPND_R(ir_idx) = null_opnd;
12871
12872 IL_FLD(arg1) = CN_Tbl_Idx;
12873 IL_IDX(arg1) = CN_INTEGER_ONE_IDX;
12874 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
12875 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
12876
12877 IL_FLD(arg2) = BD_LB_FLD(bd_idx, dim);
12878 IL_IDX(arg2) = BD_LB_IDX(bd_idx, dim);
12879 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
12880 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
12881
12882 le_idx = gen_ir(BD_XT_FLD(bd_idx, dim), BD_XT_IDX(bd_idx, dim),
12883 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12884 IR_COL_NUM(ir_idx),
12885 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
12886
12887 IL_FLD(arg3) = IR_Tbl_Idx;
12888 IL_IDX(arg3) = le_idx;
12889 }
12890 }
12891 else if (arg_info_list[info_idx1].ed.section ||
12892 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12893 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
12894
12895
12896
12897 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12898
12899 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
12900 CN_INTEGER_ONE_IDX :
12901 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
12902 OPND_IDX((*result_opnd)) = cn_idx;
12903 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12904 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12905 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12906 res_exp_desc->constant = TRUE;
12907 res_exp_desc->foldable = TRUE;
12908 }
12909 }
12910 else {
12911
12912
12913 COPY_OPND(opnd, IL_OPND(list_idx2));
12914 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
12915 COPY_OPND(IL_OPND(list_idx2), opnd);
12916
12917 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12918 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
12919 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12920 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
12921 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
12922 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12923
12924 COPY_OPND(opnd, IL_OPND(list_idx1));
12925 array_attr = find_base_attr(&opnd, &line, &col);
12926
12927 bd_idx = ATD_ARRAY_IDX(array_attr);
12928
12929
12930
12931
12932 idx = IL_IDX(list_idx1);
12933
12934 if (IR_OPR(idx) == Whole_Substring_Opr) {
12935 idx = IR_IDX_L(idx);
12936 }
12937
12938 il_idx = IR_IDX_R(idx);
12939 idx = IL_IDX(il_idx);
12940 idx = IR_IDX_L(idx);
12941
12942 OPND_FLD(base_opnd) = CN_Tbl_Idx;
12943 OPND_IDX(base_opnd) = CN_INTEGER_ZERO_IDX;
12944 OPND_LINE_NUM(base_opnd) = IR_LINE_NUM(ir_idx);
12945 OPND_COL_NUM(base_opnd) = IR_COL_NUM(ir_idx);
12946
12947 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
12948
12949 NTR_IR_LIST_TBL(arg1);
12950 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12951 NTR_IR_LIST_TBL(arg2);
12952 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12953 NTR_IR_LIST_TBL(arg3);
12954 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12955
12956
12957 IL_NEXT_LIST_IDX(arg1) = arg2;
12958 IL_NEXT_LIST_IDX(arg2) = arg3;
12959
12960 select = gen_ir(IL_Tbl_Idx, arg1,
12961 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12962 IR_COL_NUM(ir_idx),
12963 NO_Tbl_Idx, NULL_IDX);
12964
12965
12966 io_item_must_flatten = TRUE;
12967
12968 COPY_OPND(IL_OPND(arg1), IL_OPND(idx));
12969 il_idx = IL_NEXT_LIST_IDX(il_idx);
12970 idx = IL_IDX(il_idx);
12971 idx = IR_IDX_L(idx);
12972
12973 COPY_OPND(IL_OPND(arg2), base_opnd);
12974
12975 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
12976
12977 eq_idx = gen_ir(IL_FLD(list_idx2), IL_IDX(list_idx2),
12978 Eq_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12979 IR_COL_NUM(ir_idx),
12980 CN_Tbl_Idx, cn_idx);
12981
12982 IL_FLD(arg3) = IR_Tbl_Idx;
12983 IL_IDX(arg3) = eq_idx;
12984 IL_LINE_NUM(arg3) = IR_LINE_NUM(ir_idx);
12985 IL_COL_NUM(arg3) = IR_COL_NUM(ir_idx);
12986
12987 OPND_FLD(base_opnd) = IR_Tbl_Idx;
12988 OPND_IDX(base_opnd) = select;
12989 }
12990
12991
12992
12993 NTR_IR_LIST_TBL(arg1);
12994 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12995
12996 NTR_IR_LIST_TBL(arg2);
12997 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12998
12999 NTR_IR_LIST_TBL(arg3);
13000 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13001
13002
13003 IL_NEXT_LIST_IDX(arg1) = arg2;
13004 IL_NEXT_LIST_IDX(arg2) = arg3;
13005
13006 IR_OPR(ir_idx) = Cvmgt_Opr;
13007 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
13008 IR_IDX_L(ir_idx) = arg1;
13009 IR_LIST_CNT_L(ir_idx) = 3;
13010
13011
13012 io_item_must_flatten = TRUE;
13013
13014
13015 IR_OPND_R(ir_idx) = null_opnd;
13016
13017 IL_FLD(arg1) = CN_Tbl_Idx;
13018 IL_IDX(arg1) = CN_INTEGER_ONE_IDX;
13019 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13020 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13021
13022 IL_FLD(arg2) = IR_Tbl_Idx;
13023 IL_IDX(arg2) = select;
13024
13025 save_arg3 = arg3;
13026
13027 OPND_FLD(base_opnd) = CN_Tbl_Idx;
13028 OPND_IDX(base_opnd) = CN_INTEGER_ZERO_IDX;
13029 OPND_LINE_NUM(base_opnd) = IR_LINE_NUM(ir_idx);
13030 OPND_COL_NUM(base_opnd) = IR_COL_NUM(ir_idx);
13031
13032 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
13033
13034 NTR_IR_LIST_TBL(arg1);
13035 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13036 NTR_IR_LIST_TBL(arg2);
13037 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13038 NTR_IR_LIST_TBL(arg3);
13039 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13040
13041
13042 IL_NEXT_LIST_IDX(arg1) = arg2;
13043 IL_NEXT_LIST_IDX(arg2) = arg3;
13044
13045 select = gen_ir(IL_Tbl_Idx, arg1,
13046 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13047 IR_COL_NUM(ir_idx),
13048 NO_Tbl_Idx, NULL_IDX);
13049
13050
13051 io_item_must_flatten = TRUE;
13052
13053 COPY_OPND(IL_OPND(arg1),
13054 arg_info_list[info_idx1].ed.shape[i-1]);
13055 COPY_OPND(IL_OPND(arg2), base_opnd);
13056
13057 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
13058
13059 eq_idx = gen_ir(IL_FLD(list_idx2), IL_IDX(list_idx2),
13060 Eq_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13061 IR_COL_NUM(ir_idx),
13062 CN_Tbl_Idx, cn_idx);
13063
13064 IL_FLD(arg3) = IR_Tbl_Idx;
13065 IL_IDX(arg3) = eq_idx;
13066 IL_LINE_NUM(arg3) = IR_LINE_NUM(ir_idx);
13067 IL_COL_NUM(arg3) = IR_COL_NUM(ir_idx);
13068
13069 OPND_FLD(base_opnd) = IR_Tbl_Idx;
13070 OPND_IDX(base_opnd) = select;
13071 }
13072
13073 le_idx = gen_ir(IR_Tbl_Idx, select,
13074 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13075 IR_COL_NUM(ir_idx),
13076 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13077
13078 IL_FLD(save_arg3) = IR_Tbl_Idx;
13079 IL_IDX(save_arg3) = le_idx;
13080 }
13081 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
13082 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
13083 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13084 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
13085
13086
13087
13088
13089
13090 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
13091 }
13092 else if (arg_info_list[info_idx1].ed.section ||
13093 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13094 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
13095
13096 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13097
13098 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
13099 CN_INTEGER_ONE_IDX :
13100 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
13101
13102 OPND_IDX((*result_opnd)) = cn_idx;
13103 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
13104 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13105 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13106 res_exp_desc->constant = TRUE;
13107 res_exp_desc->foldable = TRUE;
13108 }
13109 }
13110 }
13111 else {
13112
13113 res_exp_desc->shape[0].fld = CN_Tbl_Idx;
13114 res_exp_desc->shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
13115 res_exp_desc->rank);
13116 SHAPE_WILL_FOLD_LATER(res_exp_desc->shape[0]) = TRUE;
13117 SHAPE_FOLDABLE(res_exp_desc->shape[0]) = TRUE;
13118
13119 res_exp_desc->rank = 1;
13120
13121 if (IR_LIST_CNT_R(ir_idx) == 1) {
13122 IR_LIST_CNT_R(ir_idx) = 2;
13123 NTR_IR_LIST_TBL(new_idx);
13124 IL_INTRIN_PLACE_HOLDER(new_idx) = TRUE;
13125 IL_ARG_DESC_VARIANT(new_idx) = TRUE;
13126 IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)) = new_idx;
13127 }
13128
13129
13130 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13131 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
13132 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13133 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
13134 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
13135
13136
13137 COPY_OPND(opnd, IL_OPND(list_idx1));
13138 array_attr = find_base_attr(&opnd, &line, &col);
13139
13140 bd_idx = ATD_ARRAY_IDX(array_attr);
13141
13142
13143
13144
13145 idx = IL_IDX(list_idx1);
13146
13147 if (IR_OPR(idx) == Whole_Substring_Opr) {
13148 idx = IR_IDX_L(idx);
13149 }
13150
13151 idx = IR_IDX_R(idx);
13152
13153 res_exp_desc->will_fold_later = TRUE;
13154
13155 for (i = 0; i < BD_RANK(bd_idx); i++) {
13156
13157 idx2 = IL_IDX(idx);
13158 idx2 = IR_IDX_L(idx2);
13159
13160 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx ||
13161 IL_FLD(idx2) != CN_Tbl_Idx) {
13162
13163 NTR_IR_LIST_TBL(arg1);
13164 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13165 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13166 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13167 IL_FLD(arg1) = CN_Tbl_Idx;
13168
13169
13170
13171 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
13172 CN_INTEGER_ONE_IDX :
13173 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
13174
13175 IL_IDX(arg1) = cn_idx;
13176
13177 NTR_IR_LIST_TBL(arg2);
13178 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13179 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
13180 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
13181 IL_FLD(arg2) = IL_FLD(idx2);
13182 IL_IDX(arg2) = IL_IDX(idx2);
13183
13184 NTR_IR_LIST_TBL(arg3);
13185 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13186
13187 le_idx = gen_ir(OPND_FLD(arg_info_list[info_idx1].ed.shape[i]),
13188 OPND_IDX(arg_info_list[info_idx1].ed.shape[i]),
13189 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13190 IR_COL_NUM(ir_idx),
13191 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13192
13193 IL_FLD(arg3) = IR_Tbl_Idx;
13194 IL_IDX(arg3) = le_idx;
13195
13196
13197 IL_NEXT_LIST_IDX(arg1) = arg2;
13198 IL_NEXT_LIST_IDX(arg2) = arg3;
13199
13200 select = gen_ir(IL_Tbl_Idx, arg1,
13201 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13202 IR_COL_NUM(ir_idx),
13203 NO_Tbl_Idx, NULL_IDX);
13204
13205
13206 io_item_must_flatten = TRUE;
13207
13208 expr_IDX[i] = select;
13209 expr_FLD[i] = IR_Tbl_Idx;
13210 host_array[i] = 0;
13211 }
13212 else if (compare_cn_and_value(arg_info_list[info_idx1].ed.
13213 shape[i].idx,
13214 0,
13215 Le_Opr)) {
13216 host_array[i] = 1;
13217 }
13218 else {
13219 host_array[i] = CN_INT_TO_C(IL_IDX(idx2));
13220 }
13221
13222 idx = IL_NEXT_LIST_IDX(idx);
13223 }
13224 }
13225 else if (arg_info_list[info_idx1].ed.section ||
13226 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13227 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
13228
13229 res_exp_desc->will_fold_later = TRUE;
13230
13231 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
13232 host_array[i] = 1;
13233 }
13234 }
13235 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
13236 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
13237 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13238 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
13239
13240
13241
13242 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
13243 attr_idx = IL_IDX(list_idx1);
13244 }
13245 else {
13246 attr_idx = IR_IDX_L(IL_IDX(list_idx1));
13247 }
13248
13249 bd_idx = ATD_ARRAY_IDX(attr_idx);
13250
13251 res_exp_desc->will_fold_later = TRUE;
13252
13253 for (i = 1; i < BD_RANK(bd_idx); i++) {
13254
13255 if (BD_LB_FLD(bd_idx, i) != CN_Tbl_Idx ||
13256 BD_XT_FLD(bd_idx, i) != CN_Tbl_Idx) {
13257
13258 res_exp_desc->will_fold_later = FALSE;
13259 break;
13260 }
13261 else if (compare_cn_and_value(BD_XT_IDX(bd_idx, i), 0, Le_Opr)) {
13262 host_array[(i-1)] = 1;
13263 }
13264 else {
13265 host_array[(i-1)] = CN_INT_TO_C(BD_LB_IDX(bd_idx,i));
13266 }
13267 }
13268
13269 if (BD_LB_FLD(bd_idx, BD_RANK(bd_idx)) != CN_Tbl_Idx) {
13270 res_exp_desc->will_fold_later = FALSE;
13271 }
13272 else {
13273 host_array[(BD_RANK(bd_idx)-1)] = CN_INT_TO_C(
13274 BD_LB_IDX(bd_idx, BD_RANK(bd_idx)));
13275 }
13276 }
13277
13278 if (res_exp_desc->will_fold_later) {
13279 make_const_tmp = TRUE;
13280 }
13281 }
13282
13283 if (make_const_tmp) {
13284 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13285 bit_length = TARGET_BITS_PER_WORD * arg_info_list[info_idx1].ed.rank;
13286 # ifdef _WHIRL_HOST64_TARGET64
13287 bit_length >>= 1;
13288 # endif
13289
13290 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
13291 TYP_TYPE(TYP_WORK_IDX) = Typeless;
13292 TYP_BIT_LEN(TYP_WORK_IDX) = bit_length;
13293 constant_type_idx = ntr_type_tbl();
13294
13295 for (i = 0; i < MAX_NUM_DIMS; i++) {
13296
13297 # if defined(_TARGET32)
13298
13299
13300
13301
13302 if (INTEGER_DEFAULT_TYPE == Integer_8) {
13303
13304
13305 }
13306 # endif
13307
13308
13309
13310 const_array[i] = (long_type) host_array[i];
13311 }
13312
13313 the_cn_idx = ntr_const_tbl(constant_type_idx,
13314 FALSE,
13315 const_array);
13316
13317
13318 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
13319 IR_COL_NUM(ir_idx),
13320 Shared, TRUE);
13321
13322 AT_SEMANTICS_DONE(tmp_idx) = TRUE;
13323 ATD_TYPE_IDX(tmp_idx) = CG_INTEGER_DEFAULT_TYPE;
13324
13325 loc_exp_desc = *res_exp_desc;
13326 loc_exp_desc.type_idx = CG_INTEGER_DEFAULT_TYPE;
13327 loc_exp_desc.type = Integer;
13328 loc_exp_desc.linear_type = CG_INTEGER_DEFAULT_TYPE;
13329
13330 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(&loc_exp_desc,
13331 IR_LINE_NUM(ir_idx),
13332 IR_COL_NUM(ir_idx));
13333
13334 ATD_SAVED(tmp_idx) = TRUE;
13335 ATD_DATA_INIT(tmp_idx) = TRUE;
13336 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STATIC_INIT_IDX(curr_scp_idx);
13337 ATD_FLD(tmp_idx) = CN_Tbl_Idx;
13338 ATD_TMP_IDX(tmp_idx) = the_cn_idx;
13339 ATD_TMP_INIT_NOT_DONE(tmp_idx) = TRUE;
13340
13341 OPND_IDX((*result_opnd)) = tmp_idx;
13342 OPND_FLD((*result_opnd)) = AT_Tbl_Idx;
13343 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13344 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13345
13346 ok = gen_whole_subscript(result_opnd, res_exp_desc);
13347
13348 if (CG_INTEGER_DEFAULT_TYPE != INTEGER_DEFAULT_TYPE) {
13349 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
13350
13351 ok = fold_aggragate_expression(result_opnd,
13352 res_exp_desc,
13353 FALSE);
13354
13355 if (OPND_FLD((*result_opnd)) == IR_Tbl_Idx) {
13356 idx = OPND_IDX((*result_opnd));
13357 if (IR_FLD_L(idx) == AT_Tbl_Idx) {
13358 tmp_idx = IR_IDX_L(idx);
13359 }
13360 }
13361 }
13362
13363 AT_REFERENCED(tmp_idx) = Referenced;
13364 AT_DEFINED(tmp_idx) = TRUE;
13365
13366 res_exp_desc->foldable = TRUE;
13367 res_exp_desc->tmp_reference = TRUE;
13368 }
13369
13370
13371
13372
13373 for (i = 0; i < MAX_NUM_DIMS; i++) {
13374 if (expr_IDX[i] != NULL_IDX) {
13375 res_exp_desc->foldable = FALSE;
13376 res_exp_desc->will_fold_later = FALSE;
13377
13378 NTR_IR_LIST_TBL(idx);
13379 IL_FLD(idx) = CN_Tbl_Idx;
13380
13381 IL_IDX(idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i+1);
13382 IL_LINE_NUM(idx) = IR_LINE_NUM(ir_idx);
13383 IL_COL_NUM(idx) = IR_COL_NUM(ir_idx);
13384
13385 NTR_IR_TBL(subscript_idx);
13386 IR_TYPE_IDX(subscript_idx) = CG_INTEGER_DEFAULT_TYPE;
13387 IR_OPR(subscript_idx) = Subscript_Opr;
13388 IR_LINE_NUM(subscript_idx) = IR_LINE_NUM(ir_idx);
13389 IR_COL_NUM(subscript_idx) = IR_COL_NUM(ir_idx);
13390 IR_FLD_L(subscript_idx) = AT_Tbl_Idx;
13391 IR_IDX_L(subscript_idx) = tmp_idx;
13392 IR_LINE_NUM_L(subscript_idx) = IR_LINE_NUM(ir_idx);
13393 IR_COL_NUM_L(subscript_idx) = IR_COL_NUM(ir_idx);
13394 IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
13395 IR_IDX_R(subscript_idx) = idx;
13396 IR_LINE_NUM_R(subscript_idx) = IR_LINE_NUM(ir_idx);
13397 IR_COL_NUM_R(subscript_idx) = IR_COL_NUM(ir_idx);
13398 IR_LIST_CNT_R(subscript_idx) = 1;
13399
13400 asg_idx = gen_ir(IR_Tbl_Idx, subscript_idx,
13401 Asg_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13402 IR_COL_NUM(ir_idx),
13403 expr_FLD[i], expr_IDX[i]);
13404
13405 gen_sh(Before,
13406 Assignment_Stmt,
13407 IR_LINE_NUM(ir_idx),
13408 IR_COL_NUM(ir_idx),
13409 FALSE,
13410 FALSE,
13411 TRUE);
13412
13413 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
13414 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
13415 }
13416 }
13417
13418
13419
13420 EXIT:
13421
13422 if (OPND_FLD((*result_opnd)) != IR_Tbl_Idx ||
13423 IR_OPR(OPND_IDX((*result_opnd))) != Call_Opr) {
13424
13425 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
13426 }
13427
13428 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
13429 IR_RANK(ir_idx) = res_exp_desc->rank;
13430
13431 TRACE (Func_Exit, "lbound_intrinsic", NULL);
13432
13433 }
13434
13435
13436
13437
13438
13439
13440
13441
13442
13443
13444
13445
13446
13447
13448
13449
13450
13451 void ubound_intrinsic(opnd_type *result_opnd,
13452 expr_arg_type *res_exp_desc,
13453 int *spec_idx)
13454 {
13455 int asg_idx;
13456 int attr_idx = NULL_IDX;
13457 int select;
13458 long64 bit_length;
13459 int constant_type_idx;
13460 long dim;
13461 int arg1;
13462 int arg2;
13463 int arg3;
13464 int ir_idx;
13465 int il_idx;
13466 int le_idx;
13467 int eq_idx;
13468 int array_attr;
13469 # ifdef _WHIRL_HOST64_TARGET64
13470 int const_array[MAX_NUM_DIMS];
13471 # else
13472 long_type const_array[MAX_NUM_DIMS];
13473 # endif
13474 long64 host_array[MAX_NUM_DIMS];
13475 int expr_IDX[MAX_NUM_DIMS];
13476 fld_type expr_FLD[MAX_NUM_DIMS];
13477 boolean ok;
13478 int idx;
13479 int idx2;
13480 int i;
13481 int bd_idx;
13482 int new_idx;
13483 int cn_idx;
13484 opnd_type opnd;
13485 opnd_type base_opnd;
13486 int info_idx1;
13487 int info_idx2;
13488 int list_idx1;
13489 int list_idx2;
13490 int line;
13491 int col;
13492 boolean make_const_tmp = FALSE;
13493 int the_cn_idx;
13494 int tmp_idx;
13495 int subscript_idx;
13496 expr_arg_type loc_exp_desc;
13497 int save_arg3;
13498
13499
13500 TRACE (Func_Entry, "ubound_intrinsic", NULL);
13501
13502 for (i = 0; i < MAX_NUM_DIMS; i++) {
13503 expr_IDX[i] = NULL_IDX;
13504 expr_FLD[i] = NO_Tbl_Idx;
13505 host_array[i] = 0;
13506 }
13507
13508 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
13509
13510 ir_idx = OPND_IDX((*result_opnd));
13511 list_idx1 = IR_IDX_R(ir_idx);
13512 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
13513 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
13514 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
13515
13516 if (arg_info_list[info_idx1].ed.reference) {
13517 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
13518 }
13519
13520 conform_check(0,
13521 ir_idx,
13522 res_exp_desc,
13523 spec_idx,
13524 TRUE);
13525
13526
13527 res_exp_desc->foldable = FALSE;
13528 res_exp_desc->will_fold_later = FALSE;
13529
13530 if (arg_info_list[info_idx1].ed.rank == 0) {
13531 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
13532 arg_info_list[info_idx1].col);
13533 }
13534
13535 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
13536 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
13537
13538 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
13539 (compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr) ||
13540 compare_cn_and_value(IL_IDX(list_idx2),
13541 (long) arg_info_list[info_idx1].ed.rank,
13542 Gt_Opr))) {
13543
13544 find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx2),
13545 &line,
13546 &col);
13547 PRINTMSG(line, 1012, Error, col);
13548 goto EXIT;
13549 }
13550
13551
13552 if (arg_info_list[info_idx2].ed.rank != 0) {
13553 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
13554 arg_info_list[info_idx2].col);
13555 goto EXIT;
13556 }
13557
13558 res_exp_desc->rank = 0;
13559
13560 if (arg_info_list[info_idx2].ed.reference) {
13561 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
13562
13563 if (AT_OPTIONAL(attr_idx)) {
13564 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
13565 arg_info_list[info_idx2].col);
13566 }
13567 }
13568
13569 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
13570 dim = (long) CN_INT_TO_C(IL_IDX(list_idx2));
13571
13572 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13573 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
13574 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13575 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
13576 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
13577
13578 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13579
13580 idx = IL_IDX(list_idx1);
13581
13582 if (IR_OPR(idx) == Whole_Substring_Opr) {
13583 idx = IR_IDX_L(idx);
13584 }
13585
13586 bd_idx = idx;
13587 idx = IR_IDX_R(idx);
13588
13589 COPY_OPND(opnd, IR_OPND_L(bd_idx));
13590 array_attr = find_base_attr(&opnd, &line, &col);
13591
13592 bd_idx = ATD_ARRAY_IDX(array_attr);
13593
13594 for (i = 1; i < dim; i++) {
13595 idx = IL_NEXT_LIST_IDX(idx);
13596 }
13597 idx = IL_IDX(idx);
13598 idx = IR_IDX_L(idx);
13599 idx = IL_NEXT_LIST_IDX(idx);
13600
13601 if (arg_info_list[info_idx1].ed.shape[dim-1].fld == CN_Tbl_Idx) {
13602
13603 if (compare_cn_and_value(
13604 arg_info_list[info_idx1].ed.shape[dim-1].idx, 0, Le_Opr)) {
13605
13606
13607 OPND_IDX((*result_opnd)) = (CG_INTEGER_DEFAULT_TYPE ==
13608 INTEGER_DEFAULT_TYPE) ?
13609 CN_INTEGER_ZERO_IDX :
13610 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 0);
13611 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
13612 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13613 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13614 }
13615 else {
13616
13617 COPY_OPND((*result_opnd), IL_OPND(idx));
13618 }
13619
13620 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
13621 res_exp_desc->constant = TRUE;
13622 res_exp_desc->foldable = TRUE;
13623 }
13624 }
13625 else {
13626
13627 NTR_IR_LIST_TBL(arg1);
13628 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13629
13630 NTR_IR_LIST_TBL(arg2);
13631 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13632
13633 NTR_IR_LIST_TBL(arg3);
13634 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13635
13636
13637 IL_NEXT_LIST_IDX(arg1) = arg2;
13638 IL_NEXT_LIST_IDX(arg2) = arg3;
13639
13640 IR_OPR(ir_idx) = Cvmgt_Opr;
13641 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
13642 IR_IDX_L(ir_idx) = arg1;
13643 IR_LIST_CNT_L(ir_idx) = 3;
13644
13645
13646 io_item_must_flatten = TRUE;
13647
13648
13649 IR_OPND_R(ir_idx) = null_opnd;
13650
13651 IL_FLD(arg1) = CN_Tbl_Idx;
13652 IL_IDX(arg1) = CN_INTEGER_ZERO_IDX;
13653 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13654 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13655
13656 COPY_OPND(IL_OPND(arg2), IL_OPND(idx));
13657
13658 le_idx=gen_ir(OPND_FLD(arg_info_list[info_idx1].ed.shape[dim-1]),
13659 OPND_IDX(arg_info_list[info_idx1].ed.shape[dim-1]),
13660 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13661 IR_COL_NUM(ir_idx),
13662 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13663
13664 IL_FLD(arg3) = IR_Tbl_Idx;
13665 IL_IDX(arg3) = le_idx;
13666
13667
13668 }
13669 }
13670 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
13671 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
13672 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13673 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
13674
13675
13676
13677 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
13678 attr_idx = IL_IDX(list_idx1);
13679 }
13680 else {
13681 attr_idx = IR_IDX_L(IL_IDX(list_idx1));
13682 }
13683
13684 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13685 bd_idx = ATD_ARRAY_IDX(attr_idx);
13686
13687 if (compare_cn_and_value(IL_IDX(list_idx2),
13688 (long) BD_RANK(bd_idx),
13689 Eq_Opr)) {
13690
13691 PRINTMSG(arg_info_list[info_idx1].line, 889, Error,
13692 arg_info_list[info_idx1].col);
13693 }
13694 else if (BD_XT_FLD(bd_idx, dim) == CN_Tbl_Idx) {
13695
13696 if (compare_cn_and_value(BD_XT_IDX(bd_idx, dim), 0, Le_Opr)) {
13697
13698 OPND_IDX((*result_opnd)) = CN_INTEGER_ZERO_IDX;
13699 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
13700 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13701 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13702 }
13703 else {
13704 OPND_IDX((*result_opnd)) = BD_UB_IDX(bd_idx, dim);
13705 OPND_FLD((*result_opnd)) = BD_UB_FLD(bd_idx, dim);
13706 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13707 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13708 }
13709
13710 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
13711 res_exp_desc->constant = TRUE;
13712 res_exp_desc->foldable = TRUE;
13713 }
13714 }
13715 else {
13716
13717
13718
13719 NTR_IR_LIST_TBL(arg1);
13720 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13721
13722 NTR_IR_LIST_TBL(arg2);
13723 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13724
13725 NTR_IR_LIST_TBL(arg3);
13726 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13727
13728
13729 IL_NEXT_LIST_IDX(arg1) = arg2;
13730 IL_NEXT_LIST_IDX(arg2) = arg3;
13731
13732 IR_OPR(ir_idx) = Cvmgt_Opr;
13733 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
13734 IR_IDX_L(ir_idx) = arg1;
13735 IR_LIST_CNT_L(ir_idx) = 3;
13736
13737
13738 io_item_must_flatten = TRUE;
13739
13740
13741 IR_OPND_R(ir_idx) = null_opnd;
13742
13743 IL_FLD(arg1) = CN_Tbl_Idx;
13744 IL_IDX(arg1) = CN_INTEGER_ONE_IDX;
13745 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13746 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13747
13748 IL_FLD(arg2) = BD_UB_FLD(bd_idx, dim);
13749 IL_IDX(arg2) = BD_UB_IDX(bd_idx, dim);
13750 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
13751 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
13752
13753 le_idx = gen_ir(BD_XT_FLD(bd_idx, dim), BD_XT_IDX(bd_idx, dim),
13754 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13755 IR_COL_NUM(ir_idx),
13756 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13757
13758 IL_FLD(arg3) = IR_Tbl_Idx;
13759 IL_IDX(arg3) = le_idx;
13760 }
13761 }
13762 else if (arg_info_list[info_idx1].ed.section ||
13763 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13764 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
13765
13766 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13767 COPY_OPND((*result_opnd),
13768 arg_info_list[info_idx1].ed.shape[dim-1]);
13769
13770 cast_opnd_to_type_idx(result_opnd, res_exp_desc->type_idx);
13771
13772 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
13773 res_exp_desc->constant = TRUE;
13774 res_exp_desc->foldable = TRUE;
13775 }
13776 else if (SHAPE_WILL_FOLD_LATER((*result_opnd)) ||
13777 SHAPE_FOLDABLE((*result_opnd))) {
13778
13779 res_exp_desc->will_fold_later = TRUE;
13780 }
13781
13782
13783 SHAPE_FOLDABLE((*result_opnd)) = FALSE;
13784 SHAPE_WILL_FOLD_LATER((*result_opnd)) = FALSE;
13785 }
13786 }
13787 else {
13788
13789
13790 COPY_OPND(opnd, IL_OPND(list_idx2));
13791 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
13792 COPY_OPND(IL_OPND(list_idx2), opnd);
13793
13794 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13795 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
13796 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13797 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
13798 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
13799
13800 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13801
13802 idx = IL_IDX(list_idx1);
13803
13804 if (IR_OPR(idx) == Whole_Substring_Opr) {
13805 idx = IR_IDX_L(idx);
13806 }
13807
13808 bd_idx = idx;
13809 il_idx = IR_IDX_R(idx);
13810
13811 COPY_OPND(opnd, IR_OPND_L(bd_idx));
13812 array_attr = find_base_attr(&opnd, &line, &col);
13813
13814 bd_idx = ATD_ARRAY_IDX(array_attr);
13815
13816 idx = IL_IDX(il_idx);
13817 idx = IR_IDX_L(idx);
13818 idx = IL_NEXT_LIST_IDX(idx);
13819
13820 OPND_IDX(base_opnd) = CN_INTEGER_ZERO_IDX;
13821 OPND_FLD(base_opnd) = CN_Tbl_Idx;
13822 OPND_LINE_NUM(base_opnd) = IR_LINE_NUM(ir_idx);
13823 OPND_COL_NUM(base_opnd) = IR_COL_NUM(ir_idx);
13824
13825 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
13826
13827 NTR_IR_LIST_TBL(arg1);
13828 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13829 NTR_IR_LIST_TBL(arg2);
13830 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13831 NTR_IR_LIST_TBL(arg3);
13832 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13833
13834
13835 IL_NEXT_LIST_IDX(arg1) = arg2;
13836 IL_NEXT_LIST_IDX(arg2) = arg3;
13837
13838 select = gen_ir(IL_Tbl_Idx, arg1,
13839 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13840 IR_COL_NUM(ir_idx),
13841 NO_Tbl_Idx, NULL_IDX);
13842
13843
13844 io_item_must_flatten = TRUE;
13845
13846 COPY_OPND(IL_OPND(arg1), IL_OPND(idx));
13847 il_idx = IL_NEXT_LIST_IDX(il_idx);
13848 idx = IL_IDX(il_idx);
13849 idx = IR_IDX_L(idx);
13850 idx = IL_NEXT_LIST_IDX(idx);
13851
13852 COPY_OPND(IL_OPND(arg2), base_opnd);
13853
13854 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
13855
13856 eq_idx = gen_ir(IL_FLD(list_idx2), IL_IDX(list_idx2),
13857 Eq_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13858 IR_COL_NUM(ir_idx),
13859 CN_Tbl_Idx, cn_idx);
13860
13861 IL_FLD(arg3) = IR_Tbl_Idx;
13862 IL_IDX(arg3) = eq_idx;
13863
13864 OPND_FLD(base_opnd) = IR_Tbl_Idx;
13865 OPND_IDX(base_opnd) = select;
13866 }
13867
13868
13869 NTR_IR_LIST_TBL(arg1);
13870 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13871 NTR_IR_LIST_TBL(arg2);
13872 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13873 NTR_IR_LIST_TBL(arg3);
13874 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13875
13876
13877 IL_NEXT_LIST_IDX(arg1) = arg2;
13878 IL_NEXT_LIST_IDX(arg2) = arg3;
13879
13880 IR_OPR(ir_idx) = Cvmgt_Opr;
13881 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
13882 IR_IDX_L(ir_idx) = arg1;
13883 IR_LIST_CNT_L(ir_idx) = 3;
13884
13885
13886 io_item_must_flatten = TRUE;
13887
13888
13889 IR_OPND_R(ir_idx) = null_opnd;
13890
13891 IL_FLD(arg1) = CN_Tbl_Idx;
13892 IL_IDX(arg1) = CN_INTEGER_ZERO_IDX;
13893 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13894 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13895
13896 IL_FLD(arg2) = IR_Tbl_Idx;
13897 IL_IDX(arg2) = select;
13898
13899 save_arg3 = arg3;
13900
13901 OPND_IDX(base_opnd) = CN_INTEGER_ZERO_IDX;
13902 OPND_FLD(base_opnd) = CN_Tbl_Idx;
13903 OPND_LINE_NUM(base_opnd) = IR_LINE_NUM(ir_idx);
13904 OPND_COL_NUM(base_opnd) = IR_COL_NUM(ir_idx);
13905
13906 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
13907
13908 NTR_IR_LIST_TBL(arg1);
13909 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13910 NTR_IR_LIST_TBL(arg2);
13911 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13912 NTR_IR_LIST_TBL(arg3);
13913 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13914
13915
13916 IL_NEXT_LIST_IDX(arg1) = arg2;
13917 IL_NEXT_LIST_IDX(arg2) = arg3;
13918
13919 select = gen_ir(IL_Tbl_Idx, arg1,
13920 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13921 IR_COL_NUM(ir_idx),
13922 NO_Tbl_Idx, NULL_IDX);
13923
13924
13925 io_item_must_flatten = TRUE;
13926
13927 COPY_OPND(IL_OPND(arg1),
13928 arg_info_list[info_idx1].ed.shape[i-1]);
13929 COPY_OPND(IL_OPND(arg2), base_opnd);
13930
13931 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
13932
13933 eq_idx = gen_ir(IL_FLD(list_idx2), IL_IDX(list_idx2),
13934 Eq_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13935 IR_COL_NUM(ir_idx),
13936 CN_Tbl_Idx, cn_idx);
13937
13938 IL_FLD(arg3) = IR_Tbl_Idx;
13939 IL_IDX(arg3) = eq_idx;
13940
13941 OPND_FLD(base_opnd) = IR_Tbl_Idx;
13942 OPND_IDX(base_opnd) = select;
13943 }
13944
13945 le_idx = gen_ir(IR_Tbl_Idx, select,
13946 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13947 IR_COL_NUM(ir_idx),
13948 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13949
13950 IL_FLD(save_arg3) = IR_Tbl_Idx;
13951 IL_IDX(save_arg3) = le_idx;
13952 }
13953 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
13954 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
13955 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13956 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
13957
13958
13959 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
13960 }
13961 else if (arg_info_list[info_idx1].ed.section ||
13962 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13963 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
13964
13965 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
13966 }
13967 }
13968 }
13969 else {
13970
13971 res_exp_desc->shape[0].fld = CN_Tbl_Idx;
13972 res_exp_desc->shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
13973 res_exp_desc->rank);
13974 SHAPE_WILL_FOLD_LATER(res_exp_desc->shape[0]) = TRUE;
13975 SHAPE_FOLDABLE(res_exp_desc->shape[0]) = TRUE;
13976
13977 res_exp_desc->rank = 1;
13978
13979 if (IR_LIST_CNT_R(ir_idx) == 1) {
13980 IR_LIST_CNT_R(ir_idx) = 2;
13981 NTR_IR_LIST_TBL(new_idx);
13982 IL_INTRIN_PLACE_HOLDER(new_idx) = TRUE;
13983 IL_ARG_DESC_VARIANT(new_idx) = TRUE;
13984 IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)) = new_idx;
13985 }
13986
13987
13988
13989
13990 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13991 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
13992 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13993 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
13994 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
13995
13996 COPY_OPND(opnd, IL_OPND(list_idx1));
13997 array_attr = find_base_attr(&opnd, &line, &col);
13998
13999 bd_idx = ATD_ARRAY_IDX(array_attr);
14000
14001
14002
14003
14004 idx = IL_IDX(list_idx1);
14005
14006 if (IR_OPR(idx) == Whole_Substring_Opr) {
14007 idx = IR_IDX_L(idx);
14008 }
14009
14010 idx = IR_IDX_R(idx);
14011
14012 res_exp_desc->will_fold_later = TRUE;
14013
14014 for (i = 0; i < BD_RANK(bd_idx); i++) {
14015 idx2 = IL_IDX(idx);
14016 idx2 = IR_IDX_L(idx2);
14017 idx2 = IL_NEXT_LIST_IDX(idx2);
14018
14019 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx ||
14020 IL_FLD(idx2) != CN_Tbl_Idx) {
14021
14022 NTR_IR_LIST_TBL(arg1);
14023 IL_ARG_DESC_VARIANT(arg1) = TRUE;
14024 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
14025 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
14026 IL_FLD(arg1) = CN_Tbl_Idx;
14027
14028
14029
14030 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 0);
14031
14032 IL_IDX(arg1) = cn_idx;
14033
14034 NTR_IR_LIST_TBL(arg2);
14035 IL_ARG_DESC_VARIANT(arg2) = TRUE;
14036 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
14037 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
14038 IL_FLD(arg2) = IL_FLD(idx2);
14039 IL_IDX(arg2) = IL_IDX(idx2);
14040
14041 NTR_IR_LIST_TBL(arg3);
14042 IL_ARG_DESC_VARIANT(arg3) = TRUE;
14043
14044 le_idx = gen_ir(OPND_FLD(arg_info_list[info_idx1].ed.shape[i]),
14045 OPND_IDX(arg_info_list[info_idx1].ed.shape[i]),
14046 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
14047 IR_COL_NUM(ir_idx),
14048 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
14049
14050 IL_FLD(arg3) = IR_Tbl_Idx;
14051 IL_IDX(arg3) = le_idx;
14052
14053
14054 IL_NEXT_LIST_IDX(arg1) = arg2;
14055 IL_NEXT_LIST_IDX(arg2) = arg3;
14056
14057 select = gen_ir(IL_Tbl_Idx, arg1,
14058 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
14059 IR_COL_NUM(ir_idx),
14060 NO_Tbl_Idx, NULL_IDX);
14061
14062
14063 io_item_must_flatten = TRUE;
14064
14065 expr_IDX[i] = select;
14066 expr_FLD[i] = IR_Tbl_Idx;
14067 host_array[i] = 0;
14068 }
14069 else if (compare_cn_and_value(
14070 arg_info_list[info_idx1].ed.shape[i].idx, 0, Le_Opr)) {
14071 host_array[i] = 0;
14072 }
14073 else {
14074 host_array[i] = (long_type) CN_INT_TO_C(IL_IDX(idx2));
14075 }
14076
14077 idx = IL_NEXT_LIST_IDX(idx);
14078 }
14079
14080 if (res_exp_desc->will_fold_later) {
14081 make_const_tmp = TRUE;
14082 }
14083
14084 }
14085 else if (arg_info_list[info_idx1].ed.section ||
14086 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14087 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
14088
14089 res_exp_desc->will_fold_later = TRUE;
14090 res_exp_desc->foldable = TRUE;
14091
14092 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
14093 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx) {
14094 res_exp_desc->foldable = FALSE;
14095 }
14096 else {
14097 host_array[i] = (long_type)
14098 CN_INT_TO_C(arg_info_list[info_idx1].ed.shape[i].idx);
14099 }
14100
14101 if (! SHAPE_WILL_FOLD_LATER(arg_info_list[info_idx1].ed.shape[i])) {
14102 res_exp_desc->will_fold_later = FALSE;
14103 }
14104 }
14105
14106 if (res_exp_desc->foldable) {
14107 make_const_tmp = TRUE;
14108 }
14109 }
14110 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
14111 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
14112 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14113 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
14114
14115
14116 PRINTMSG(arg_info_list[info_idx1].line, 889, Error,
14117 arg_info_list[info_idx1].col);
14118 }
14119 }
14120
14121 if (make_const_tmp) {
14122 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14123 bit_length = TARGET_BITS_PER_WORD* (long)arg_info_list[info_idx1].ed.rank;
14124 # ifdef _WHIRL_HOST64_TARGET64
14125 bit_length >>= 1;
14126 # endif
14127
14128 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
14129 TYP_TYPE(TYP_WORK_IDX) = Typeless;
14130 TYP_BIT_LEN(TYP_WORK_IDX) = bit_length;
14131 constant_type_idx = ntr_type_tbl();
14132
14133 for (i = 0; i < MAX_NUM_DIMS; i++) {
14134
14135 # if defined(_TARGET32)
14136
14137
14138
14139
14140 if (INTEGER_DEFAULT_TYPE == Integer_8) {
14141
14142
14143 }
14144 # endif
14145
14146
14147
14148 const_array[i] = (long_type) host_array[i];
14149 }
14150
14151 the_cn_idx = ntr_const_tbl(constant_type_idx,
14152 FALSE,
14153 const_array);
14154
14155 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
14156 IR_COL_NUM(ir_idx),
14157 Shared, TRUE);
14158
14159 AT_SEMANTICS_DONE(tmp_idx)= TRUE;
14160 ATD_TYPE_IDX(tmp_idx) = CG_INTEGER_DEFAULT_TYPE;
14161
14162 loc_exp_desc = *res_exp_desc;
14163 loc_exp_desc.type_idx = CG_INTEGER_DEFAULT_TYPE;
14164 loc_exp_desc.type = Integer;
14165 loc_exp_desc.linear_type = CG_INTEGER_DEFAULT_TYPE;
14166
14167 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(&loc_exp_desc,
14168 IR_LINE_NUM(ir_idx),
14169 IR_COL_NUM(ir_idx));
14170
14171 ATD_SAVED(tmp_idx) = TRUE;
14172 ATD_DATA_INIT(tmp_idx) = TRUE;
14173 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STATIC_INIT_IDX(curr_scp_idx);
14174 ATD_FLD(tmp_idx) = CN_Tbl_Idx;
14175 ATD_TMP_IDX(tmp_idx) = the_cn_idx;
14176 ATD_TMP_INIT_NOT_DONE(tmp_idx) = TRUE;
14177
14178 OPND_IDX((*result_opnd)) = tmp_idx;
14179 OPND_FLD((*result_opnd)) = AT_Tbl_Idx;
14180 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14181 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14182
14183 ok = gen_whole_subscript(result_opnd, res_exp_desc);
14184
14185 if (CG_INTEGER_DEFAULT_TYPE != INTEGER_DEFAULT_TYPE) {
14186 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14187
14188 ok = fold_aggragate_expression(result_opnd,
14189 res_exp_desc,
14190 FALSE);
14191
14192 if (OPND_FLD((*result_opnd)) == IR_Tbl_Idx) {
14193 idx = OPND_IDX((*result_opnd));
14194 if (IR_FLD_L(idx) == AT_Tbl_Idx) {
14195 tmp_idx = IR_IDX_L(idx);
14196 }
14197 }
14198 }
14199
14200 AT_REFERENCED(tmp_idx) = Referenced;
14201 AT_DEFINED(tmp_idx) = TRUE;
14202
14203 res_exp_desc->foldable = TRUE;
14204 res_exp_desc->tmp_reference = TRUE;
14205 }
14206
14207
14208
14209
14210 for (i = 0; i < MAX_NUM_DIMS; i++) {
14211 if (expr_IDX[i] != NULL_IDX) {
14212 res_exp_desc->foldable = FALSE;
14213 res_exp_desc->will_fold_later = FALSE;
14214
14215 NTR_IR_LIST_TBL(idx);
14216 IL_FLD(idx) = CN_Tbl_Idx;
14217
14218 IL_IDX(idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i+1);
14219
14220 IL_LINE_NUM(idx) = IR_LINE_NUM(ir_idx);
14221 IL_COL_NUM(idx) = IR_COL_NUM(ir_idx);
14222
14223 NTR_IR_TBL(subscript_idx);
14224 IR_TYPE_IDX(subscript_idx) = CG_INTEGER_DEFAULT_TYPE;
14225 IR_OPR(subscript_idx) = Subscript_Opr;
14226 IR_LINE_NUM(subscript_idx) = IR_LINE_NUM(ir_idx);
14227 IR_COL_NUM(subscript_idx) = IR_COL_NUM(ir_idx);
14228 IR_FLD_L(subscript_idx) = AT_Tbl_Idx;
14229 IR_IDX_L(subscript_idx) = tmp_idx;
14230 IR_LINE_NUM_L(subscript_idx) = IR_LINE_NUM(ir_idx);
14231 IR_COL_NUM_L(subscript_idx) = IR_COL_NUM(ir_idx);
14232 IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
14233 IR_IDX_R(subscript_idx) = idx;
14234 IR_LINE_NUM_R(subscript_idx) = IR_LINE_NUM(ir_idx);
14235 IR_COL_NUM_R(subscript_idx) = IR_COL_NUM(ir_idx);
14236 IR_LIST_CNT_R(subscript_idx) = 1;
14237
14238 asg_idx = gen_ir(IR_Tbl_Idx, subscript_idx,
14239 Asg_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
14240 IR_COL_NUM(ir_idx),
14241 expr_FLD[i], expr_IDX[i]);
14242
14243 gen_sh(Before,
14244 Assignment_Stmt,
14245 IR_LINE_NUM(ir_idx),
14246 IR_COL_NUM(ir_idx),
14247 FALSE,
14248 FALSE,
14249 TRUE);
14250
14251 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
14252 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
14253 }
14254 }
14255
14256
14257 EXIT:
14258
14259 if (OPND_FLD((*result_opnd)) != IR_Tbl_Idx ||
14260 IR_OPR(OPND_IDX((*result_opnd))) != Call_Opr) {
14261
14262 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14263 }
14264
14265 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
14266 IR_RANK(ir_idx) = res_exp_desc->rank;
14267
14268 TRACE (Func_Exit, "ubound_intrinsic", NULL);
14269
14270 }
14271
14272
14273
14274
14275
14276
14277
14278
14279
14280
14281
14282
14283
14284
14285
14286
14287
14288
14289
14290 void size_intrinsic(opnd_type *result_opnd,
14291 expr_arg_type *res_exp_desc,
14292 int *spec_idx)
14293 {
14294 long dim;
14295 int ir_idx;
14296 int array_attr;
14297 int attr_idx = NULL_IDX;
14298 boolean constant_result;
14299 int idx1;
14300 int idx2;
14301 int i;
14302 int bd_idx;
14303 int cn_idx;
14304 int new_idx;
14305 opnd_type opnd;
14306 int info_idx1;
14307 int info_idx2;
14308 int list_idx1;
14309 int list_idx2;
14310 int line;
14311 int col;
14312 boolean result_will_fold;
14313 long64 num;
14314
14315
14316 TRACE (Func_Entry, "size_intrinsic", NULL);
14317
14318 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
14319
14320 ir_idx = OPND_IDX((*result_opnd));
14321 list_idx1 = IR_IDX_R(ir_idx);
14322 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
14323 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
14324 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
14325
14326 if (arg_info_list[info_idx1].ed.reference) {
14327 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
14328 }
14329
14330 conform_check(0,
14331 ir_idx,
14332 res_exp_desc,
14333 spec_idx,
14334 TRUE);
14335
14336
14337
14338 res_exp_desc->foldable = FALSE;
14339 res_exp_desc->will_fold_later = FALSE;
14340
14341
14342 res_exp_desc->rank = 0;
14343
14344 if (arg_info_list[info_idx1].ed.rank == 0) {
14345 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
14346 arg_info_list[info_idx1].col);
14347 }
14348
14349 if (list_idx2 != NULL_IDX &&
14350 IL_FLD(list_idx2) == CN_Tbl_Idx &&
14351 (compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr) ||
14352 compare_cn_and_value(IL_IDX(list_idx2),
14353 (long) arg_info_list[info_idx1].ed.rank,
14354 Gt_Opr))) {
14355
14356 find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx2),
14357 &line,
14358 &col);
14359 PRINTMSG(line, 1012, Error, col);
14360 goto EXIT;
14361 }
14362
14363 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
14364 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
14365
14366 if (arg_info_list[info_idx2].ed.rank != 0) {
14367 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
14368 arg_info_list[info_idx2].col);
14369 goto EXIT;
14370 }
14371
14372 res_exp_desc->rank = 0;
14373
14374 if (arg_info_list[info_idx2].ed.reference) {
14375 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
14376
14377 if (AT_OPTIONAL(attr_idx)) {
14378 #ifdef KEY
14379
14380 #else
14381 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
14382 arg_info_list[info_idx2].col);
14383 #endif
14384 }
14385 }
14386
14387 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
14388
14389 dim = (long) CN_INT_TO_C(IL_IDX(list_idx2));
14390 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14391
14392 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14393 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
14394 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14395 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
14396 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
14397
14398 COPY_OPND((*result_opnd),
14399 arg_info_list[info_idx1].ed.shape[dim-1]);
14400
14401 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14402 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14403 res_exp_desc->linear_type =
14404 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
14405
14406 if (SHAPE_WILL_FOLD_LATER((*result_opnd)) ||
14407 SHAPE_FOLDABLE((*result_opnd))) {
14408 res_exp_desc->will_fold_later = TRUE;
14409 }
14410
14411
14412 SHAPE_FOLDABLE((*result_opnd)) = FALSE;
14413 SHAPE_WILL_FOLD_LATER((*result_opnd)) = FALSE;
14414
14415 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
14416 res_exp_desc->constant = TRUE;
14417 res_exp_desc->foldable = TRUE;
14418 }
14419 }
14420 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
14421 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
14422 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14423 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
14424
14425
14426
14427 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
14428 attr_idx = IL_IDX(list_idx1);
14429 }
14430 else {
14431 attr_idx = IR_IDX_L(IL_IDX(list_idx1));
14432 }
14433
14434 if (dim == arg_info_list[info_idx1].ed.rank) {
14435 PRINTMSG(arg_info_list[info_idx1].line, 889, Error,
14436 arg_info_list[info_idx1].col);
14437 }
14438 else {
14439 OPND_FLD((*result_opnd)) =
14440 BD_XT_FLD(ATD_ARRAY_IDX(attr_idx), dim);
14441 OPND_IDX((*result_opnd)) =
14442 BD_XT_IDX(ATD_ARRAY_IDX(attr_idx), dim);
14443 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14444 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14445
14446 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
14447 res_exp_desc->constant = TRUE;
14448 res_exp_desc->foldable = TRUE;
14449 }
14450 }
14451 }
14452 else if (arg_info_list[info_idx1].ed.section ||
14453 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14454 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
14455 #ifdef KEY
14456
14457 if (arg_info_list[info_idx1].ed.shape[dim-1].fld == CN_Tbl_Idx){
14458 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
14459 int const_idx = arg_info_list[info_idx1].ed.shape[dim-1].idx;
14460 if (CN_CONST (const_idx) > 0)
14461 OPND_IDX((*result_opnd)) = const_idx;
14462 else
14463 OPND_IDX((*result_opnd)) = CN_INTEGER_ZERO_IDX;
14464 }
14465 else{
14466 #endif
14467 NTR_IR_LIST_TBL(idx1);
14468 COPY_OPND(IL_OPND(idx1),
14469 arg_info_list[info_idx1].ed.shape[dim-1]);
14470
14471 NTR_IR_LIST_TBL(idx2);
14472 IL_NEXT_LIST_IDX(idx1) = idx2;
14473 IL_IDX(idx2) = CN_INTEGER_ZERO_IDX;
14474 IL_FLD(idx2) = CN_Tbl_Idx;
14475 IL_LINE_NUM(idx2) = IR_LINE_NUM(ir_idx);
14476 IL_COL_NUM(idx2) = IR_COL_NUM(ir_idx);
14477
14478 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14479 IR_OPR(ir_idx) = Max_Opr;
14480
14481 IR_IDX_L(ir_idx) = idx1;
14482 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
14483 IR_LIST_CNT_L(ir_idx) = 2;
14484 IR_OPND_R(ir_idx) = null_opnd;
14485 #ifdef KEY
14486 }
14487 #endif
14488 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
14489 res_exp_desc->constant = TRUE;
14490 res_exp_desc->foldable = TRUE;
14491 }
14492 else if (SHAPE_WILL_FOLD_LATER((*result_opnd)) ||
14493 SHAPE_FOLDABLE((*result_opnd))) {
14494
14495 res_exp_desc->will_fold_later = TRUE;
14496 }
14497
14498
14499 SHAPE_FOLDABLE((*result_opnd)) = FALSE;
14500 SHAPE_WILL_FOLD_LATER((*result_opnd)) = FALSE;
14501 }
14502 }
14503 else {
14504
14505
14506 COPY_OPND(opnd, IL_OPND(list_idx2));
14507 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
14508 COPY_OPND(IL_OPND(list_idx2), opnd);
14509 #ifdef KEY
14510 int opt_dummy_idx = is_optional_dummy(list_idx2);
14511 if (NULL_IDX != opt_dummy_idx &&
14512 IL_FLD(list_idx2) == IR_Tbl_Idx &&
14513 IR_OPR(IL_IDX(list_idx2)) == Cvrt_Opr) {
14514
14515
14516
14517
14518
14519
14520
14521
14522
14523
14524
14525
14526
14527
14528
14529
14530
14531
14532
14533
14534
14535
14536
14537 int tmp_attr = gen_compiler_tmp(line, col, Priv, TRUE);
14538 ATD_STOR_BLK_IDX(tmp_attr) = SCP_SB_STACK_IDX(curr_scp_idx);
14539 ATD_TYPE_IDX(tmp_attr) = CG_INTEGER_DEFAULT_TYPE;
14540 AT_SEMANTICS_DONE(tmp_attr) = TRUE;
14541 int asg_idx = gen_ir(AT_Tbl_Idx, tmp_attr, Asg_Opr,
14542 CG_INTEGER_DEFAULT_TYPE, line, col,
14543 IL_FLD(list_idx2), IL_IDX(list_idx2));
14544 gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
14545 int loc_idx = gen_ir(AT_Tbl_Idx, tmp_attr, Aloc_Opr,
14546 SA_INTEGER_DEFAULT_TYPE, line, col,
14547 NO_Tbl_Idx, NULL_IDX);
14548 int zero_constant_idx =
14549 (SA_INTEGER_DEFAULT_TYPE == CG_INTEGER_DEFAULT_TYPE) ?
14550 CN_INTEGER_ZERO_IDX :
14551 C_INT_TO_CN(SA_INTEGER_DEFAULT_TYPE, 0);
14552 int select_idx = gen_select_present(line, col, opt_dummy_idx,
14553 IR_Tbl_Idx, loc_idx,
14554 CN_Tbl_Idx, zero_constant_idx,
14555 SA_INTEGER_DEFAULT_TYPE);
14556 int val_idx = gen_ir(IR_Tbl_Idx, select_idx, Percent_Val_Opr,
14557 SA_INTEGER_DEFAULT_TYPE, line, col,
14558 NO_Tbl_Idx, NULL_IDX);
14559 IL_FLD(list_idx2) = IR_Tbl_Idx;
14560 IL_IDX(list_idx2) = val_idx;
14561 }
14562 #endif
14563 }
14564 }
14565 else {
14566 if (IR_LIST_CNT_R(ir_idx) == 1) {
14567 IR_LIST_CNT_R(ir_idx) = 2;
14568 NTR_IR_LIST_TBL(new_idx);
14569 IL_INTRIN_PLACE_HOLDER(new_idx) = TRUE;
14570 IL_ARG_DESC_VARIANT(new_idx) = TRUE;
14571 IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)) = new_idx;
14572 }
14573
14574
14575 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14576 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
14577 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14578 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
14579 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
14580
14581 COPY_OPND(opnd, IL_OPND(list_idx1));
14582 array_attr = find_base_attr(&opnd, &line, &col);
14583
14584 bd_idx = ATD_ARRAY_IDX(array_attr);
14585
14586 constant_result = TRUE;
14587
14588 num = 1;
14589
14590 for (i = 0; i < BD_RANK(bd_idx); i++) {
14591
14592 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx) {
14593 constant_result = FALSE;
14594 break;
14595 }
14596 else {
14597 num *= CN_INT_TO_C(arg_info_list[info_idx1].ed.shape[i].idx);
14598 }
14599 }
14600
14601 if (constant_result) {
14602 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14603 res_exp_desc->constant = TRUE;
14604 res_exp_desc->foldable = TRUE;
14605
14606 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
14607
14608 OPND_IDX((*result_opnd)) = cn_idx;
14609 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
14610 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14611 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14612 }
14613 }
14614 else if (arg_info_list[info_idx1].ed.section ||
14615 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14616 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
14617
14618 constant_result = TRUE;
14619 result_will_fold = TRUE;
14620 num = 1;
14621 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
14622
14623 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx) {
14624 constant_result = FALSE;
14625
14626 if (! SHAPE_FOLDABLE(arg_info_list[info_idx1].ed.shape[i]) &&
14627 ! SHAPE_WILL_FOLD_LATER(arg_info_list[info_idx1].ed.shape[i])) {
14628
14629 result_will_fold = FALSE;
14630 }
14631 }
14632 else {
14633 num *= CN_INT_TO_C(arg_info_list[info_idx1].ed.shape[i].idx);
14634 }
14635 }
14636
14637 if (constant_result) {
14638 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14639 res_exp_desc->constant = TRUE;
14640 res_exp_desc->foldable = TRUE;
14641
14642 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
14643
14644 OPND_IDX((*result_opnd)) = cn_idx;
14645 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
14646 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14647 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14648 }
14649 else if (result_will_fold) {
14650 res_exp_desc->will_fold_later = TRUE;
14651 }
14652 }
14653 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
14654 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
14655 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14656 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
14657
14658
14659 PRINTMSG(arg_info_list[info_idx1].line, 889, Error,
14660 arg_info_list[info_idx1].col);
14661 }
14662 }
14663
14664
14665 EXIT:
14666
14667 if (OPND_FLD((*result_opnd)) != IR_Tbl_Idx ||
14668 IR_OPR(OPND_IDX((*result_opnd))) != Call_Opr) {
14669
14670 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14671 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14672 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
14673 }
14674
14675 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
14676 IR_RANK(ir_idx) = res_exp_desc->rank;
14677
14678 TRACE (Func_Exit, "size_intrinsic", NULL);
14679
14680 }
14681
14682
14683
14684
14685
14686
14687
14688
14689
14690
14691
14692
14693
14694
14695
14696
14697
14698
14699 void shape_intrinsic(opnd_type *result_opnd,
14700 expr_arg_type *res_exp_desc,
14701 int *spec_idx)
14702 {
14703 int asg_idx;
14704 int subscript_idx;
14705 int triplet_idx;
14706 long64 bit_length;
14707 int constant_type_idx;
14708 # ifdef _WHIRL_HOST64_TARGET64
14709 int const_array[MAX_NUM_DIMS];
14710 # else
14711 long_type const_array[MAX_NUM_DIMS];
14712 # endif
14713 long64 host_array[MAX_NUM_DIMS];
14714 int ir_idx;
14715 int cn_idx;
14716 int info_idx1;
14717 int i;
14718 boolean ok;
14719 int list_idx1;
14720 int list_idx;
14721 int the_cn_idx;
14722 int tmp_idx;
14723 expr_arg_type loc_exp_desc;
14724
14725
14726 TRACE (Func_Entry, "shape_intrinsic", NULL);
14727
14728 for (i = 0; i < MAX_NUM_DIMS; i++) {
14729 host_array[i] = 0;
14730 }
14731
14732 ir_idx = OPND_IDX((*result_opnd));
14733 list_idx1 = IR_IDX_R(ir_idx);
14734 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
14735
14736 conform_check(0,
14737 ir_idx,
14738 res_exp_desc,
14739 spec_idx,
14740 FALSE);
14741
14742 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14743 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
14744 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
14745
14746 res_exp_desc->rank = 1;
14747 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
14748 IR_RANK(ir_idx) = res_exp_desc->rank;
14749
14750 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
14751
14752 res_exp_desc->shape[0].fld = CN_Tbl_Idx;
14753 res_exp_desc->shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
14754 arg_info_list[info_idx1].ed.rank);
14755
14756 SHAPE_WILL_FOLD_LATER(res_exp_desc->shape[0]) = TRUE;
14757 SHAPE_FOLDABLE(res_exp_desc->shape[0]) = TRUE;
14758
14759 res_exp_desc->foldable = TRUE;
14760 res_exp_desc->will_fold_later = TRUE;
14761
14762 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
14763
14764 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx) {
14765 res_exp_desc->foldable = FALSE;
14766 }
14767 else {
14768 host_array[i] = CN_CONST(arg_info_list[info_idx1].ed.shape[i].idx);
14769 }
14770
14771 if (! SHAPE_FOLDABLE(arg_info_list[info_idx1].ed.shape[i]) &&
14772 ! SHAPE_WILL_FOLD_LATER(arg_info_list[info_idx1].ed.shape[i])) {
14773 res_exp_desc->will_fold_later = FALSE;
14774 }
14775 }
14776
14777 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14778
14779 if (res_exp_desc->foldable) {
14780 bit_length = TARGET_BITS_PER_WORD* (long)arg_info_list[info_idx1].ed.rank;
14781 # ifdef _WHIRL_HOST64_TARGET64
14782 bit_length >>= 1;
14783 # endif
14784
14785 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
14786 TYP_TYPE(TYP_WORK_IDX) = Typeless;
14787 TYP_BIT_LEN(TYP_WORK_IDX) = bit_length;
14788 constant_type_idx = ntr_type_tbl();
14789
14790 for (i = 0; i < MAX_NUM_DIMS; i++) {
14791
14792 # if defined(_TARGET32)
14793
14794
14795
14796
14797 if (INTEGER_DEFAULT_TYPE == Integer_8) {
14798
14799
14800 }
14801 # endif
14802
14803
14804
14805 const_array[i] = (long_type) host_array[i];
14806 }
14807
14808 the_cn_idx = ntr_const_tbl(constant_type_idx,
14809 FALSE,
14810 const_array);
14811
14812 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
14813 IR_COL_NUM(ir_idx),
14814 Shared, TRUE);
14815
14816 ATD_TYPE_IDX(tmp_idx) = CG_INTEGER_DEFAULT_TYPE;
14817 AT_SEMANTICS_DONE(tmp_idx)= TRUE;
14818
14819 loc_exp_desc = *res_exp_desc;
14820 loc_exp_desc.type_idx = CG_INTEGER_DEFAULT_TYPE;
14821 loc_exp_desc.type = Integer;
14822 loc_exp_desc.linear_type = CG_INTEGER_DEFAULT_TYPE;
14823
14824 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(&loc_exp_desc,
14825 IR_LINE_NUM(ir_idx),
14826 IR_COL_NUM(ir_idx));
14827
14828 ATD_SAVED(tmp_idx) = TRUE;
14829 ATD_DATA_INIT(tmp_idx) = TRUE;
14830 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STATIC_INIT_IDX(curr_scp_idx);
14831 ATD_FLD(tmp_idx) = CN_Tbl_Idx;
14832 ATD_TMP_IDX(tmp_idx) = the_cn_idx;
14833 ATD_TMP_INIT_NOT_DONE(tmp_idx) = TRUE;
14834
14835 OPND_IDX((*result_opnd)) = tmp_idx;
14836 OPND_FLD((*result_opnd)) = AT_Tbl_Idx;
14837 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14838 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14839
14840 ok = gen_whole_subscript(result_opnd, res_exp_desc);
14841
14842 if (CG_INTEGER_DEFAULT_TYPE != INTEGER_DEFAULT_TYPE) {
14843 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14844
14845 ok = fold_aggragate_expression(result_opnd,
14846 res_exp_desc,
14847 FALSE);
14848 }
14849
14850
14851 AT_REFERENCED(tmp_idx) = Referenced;
14852 AT_DEFINED(tmp_idx) = TRUE;
14853
14854 res_exp_desc->foldable = TRUE;
14855 res_exp_desc->tmp_reference = TRUE;
14856 }
14857 else {
14858 io_item_must_flatten = TRUE;
14859 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
14860 IR_COL_NUM(ir_idx),
14861 Priv, TRUE);
14862
14863 ATD_TYPE_IDX(tmp_idx) = INTEGER_DEFAULT_TYPE;
14864 AT_SEMANTICS_DONE(tmp_idx) = TRUE;
14865
14866 loc_exp_desc = *res_exp_desc;
14867 loc_exp_desc.type_idx = INTEGER_DEFAULT_TYPE;
14868 loc_exp_desc.type = Integer;
14869 loc_exp_desc.linear_type = TYP_LINEAR(INTEGER_DEFAULT_TYPE);
14870
14871 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(&loc_exp_desc,
14872 IR_LINE_NUM(ir_idx),
14873 IR_COL_NUM(ir_idx));
14874
14875 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
14876
14877 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
14878
14879 NTR_IR_TBL(subscript_idx);
14880 IR_TYPE_IDX(subscript_idx) = INTEGER_DEFAULT_TYPE;
14881 IR_OPR(subscript_idx) = Subscript_Opr;
14882 IR_LINE_NUM(subscript_idx) = IR_LINE_NUM(ir_idx);
14883 IR_COL_NUM(subscript_idx) = IR_COL_NUM(ir_idx);
14884
14885 asg_idx = gen_ir(IR_Tbl_Idx, subscript_idx,
14886 Asg_Opr,
14887 INTEGER_DEFAULT_TYPE,
14888 IR_LINE_NUM(ir_idx),
14889 IR_COL_NUM(ir_idx),
14890 OPND_FLD(arg_info_list[info_idx1].ed.shape[i]),
14891 OPND_IDX(arg_info_list[info_idx1].ed.shape[i]));
14892
14893 IR_FLD_L(subscript_idx) = AT_Tbl_Idx;
14894 IR_IDX_L(subscript_idx) = tmp_idx;
14895 IR_LINE_NUM_L(subscript_idx) = IR_LINE_NUM(ir_idx);
14896 IR_COL_NUM_L(subscript_idx) = IR_COL_NUM(ir_idx);
14897
14898 NTR_IR_LIST_TBL(list_idx);
14899 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i+1);
14900
14901 IL_FLD(list_idx) = CN_Tbl_Idx;
14902 IL_IDX(list_idx) = cn_idx;
14903 IL_LINE_NUM(list_idx) = IR_LINE_NUM(ir_idx);
14904 IL_COL_NUM(list_idx) = IR_COL_NUM(ir_idx);
14905
14906 IR_LIST_CNT_R(subscript_idx) = 1;
14907 IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
14908 IR_IDX_R(subscript_idx) = list_idx;
14909
14910 gen_sh(Before,
14911 Assignment_Stmt,
14912 IR_LINE_NUM(ir_idx),
14913 IR_COL_NUM(ir_idx),
14914 FALSE,
14915 FALSE,
14916 TRUE);
14917
14918 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
14919 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
14920 }
14921
14922 IR_OPR(ir_idx) = Whole_Subscript_Opr;
14923 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
14924 IR_IDX_L(ir_idx) = tmp_idx;
14925 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
14926 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
14927
14928 NTR_IR_LIST_TBL(list_idx);
14929 IR_FLD_R(ir_idx) = IL_Tbl_Idx;
14930 IR_IDX_R(ir_idx) = list_idx;
14931 IR_LIST_CNT_R(ir_idx) = 1;
14932
14933 NTR_IR_TBL(triplet_idx);
14934 IR_TYPE_IDX(triplet_idx) = CG_INTEGER_DEFAULT_TYPE;
14935 IR_OPR(triplet_idx) = Triplet_Opr;
14936 IR_LINE_NUM(triplet_idx) = IR_LINE_NUM(ir_idx);
14937 IR_COL_NUM(triplet_idx) = IR_COL_NUM(ir_idx);
14938
14939 IL_FLD(list_idx) = IR_Tbl_Idx;
14940 IL_IDX(list_idx) = triplet_idx;
14941
14942 NTR_IR_LIST_TBL(list_idx);
14943 IR_FLD_L(triplet_idx) = IL_Tbl_Idx;
14944 IR_IDX_L(triplet_idx) = list_idx;
14945 IR_LIST_CNT_L(triplet_idx) = 3;
14946
14947 cn_idx = CN_INTEGER_ONE_IDX;
14948
14949 IL_FLD(list_idx) = CN_Tbl_Idx;
14950 IL_IDX(list_idx) = cn_idx;
14951 IL_LINE_NUM(list_idx) = IR_LINE_NUM(ir_idx);
14952 IL_COL_NUM(list_idx) = IR_COL_NUM(ir_idx);
14953
14954 NTR_IR_LIST_TBL(tmp_idx);
14955 IL_NEXT_LIST_IDX(list_idx) = tmp_idx;
14956
14957 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
14958
14959 IL_FLD(tmp_idx) = CN_Tbl_Idx;
14960 IL_IDX(tmp_idx) = cn_idx;
14961 IL_LINE_NUM(tmp_idx) = IR_LINE_NUM(ir_idx);
14962 IL_COL_NUM(tmp_idx) = IR_COL_NUM(ir_idx);
14963
14964 NTR_IR_LIST_TBL(list_idx);
14965 IL_NEXT_LIST_IDX(tmp_idx) = list_idx;
14966
14967 cn_idx = CN_INTEGER_ONE_IDX;
14968
14969 IL_FLD(list_idx) = CN_Tbl_Idx;
14970 IL_IDX(list_idx) = cn_idx;
14971 IL_LINE_NUM(list_idx) = IR_LINE_NUM(ir_idx);
14972 IL_COL_NUM(list_idx) = IR_COL_NUM(ir_idx);
14973
14974
14975
14976
14977
14978 res_exp_desc->foldable = FALSE;
14979 res_exp_desc->will_fold_later = FALSE;
14980 }
14981
14982 if (OPND_FLD((*result_opnd)) != IR_Tbl_Idx ||
14983 IR_OPR(OPND_IDX((*result_opnd))) != Call_Opr) {
14984
14985 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14986 }
14987
14988 TRACE (Func_Exit, "shape_intrinsic", NULL);
14989
14990 }
14991
14992
14993
14994
14995
14996
14997
14998
14999
15000
15001
15002
15003
15004
15005
15006
15007
15008
15009 void present_intrinsic(opnd_type *result_opnd,
15010 expr_arg_type *res_exp_desc,
15011 int *spec_idx)
15012 {
15013 int attr_idx;
15014 int info_idx1;
15015 int ir_idx;
15016 int list_idx;
15017 opnd_type opnd;
15018
15019
15020 TRACE (Func_Entry, "present_intrinsic", NULL);
15021
15022 has_present_opr = TRUE;
15023
15024 ir_idx = OPND_IDX((*result_opnd));
15025 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
15026 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
15027
15028 conform_check(0,
15029 ir_idx,
15030 res_exp_desc,
15031 spec_idx,
15032 TRUE);
15033
15034 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15035 res_exp_desc->type = Logical;
15036 res_exp_desc->linear_type =
15037 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
15038 res_exp_desc->rank = 0;
15039 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15040 IR_RANK(ir_idx) = res_exp_desc->rank;
15041 list_idx = IR_IDX_R(ir_idx);
15042
15043
15044
15045
15046 COPY_OPND(opnd, IL_OPND(list_idx));
15047
15048 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
15049
15050 attr_idx = IL_IDX(list_idx);
15051
15052 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
15053 ATD_CLASS(attr_idx) == Compiler_Tmp &&
15054 ATD_COPY_ASSUMED_SHAPE(attr_idx) &&
15055 ATD_TMP_IDX(attr_idx) != NULL_IDX) {
15056
15057 attr_idx = ATD_TMP_IDX(attr_idx);
15058 }
15059
15060 if ((!AT_IS_DARG(attr_idx)) || (!AT_OPTIONAL(attr_idx))) {
15061 PRINTMSG(arg_info_list[info_idx1].line, 777, Error,
15062 arg_info_list[info_idx1].col);
15063 }
15064 }
15065 else {
15066
15067 if (OPND_FLD(opnd) == IR_Tbl_Idx) {
15068
15069 while (OPND_FLD(opnd) == IR_Tbl_Idx &&
15070 (IR_OPR(OPND_IDX(opnd)) == Whole_Substring_Opr ||
15071 IR_OPR(OPND_IDX(opnd)) == Whole_Subscript_Opr ||
15072 IR_OPR(OPND_IDX(opnd)) == Dv_Deref_Opr)) {
15073
15074 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
15075 }
15076
15077 if (OPND_FLD(opnd) != AT_Tbl_Idx) {
15078 PRINTMSG(arg_info_list[info_idx1].line, 1080, Error,
15079 arg_info_list[info_idx1].col);
15080 }
15081 }
15082
15083 while (OPND_FLD(opnd) == IR_Tbl_Idx) {
15084 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
15085 }
15086
15087 attr_idx = OPND_IDX(opnd);
15088
15089 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
15090 ATD_CLASS(attr_idx) == Compiler_Tmp &&
15091 ATD_COPY_ASSUMED_SHAPE(attr_idx) &&
15092 ATD_TMP_IDX(attr_idx) != NULL_IDX) {
15093
15094 attr_idx = ATD_TMP_IDX(attr_idx);
15095 OPND_IDX(opnd) = attr_idx;
15096 }
15097
15098 if ((OPND_FLD(opnd) != AT_Tbl_Idx) ||
15099 (!AT_IS_DARG(OPND_IDX(opnd))) ||
15100 (!AT_OPTIONAL(OPND_IDX(opnd)))) {
15101 PRINTMSG(arg_info_list[info_idx1].line, 777, Error,
15102 arg_info_list[info_idx1].col);
15103 }
15104 }
15105
15106 IR_OPR(ir_idx) = Present_Opr;
15107 IR_TYPE_IDX(ir_idx) = LOGICAL_DEFAULT_TYPE;
15108
15109 IR_IDX_L(ir_idx) = attr_idx;
15110 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
15111 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
15112 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
15113 IR_OPND_R(ir_idx) = null_opnd;
15114
15115
15116
15117
15118 res_exp_desc->foldable = FALSE;
15119 res_exp_desc->will_fold_later = FALSE;
15120
15121 TRACE (Func_Exit, "present_intrinsic", NULL);
15122
15123 }
15124
15125
15126
15127
15128
15129
15130
15131
15132
15133
15134
15135
15136
15137
15138
15139
15140
15141
15142 void logical_intrinsic(opnd_type *result_opnd,
15143 expr_arg_type *res_exp_desc,
15144 int *spec_idx)
15145 {
15146 int info_idx2;
15147 int ir_idx;
15148 int list_idx1;
15149 int list_idx2;
15150
15151
15152 TRACE (Func_Entry, "logical_intrinsic", NULL);
15153
15154 ir_idx = OPND_IDX((*result_opnd));
15155 list_idx1 = IR_IDX_R(ir_idx);
15156 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
15157
15158 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
15159 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
15160 kind_to_linear_type(&((IL_OPND(list_idx2))),
15161 ATP_RSLT_IDX(*spec_idx),
15162 arg_info_list[info_idx2].ed.kind0seen,
15163 arg_info_list[info_idx2].ed.kind0E0seen,
15164 arg_info_list[info_idx2].ed.kind0D0seen,
15165 ! arg_info_list[info_idx2].ed.kindnotconst);
15166 }
15167 else {
15168 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
15169 }
15170
15171 conform_check(0,
15172 ir_idx,
15173 res_exp_desc,
15174 spec_idx,
15175 FALSE);
15176
15177 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15178 IR_RANK(ir_idx) = res_exp_desc->rank;
15179 IR_OPR(ir_idx) = Logical_Opr;
15180
15181 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15182 IR_OPND_R(ir_idx) = null_opnd;
15183 IR_LIST_CNT_L(ir_idx) = 1;
15184 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
15185
15186
15187
15188
15189 res_exp_desc->foldable = FALSE;
15190 res_exp_desc->will_fold_later = FALSE;
15191
15192
15193 TRACE (Func_Exit, "logical_intrinsic", NULL);
15194
15195 }
15196
15197
15198
15199
15200
15201
15202
15203
15204
15205
15206
15207
15208
15209
15210
15211
15212
15213
15214 void len_trim_intrinsic(opnd_type *result_opnd,
15215 expr_arg_type *res_exp_desc,
15216 int *spec_idx)
15217 {
15218 int ir_idx;
15219 int list_idx1;
15220 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
15221 int type_idx;
15222 int info_idx1;
15223
15224
15225 TRACE (Func_Entry, "len_trim_intrinsic", NULL);
15226
15227 ir_idx = OPND_IDX((*result_opnd));
15228 list_idx1 = IR_IDX_R(ir_idx);
15229 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
15230 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
15231 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15232
15233 conform_check(0,
15234 ir_idx,
15235 res_exp_desc,
15236 spec_idx,
15237 FALSE);
15238
15239 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15240 IR_RANK(ir_idx) = res_exp_desc->rank;
15241 res_exp_desc->type_idx = type_idx;
15242 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
15243
15244 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
15245 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
15246 arg_info_list[info_idx1].ed.type_idx,
15247 NULL,
15248 NULL_IDX,
15249 folded_const,
15250 &type_idx,
15251 IR_LINE_NUM(ir_idx),
15252 IR_COL_NUM(ir_idx),
15253 1,
15254 Len_Trim_Opr)) {
15255 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
15256 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
15257 FALSE,
15258 folded_const);
15259 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
15260 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
15261 res_exp_desc->constant = TRUE;
15262 res_exp_desc->foldable = TRUE;
15263 }
15264 else {
15265 IR_OPR(ir_idx) = Len_Trim_Opr;
15266 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15267 IR_OPND_R(ir_idx) = null_opnd;
15268 }
15269
15270 TRACE (Func_Exit, "len_trim_intrinsic", NULL);
15271
15272 }
15273
15274
15275
15276
15277
15278
15279
15280
15281
15282
15283
15284
15285
15286
15287
15288
15289
15290
15291 void nearest_intrinsic(opnd_type *result_opnd,
15292 expr_arg_type *res_exp_desc,
15293 int *spec_idx)
15294 {
15295 int ir_idx;
15296 int cn_idx;
15297 int list_idx1;
15298 int list_idx2;
15299 int list_idx3;
15300 int info_idx1;
15301 #ifdef KEY
15302 int num = 0;
15303 #else
15304 int num;
15305 #endif
15306
15307
15308 TRACE (Func_Entry, "nearest_intrinsic", NULL);
15309
15310 ir_idx = OPND_IDX((*result_opnd));
15311 list_idx1 = IR_IDX_R(ir_idx);
15312 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
15313 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
15314 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15315
15316 conform_check(0,
15317 ir_idx,
15318 res_exp_desc,
15319 spec_idx,
15320 FALSE);
15321
15322 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15323 IR_RANK(ir_idx) = res_exp_desc->rank;
15324 IR_OPR(ir_idx) = Nearest_Opr;
15325 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15326 IR_LIST_CNT_L(ir_idx) = 3;
15327
15328 switch (arg_info_list[info_idx1].ed.linear_type) {
15329 case Real_4:
15330 num = DIGITS_REAL4_F90;
15331 break;
15332
15333 case Real_8:
15334 num = DIGITS_REAL8_F90;
15335 break;
15336
15337 case Real_16:
15338 num = DIGITS_REAL16_F90;
15339 break;
15340 }
15341
15342 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
15343
15344 NTR_IR_LIST_TBL(list_idx3);
15345 IL_ARG_DESC_VARIANT(list_idx3) = TRUE;
15346
15347
15348 IL_NEXT_LIST_IDX(list_idx2) = list_idx3;
15349
15350 IL_IDX(list_idx3) = cn_idx;
15351 IL_FLD(list_idx3) = CN_Tbl_Idx;
15352 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
15353 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
15354
15355 IL_LINE_NUM(list_idx3) = IL_LINE_NUM(list_idx1);
15356 IL_COL_NUM(list_idx3) = IL_COL_NUM(list_idx1);
15357
15358 IR_OPND_R(ir_idx) = null_opnd;
15359
15360
15361
15362
15363
15364 res_exp_desc->foldable = FALSE;
15365 res_exp_desc->will_fold_later = FALSE;
15366
15367 TRACE (Func_Exit, "nearest_intrinsic", NULL);
15368
15369 }
15370
15371
15372
15373
15374
15375
15376
15377
15378
15379
15380
15381
15382
15383
15384
15385
15386
15387
15388 void rrspacing_intrinsic(opnd_type *result_opnd,
15389 expr_arg_type *res_exp_desc,
15390 int *spec_idx)
15391 {
15392 int ir_idx;
15393 int cn_idx;
15394 int info_idx1;
15395 int list_idx1;
15396 int list_idx2;
15397 #ifdef KEY
15398 int num = 0;
15399 #else
15400 int num;
15401 #endif
15402
15403
15404 TRACE (Func_Entry, "rrspacing_intrinsic", NULL);
15405
15406 ir_idx = OPND_IDX((*result_opnd));
15407 list_idx1 = IR_IDX_R(ir_idx);
15408 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
15409 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15410
15411 conform_check(0,
15412 ir_idx,
15413 res_exp_desc,
15414 spec_idx,
15415 FALSE);
15416
15417 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15418 IR_RANK(ir_idx) = res_exp_desc->rank;
15419 IR_OPR(ir_idx) = Rrspacing_Opr;
15420 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15421 IR_LIST_CNT_L(ir_idx) = 2;
15422
15423 switch (arg_info_list[info_idx1].ed.linear_type) {
15424 case Real_4:
15425 num = DIGITS_REAL4_F90;
15426 break;
15427
15428 case Real_8:
15429 num = DIGITS_REAL8_F90;
15430 break;
15431
15432 case Real_16:
15433 num = DIGITS_REAL16_F90;
15434 break;
15435 }
15436
15437 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
15438
15439 NTR_IR_LIST_TBL(list_idx2);
15440 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
15441
15442
15443 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
15444
15445 IL_IDX(list_idx2) = cn_idx;
15446 IL_FLD(list_idx2) = CN_Tbl_Idx;
15447
15448 IL_LINE_NUM(list_idx2) = IR_LINE_NUM(ir_idx);
15449 IL_COL_NUM(list_idx2) = IR_COL_NUM(ir_idx);
15450
15451 IR_OPND_R(ir_idx) = null_opnd;
15452
15453
15454
15455
15456 res_exp_desc->foldable = FALSE;
15457 res_exp_desc->will_fold_later = FALSE;
15458
15459 TRACE (Func_Exit, "rrspacing_intrinsic", NULL);
15460
15461 }
15462
15463
15464
15465
15466
15467
15468
15469
15470
15471
15472
15473
15474
15475
15476
15477
15478
15479
15480 void scale_intrinsic(opnd_type *result_opnd,
15481 expr_arg_type *res_exp_desc,
15482 int *spec_idx)
15483 {
15484 int ir_idx;
15485 int info_idx1;
15486
15487
15488 TRACE (Func_Entry, "scale_intrinsic", NULL);
15489
15490 ir_idx = OPND_IDX((*result_opnd));
15491 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
15492 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15493
15494 conform_check(0,
15495 ir_idx,
15496 res_exp_desc,
15497 spec_idx,
15498 FALSE);
15499
15500 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15501 IR_RANK(ir_idx) = res_exp_desc->rank;
15502
15503 IR_OPR(ir_idx) = Scale_Opr;
15504 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15505 IR_OPND_R(ir_idx) = null_opnd;
15506
15507
15508
15509
15510 res_exp_desc->foldable = FALSE;
15511 res_exp_desc->will_fold_later = FALSE;
15512
15513 TRACE (Func_Exit, "scale_intrinsic", NULL);
15514
15515 }
15516
15517
15518
15519
15520
15521
15522
15523
15524
15525
15526
15527
15528
15529
15530
15531
15532
15533
15534 void set_exponent_intrinsic(opnd_type *result_opnd,
15535 expr_arg_type *res_exp_desc,
15536 int *spec_idx)
15537 {
15538 int ir_idx;
15539 int info_idx1;
15540
15541
15542 TRACE (Func_Entry, "set_exponent_intrinsic", NULL);
15543
15544 ir_idx = OPND_IDX((*result_opnd));
15545 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
15546 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15547
15548 conform_check(0,
15549 ir_idx,
15550 res_exp_desc,
15551 spec_idx,
15552 FALSE);
15553
15554 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15555 IR_RANK(ir_idx) = res_exp_desc->rank;
15556
15557 IR_OPR(ir_idx) = Set_Exponent_Opr;
15558 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15559 IR_OPND_R(ir_idx) = null_opnd;
15560
15561
15562
15563
15564 res_exp_desc->foldable = FALSE;
15565 res_exp_desc->will_fold_later = FALSE;
15566
15567 TRACE (Func_Exit, "set_exponent_intrinsic", NULL);
15568
15569 }
15570
15571
15572
15573
15574
15575
15576
15577
15578
15579
15580
15581
15582
15583
15584
15585
15586
15587
15588
15589 void dshiftl_intrinsic(opnd_type *result_opnd,
15590 expr_arg_type *res_exp_desc,
15591 int *spec_idx)
15592 {
15593 int ir_idx;
15594 int cn_idx;
15595 int info_idx1;
15596 int info_idx2;
15597 int list_idx1;
15598 int list_idx2;
15599 int list_idx3;
15600 int minus_idx;
15601 int mask_idx;
15602 int shiftl_idx;
15603 int shiftr_idx;
15604 int first_idx;
15605 int second_idx;
15606 int band_idx;
15607 int typeless_idx;
15608 opnd_type opnd;
15609 int line;
15610 long num;
15611 int column;
15612
15613
15614 TRACE (Func_Entry, "dshiftl_intrinsic", NULL);
15615
15616 ir_idx = OPND_IDX((*result_opnd));
15617 list_idx1 = IR_IDX_R(ir_idx);
15618 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
15619 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
15620 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
15621 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
15622
15623 line = IR_LINE_NUM(ir_idx);
15624 column = IR_COL_NUM(ir_idx);
15625
15626 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15627
15628 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8) {
15629 typeless_idx = Typeless_8;
15630 }
15631 else {
15632 typeless_idx = TYPELESS_DEFAULT_TYPE;
15633 }
15634
15635 # ifdef _TARGET_OS_MAX
15636 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
15637 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
15638 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
15639 typeless_idx = Typeless_4;
15640 }
15641 # endif
15642
15643 conform_check(0,
15644 ir_idx,
15645 res_exp_desc,
15646 spec_idx,
15647 FALSE);
15648
15649 if (arg_info_list[info_idx1].ed.linear_type !=
15650 arg_info_list[info_idx2].ed.linear_type) {
15651 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
15652 arg_info_list[info_idx2].col);
15653 }
15654
15655
15656 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15657 IR_RANK(ir_idx) = res_exp_desc->rank;
15658
15659 if (ATP_INTRIN_ENUM(*spec_idx) == Dshiftl_Intrinsic) {
15660 mask_idx = gen_ir(IL_FLD(list_idx3), IL_IDX(list_idx3),
15661 Mask_Opr, typeless_idx, line, column,
15662 NO_Tbl_Idx, NULL_IDX);
15663
15664 COPY_OPND(opnd, IL_OPND(list_idx2));
15665 cast_opnd_to_type_idx(&opnd, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
15666 COPY_OPND(IL_OPND(list_idx2), opnd);
15667
15668 band_idx = gen_ir(IR_Tbl_Idx, mask_idx,
15669 Band_Opr, typeless_idx, line, column,
15670 IL_FLD(list_idx2), IL_IDX(list_idx2));
15671
15672
15673 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
15674 ATP_RSLT_IDX(*spec_idx)))];
15675
15676 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
15677
15678 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
15679 Minus_Opr,ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
15680 IL_FLD(list_idx3), IL_IDX(list_idx3));
15681
15682
15683 NTR_IR_LIST_TBL(first_idx);
15684 IL_FLD(first_idx) = IR_Tbl_Idx;
15685 IL_IDX(first_idx) = band_idx;
15686
15687
15688 NTR_IR_LIST_TBL(second_idx);
15689 IL_FLD(second_idx) = IR_Tbl_Idx;
15690 IL_IDX(second_idx) = minus_idx;
15691
15692 IL_NEXT_LIST_IDX(first_idx) = second_idx;
15693
15694
15695 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
15696 Shiftr_Opr, typeless_idx, line, column,
15697 NO_Tbl_Idx, NULL_IDX);
15698
15699 NTR_IR_LIST_TBL(first_idx);
15700 COPY_OPND(IL_OPND(first_idx), IL_OPND(list_idx1));
15701 NTR_IR_LIST_TBL(second_idx);
15702 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx3));
15703 IL_NEXT_LIST_IDX(first_idx) = second_idx;
15704
15705
15706 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
15707 Shiftl_Opr, typeless_idx, line, column,
15708 NO_Tbl_Idx, NULL_IDX);
15709
15710 IR_OPR(ir_idx) = Bor_Opr;
15711 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
15712 IR_IDX_L(ir_idx) = shiftr_idx;
15713 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
15714 IR_IDX_R(ir_idx) = shiftl_idx;
15715 }
15716 else {
15717
15718 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
15719 ATP_RSLT_IDX(*spec_idx)))]*2;
15720
15721 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
15722
15723 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
15724 Minus_Opr,ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
15725 IL_FLD(list_idx3), IL_IDX(list_idx3));
15726
15727 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
15728 Mask_Opr, typeless_idx, line, column,
15729 NO_Tbl_Idx, NULL_IDX);
15730
15731 COPY_OPND(opnd, IL_OPND(list_idx1));
15732 cast_opnd_to_type_idx(&opnd, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
15733 COPY_OPND(IL_OPND(list_idx1), opnd);
15734
15735 band_idx = gen_ir(IR_Tbl_Idx, mask_idx,
15736 Band_Opr, typeless_idx, line, column,
15737 IL_FLD(list_idx1), IL_IDX(list_idx1));
15738
15739
15740 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
15741 ATP_RSLT_IDX(*spec_idx)))];
15742
15743 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
15744
15745 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
15746 Minus_Opr,ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
15747 IL_FLD(list_idx3), IL_IDX(list_idx3));
15748
15749
15750 NTR_IR_LIST_TBL(first_idx);
15751 IL_FLD(first_idx) = IR_Tbl_Idx;
15752 IL_IDX(first_idx) = band_idx;
15753
15754 NTR_IR_LIST_TBL(second_idx);
15755 IL_FLD(second_idx) = IR_Tbl_Idx;
15756 IL_IDX(second_idx) = minus_idx;
15757
15758 IL_NEXT_LIST_IDX(first_idx) = second_idx;
15759
15760
15761 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
15762 Shiftl_Opr, typeless_idx, line, column,
15763 NO_Tbl_Idx, NULL_IDX);
15764
15765 NTR_IR_LIST_TBL(first_idx);
15766 COPY_OPND(IL_OPND(first_idx), IL_OPND(list_idx2));
15767 NTR_IR_LIST_TBL(second_idx);
15768 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx3));
15769 IL_NEXT_LIST_IDX(first_idx) = second_idx;
15770
15771
15772 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
15773 Shiftr_Opr, typeless_idx, line, column,
15774 NO_Tbl_Idx, NULL_IDX);
15775
15776 IR_OPR(ir_idx) = Bor_Opr;
15777 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
15778 IR_IDX_L(ir_idx) = shiftl_idx;
15779 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
15780 IR_IDX_R(ir_idx) = shiftr_idx;
15781 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
15782 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
15783 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
15784 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
15785 }
15786
15787
15788
15789
15790 res_exp_desc->foldable = FALSE;
15791 res_exp_desc->will_fold_later = FALSE;
15792
15793 TRACE (Func_Exit, "dshiftl_intrinsic", NULL);
15794
15795 }
15796
15797
15798
15799
15800
15801
15802
15803
15804
15805
15806
15807
15808
15809
15810
15811
15812
15813
15814
15815
15816
15817
15818
15819
15820 void minval_intrinsic(opnd_type *result_opnd,
15821 expr_arg_type *res_exp_desc,
15822 int *spec_idx)
15823 {
15824 int i;
15825 int j;
15826 int ir_idx;
15827 int attr_idx;
15828 int info_idx1;
15829 #ifdef KEY
15830 int info_idx2 = 0;
15831 #else
15832 int info_idx2;
15833 #endif
15834 int info_idx3;
15835 int list_idx1;
15836 int list_idx2;
15837 int list_idx3 = NULL_IDX;
15838 int tmp_idx;
15839 int line;
15840 int col;
15841
15842 # ifdef _TARGET_HAS_FAST_INTEGER
15843 int name_idx;
15844 char *name_ptr;
15845 token_type ext_token;
15846 # endif
15847
15848
15849 TRACE (Func_Entry, "minval_intrinsic", NULL);
15850
15851 ir_idx = OPND_IDX((*result_opnd));
15852 list_idx1 = IR_IDX_R(ir_idx);
15853 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
15854
15855 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
15856 if (list_idx2 != NULL_IDX) {
15857 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
15858 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
15859 }
15860
15861 if (list_idx3 != NULL_IDX) {
15862 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
15863 }
15864
15865 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
15866
15867 if (ATP_INTRIN_ENUM(*spec_idx) == Minloc_Intrinsic ||
15868 ATP_INTRIN_ENUM(*spec_idx) == Maxloc_Intrinsic) {
15869 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
15870 }
15871
15872 if (arg_info_list[info_idx1].ed.rank < 1) {
15873 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
15874 arg_info_list[info_idx1].col);
15875 }
15876
15877 # ifdef _INLINE_INTRINSICS
15878 #ifdef KEY
15879
15880
15881
15882
15883 boolean optional = is_optional_dummy(list_idx3);
15884 #endif
15885 if (list_idx2 != NULL_IDX) {
15886 if (arg_info_list[info_idx2].ed.type == Integer &&
15887 IL_FLD(list_idx2) == CN_Tbl_Idx) {
15888 #ifdef KEY
15889 ATP_EXTERNAL_INTRIN(*spec_idx) = optional;
15890 #else
15891 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
15892 #endif
15893 }
15894 else if (arg_info_list[info_idx2].ed.type == Logical) {
15895 #ifdef KEY
15896 ATP_EXTERNAL_INTRIN(*spec_idx) = optional;
15897 #else
15898 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
15899 #endif
15900 }
15901 }
15902 else {
15903 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
15904 }
15905 # endif
15906
15907 # ifdef _TARGET_HAS_FAST_INTEGER
15908 if ((opt_flags.set_fastint_option &&
15909 arg_info_list[info_idx1].ed.linear_type == Integer_8 &&
15910 ATP_EXTERNAL_INTRIN(*spec_idx) &&
15911 TYP_DESC(arg_info_list[info_idx1].ed.type_idx) == Default_Typed) ||
15912 (opt_flags.set_allfastint_option &&
15913 arg_info_list[info_idx1].ed.linear_type == Integer_8 &&
15914 ATP_EXTERNAL_INTRIN(*spec_idx))) {
15915 name_ptr = &name_pool[AT_NAME_IDX(*spec_idx)].name_char;
15916
15917 j = -1;
15918 if (name_ptr[6] == 'J') {
15919 j = 6;
15920 }
15921 else if (name_ptr[7] == 'J') {
15922 j = 7;
15923 }
15924 else if (name_ptr[8] == 'J') {
15925 j = 8;
15926 }
15927 else if (name_ptr[9] == 'J') {
15928 j = 9;
15929 }
15930 else if (name_ptr[10] == 'J') {
15931 j = 10;
15932 }
15933
15934 NTR_ATTR_TBL(tmp_idx);
15935 COPY_COMMON_ATTR_INFO(*spec_idx,
15936 tmp_idx,
15937 Pgm_Unit);
15938
15939 COPY_VARIANT_ATTR_INFO(*spec_idx,
15940 tmp_idx,
15941 Pgm_Unit);
15942
15943
15944 for (i = 0; i < AT_NAME_LEN(*spec_idx); i++) {
15945 if (j == i) {
15946 TOKEN_STR(ext_token)[i] = 'I';
15947 }
15948 else {
15949 TOKEN_STR(ext_token)[i] = name_ptr[i];
15950 }
15951 }
15952
15953 TOKEN_STR(ext_token)[i] = '\0';
15954
15955 NTR_NAME_POOL(TOKEN_ID(ext_token).words,
15956 AT_NAME_LEN(*spec_idx),
15957 name_idx);
15958
15959 AT_NAME_IDX(tmp_idx) = name_idx;
15960 ATP_EXT_NAME_IDX(tmp_idx) = name_idx;
15961 *spec_idx = tmp_idx;
15962 }
15963 # endif
15964
15965 conform_check(0,
15966 ir_idx,
15967 res_exp_desc,
15968 spec_idx,
15969 FALSE);
15970
15971 if (list_idx2 == NULL_IDX) {
15972 if (ATP_INTRIN_ENUM(*spec_idx) == Minloc_Intrinsic ||
15973 ATP_INTRIN_ENUM(*spec_idx) == Maxloc_Intrinsic) {
15974 res_exp_desc->rank = 1;
15975 res_exp_desc->shape[0].fld = CN_Tbl_Idx;
15976 res_exp_desc->shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
15977 arg_info_list[info_idx1].ed.rank);
15978 }
15979 else {
15980 res_exp_desc->rank = 0;
15981 }
15982
15983 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
15984 NTR_IR_LIST_TBL(list_idx2);
15985 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
15986 IL_INTRIN_PLACE_HOLDER(list_idx2) = TRUE;
15987 NTR_IR_LIST_TBL(list_idx3);
15988 IL_ARG_DESC_VARIANT(list_idx3) = TRUE;
15989 IL_INTRIN_PLACE_HOLDER(list_idx3) = TRUE;
15990 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
15991 IL_NEXT_LIST_IDX(list_idx2) = list_idx3;
15992 IR_LIST_CNT_R(ir_idx) = 3;
15993 }
15994 }
15995 else {
15996 if (arg_info_list[info_idx2].ed.type == Logical) {
15997 if (cmd_line_flags.runtime_conformance) {
15998 gen_runtime_conformance(&IL_OPND(list_idx1),
15999 &(arg_info_list[info_idx1].ed),
16000 &IL_OPND(list_idx2),
16001 &(arg_info_list[info_idx2].ed));
16002 }
16003 #ifdef KEY
16004 if (is_optional_dummy(list_idx2)) {
16005 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
16006 }
16007 #endif
16008
16009 if (ATP_INTRIN_ENUM(*spec_idx) == Minloc_Intrinsic ||
16010 ATP_INTRIN_ENUM(*spec_idx) == Maxloc_Intrinsic) {
16011 res_exp_desc->rank = 1;
16012 res_exp_desc->shape[0].fld = CN_Tbl_Idx;
16013 res_exp_desc->shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
16014 arg_info_list[info_idx1].ed.rank);
16015 }
16016 else {
16017 res_exp_desc->rank = 0;
16018 }
16019
16020 if (arg_info_list[info_idx2].ed.rank > 0) {
16021 if (arg_info_list[info_idx1].ed.rank !=
16022 arg_info_list[info_idx2].ed.rank) {
16023 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
16024 arg_info_list[info_idx2].col);
16025 }
16026 }
16027
16028 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
16029 NTR_IR_LIST_TBL(tmp_idx);
16030 IL_ARG_DESC_VARIANT(tmp_idx) = TRUE;
16031 IL_INTRIN_PLACE_HOLDER(tmp_idx) = TRUE;
16032 IL_NEXT_LIST_IDX(list_idx1) = tmp_idx;
16033 IL_NEXT_LIST_IDX(tmp_idx) = list_idx2;
16034 IR_LIST_CNT_R(ir_idx) = 3;
16035 }
16036 }
16037 else if (arg_info_list[info_idx2].ed.type == Integer) {
16038 if (arg_info_list[info_idx2].ed.rank != 0) {
16039 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
16040 arg_info_list[info_idx2].col);
16041 }
16042
16043 if (arg_info_list[info_idx2].ed.reference) {
16044 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
16045
16046 if (AT_OPTIONAL(attr_idx)) {
16047 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
16048 arg_info_list[info_idx2].col);
16049 }
16050 }
16051
16052 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
16053 j = 1;
16054 for (i = 1; i < 8; i++) {
16055 if (i == (long) CN_INT_TO_C(IL_IDX(list_idx2))) {
16056 j = j + 1;
16057 }
16058
16059 COPY_OPND(res_exp_desc->shape[i-1],
16060 arg_info_list[info_idx1].ed.shape[j-1]);
16061 j = j + 1;
16062 }
16063
16064 if (compare_cn_and_value(IL_IDX(list_idx2),
16065 (long) arg_info_list[info_idx1].ed.rank,
16066 Gt_Opr) ||
16067 compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr)) {
16068
16069 PRINTMSG(arg_info_list[info_idx2].line, 540, Error,
16070 arg_info_list[info_idx2].col);
16071 }
16072 }
16073
16074 res_exp_desc->rank = res_exp_desc->rank - 1;
16075
16076 if (list_idx3 == NULL_IDX) {
16077 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
16078 NTR_IR_LIST_TBL(tmp_idx);
16079 IL_ARG_DESC_VARIANT(tmp_idx) = TRUE;
16080 IL_INTRIN_PLACE_HOLDER(tmp_idx) = TRUE;
16081 IL_NEXT_LIST_IDX(list_idx2) = tmp_idx;
16082 IR_LIST_CNT_R(ir_idx) = 3;
16083 }
16084 }
16085 else {
16086 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
16087 if (arg_info_list[info_idx3].ed.rank > 0) {
16088 if (arg_info_list[info_idx1].ed.rank !=
16089 arg_info_list[info_idx3].ed.rank) {
16090 PRINTMSG(arg_info_list[info_idx3].line, 654, Error,
16091 arg_info_list[info_idx3].col);
16092 }
16093 }
16094
16095 if (cmd_line_flags.runtime_conformance) {
16096 gen_runtime_conformance(&IL_OPND(list_idx1),
16097 &(arg_info_list[info_idx1].ed),
16098 &IL_OPND(list_idx3),
16099 &(arg_info_list[info_idx3].ed));
16100 }
16101 }
16102 }
16103 }
16104
16105 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
16106 io_item_must_flatten = TRUE;
16107 if (ATP_INTRIN_ENUM(*spec_idx) == Sum_Intrinsic) {
16108 IR_OPR(ir_idx) = Sum_Opr;
16109 }
16110 else if (ATP_INTRIN_ENUM(*spec_idx) == Product_Intrinsic) {
16111 IR_OPR(ir_idx) = Product_Opr;
16112 }
16113 else if (ATP_INTRIN_ENUM(*spec_idx) == Minval_Intrinsic) {
16114 IR_OPR(ir_idx) = Minval_Opr;
16115 }
16116 else if (ATP_INTRIN_ENUM(*spec_idx) == Minloc_Intrinsic) {
16117 IR_OPR(ir_idx) = Minloc_Opr;
16118 }
16119 else if (ATP_INTRIN_ENUM(*spec_idx) == Maxloc_Intrinsic) {
16120 IR_OPR(ir_idx) = Maxloc_Opr;
16121 }
16122 else {
16123 IR_OPR(ir_idx) = Maxval_Opr;
16124 }
16125
16126 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
16127 IR_IDX_R(ir_idx) = NULL_IDX;
16128 }
16129 else {
16130 if (list_idx2 == NULL_IDX) {
16131 NTR_IR_LIST_TBL(list_idx2);
16132 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
16133 IL_INTRIN_PLACE_HOLDER(list_idx2) = TRUE;
16134 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
16135 IR_LIST_CNT_R(ir_idx) = 3;
16136 }
16137
16138 if (list_idx3 == NULL_IDX) {
16139 NTR_IR_LIST_TBL(list_idx3);
16140 IL_ARG_DESC_VARIANT(list_idx3) = TRUE;
16141 IL_INTRIN_PLACE_HOLDER(list_idx3) = TRUE;
16142 IL_NEXT_LIST_IDX(list_idx2) = list_idx3;
16143 IR_LIST_CNT_R(ir_idx) = 3;
16144 }
16145 }
16146
16147 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16148 IR_RANK(ir_idx) = res_exp_desc->rank;
16149
16150
16151
16152
16153 res_exp_desc->foldable = FALSE;
16154 res_exp_desc->will_fold_later = FALSE;
16155
16156 TRACE (Func_Exit, "minval_intrinsic", NULL);
16157
16158 }
16159
16160
16161
16162
16163
16164
16165
16166
16167
16168
16169
16170
16171
16172
16173
16174
16175
16176
16177
16178
16179
16180
16181
16182
16183
16184
16185
16186
16187
16188
16189 void dsm_numthreads_intrinsic(opnd_type *result_opnd,
16190 expr_arg_type *res_exp_desc,
16191 int *spec_idx)
16192
16193 {
16194 int cn_idx;
16195 int ir_idx;
16196 int list_idx;
16197 int info_idx;
16198 int info_idx1;
16199 int list_idx1;
16200 int list_idx2;
16201 int minus_idx;
16202 opnd_type new_opnd;
16203
16204
16205 TRACE (Func_Entry, "dsm_numthreads_intrinsic", NULL);
16206
16207 ir_idx = OPND_IDX((*result_opnd));
16208 list_idx1 = IR_IDX_R(ir_idx);
16209 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
16210 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
16211
16212 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
16213
16214 conform_check(0,
16215 ir_idx,
16216 res_exp_desc,
16217 spec_idx,
16218 FALSE);
16219
16220 if (list_idx2 != NULL_IDX) {
16221 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
16222 arg_info_list[info_idx1].ed.rank);
16223 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
16224 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
16225 IR_COL_NUM(ir_idx),
16226 IL_FLD(list_idx2), IL_IDX(list_idx2));
16227
16228 IL_IDX(list_idx2) = minus_idx;
16229 IL_FLD(list_idx2) = IR_Tbl_Idx;
16230 }
16231
16232 list_idx = IR_IDX_R(ir_idx);
16233 list_idx = IL_NEXT_LIST_IDX(list_idx);
16234 while (list_idx != NULL_IDX) {
16235 info_idx = IL_ARG_DESC_IDX(list_idx);
16236 COPY_OPND(new_opnd, IL_OPND(list_idx));
16237 cast_to_type_idx(&new_opnd, &arg_info_list[info_idx].ed, Integer_8);
16238 COPY_OPND(IL_OPND(list_idx), new_opnd);
16239 list_idx = IL_NEXT_LIST_IDX(list_idx);
16240 }
16241
16242 list_idx = IR_IDX_R(ir_idx);
16243 list_idx = IL_NEXT_LIST_IDX(list_idx);
16244 while (list_idx != NULL_IDX) {
16245 info_idx = IL_ARG_DESC_IDX(list_idx);
16246 arg_info_list[info_idx].ed.percent_val_arg = TRUE;
16247 list_idx = IL_NEXT_LIST_IDX(list_idx);
16248 }
16249
16250 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16251 IR_RANK(ir_idx) = res_exp_desc->rank;
16252 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16253 res_exp_desc->linear_type =
16254 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
16255
16256
16257
16258
16259 res_exp_desc->foldable = FALSE;
16260 res_exp_desc->will_fold_later = FALSE;
16261
16262 TRACE (Func_Exit, "dsm_numthreads_intrinsic", NULL);
16263
16264 }
16265
16266
16267
16268
16269
16270
16271
16272
16273
16274
16275
16276
16277
16278
16279
16280
16281
16282
16283
16284
16285
16286
16287
16288
16289 void omp_get_max_threads_intrinsic(opnd_type *result_opnd,
16290 expr_arg_type *res_exp_desc,
16291 int *spec_idx)
16292
16293 {
16294 int ir_idx;
16295 int type_idx;
16296
16297
16298 TRACE (Func_Entry, "omp_get_max_threads", NULL);
16299
16300 ir_idx = OPND_IDX((*result_opnd));
16301 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
16302
16303 if (ATP_INTRIN_ENUM(*spec_idx) == Omp_Get_Max_Threads_Intrinsic ||
16304 ATP_INTRIN_ENUM(*spec_idx) == Omp_Get_Num_Procs_Intrinsic ||
16305 ATP_INTRIN_ENUM(*spec_idx) == Omp_Get_Num_Threads_Intrinsic ||
16306 ATP_INTRIN_ENUM(*spec_idx) == Omp_Get_Thread_Num_Intrinsic) {
16307 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
16308 }
16309 #ifdef KEY
16310 else if (ATP_INTRIN_ENUM(*spec_idx) == Omp_Get_Wtime_Intrinsic ||
16311 ATP_INTRIN_ENUM(*spec_idx) == Omp_Get_Wtick_Intrinsic)
16312 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = DOUBLE_DEFAULT_TYPE;
16313 #endif
16314 #ifdef KEY
16315 else if (ATP_INTRIN_ENUM(*spec_idx) == Omp_Test_Nest_Lock_Intrinsic)
16316 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
16317 #endif
16318
16319 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16320
16321 conform_check(0,
16322 ir_idx,
16323 res_exp_desc,
16324 spec_idx,
16325 FALSE);
16326
16327 IR_TYPE_IDX(ir_idx) = type_idx;
16328 IR_RANK(ir_idx) = res_exp_desc->rank;
16329 res_exp_desc->type_idx = type_idx;
16330 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
16331
16332
16333
16334
16335 res_exp_desc->foldable = FALSE;
16336 res_exp_desc->will_fold_later = FALSE;
16337
16338 TRACE (Func_Exit, "omp_get_max_threads", NULL);
16339
16340 }
16341
16342
16343
16344
16345
16346
16347
16348
16349
16350
16351
16352
16353
16354
16355
16356
16357
16358
16359
16360
16361
16362 void omp_set_lock_intrinsic(opnd_type *result_opnd,
16363 expr_arg_type *res_exp_desc,
16364 int *spec_idx)
16365
16366 {
16367 int ir_idx;
16368 int type_idx;
16369 int info_idx1;
16370 int list_idx1;
16371
16372
16373 TRACE (Func_Entry, "omp_set_lock_intrinsic", NULL);
16374
16375 ir_idx = OPND_IDX((*result_opnd));
16376
16377 list_idx1 = IR_IDX_R(ir_idx);
16378 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
16379
16380 conform_check(0,
16381 ir_idx,
16382 res_exp_desc,
16383 spec_idx,
16384 FALSE);
16385
16386 if (cmd_line_flags.s_pointer8 &&
16387 arg_info_list[info_idx1].ed.linear_type == Integer_4) {
16388 PRINTMSG(arg_info_list[info_idx1].line,
16389 1664,
16390 Error,
16391 arg_info_list[info_idx1].col);
16392 }
16393
16394 if (ATP_INTRIN_ENUM(*spec_idx) == Omp_Test_Lock_Intrinsic) {
16395 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
16396 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16397 IR_TYPE_IDX(ir_idx) = type_idx;
16398 IR_RANK(ir_idx) = res_exp_desc->rank;
16399 res_exp_desc->type_idx = type_idx;
16400 res_exp_desc->type = TYP_TYPE(type_idx);
16401 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
16402 }
16403
16404 io_item_must_flatten = TRUE;
16405
16406 if (ATP_INTRIN_ENUM(*spec_idx) == Omp_Set_Lock_Intrinsic) {
16407 IR_OPR(ir_idx) = Omp_Set_Lock_Opr;
16408 }
16409 else if (ATP_INTRIN_ENUM(*spec_idx) == Omp_Unset_Lock_Intrinsic) {
16410 IR_OPR(ir_idx) = Omp_Unset_Lock_Opr;
16411 }
16412 else {
16413 IR_OPR(ir_idx) = Omp_Test_Lock_Opr;
16414 }
16415 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
16416 IR_OPND_R(ir_idx) = null_opnd;
16417
16418
16419
16420
16421 res_exp_desc->foldable = FALSE;
16422 res_exp_desc->will_fold_later = FALSE;
16423
16424 TRACE (Func_Exit, "omp_set_lock_intrinsic", NULL);
16425
16426 }
16427
16428
16429
16430
16431
16432
16433
16434
16435
16436
16437
16438
16439
16440
16441
16442
16443
16444
16445
16446
16447
16448
16449 void clock_intrinsic(opnd_type *result_opnd,
16450 expr_arg_type *res_exp_desc,
16451 int *spec_idx)
16452
16453 {
16454 int type_idx;
16455 int info_idx1;
16456 int ir_idx;
16457 int list_idx1;
16458
16459
16460 TRACE (Func_Entry, "clock_intrinsic", NULL);
16461
16462
16463 # if defined(_TARGET_OS_SOLARIS) || (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
16464 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
16465 TYP_TYPE(TYP_WORK_IDX) = Character;
16466 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE;
16467 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char;
16468 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx;
16469 # ifdef KEY
16470 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 24);
16471 # else
16472 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 8);
16473 # endif
16474 type_idx = ntr_type_tbl();
16475
16476 res_exp_desc->type_idx = type_idx;
16477 res_exp_desc->char_len.fld = TYP_FLD(type_idx);
16478 res_exp_desc->char_len.idx = TYP_IDX(type_idx);
16479 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
16480 # endif
16481
16482 # ifdef _TARGET_OS_MAX
16483 ir_idx = OPND_IDX((*result_opnd));
16484 list_idx1 = IR_IDX_R(ir_idx);
16485
16486 if (list_idx1 != NULL_IDX) {
16487 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
16488 if ((arg_info_list[info_idx1].ed.linear_type == Integer_1) ||
16489 (arg_info_list[info_idx1].ed.linear_type == Integer_2) ||
16490 (arg_info_list[info_idx1].ed.linear_type == Integer_4)) {
16491 PRINTMSG(arg_info_list[info_idx1].line, 1054, Error,
16492 arg_info_list[info_idx1].col);
16493 }
16494 }
16495 # endif
16496
16497
16498
16499
16500
16501 res_exp_desc->foldable = FALSE;
16502 res_exp_desc->will_fold_later = FALSE;
16503
16504 TRACE (Func_Exit, "clock_intrinsic", NULL);
16505
16506 }
16507
16508
16509
16510
16511
16512
16513
16514
16515
16516
16517
16518
16519
16520
16521
16522
16523
16524
16525 void pack_intrinsic(opnd_type *result_opnd,
16526 expr_arg_type *res_exp_desc,
16527 int *spec_idx)
16528 {
16529 int list_idx1;
16530 int list_idx2;
16531 int list_idx3;
16532 int info_idx1;
16533 int info_idx2;
16534 int info_idx3;
16535 int ir_idx;
16536 int i;
16537
16538
16539 TRACE (Func_Entry, "pack_intrinsic", NULL);
16540
16541 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
16542
16543 ir_idx = OPND_IDX((*result_opnd));
16544 list_idx1 = IR_IDX_R(ir_idx);
16545 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
16546 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
16547 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
16548 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
16549 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
16550
16551 io_item_must_flatten = TRUE;
16552
16553 if (arg_info_list[info_idx1].ed.rank < 1) {
16554 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
16555 arg_info_list[info_idx1].col);
16556 }
16557
16558 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
16559 if (OPND_FLD(arg_info_list[info_idx1].ed.shape[i]) == CN_Tbl_Idx &&
16560 OPND_FLD(arg_info_list[info_idx2].ed.shape[i]) == CN_Tbl_Idx) {
16561 if (CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx1].ed.shape[i])) !=
16562 CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx2].ed.shape[i]))) {
16563 PRINTMSG(arg_info_list[info_idx2].line, 1155, Error,
16564 arg_info_list[info_idx2].col);
16565 }
16566 }
16567 }
16568
16569 if (list_idx3 != NULL_IDX && IL_IDX(list_idx3) != NULL_IDX) {
16570 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
16571 COPY_OPND(res_exp_desc->shape[0],arg_info_list[info_idx3].ed.shape[0]);
16572 COPY_OPND(res_exp_desc->char_len,arg_info_list[info_idx3].ed.char_len);
16573
16574 # ifdef _INLINE_INTRINSICS
16575 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
16576 # endif
16577
16578 if ((TYP_CHAR_CLASS(arg_info_list[info_idx1].ed.type_idx) ==
16579 Const_Len_Char) &&
16580 (TYP_CHAR_CLASS(arg_info_list[info_idx3].ed.type_idx) ==
16581 Const_Len_Char)) {
16582 if (CN_INT_TO_C(TYP_IDX(arg_info_list[info_idx1].ed.type_idx)) !=
16583 CN_INT_TO_C(TYP_IDX(arg_info_list[info_idx3].ed.type_idx))) {
16584 PRINTMSG(arg_info_list[info_idx3].line, 1153, Error,
16585 arg_info_list[info_idx3].col);
16586 }
16587 }
16588
16589 if ((arg_info_list[info_idx1].ed.linear_type !=
16590 arg_info_list[info_idx3].ed.linear_type) ||
16591 (arg_info_list[info_idx3].ed.rank != 1)) {
16592 PRINTMSG(arg_info_list[info_idx3].line, 1153, Error,
16593 arg_info_list[info_idx3].col);
16594 }
16595
16596 if (cmd_line_flags.runtime_conformance) {
16597 gen_runtime_conformance(&IL_OPND(list_idx1),
16598 &(arg_info_list[info_idx1].ed),
16599 &IL_OPND(list_idx3),
16600 &(arg_info_list[info_idx3].ed));
16601 }
16602 #ifdef KEY
16603 if (NULL_IDX != is_optional_dummy(list_idx3)) {
16604 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
16605 }
16606 #endif
16607 }
16608
16609 conform_check(0,
16610 ir_idx,
16611 res_exp_desc,
16612 spec_idx,
16613 FALSE);
16614
16615 if (cmd_line_flags.runtime_conformance) {
16616 gen_runtime_conformance(&IL_OPND(list_idx1),
16617 &(arg_info_list[info_idx1].ed),
16618 &IL_OPND(list_idx2),
16619 &(arg_info_list[info_idx2].ed));
16620 }
16621
16622 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
16623 IR_OPR(ir_idx) = Pack_Opr;
16624 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
16625 IR_OPND_R(ir_idx) = null_opnd;
16626 }
16627
16628 res_exp_desc->rank = 1;
16629 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16630 IR_RANK(ir_idx) = res_exp_desc->rank;
16631
16632 #ifdef KEY
16633
16634
16635 if (Character == res_exp_desc->type) {
16636 res_exp_desc->char_len = arg_info_list[info_idx1].ed.char_len;
16637 }
16638 #endif
16639
16640
16641
16642
16643 res_exp_desc->foldable = FALSE;
16644 res_exp_desc->will_fold_later = FALSE;
16645
16646 TRACE (Func_Exit, "pack_intrinsic", NULL);
16647
16648 }
16649
16650
16651
16652
16653
16654
16655
16656
16657
16658
16659
16660
16661
16662
16663
16664
16665
16666
16667 void unpack_intrinsic(opnd_type *result_opnd,
16668 expr_arg_type *res_exp_desc,
16669 int *spec_idx)
16670 {
16671 int info_idx1;
16672 int info_idx2;
16673 int info_idx3;
16674 int list_idx1;
16675 int list_idx2;
16676 int list_idx3;
16677 int i;
16678 int ir_idx;
16679
16680
16681 TRACE (Func_Entry, "unpack_intrinsic", NULL);
16682
16683 ir_idx = OPND_IDX((*result_opnd));
16684 list_idx1 = IR_IDX_R(ir_idx);
16685 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
16686 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
16687 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
16688 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
16689 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
16690 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
16691
16692 io_item_must_flatten = TRUE;
16693 # ifdef _INLINE_INTRINSICS
16694 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
16695 # endif
16696
16697 if (arg_info_list[info_idx1].ed.rank != 1) {
16698 PRINTMSG(arg_info_list[info_idx1].line, 654, Error,
16699 arg_info_list[info_idx1].col);
16700 }
16701
16702 if ((TYP_CHAR_CLASS(arg_info_list[info_idx1].ed.type_idx) ==
16703 Const_Len_Char) &&
16704 (TYP_CHAR_CLASS(arg_info_list[info_idx3].ed.type_idx) ==
16705 Const_Len_Char)) {
16706 if (CN_INT_TO_C(TYP_IDX(arg_info_list[info_idx1].ed.type_idx)) !=
16707 CN_INT_TO_C(TYP_IDX(arg_info_list[info_idx3].ed.type_idx))) {
16708 PRINTMSG(arg_info_list[info_idx3].line, 1154, Error,
16709 arg_info_list[info_idx3].col);
16710 }
16711 }
16712
16713 if ((arg_info_list[info_idx1].ed.linear_type != Short_Char_Const) &&
16714 (arg_info_list[info_idx3].ed.linear_type != Short_Char_Const)) {
16715 if (arg_info_list[info_idx1].ed.linear_type !=
16716 arg_info_list[info_idx3].ed.linear_type) {
16717 PRINTMSG(arg_info_list[info_idx3].line, 1154, Error,
16718 arg_info_list[info_idx3].col);
16719 }
16720 }
16721
16722 if (arg_info_list[info_idx2].ed.rank !=arg_info_list[info_idx3].ed.rank) {
16723 if (arg_info_list[info_idx3].ed.rank != 0) {
16724 PRINTMSG(arg_info_list[info_idx3].line, 1222, Error,
16725 arg_info_list[info_idx3].col);
16726 }
16727 }
16728 else {
16729 for (i = 1; i <= arg_info_list[info_idx2].ed.rank; i++) {
16730 if (OPND_FLD(arg_info_list[info_idx2].ed.shape[i-1])== CN_Tbl_Idx &&
16731 OPND_FLD(arg_info_list[info_idx3].ed.shape[i-1])== CN_Tbl_Idx &&
16732 CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx2].ed.shape[i-1])) !=
16733 CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx3].ed.shape[i-1]))) {
16734 PRINTMSG(arg_info_list[info_idx3].line, 1222, Error,
16735 arg_info_list[info_idx3].col);
16736 break;
16737 }
16738 }
16739 }
16740
16741 conform_check(0,
16742 ir_idx,
16743 res_exp_desc,
16744 spec_idx,
16745 FALSE);
16746
16747 if (cmd_line_flags.runtime_conformance) {
16748 gen_runtime_conformance(&IL_OPND(list_idx2),
16749 &(arg_info_list[info_idx2].ed),
16750 &IL_OPND(list_idx3),
16751 &(arg_info_list[info_idx3].ed));
16752 }
16753
16754 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
16755 IR_OPR(ir_idx) = Unpack_Opr;
16756 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
16757 IR_OPND_R(ir_idx) = null_opnd;
16758 }
16759
16760 res_exp_desc->rank = arg_info_list[info_idx2].ed.rank;
16761 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16762 IR_RANK(ir_idx) = res_exp_desc->rank;
16763
16764 COPY_OPND(res_exp_desc->shape[0], arg_info_list[info_idx2].ed.shape[0]);
16765 COPY_OPND(res_exp_desc->shape[1], arg_info_list[info_idx2].ed.shape[1]);
16766 COPY_OPND(res_exp_desc->shape[2], arg_info_list[info_idx2].ed.shape[2]);
16767 COPY_OPND(res_exp_desc->shape[3], arg_info_list[info_idx2].ed.shape[3]);
16768 COPY_OPND(res_exp_desc->shape[4], arg_info_list[info_idx2].ed.shape[4]);
16769 COPY_OPND(res_exp_desc->shape[5], arg_info_list[info_idx2].ed.shape[5]);
16770 COPY_OPND(res_exp_desc->shape[6], arg_info_list[info_idx2].ed.shape[6]);
16771 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
16772
16773
16774
16775
16776 res_exp_desc->foldable = FALSE;
16777 res_exp_desc->will_fold_later = FALSE;
16778
16779 TRACE (Func_Exit, "unpack_intrinsic", NULL);
16780
16781 }
16782
16783
16784
16785
16786
16787
16788
16789
16790
16791
16792
16793
16794
16795
16796
16797
16798
16799 void trim_intrinsic(opnd_type *result_opnd,
16800 expr_arg_type *res_exp_desc,
16801 int *spec_idx)
16802
16803 {
16804 long_type folded_const[MAX_WORDS_FOR_INTEGER];
16805 int info_idx1;
16806 int ir_idx;
16807 int len_idx;
16808 int list_idx1;
16809 opnd_type opnd;
16810 int type_idx;
16811
16812
16813 TRACE (Func_Entry, "trim_intrinsic", NULL);
16814
16815 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
16816
16817 ir_idx = OPND_IDX((*result_opnd));
16818 list_idx1 = IR_IDX_R(ir_idx);
16819 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
16820 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Character_1;
16821 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16822
16823 if (arg_info_list[info_idx1].ed.rank != 0) {
16824 PRINTMSG(arg_info_list[info_idx1].line, 654, Error,
16825 arg_info_list[info_idx1].col);
16826 }
16827
16828 conform_check(0,
16829 ir_idx,
16830 res_exp_desc,
16831 spec_idx,
16832 FALSE);
16833
16834 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
16835 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
16836 arg_info_list[info_idx1].ed.type_idx,
16837 NULL,
16838 NULL_IDX,
16839 folded_const,
16840 &type_idx,
16841 IR_LINE_NUM(ir_idx),
16842 IR_COL_NUM(ir_idx),
16843 1,
16844 Trim_Opr)) {
16845 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
16846
16847
16848
16849 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
16850 OPND_IDX((*result_opnd)) = (int) F_INT_TO_C(folded_const, type_idx);
16851 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
16852 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
16853
16854 res_exp_desc->char_len.fld = TYP_FLD(type_idx);
16855 res_exp_desc->char_len.idx = TYP_IDX(type_idx);
16856 res_exp_desc->constant = TRUE;
16857 res_exp_desc->foldable = TRUE;
16858 }
16859 else {
16860 copy_subtree(&IR_OPND_R(ir_idx), &opnd);
16861
16862 len_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
16863 Len_Trim_Opr,
16864 INTEGER_DEFAULT_TYPE,
16865 IR_LINE_NUM(ir_idx),
16866 IR_COL_NUM(ir_idx),
16867 NO_Tbl_Idx, NULL_IDX);
16868
16869 res_exp_desc->char_len.fld = IR_Tbl_Idx;
16870 res_exp_desc->char_len.idx = len_idx;
16871
16872 ATD_CHAR_LEN_IN_DV(ATP_RSLT_IDX(*spec_idx)) = TRUE;
16873 }
16874
16875 res_exp_desc->type_idx = type_idx;
16876 IR_TYPE_IDX(ir_idx) = type_idx;
16877 IR_RANK(ir_idx) = res_exp_desc->rank;
16878
16879 TRACE (Func_Exit, "trim_intrinsic", NULL);
16880
16881 }
16882
16883
16884
16885
16886
16887
16888
16889
16890
16891
16892
16893
16894
16895
16896
16897
16898
16899
16900 void transpose_intrinsic(opnd_type *result_opnd,
16901 expr_arg_type *res_exp_desc,
16902 int *spec_idx)
16903 {
16904 int info_idx1;
16905 int list_idx1;
16906 int ir_idx;
16907 int type_idx;
16908
16909
16910 TRACE (Func_Entry, "transpose_intrinsic", NULL);
16911
16912 # ifdef _INLINE_INTRINSICS
16913 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
16914 # endif
16915
16916 ir_idx = OPND_IDX((*result_opnd));
16917 list_idx1 = IR_IDX_R(ir_idx);
16918 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
16919 type_idx = arg_info_list[info_idx1].ed.type_idx;
16920 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
16921
16922 if (arg_info_list[info_idx1].ed.rank != 2) {
16923 PRINTMSG(arg_info_list[info_idx1].line, 654, Error,
16924 arg_info_list[info_idx1].col);
16925 }
16926
16927 conform_check(0,
16928 ir_idx,
16929 res_exp_desc,
16930 spec_idx,
16931 FALSE);
16932
16933 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
16934 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
16935 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
16936 COPY_OPND(res_exp_desc->shape[0], arg_info_list[info_idx1].ed.shape[1]);
16937 COPY_OPND(res_exp_desc->shape[1], arg_info_list[info_idx1].ed.shape[0]);
16938 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
16939
16940 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
16941 io_item_must_flatten = TRUE;
16942 IR_OPR(ir_idx) = Transpose_Opr;
16943 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
16944 IR_OPND_R(ir_idx) = null_opnd;
16945 }
16946
16947 IR_TYPE_IDX(ir_idx) = type_idx;
16948 IR_RANK(ir_idx) = res_exp_desc->rank;
16949
16950
16951
16952
16953 res_exp_desc->foldable = FALSE;
16954 res_exp_desc->will_fold_later = FALSE;
16955
16956 TRACE (Func_Exit, "transpose_intrinsic", NULL);
16957
16958 }
16959
16960
16961
16962
16963
16964
16965
16966
16967
16968
16969
16970
16971
16972
16973
16974
16975
16976
16977 void spread_intrinsic(opnd_type *result_opnd,
16978 expr_arg_type *res_exp_desc,
16979 int *spec_idx)
16980 {
16981 int list_idx1;
16982 int list_idx2;
16983 int list_idx3;
16984 int info_idx1;
16985 int info_idx2;
16986 int info_idx3;
16987 int idx;
16988 int idx1;
16989 int idx2;
16990 int ir_idx;
16991 int i;
16992 int j;
16993 int type_idx;
16994 opnd_type opnd;
16995 opnd_type shape_opnd;
16996
16997
16998 TRACE (Func_Entry, "spread_intrinsic", NULL);
16999
17000 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
17001
17002 ir_idx = OPND_IDX((*result_opnd));
17003 list_idx1 = IR_IDX_R(ir_idx);
17004 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
17005 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
17006 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
17007 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
17008 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
17009 type_idx = arg_info_list[info_idx1].ed.type_idx;
17010 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
17011
17012 conform_check(0,
17013 ir_idx,
17014 res_exp_desc,
17015 spec_idx,
17016 FALSE);
17017
17018 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
17019 res_exp_desc->rank = arg_info_list[info_idx1].ed.rank + 1;
17020
17021 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
17022 if ((compare_cn_and_value(IL_IDX(list_idx2),
17023 (long) arg_info_list[info_idx1].ed.rank+1,
17024 Gt_Opr) ||
17025 compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr))) {
17026
17027 PRINTMSG(arg_info_list[info_idx2].line, 1120, Error,
17028 arg_info_list[info_idx2].col);
17029 }
17030
17031 j = 1;
17032 for (i = 1; i <= res_exp_desc->rank; i++) {
17033 if (compare_cn_and_value(IL_IDX(list_idx2),
17034 i,
17035 Eq_Opr)) {
17036 OPND_LINE_NUM(shape_opnd) = IR_LINE_NUM(ir_idx);
17037 OPND_COL_NUM(shape_opnd) = IR_COL_NUM(ir_idx);
17038
17039 NTR_IR_LIST_TBL(idx1);
17040 NTR_IR_LIST_TBL(idx2);
17041 IL_NEXT_LIST_IDX(idx1) = idx2;
17042 IL_IDX(idx2) = CN_INTEGER_ZERO_IDX;
17043 IL_FLD(idx2) = CN_Tbl_Idx;
17044 IL_LINE_NUM(idx2) = IR_LINE_NUM(ir_idx);
17045 IL_COL_NUM(idx2) = IR_COL_NUM(ir_idx);
17046
17047 IL_IDX(idx1) = IL_IDX(list_idx3);
17048 IL_FLD(idx1) = IL_FLD(list_idx3);
17049 IL_LINE_NUM(idx1) = IR_LINE_NUM(ir_idx);
17050 IL_COL_NUM(idx1) = IR_COL_NUM(ir_idx);
17051
17052 idx = gen_ir(IL_Tbl_Idx, idx1,
17053 Max_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
17054 IR_COL_NUM(ir_idx),
17055 NO_Tbl_Idx, NULL_IDX);
17056
17057 OPND_FLD(shape_opnd) = IR_Tbl_Idx;
17058 OPND_IDX(shape_opnd) = idx;
17059
17060 COPY_OPND(res_exp_desc->shape[i-1], shape_opnd);
17061 }
17062 else {
17063 COPY_OPND(res_exp_desc->shape[i-1],
17064 arg_info_list[info_idx1].ed.shape[j-1]);
17065 j = j + 1;
17066 }
17067 }
17068
17069 # ifdef _INLINE_INTRINSICS
17070 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
17071 # endif
17072 }
17073
17074 COPY_OPND(opnd, IL_OPND(list_idx2));
17075 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
17076 COPY_OPND(IL_OPND(list_idx2), opnd);
17077
17078 COPY_OPND(opnd, IL_OPND(list_idx3));
17079 cast_to_cg_default(&opnd, &(arg_info_list[info_idx3].ed));
17080 COPY_OPND(IL_OPND(list_idx3), opnd);
17081
17082 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
17083 io_item_must_flatten = TRUE;
17084 IR_OPR(ir_idx) = Spread_Opr;
17085 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
17086 IR_OPND_R(ir_idx) = null_opnd;
17087 IR_LIST_CNT_L(ir_idx) = IR_LIST_CNT_R(ir_idx);
17088 }
17089
17090 IR_TYPE_IDX(ir_idx) = type_idx;
17091 IR_RANK(ir_idx) = res_exp_desc->rank;
17092
17093
17094
17095
17096 res_exp_desc->foldable = FALSE;
17097 res_exp_desc->will_fold_later = FALSE;
17098
17099 TRACE (Func_Exit, "spread_intrinsic", NULL);
17100
17101 }
17102
17103
17104
17105
17106
17107
17108
17109
17110
17111
17112
17113
17114
17115
17116
17117
17118
17119
17120 void selected_int_kind_intrinsic(opnd_type *result_opnd,
17121 expr_arg_type *res_exp_desc,
17122 int *spec_idx)
17123 {
17124 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
17125 int info_idx1;
17126 int ir_idx;
17127 int type_idx;
17128 int list_idx1;
17129 int fifth_select;
17130 int fourth_select;
17131 int third_select;
17132 int second_select;
17133 int arg1;
17134 int arg2;
17135 int arg3;
17136 int le_idx;
17137 int cn_idx;
17138
17139
17140 TRACE (Func_Entry, "selected_int_kind_intrinsic", NULL);
17141
17142 ir_idx = OPND_IDX((*result_opnd));
17143 list_idx1 = IR_IDX_R(ir_idx);
17144 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
17145 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
17146
17147 if (arg_info_list[info_idx1].ed.rank != 0) {
17148 PRINTMSG(arg_info_list[info_idx1].line, 654, Error,
17149 arg_info_list[info_idx1].col);
17150 }
17151
17152 conform_check(0,
17153 ir_idx,
17154 res_exp_desc,
17155 spec_idx,
17156 FALSE);
17157
17158 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
17159 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
17160 res_exp_desc->type = Integer;
17161 res_exp_desc->linear_type = INTEGER_DEFAULT_TYPE;
17162 type_idx = INTEGER_DEFAULT_TYPE;
17163
17164 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
17165 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
17166 arg_info_list[info_idx1].ed.type_idx,
17167 NULL,
17168 NULL_IDX,
17169 folded_const,
17170 &type_idx,
17171 IR_LINE_NUM(ir_idx),
17172 IR_COL_NUM(ir_idx),
17173 1,
17174 SIK_Opr)) {
17175
17176 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
17177 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
17178 FALSE,
17179 folded_const);
17180 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
17181 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
17182 res_exp_desc->constant = TRUE;
17183 res_exp_desc->foldable = TRUE;
17184 }
17185 else {
17186 NTR_IR_LIST_TBL(arg1);
17187 IL_ARG_DESC_VARIANT(arg1) = TRUE;
17188
17189 NTR_IR_LIST_TBL(arg2);
17190 IL_ARG_DESC_VARIANT(arg2) = TRUE;
17191
17192 NTR_IR_LIST_TBL(arg3);
17193 IL_ARG_DESC_VARIANT(arg3) = TRUE;
17194
17195
17196 IL_NEXT_LIST_IDX(arg1) = arg2;
17197 IL_NEXT_LIST_IDX(arg2) = arg3;
17198
17199 fifth_select = gen_ir(IL_Tbl_Idx, arg1,
17200 Cvmgt_Opr,
17201 INTEGER_DEFAULT_TYPE,
17202 IR_LINE_NUM(ir_idx),
17203 IR_COL_NUM(ir_idx),
17204 NO_Tbl_Idx, NULL_IDX);
17205
17206
17207 io_item_must_flatten = TRUE;
17208
17209
17210
17211 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 8);
17212 IL_FLD(arg1) = CN_Tbl_Idx;
17213 IL_IDX(arg1) = cn_idx;
17214 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
17215 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
17216
17217 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
17218 CN_INTEGER_NEG_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, -1);
17219 IL_FLD(arg2) = CN_Tbl_Idx;
17220 IL_IDX(arg2) = cn_idx;
17221 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
17222 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
17223
17224 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, RANGE_INT8_F90);
17225
17226 le_idx = gen_ir(IL_FLD(IR_IDX_R(ir_idx)), IL_IDX(IR_IDX_R(ir_idx)),
17227 Le_Opr,
17228 LOGICAL_DEFAULT_TYPE,
17229 IR_LINE_NUM(ir_idx),
17230 IR_COL_NUM(ir_idx),
17231 CN_Tbl_Idx, cn_idx);
17232
17233 IL_FLD(arg3) = IR_Tbl_Idx;
17234 IL_IDX(arg3) = le_idx;
17235
17236
17237 NTR_IR_LIST_TBL(arg1);
17238 IL_ARG_DESC_VARIANT(arg1) = TRUE;
17239
17240 NTR_IR_LIST_TBL(arg2);
17241 IL_ARG_DESC_VARIANT(arg2) = TRUE;
17242
17243 NTR_IR_LIST_TBL(arg3);
17244 IL_ARG_DESC_VARIANT(arg3) = TRUE;
17245
17246
17247 IL_NEXT_LIST_IDX(arg1) = arg2;
17248 IL_NEXT_LIST_IDX(arg2) = arg3;
17249
17250 fourth_select = gen_ir(IL_Tbl_Idx, arg1,
17251 Cvmgt_Opr,
17252 INTEGER_DEFAULT_TYPE,
17253 IR_LINE_NUM(ir_idx),
17254 IR_COL_NUM(ir_idx),
17255 NO_Tbl_Idx, NULL_IDX);
17256
17257
17258 io_item_must_flatten = TRUE;
17259
17260 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 4);
17261 IL_FLD(arg1) = CN_Tbl_Idx;
17262 IL_IDX(arg1) = cn_idx;
17263 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
17264 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
17265
17266 IL_FLD(arg2) = IR_Tbl_Idx;
17267 IL_IDX(arg2) = fifth_select;
17268
17269 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, RANGE_INT4_F90);
17270
17271 le_idx = gen_ir(IL_FLD(IR_IDX_R(ir_idx)), IL_IDX(IR_IDX_R(ir_idx)),
17272 Le_Opr,
17273 LOGICAL_DEFAULT_TYPE,
17274 IR_LINE_NUM(ir_idx),
17275 IR_COL_NUM(ir_idx),
17276 CN_Tbl_Idx, cn_idx);
17277
17278 IL_FLD(arg3) = IR_Tbl_Idx;
17279 IL_IDX(arg3) = le_idx;
17280
17281
17282
17283
17284
17285
17286 NTR_IR_LIST_TBL(arg1);
17287 IL_ARG_DESC_VARIANT(arg1) = TRUE;
17288
17289 NTR_IR_LIST_TBL(arg2);
17290 IL_ARG_DESC_VARIANT(arg2) = TRUE;
17291
17292 NTR_IR_LIST_TBL(arg3);
17293 IL_ARG_DESC_VARIANT(arg3) = TRUE;
17294
17295
17296 IL_NEXT_LIST_IDX(arg1) = arg2;
17297 IL_NEXT_LIST_IDX(arg2) = arg3;
17298
17299 third_select = gen_ir(IL_Tbl_Idx, arg1,
17300 Cvmgt_Opr,
17301 INTEGER_DEFAULT_TYPE,
17302 IR_LINE_NUM(ir_idx),
17303 IR_COL_NUM(ir_idx),
17304 NO_Tbl_Idx, NULL_IDX);
17305
17306
17307 io_item_must_flatten = TRUE;
17308
17309 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
17310 CN_INTEGER_TWO_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 2);
17311 IL_FLD(arg1) = CN_Tbl_Idx;
17312 IL_IDX(arg1) = cn_idx;
17313 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
17314 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
17315
17316 IL_FLD(arg2) = IR_Tbl_Idx;
17317 IL_IDX(arg2) = fourth_select;
17318
17319 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, RANGE_INT2_F90);
17320
17321 le_idx = gen_ir(IL_FLD(IR_IDX_R(ir_idx)), IL_IDX(IR_IDX_R(ir_idx)),
17322 Le_Opr,LOGICAL_DEFAULT_TYPE,IR_LINE_NUM(ir_idx),
17323 IR_COL_NUM(ir_idx),
17324 CN_Tbl_Idx, cn_idx);
17325
17326 IL_FLD(arg3) = IR_Tbl_Idx;
17327 IL_IDX(arg3) = le_idx;
17328
17329
17330
17331 NTR_IR_LIST_TBL(arg1);
17332 IL_ARG_DESC_VARIANT(arg1) = TRUE;
17333
17334 NTR_IR_LIST_TBL(arg2);
17335 IL_ARG_DESC_VARIANT(arg2) = TRUE;
17336
17337 NTR_IR_LIST_TBL(arg3);
17338 IL_ARG_DESC_VARIANT(arg3) = TRUE;
17339
17340
17341 IL_NEXT_LIST_IDX(arg1) = arg2;
17342 IL_NEXT_LIST_IDX(arg2) = arg3;
17343
17344 second_select = gen_ir(IL_Tbl_Idx, arg1,
17345 Cvmgt_Opr,
17346 INTEGER_DEFAULT_TYPE,
17347 IR_LINE_NUM(ir_idx),
17348 IR_COL_NUM(ir_idx),
17349 NO_Tbl_Idx, NULL_IDX);
17350
17351
17352 io_item_must_flatten = TRUE;
17353
17354 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
17355 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
17356 IL_FLD(arg1) = CN_Tbl_Idx;
17357 IL_IDX(arg1) = cn_idx;
17358 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
17359 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
17360
17361 IL_FLD(arg2) = IR_Tbl_Idx;
17362 IL_IDX(arg2) = third_select;
17363
17364 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, RANGE_INT1_F90);
17365
17366 le_idx = gen_ir(IL_FLD(IR_IDX_R(ir_idx)), IL_IDX(IR_IDX_R(ir_idx)),
17367 Le_Opr,
17368 LOGICAL_DEFAULT_TYPE,
17369 IR_LINE_NUM(ir_idx),
17370 IR_COL_NUM(ir_idx),
17371 CN_Tbl_Idx, cn_idx);
17372
17373 IL_FLD(arg3) = IR_Tbl_Idx;
17374 IL_IDX(arg3) = le_idx;
17375
17376
17377
17378
17379
17380
17381 NTR_IR_LIST_TBL(arg1);
17382 IL_ARG_DESC_VARIANT(arg1) = TRUE;
17383
17384 NTR_IR_LIST_TBL(arg2);
17385 IL_ARG_DESC_VARIANT(arg2) = TRUE;
17386
17387 NTR_IR_LIST_TBL(arg3);
17388 IL_ARG_DESC_VARIANT(arg3) = TRUE;
17389
17390
17391 IL_NEXT_LIST_IDX(arg1) = arg2;
17392 IL_NEXT_LIST_IDX(arg2) = arg3;
17393
17394 IR_OPR(ir_idx) = Cvmgt_Opr;
17395 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
17396 IR_IDX_L(ir_idx) = arg1;
17397 IR_LIST_CNT_L(ir_idx) = 3;
17398
17399
17400 io_item_must_flatten = TRUE;
17401
17402 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
17403 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
17404 IL_FLD(arg1) = CN_Tbl_Idx;
17405 IL_IDX(arg1) = cn_idx;
17406 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
17407 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
17408
17409 IL_FLD(arg2) = IR_Tbl_Idx;
17410 IL_IDX(arg2) = second_select;
17411
17412 le_idx = gen_ir(IL_FLD(IR_IDX_R(ir_idx)), IL_IDX(IR_IDX_R(ir_idx)),
17413 Le_Opr,
17414 LOGICAL_DEFAULT_TYPE,
17415 IR_LINE_NUM(ir_idx),
17416 IR_COL_NUM(ir_idx),
17417 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
17418
17419 IL_FLD(arg3) = IR_Tbl_Idx;
17420 IL_IDX(arg3) = le_idx;
17421
17422
17423 IR_OPND_R(ir_idx) = null_opnd;
17424 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
17425 IR_RANK(ir_idx) = res_exp_desc->rank;
17426
17427
17428
17429
17430 res_exp_desc->foldable = FALSE;
17431 res_exp_desc->will_fold_later = FALSE;
17432 }
17433
17434 TRACE (Func_Exit, "selected_int_kind_intrinsic", NULL);
17435
17436 }
17437
17438
17439
17440
17441
17442
17443
17444
17445
17446
17447
17448
17449
17450
17451
17452
17453
17454
17455 void selected_real_kind_intrinsic(opnd_type *result_opnd,
17456 expr_arg_type *res_exp_desc,
17457 int *spec_idx)
17458 {
17459 int ir_idx;
17460 int type_idx;
17461 #ifdef KEY
17462 int info_idx1 = 0;
17463 int info_idx2 = 0;
17464 #else
17465 int info_idx1;
17466 int info_idx2;
17467 #endif
17468 int list_idx1;
17469 int list_idx2;
17470 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
17471 opnd_type opnd;
17472
17473
17474 TRACE (Func_Entry, "selected_real_kind_intrinsic", NULL);
17475
17476 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
17477 ir_idx = OPND_IDX((*result_opnd));
17478 list_idx1 = IR_IDX_R(ir_idx);
17479 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
17480 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
17481
17482 conform_check(0,
17483 ir_idx,
17484 res_exp_desc,
17485 spec_idx,
17486 FALSE);
17487
17488 if (list_idx1 != NULL_IDX && IL_IDX(list_idx1) != NULL_IDX) {
17489 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
17490
17491 if (arg_info_list[IL_ARG_DESC_IDX(list_idx1)].ed.rank != 0) {
17492 PRINTMSG(arg_info_list[IL_ARG_DESC_IDX(list_idx1)].line, 654, Error,
17493 arg_info_list[IL_ARG_DESC_IDX(list_idx1)].col);
17494 }
17495 }
17496
17497
17498 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
17499 info_idx2 = IL_ARG_DESC_IDX(IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)));
17500
17501 if (arg_info_list[IL_ARG_DESC_IDX(list_idx2)].ed.rank != 0) {
17502 PRINTMSG(arg_info_list[IL_ARG_DESC_IDX(list_idx2)].line, 654, Error,
17503 arg_info_list[IL_ARG_DESC_IDX(list_idx2)].col);
17504 }
17505 }
17506
17507 if ((IL_IDX(list_idx1) == NULL_IDX) && (IL_IDX(list_idx2) == NULL_IDX)) {
17508 PRINTMSG(IR_LINE_NUM(ir_idx), 728, Error,
17509 IR_COL_NUM(ir_idx));
17510 }
17511
17512 if (IL_IDX(list_idx1) != NULL_IDX) {
17513 #ifdef KEY
17514 if (NULL_IDX != is_optional_dummy(list_idx1)) {
17515 int cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
17516 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
17517 pass_dummy_or_default_const(list_idx1, cn_idx, TRUE);
17518 }
17519 #endif
17520 COPY_OPND(opnd, IL_OPND(list_idx1));
17521 cast_to_cg_default(&opnd, &(arg_info_list[info_idx1].ed));
17522 COPY_OPND(IL_OPND(list_idx1), opnd);
17523 }
17524
17525 if (IL_IDX(list_idx2) != NULL_IDX) {
17526 #ifdef KEY
17527 if (NULL_IDX != is_optional_dummy(list_idx2)) {
17528 int cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
17529 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
17530 pass_dummy_or_default_const(list_idx2, cn_idx, TRUE);
17531 }
17532 #endif
17533 COPY_OPND(opnd, IL_OPND(list_idx2));
17534 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
17535 COPY_OPND(IL_OPND(list_idx2), opnd);
17536 }
17537
17538 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
17539 IR_RANK(ir_idx) = res_exp_desc->rank;
17540 res_exp_desc->type_idx = INTEGER_DEFAULT_TYPE;
17541 type_idx = INTEGER_DEFAULT_TYPE;
17542 res_exp_desc->type = Integer;
17543 res_exp_desc->linear_type = INTEGER_DEFAULT_TYPE;
17544
17545 if (IL_IDX(list_idx1) != NULL_IDX &&
17546 IL_IDX(list_idx2) != NULL_IDX &&
17547 IL_FLD(list_idx1) == CN_Tbl_Idx &&
17548 IL_FLD(list_idx2) == CN_Tbl_Idx &&
17549 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
17550 arg_info_list[info_idx1].ed.type_idx,
17551 (char *)&CN_CONST(IL_IDX(list_idx2)),
17552 arg_info_list[info_idx2].ed.type_idx,
17553 folded_const,
17554 &type_idx,
17555 IR_LINE_NUM(ir_idx),
17556 IR_COL_NUM(ir_idx),
17557 2,
17558 SRK_Opr)) {
17559 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
17560 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
17561 FALSE,
17562 folded_const);
17563 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
17564 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
17565 res_exp_desc->constant = TRUE;
17566 res_exp_desc->foldable = TRUE;
17567 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
17568 }
17569 else if (IL_IDX(list_idx1) != NULL_IDX &&
17570 IL_IDX(list_idx2) == NULL_IDX &&
17571 IL_FLD(list_idx1) == CN_Tbl_Idx &&
17572 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
17573 arg_info_list[info_idx1].ed.type_idx,
17574 NULL,
17575 NULL_IDX,
17576 folded_const,
17577 &type_idx,
17578 IR_LINE_NUM(ir_idx),
17579 IR_COL_NUM(ir_idx),
17580 2,
17581 SRK_Opr)) {
17582 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
17583 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
17584 FALSE,
17585 folded_const);
17586 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
17587 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
17588 res_exp_desc->constant = TRUE;
17589 res_exp_desc->foldable = TRUE;
17590 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
17591 }
17592 else if (IL_IDX(list_idx2) != NULL_IDX &&
17593 IL_IDX(list_idx1) == NULL_IDX &&
17594 IL_FLD(list_idx2) == CN_Tbl_Idx &&
17595 folder_driver(NULL,
17596 NULL_IDX,
17597 (char *)&CN_CONST(IL_IDX(list_idx2)),
17598 arg_info_list[info_idx2].ed.type_idx,
17599 folded_const,
17600 &type_idx,
17601 IR_LINE_NUM(ir_idx),
17602 IR_COL_NUM(ir_idx),
17603 2,
17604 SRK_Opr)) {
17605 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
17606 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
17607 FALSE,
17608 folded_const);
17609 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
17610 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
17611 res_exp_desc->constant = TRUE;
17612 res_exp_desc->foldable = TRUE;
17613 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
17614 }
17615
17616
17617 TRACE (Func_Exit, "selected_real_kind_intrinsic", NULL);
17618
17619 }
17620
17621
17622
17623
17624
17625
17626
17627
17628
17629
17630
17631
17632
17633
17634
17635
17636
17637
17638 void repeat_intrinsic(opnd_type *result_opnd,
17639 expr_arg_type *res_exp_desc,
17640 int *spec_idx)
17641 {
17642 long_type folded_const[MAX_WORDS_FOR_INTEGER];
17643 int info_idx1;
17644 int info_idx2;
17645 int ir_idx;
17646 int list_idx1;
17647 int list_idx2;
17648 int mult_idx;
17649 opnd_type opnd;
17650 opnd_type opnd2;
17651 int type_idx;
17652
17653
17654 TRACE (Func_Entry, "repeat_intrinsic", NULL);
17655
17656 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
17657 ir_idx = OPND_IDX((*result_opnd));
17658 list_idx1 = IR_IDX_R(ir_idx);
17659 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
17660 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Character_1;
17661 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
17662
17663 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
17664 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
17665
17666 if (arg_info_list[info_idx1].ed.rank != 0) {
17667 PRINTMSG(arg_info_list[info_idx1].line, 654, Error,
17668 arg_info_list[info_idx1].col);
17669 }
17670
17671 if (arg_info_list[info_idx2].ed.rank != 0) {
17672 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
17673 arg_info_list[info_idx2].col);
17674 }
17675
17676 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
17677 if (compare_cn_and_value(IL_IDX(list_idx2), 0, Lt_Opr)) {
17678 PRINTMSG(arg_info_list[info_idx2].line, 1056, Error,
17679 arg_info_list[info_idx2].col);
17680 }
17681
17682 }
17683
17684 conform_check(0,
17685 ir_idx,
17686 res_exp_desc,
17687 spec_idx,
17688 FALSE);
17689
17690 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
17691 IL_FLD(list_idx2) == CN_Tbl_Idx &&
17692 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
17693 arg_info_list[info_idx1].ed.type_idx,
17694 (char *)&CN_CONST(IL_IDX(list_idx2)),
17695 arg_info_list[info_idx2].ed.type_idx,
17696 folded_const,
17697 &type_idx,
17698 IR_LINE_NUM(ir_idx),
17699 IR_COL_NUM(ir_idx),
17700 2,
17701 Repeat_Opr)) {
17702
17703 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
17704 OPND_IDX((*result_opnd)) = (int) F_INT_TO_C(folded_const, type_idx);
17705 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
17706 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
17707
17708 res_exp_desc->char_len.fld = TYP_FLD(type_idx);
17709 res_exp_desc->char_len.idx = TYP_IDX(type_idx);
17710 res_exp_desc->constant = TRUE;
17711 res_exp_desc->foldable = TRUE;
17712 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
17713 }
17714 else {
17715 COPY_OPND(opnd, arg_info_list[info_idx1].ed.char_len);
17716 copy_subtree(&opnd, &opnd);
17717
17718 COPY_OPND(opnd2, IL_OPND(list_idx2));
17719 copy_subtree(&opnd2, &opnd2);
17720
17721 mult_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
17722 Mult_Opr, CG_INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
17723 IR_COL_NUM(ir_idx),
17724 OPND_FLD(opnd2), OPND_IDX(opnd2));
17725
17726 res_exp_desc->char_len.fld = IR_Tbl_Idx;
17727 res_exp_desc->char_len.idx = mult_idx;
17728
17729 ATD_CHAR_LEN_IN_DV(ATP_RSLT_IDX(*spec_idx)) = TRUE;
17730 }
17731
17732 COPY_OPND(opnd, IL_OPND(list_idx2));
17733 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
17734 COPY_OPND(IL_OPND(list_idx2), opnd);
17735
17736 res_exp_desc->type_idx = type_idx;
17737 IR_TYPE_IDX(ir_idx) = type_idx;
17738 IR_RANK(ir_idx) = res_exp_desc->rank;
17739
17740 TRACE (Func_Exit, "repeat_intrinsic", NULL);
17741
17742 }
17743
17744
17745
17746
17747
17748
17749
17750
17751
17752
17753
17754
17755
17756
17757
17758
17759
17760
17761 void dot_product_intrinsic(opnd_type *result_opnd,
17762 expr_arg_type *res_exp_desc,
17763 int *spec_idx)
17764 {
17765 int ir_idx;
17766
17767 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
17768 int list_idx1;
17769 int info_idx1;
17770 # endif
17771
17772
17773 TRACE (Func_Entry, "dot_product_intrinsic", NULL);
17774
17775 # ifdef _INLINE_INTRINSICS
17776 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
17777 # endif
17778
17779 ir_idx = OPND_IDX((*result_opnd));
17780
17781 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
17782 list_idx1 = IR_IDX_R(ir_idx);
17783 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
17784 # endif
17785
17786 conform_check(0,
17787 ir_idx,
17788 res_exp_desc,
17789 spec_idx,
17790 FALSE);
17791
17792 res_exp_desc->rank = 0;
17793 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
17794 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
17795 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
17796
17797 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
17798 io_item_must_flatten = TRUE;
17799 IR_OPR(ir_idx) = Dot_Product_Opr;
17800
17801 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
17802 if (arg_info_list[info_idx1].ed.type == Logical) {
17803 IR_OPR(ir_idx) = Dot_Product_Logical_Opr;
17804 }
17805 # endif
17806 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
17807 IR_OPND_R(ir_idx) = null_opnd;
17808 }
17809
17810 IR_TYPE_IDX(ir_idx) = res_exp_desc->type_idx;
17811 IR_RANK(ir_idx) = res_exp_desc->rank;
17812
17813
17814
17815
17816 res_exp_desc->foldable = FALSE;
17817 res_exp_desc->will_fold_later = FALSE;
17818
17819 TRACE (Func_Exit, "dot_product_intrinsic", NULL);
17820
17821 }
17822
17823
17824
17825
17826
17827
17828
17829
17830
17831
17832
17833
17834
17835
17836
17837
17838
17839
17840 void matmul_intrinsic(opnd_type *result_opnd,
17841 expr_arg_type *res_exp_desc,
17842 int *spec_idx)
17843 {
17844 int ir_idx;
17845 int list_idx1;
17846 int list_idx2;
17847 int info_idx1;
17848 int info_idx2;
17849 opnd_type temp_opnd;
17850
17851
17852 TRACE (Func_Entry, "matmul_intrinsic", NULL);
17853
17854 # ifdef _INLINE_INTRINSICS
17855 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
17856 # endif
17857
17858 ir_idx = OPND_IDX((*result_opnd));
17859 list_idx1 = IR_IDX_R(ir_idx);
17860 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
17861 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
17862 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
17863
17864 conform_check(0,
17865 ir_idx,
17866 res_exp_desc,
17867 spec_idx,
17868 FALSE);
17869
17870 res_exp_desc->rank = BD_RANK(ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)));
17871 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
17872 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
17873 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
17874
17875 if (arg_info_list[info_idx1].ed.rank == 2) {
17876 COPY_OPND(temp_opnd,arg_info_list[info_idx1].ed.shape[1]);
17877 }
17878
17879 if (arg_info_list[info_idx1].ed.rank == 1) {
17880 COPY_OPND(res_exp_desc->shape[0],arg_info_list[info_idx2].ed.shape[1]);
17881 COPY_OPND(temp_opnd,arg_info_list[info_idx1].ed.shape[0]);
17882 }
17883 else if (arg_info_list[info_idx2].ed.rank == 1) {
17884 COPY_OPND(res_exp_desc->shape[0],arg_info_list[info_idx1].ed.shape[0]);
17885 }
17886 else {
17887 COPY_OPND(res_exp_desc->shape[0],arg_info_list[info_idx1].ed.shape[0]);
17888 COPY_OPND(res_exp_desc->shape[1],arg_info_list[info_idx2].ed.shape[1]);
17889 }
17890
17891 if ((OPND_FLD(arg_info_list[info_idx2].ed.shape[0]) == CN_Tbl_Idx) &&
17892 (OPND_FLD(temp_opnd) == CN_Tbl_Idx)) {
17893 if (CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx2].ed.shape[0])) !=
17894 CN_INT_TO_C(OPND_IDX(temp_opnd))) {
17895 PRINTMSG(arg_info_list[info_idx1].line, 1152, Error,
17896 arg_info_list[info_idx1].col);
17897 }
17898 }
17899
17900 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
17901
17902 if (res_exp_desc->rank == 1) {
17903 ATP_EXTERNAL_INTRIN(*spec_idx) = !opt_flags.mv_matmul_inline;
17904 }
17905 else {
17906 ATP_EXTERNAL_INTRIN(*spec_idx) = !opt_flags.matmul_inline;
17907 }
17908 # endif
17909
17910 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
17911 io_item_must_flatten = TRUE;
17912 IR_OPR(ir_idx) = Matmul_Opr;
17913 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
17914 IR_OPND_R(ir_idx) = null_opnd;
17915 }
17916
17917 IR_TYPE_IDX(ir_idx) = res_exp_desc->type_idx;
17918 IR_RANK(ir_idx) = res_exp_desc->rank;
17919
17920
17921
17922
17923 res_exp_desc->foldable = FALSE;
17924 res_exp_desc->will_fold_later = FALSE;
17925
17926 TRACE (Func_Exit, "matmul_intrinsic", NULL);
17927
17928 }
17929
17930
17931
17932
17933
17934
17935
17936
17937
17938
17939
17940
17941
17942
17943
17944
17945
17946
17947 void transfer_intrinsic(opnd_type *result_opnd,
17948 expr_arg_type *res_exp_desc,
17949 int *spec_idx)
17950 {
17951 int line;
17952 int col;
17953 int ch_asg_idx;
17954 int info_idx1;
17955 int info_idx2;
17956 #ifdef KEY
17957 int info_idx3 = 0;
17958 #else
17959 int info_idx3;
17960 #endif
17961 int ir_idx;
17962 opnd_type length_opnd;
17963 int list_idx1;
17964 int list_idx2;
17965 int list_idx3;
17966 expr_arg_type loc_exp_desc;
17967 int new_idx;
17968 int type_idx;
17969 int_dope_type dope_1;
17970 int_dope_type dope_2;
17971 opnd_type opnd;
17972 boolean fold_it;
17973 int the_cn_idx;
17974 int i;
17975 int tmp_idx;
17976 int or_idx;
17977 int attr_idx;
17978 int constant_type_idx;
17979 long64 bit_length;
17980 int_dope_type dope_result;
17981 cif_usage_code_type save_xref_state;
17982 opnd_type shape_opnd;
17983 boolean ok;
17984 long_type the_constant[MAX_WORDS_FOR_NUMERIC];
17985
17986
17987 TRACE (Func_Entry, "transfer_intrinsic", NULL);
17988
17989 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
17990
17991 ir_idx = OPND_IDX((*result_opnd));
17992 list_idx1 = IR_IDX_R(ir_idx);
17993 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
17994 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
17995 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
17996 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
17997
17998 fold_it = arg_info_list[info_idx1].ed.foldable &&
17999 arg_info_list[info_idx2].ed.foldable;
18000
18001 type_idx = arg_info_list[info_idx2].ed.type_idx;
18002
18003 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
18004
18005 conform_check(0,
18006 ir_idx,
18007 res_exp_desc,
18008 spec_idx,
18009 FALSE);
18010
18011 res_exp_desc->rank = 0;
18012 res_exp_desc->type_idx = type_idx;
18013
18014 if (TYP_TYPE(type_idx) == Character) {
18015 COPY_OPND((res_exp_desc->char_len),
18016 (arg_info_list[info_idx2].ed.char_len));
18017 }
18018
18019 if (list_idx3 == NULL_IDX) {
18020 if (arg_info_list[info_idx2].ed.rank > 0) {
18021 res_exp_desc->rank = 1;
18022 }
18023 }
18024 else {
18025 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
18026
18027 if (arg_info_list[info_idx3].ed.reference) {
18028 attr_idx = find_base_attr(&IL_OPND(list_idx3), &line, &col);
18029
18030 if (AT_OPTIONAL(attr_idx)) {
18031 PRINTMSG(arg_info_list[info_idx3].line, 875, Error,
18032 arg_info_list[info_idx3].col);
18033 }
18034 }
18035
18036 res_exp_desc->rank = 1;
18037 fold_it = fold_it && arg_info_list[info_idx3].ed.foldable;
18038 }
18039
18040 if (fold_it) {
18041 COPY_OPND(opnd, IL_OPND(list_idx1));
18042 gen_internal_dope_vector(&dope_1,
18043 &opnd,
18044 FALSE,
18045 &arg_info_list[info_idx1].ed);
18046
18047 COPY_OPND(opnd, IL_OPND(list_idx2));
18048 gen_internal_dope_vector(&dope_2,
18049 &opnd,
18050 FALSE,
18051 &arg_info_list[info_idx2].ed);
18052
18053 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
18054
18055 gen_internal_dope_vector(&dope_result,
18056 &opnd,
18057 TRUE,
18058 &arg_info_list[info_idx2].ed);
18059
18060 dope_result.num_dims = res_exp_desc->rank;
18061
18062 if (list_idx3 == NULL_IDX) {
18063 if (folder_driver((char *)&dope_1,
18064 arg_info_list[info_idx1].ed.type_idx,
18065 (char *)&dope_2,
18066 arg_info_list[info_idx2].ed.type_idx,
18067 (long_type *)&dope_result,
18068 &type_idx,
18069 IR_LINE_NUM(ir_idx),
18070 IR_COL_NUM(ir_idx),
18071 3,
18072 Transfer_Opr,
18073 0L,
18074 0L)) {
18075 }
18076 }
18077 else {
18078 if (folder_driver((char *)&dope_1,
18079 arg_info_list[info_idx1].ed.type_idx,
18080 (char *)&dope_2,
18081 arg_info_list[info_idx2].ed.type_idx,
18082 (long_type *)&dope_result,
18083 &type_idx,
18084 IR_LINE_NUM(ir_idx),
18085 IR_COL_NUM(ir_idx),
18086 3,
18087 Transfer_Opr,
18088 (char *)&CN_CONST(IL_IDX(list_idx3)),
18089 (long)arg_info_list[info_idx3].ed.type_idx)) {
18090 }
18091 }
18092
18093 res_exp_desc->type = arg_info_list[info_idx2].ed.type;
18094 res_exp_desc->linear_type = arg_info_list[info_idx2].ed.linear_type;
18095 res_exp_desc->type_idx = arg_info_list[info_idx2].ed.type_idx;
18096
18097 if (res_exp_desc->rank == 0 && res_exp_desc->type != Structure) {
18098
18099
18100
18101
18102 # ifdef _TARGET_OS_MAX
18103
18104 if (TYP_LINEAR(type_idx) == Complex_4) {
18105
18106 the_constant[0] = ((long_type *)dope_result.base_addr)[0];
18107 the_constant[1] = the_constant[0] & 0xFFFFFFFF;
18108 the_constant[0] = the_constant[0] >> 32;
18109
18110 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
18111 OPND_IDX((*result_opnd)) = ntr_const_tbl(res_exp_desc->type_idx,
18112 FALSE,
18113 the_constant);
18114 }
18115 else
18116 # endif
18117 if (res_exp_desc->type != Character &&
18118 storage_bit_size_tbl[res_exp_desc->linear_type] <
18119 TARGET_BITS_PER_WORD) {
18120
18121
18122 the_constant[0] = ((long_type *)dope_result.base_addr)[0] >>
18123 (TARGET_BITS_PER_WORD -
18124 storage_bit_size_tbl[res_exp_desc->linear_type]);
18125
18126 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
18127 OPND_IDX((*result_opnd)) = ntr_const_tbl(res_exp_desc->type_idx,
18128 FALSE,
18129 the_constant);
18130 }
18131 else {
18132 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
18133 OPND_IDX((*result_opnd)) = ntr_const_tbl(res_exp_desc->type_idx,
18134 FALSE,
18135 (long_type *)(dope_result.base_addr));
18136 }
18137
18138 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
18139 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
18140 res_exp_desc->foldable = TRUE;
18141 res_exp_desc->constant = TRUE;
18142 }
18143 else {
18144 bit_length = 1;
18145 for (i = 1; i <= dope_result.num_dims; i++) {
18146 bit_length = bit_length * dope_result.dim[i-1].extent;
18147 }
18148 bit_length = bit_length * dope_result.el_len;
18149
18150 if (char_len_in_bytes) {
18151 if (TYP_TYPE(type_idx) == Character) {
18152
18153 bit_length *= CHAR_BIT;
18154 }
18155 }
18156
18157 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
18158 TYP_TYPE(TYP_WORK_IDX) = Typeless;
18159 TYP_BIT_LEN(TYP_WORK_IDX) = bit_length;
18160 constant_type_idx = ntr_type_tbl();
18161
18162
18163 the_cn_idx = ntr_const_tbl(constant_type_idx,
18164 FALSE,
18165 (long_type *)(dope_result.base_addr));
18166
18167 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
18168 IR_COL_NUM(ir_idx),
18169 Shared, TRUE);
18170
18171 ATD_TYPE_IDX(tmp_idx) = type_idx;
18172 AT_SEMANTICS_DONE(tmp_idx)= TRUE;
18173
18174 for (i = 1; i <= dope_result.num_dims; i++) {
18175 OPND_FLD(shape_opnd) = CN_Tbl_Idx;
18176 OPND_IDX(shape_opnd) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
18177 dope_result.dim[i-1].extent);
18178
18179 OPND_LINE_NUM(shape_opnd) = IR_LINE_NUM(ir_idx);
18180 OPND_COL_NUM(shape_opnd) = IR_COL_NUM(ir_idx);
18181 SHAPE_WILL_FOLD_LATER(shape_opnd) = TRUE;
18182 SHAPE_FOLDABLE(shape_opnd) = TRUE;
18183 res_exp_desc->shape[i-1] = shape_opnd;
18184 }
18185
18186 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(res_exp_desc,
18187 IR_LINE_NUM(ir_idx),
18188 IR_COL_NUM(ir_idx));
18189
18190 ATD_SAVED(tmp_idx) = TRUE;
18191 ATD_DATA_INIT(tmp_idx) = TRUE;
18192 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STATIC_INIT_IDX(curr_scp_idx);
18193 ATD_FLD(tmp_idx) = CN_Tbl_Idx;
18194 ATD_TMP_IDX(tmp_idx) = the_cn_idx;
18195 ATD_TMP_INIT_NOT_DONE(tmp_idx) = TRUE;
18196
18197 OPND_IDX((*result_opnd)) = tmp_idx;
18198 OPND_FLD((*result_opnd)) = AT_Tbl_Idx;
18199 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
18200 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
18201
18202 if (insert_subs_ok) {
18203 if (res_exp_desc->rank) {
18204 ok = gen_whole_subscript(result_opnd, res_exp_desc);
18205 }
18206 else if (res_exp_desc->type == Character) {
18207 ok = gen_whole_substring(result_opnd, res_exp_desc->rank);
18208 }
18209 }
18210
18211 AT_REFERENCED(tmp_idx) = Referenced;
18212 AT_DEFINED(tmp_idx) = TRUE;
18213
18214 res_exp_desc->foldable = TRUE;
18215 res_exp_desc->tmp_reference = TRUE;
18216 }
18217 }
18218 else {
18219
18220
18221
18222
18223 res_exp_desc->foldable = FALSE;
18224 res_exp_desc->will_fold_later = FALSE;
18225
18226 io_item_must_flatten = TRUE;
18227
18228 if (arg_info_list[info_idx2].ed.type == Character &&
18229 (arg_info_list[info_idx2].ed.char_len.fld !=
18230 TYP_FLD(arg_info_list[info_idx2].ed.type_idx) ||
18231 arg_info_list[info_idx2].ed.char_len.idx !=
18232 TYP_IDX(arg_info_list[info_idx2].ed.type_idx) ||
18233 (IL_FLD(list_idx2) == IR_Tbl_Idx &&
18234 IR_OPR(IL_IDX(list_idx2)) == Concat_Opr))) {
18235
18236
18237
18238 loc_exp_desc.rank = 0;
18239
18240 if (IL_FLD(list_idx2) == IR_Tbl_Idx &&
18241 IR_OPR(IL_IDX(list_idx2)) == Concat_Opr) {
18242
18243 get_concat_len(IL_IDX(list_idx2), &length_opnd);
18244 }
18245 else {
18246 COPY_OPND(length_opnd, (arg_info_list[info_idx2].ed.char_len));
18247 }
18248
18249 save_xref_state = xref_state;
18250 xref_state = CIF_No_Usage_Rec;
18251 ok = expr_semantics(&length_opnd, &loc_exp_desc);
18252 xref_state = save_xref_state;
18253
18254 if (loc_exp_desc.constant) {
18255 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
18256
18257 TYP_TYPE(TYP_WORK_IDX) = Character;
18258 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE;
18259 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char;
18260 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx;
18261 TYP_IDX(TYP_WORK_IDX) = OPND_IDX(length_opnd);
18262 res_exp_desc->type_idx = ntr_type_tbl();
18263 res_exp_desc->type = Character;
18264 res_exp_desc->linear_type = CHARACTER_DEFAULT_TYPE;
18265 }
18266 else {
18267
18268 GEN_COMPILER_TMP_ASG(ch_asg_idx,
18269 tmp_idx,
18270 TRUE,
18271 IR_LINE_NUM(ir_idx),
18272 IR_COL_NUM(ir_idx),
18273 loc_exp_desc.type_idx,
18274 Priv);
18275
18276 COPY_OPND(IR_OPND_R(ch_asg_idx), length_opnd);
18277
18278 gen_sh(Before, Assignment_Stmt, stmt_start_line,
18279 stmt_start_col, FALSE, FALSE, TRUE);
18280
18281 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = ch_asg_idx;
18282 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
18283
18284 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
18285
18286 TYP_TYPE(TYP_WORK_IDX) = Character;
18287 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE;
18288 TYP_CHAR_CLASS(TYP_WORK_IDX) = Var_Len_Char;
18289 TYP_FLD(TYP_WORK_IDX) = AT_Tbl_Idx;
18290 TYP_IDX(TYP_WORK_IDX) = tmp_idx;
18291 TYP_ORIG_LEN_IDX(TYP_WORK_IDX) = tmp_idx;
18292 res_exp_desc->type_idx = ntr_type_tbl();
18293 res_exp_desc->type = Character;
18294 res_exp_desc->linear_type = CHARACTER_DEFAULT_TYPE;
18295 }
18296
18297 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = res_exp_desc->type_idx;
18298 arg_info_list[info_idx2].ed.type_idx = res_exp_desc->type_idx;
18299 arg_info_list[info_idx2].ed.char_len.fld =
18300 TYP_FLD(res_exp_desc->type_idx);
18301 arg_info_list[info_idx2].ed.char_len.idx =
18302 TYP_IDX(res_exp_desc->type_idx);
18303 }
18304
18305
18306 IR_LIST_CNT_R(ir_idx) = 3;
18307
18308 if (list_idx3 == NULL_IDX) {
18309 NTR_IR_LIST_TBL(new_idx);
18310 IL_INTRIN_PLACE_HOLDER(new_idx) = TRUE;
18311 IL_NEXT_LIST_IDX(list_idx2) = new_idx;
18312 IL_ARG_DESC_VARIANT(new_idx) = TRUE;
18313 }
18314 else {
18315 COPY_OPND(opnd, IL_OPND(list_idx3));
18316 cast_to_cg_default(&opnd, &(arg_info_list[info_idx3].ed));
18317 COPY_OPND(IL_OPND(list_idx3), opnd);
18318 }
18319
18320
18321 IR_TYPE_IDX(ir_idx) = type_idx;
18322 IR_RANK(ir_idx) = res_exp_desc->rank;
18323
18324 if (res_exp_desc->type == Character) {
18325 res_exp_desc->char_len.fld = TYP_FLD(res_exp_desc->type_idx);
18326 res_exp_desc->char_len.idx = TYP_IDX(res_exp_desc->type_idx);
18327 }
18328
18329 if (
18330 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
18331 FALSE &&
18332 # endif
18333 arg_info_list[info_idx1].ed.type != Character &&
18334 arg_info_list[info_idx2].ed.type != Character &&
18335 storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] ==
18336 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type] &&
18337 storage_bit_size_tbl[TYPELESS_DEFAULT_TYPE] ==
18338 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type] &&
18339 arg_info_list[info_idx1].ed.rank ==
18340 arg_info_list[info_idx2].ed.rank &&
18341 arg_info_list[info_idx2].ed.rank <= 1) {
18342
18343
18344
18345
18346
18347 if (!(list_idx3 != NULL_IDX &&
18348 IL_FLD(list_idx3) == CN_Tbl_Idx &&
18349 OPND_FLD(arg_info_list[info_idx1].ed.shape[0]) == CN_Tbl_Idx &&
18350 IL_IDX(list_idx3) !=
18351 OPND_IDX(arg_info_list[info_idx1].ed.shape[0]))) {
18352
18353 res_exp_desc->type = arg_info_list[info_idx2].ed.type;
18354 res_exp_desc->linear_type = arg_info_list[info_idx2].ed.linear_type;
18355 res_exp_desc->type_idx = arg_info_list[info_idx2].ed.type_idx;
18356
18357 COPY_OPND(res_exp_desc->shape[0],
18358 arg_info_list[info_idx1].ed.shape[0]);
18359
18360 or_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
18361 Bor_Opr, TYPELESS_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
18362 IR_COL_NUM(ir_idx),
18363 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
18364
18365 IR_OPR(ir_idx) = Cvrt_Opr;
18366 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
18367 IR_IDX_L(ir_idx) = or_idx;
18368 IR_OPND_R(ir_idx) = null_opnd;
18369 IR_TYPE_IDX(ir_idx) = res_exp_desc->type_idx;
18370 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
18371 }
18372 }
18373 }
18374
18375 TRACE (Func_Exit, "transfer_intrinsic", NULL);
18376
18377 }
18378
18379
18380
18381
18382
18383
18384
18385
18386
18387
18388
18389
18390
18391
18392
18393
18394
18395
18396
18397 void sizeof_intrinsic(opnd_type *result_opnd,
18398 expr_arg_type *res_exp_desc,
18399 int *spec_idx)
18400 {
18401 int ir_idx;
18402 int info_idx1;
18403 int cn_idx;
18404 long num;
18405
18406
18407 TRACE (Func_Entry, "sizeof_intrinsic", NULL);
18408
18409 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
18410 ir_idx = OPND_IDX((*result_opnd));
18411 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
18412
18413 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
18414
18415 conform_check(0,
18416 ir_idx,
18417 res_exp_desc,
18418 spec_idx,
18419 FALSE);
18420
18421 res_exp_desc->rank = 0;
18422 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
18423 IR_RANK(ir_idx) = res_exp_desc->rank;
18424
18425
18426
18427
18428 res_exp_desc->foldable = FALSE;
18429 res_exp_desc->will_fold_later = FALSE;
18430
18431 if (arg_info_list[info_idx1].ed.rank == 0 &&
18432 arg_info_list[info_idx1].ed.type != Character) {
18433
18434 num = storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] /
18435 CHAR_BIT;
18436
18437 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
18438
18439 OPND_IDX((*result_opnd)) = cn_idx;
18440 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
18441 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
18442 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
18443 res_exp_desc->constant = TRUE;
18444 res_exp_desc->foldable = TRUE;
18445 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
18446 }
18447
18448 TRACE (Func_Exit, "sizeof_intrinsic", NULL);
18449
18450 }
18451
18452
18453
18454
18455
18456
18457
18458
18459
18460
18461
18462
18463
18464
18465
18466
18467
18468
18469
18470
18471 void allocated_intrinsic(opnd_type *result_opnd,
18472 expr_arg_type *res_exp_desc,
18473 int *spec_idx)
18474 {
18475 int col;
18476 int dv_idx;
18477 int ir_idx;
18478 int info_idx1;
18479 int line;
18480 opnd_type opnd;
18481
18482
18483 TRACE (Func_Entry, "allocated_intrinsic", NULL);
18484
18485 has_present_opr = TRUE;
18486
18487 ir_idx = OPND_IDX((*result_opnd));
18488 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
18489 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
18490
18491 COPY_OPND(opnd, IL_OPND(IR_IDX_R(ir_idx)));
18492 line = IR_LINE_NUM(ir_idx);
18493 col = IR_COL_NUM(ir_idx);
18494
18495 conform_check(0,
18496 ir_idx,
18497 res_exp_desc,
18498 spec_idx,
18499 FALSE);
18500
18501 if (!arg_info_list[info_idx1].ed.allocatable) {
18502 PRINTMSG(arg_info_list[info_idx1].line, 833, Error,
18503 arg_info_list[info_idx1].col);
18504 }
18505
18506 res_exp_desc->rank = 0;
18507 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
18508
18509
18510 if (OPND_FLD(opnd) == IR_Tbl_Idx &&
18511 (IR_OPR(OPND_IDX(opnd)) == Substring_Opr ||
18512 IR_OPR(OPND_IDX(opnd)) == Whole_Substring_Opr)) {
18513
18514 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
18515 }
18516
18517 if (OPND_FLD(opnd) == IR_Tbl_Idx &&
18518 (IR_OPR(OPND_IDX(opnd)) == Whole_Subscript_Opr ||
18519 IR_OPR(OPND_IDX(opnd)) == Section_Subscript_Opr ||
18520 IR_OPR(OPND_IDX(opnd)) == Subscript_Opr)) {
18521
18522 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
18523 }
18524
18525 if (OPND_FLD(opnd) == IR_Tbl_Idx &&
18526 IR_OPR(OPND_IDX(opnd)) == Dv_Deref_Opr) {
18527 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
18528 }
18529
18530 dv_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
18531 Dv_Access_Assoc, CG_INTEGER_DEFAULT_TYPE, line, col,
18532 NO_Tbl_Idx, NULL_IDX);
18533
18534 ir_idx = gen_ir(IR_Tbl_Idx, dv_idx,
18535 Eq_Opr, LOGICAL_DEFAULT_TYPE, line, col,
18536 CN_Tbl_Idx, CN_INTEGER_ONE_IDX);
18537
18538 OPND_FLD((*result_opnd)) = IR_Tbl_Idx;
18539 OPND_IDX((*result_opnd)) = ir_idx;
18540
18541
18542
18543
18544 res_exp_desc->foldable = FALSE;
18545 res_exp_desc->will_fold_later = FALSE;
18546
18547 TRACE (Func_Exit, "allocted_intrinsic", NULL);
18548
18549 }
18550
18551
18552
18553
18554
18555
18556
18557
18558
18559
18560
18561
18562
18563
18564
18565
18566
18567
18568 void associated_intrinsic(opnd_type *result_opnd,
18569 expr_arg_type *res_exp_desc,
18570 int *spec_idx)
18571 {
18572 int col;
18573 int dv_idx;
18574 int info_idx1;
18575 int info_idx2;
18576 int ir_idx;
18577 int line;
18578 int list_idx1;
18579 int list_idx2;
18580 opnd_type opnd;
18581
18582
18583 TRACE (Func_Entry, "associated_intrinsic", NULL);
18584
18585 has_present_opr = TRUE;
18586
18587 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
18588 ir_idx = OPND_IDX((*result_opnd));
18589 list_idx1 = IR_IDX_R(ir_idx);
18590 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
18591 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
18592 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
18593
18594 conform_check(0,
18595 ir_idx,
18596 res_exp_desc,
18597 spec_idx,
18598 FALSE);
18599
18600 if (!arg_info_list[info_idx1].ed.pointer) {
18601 PRINTMSG(arg_info_list[info_idx1].line, 784, Error,
18602 arg_info_list[info_idx1].col);
18603 }
18604
18605 if (list_idx2 == NULL_IDX) {
18606
18607
18608 COPY_OPND(opnd, IL_OPND(list_idx1));
18609 line = IR_LINE_NUM(ir_idx);
18610 col = IR_COL_NUM(ir_idx);
18611
18612 res_exp_desc->rank = 0;
18613 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
18614
18615 if (OPND_FLD(opnd) == IR_Tbl_Idx &&
18616 (IR_OPR(OPND_IDX(opnd)) == Substring_Opr ||
18617 IR_OPR(OPND_IDX(opnd)) == Whole_Substring_Opr)) {
18618 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
18619 }
18620
18621 if (OPND_FLD(opnd) == IR_Tbl_Idx &&
18622 (IR_OPR(OPND_IDX(opnd)) == Whole_Subscript_Opr ||
18623 IR_OPR(OPND_IDX(opnd)) == Section_Subscript_Opr ||
18624 IR_OPR(OPND_IDX(opnd)) == Subscript_Opr)) {
18625 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
18626 }
18627
18628 if (OPND_FLD(opnd) == IR_Tbl_Idx &&
18629 IR_OPR(OPND_IDX(opnd)) == Dv_Deref_Opr) {
18630 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
18631 }
18632
18633 dv_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
18634 Dv_Access_Assoc, CG_INTEGER_DEFAULT_TYPE, line, col,
18635 NO_Tbl_Idx, NULL_IDX);
18636
18637 ir_idx = gen_ir(IR_Tbl_Idx, dv_idx,
18638 Eq_Opr, LOGICAL_DEFAULT_TYPE, line, col,
18639 CN_Tbl_Idx, CN_INTEGER_ONE_IDX);
18640
18641 OPND_FLD((*result_opnd)) = IR_Tbl_Idx;
18642 OPND_IDX((*result_opnd)) = ir_idx;
18643
18644 }
18645 else {
18646 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
18647
18648 if ((!arg_info_list[info_idx2].ed.pointer) &&
18649 (!arg_info_list[info_idx2].ed.target)) {
18650 PRINTMSG(arg_info_list[info_idx2].line, 783, Error,
18651 arg_info_list[info_idx2].col);
18652 }
18653
18654 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
18655 res_exp_desc->rank = 0;
18656 IR_RANK(ir_idx) = res_exp_desc->rank;
18657 }
18658
18659
18660
18661
18662 res_exp_desc->foldable = FALSE;
18663 res_exp_desc->will_fold_later = FALSE;
18664
18665 TRACE (Func_Exit, "associated_intrinsic", NULL);
18666
18667 }
18668
18669
18670
18671
18672
18673
18674
18675
18676
18677
18678
18679
18680
18681
18682
18683
18684
18685
18686 void reshape_intrinsic(opnd_type *result_opnd,
18687 expr_arg_type *res_exp_desc,
18688 int *spec_idx)
18689
18690 {
18691 int info_idx1;
18692 int info_idx2;
18693 #ifdef KEY
18694 int info_idx3 = 0;
18695 int info_idx4 = 0;
18696 #else
18697 int info_idx3;
18698 int info_idx4;
18699 #endif
18700 int ir_idx;
18701 int line;
18702 int col;
18703 int the_cn_idx;
18704 int cn_idx;
18705 int i;
18706 int tmp_idx;
18707 opnd_type new_opnd;
18708 int list_idx;
18709 int list_idx1;
18710 int list_idx2;
18711 int list_idx3;
18712 int list_idx4;
18713 int type_idx;
18714 int lhs_type;
18715 int rhs_type;
18716 int attr_idx;
18717 int constant_type_idx;
18718 long64 bit_length;
18719 int_dope_type dope_result;
18720 int_dope_type dope_1;
18721 int_dope_type dope_2;
18722 int_dope_type dope_3;
18723 int_dope_type dope_4;
18724 opnd_type opnd;
18725 opnd_type shape_opnd;
18726 int sub_idx;
18727 int left_idx;
18728 int left_fld;
18729 long64 rank;
18730 boolean fold_it;
18731 boolean optimize = TRUE;
18732 boolean ok;
18733 long64 vv;
18734 int valu1;
18735 long valu2;
18736 expr_arg_type exp_desc;
18737
18738
18739 TRACE (Func_Entry, "reshape_intrinsic", NULL);
18740
18741 ir_idx = OPND_IDX((*result_opnd));
18742 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
18743
18744 list_idx1 = IR_IDX_R(ir_idx);
18745 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
18746 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
18747 list_idx4 = IL_NEXT_LIST_IDX(list_idx3);
18748
18749 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
18750 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
18751
18752 type_idx = arg_info_list[info_idx1].ed.type_idx;
18753
18754 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
18755
18756 fold_it = arg_info_list[info_idx1].ed.foldable &&
18757 arg_info_list[info_idx2].ed.foldable;
18758
18759 if (arg_info_list[info_idx1].ed.rank < 1) {
18760 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
18761 arg_info_list[info_idx1].col);
18762 fold_it = FALSE;
18763 optimize = FALSE;
18764 }
18765
18766 conform_check(0,
18767 ir_idx,
18768 res_exp_desc,
18769 spec_idx,
18770 FALSE);
18771
18772 #ifdef KEY
18773
18774
18775
18776
18777
18778
18779
18780
18781
18782
18783
18784
18785
18786
18787
18788
18789
18790 #else
18791
18792
18793
18794
18795
18796
18797
18798 if (list_idx1 != NULL_IDX && IL_IDX(list_idx1) != NULL_IDX &&
18799 list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX &&
18800 list_idx3 != NULL_IDX && IL_IDX(list_idx3) == NULL_IDX &&
18801 list_idx4 != NULL_IDX && IL_IDX(list_idx4) == NULL_IDX) {
18802 if (IR_FLD_R(ir_idx) == IL_Tbl_Idx &&
18803 IL_FLD(list_idx1) == IR_Tbl_Idx &&
18804 IL_FLD(list_idx2) == IR_Tbl_Idx &&
18805 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx &&
18806 IR_FLD_L(IL_IDX(list_idx2)) == AT_Tbl_Idx &&
18807 AT_OBJ_CLASS(IR_IDX_L(IL_IDX(list_idx1))) == Data_Obj &&
18808 ATD_CLASS(IR_IDX_L(IL_IDX(list_idx1))) == Compiler_Tmp &&
18809 ATD_TMP_INIT_NOT_DONE(IR_IDX_L(IL_IDX(list_idx1)))) {
18810 rhs_type = TYP_LINEAR(ATD_TYPE_IDX(IR_IDX_L(IL_IDX(list_idx1))));
18811
18812 list_idx = IR_IDX_R(IL_IDX(list_idx2));
18813 list_idx = IL_IDX(list_idx);
18814 list_idx = IR_IDX_L(list_idx);
18815 list_idx = IL_NEXT_LIST_IDX(list_idx);
18816 if (IL_FLD(list_idx) == CN_Tbl_Idx) {
18817 rank = (long) CN_INT_TO_C(IL_IDX(list_idx));
18818 if (rank == 2 &&
18819 IR_OPR(SH_IR_IDX(curr_stmt_sh_idx)) == Asg_Opr) {
18820 left_idx = IR_IDX_L(SH_IR_IDX(curr_stmt_sh_idx));
18821 left_fld = IR_FLD_L(SH_IR_IDX(curr_stmt_sh_idx));
18822 lhs_type = TYP_LINEAR(IR_TYPE_IDX(left_idx));
18823 if (left_fld == IR_Tbl_Idx &&
18824 IR_RANK(left_idx) == rank &&
18825 rhs_type == lhs_type) {
18826 copy_subtree(&IR_OPND_L(SH_IR_IDX(curr_stmt_sh_idx)),
18827 &new_opnd);
18828 if (IR_FLD_L(OPND_IDX(new_opnd)) == AT_Tbl_Idx) {
18829 attr_idx = IR_IDX_L(OPND_IDX(new_opnd));
18830 IR_IDX_L(OPND_IDX(new_opnd)) = IR_IDX_L(IL_IDX(list_idx1));
18831 ATD_ARRAY_IDX(IR_IDX_L(IL_IDX(list_idx1))) =
18832 ATD_ARRAY_IDX(attr_idx);
18833
18834 # ifdef KEY
18835 int para_idx = IR_IDX_R(OPND_IDX(new_opnd));
18836 while (para_idx != NULL_IDX) {
18837 if (IL_FLD(para_idx) == CN_Tbl_Idx &&
18838 IL_IDX(para_idx) != CN_INTEGER_ONE_IDX)
18839 IL_IDX(para_idx) = CN_INTEGER_ONE_IDX;
18840 else if (IL_FLD(para_idx) != IR_Tbl_Idx || IR_OPR(IL_IDX(para_idx)) != Triplet_Opr){
18841 IL_FLD(para_idx) = CN_Tbl_Idx;
18842 IL_IDX(para_idx) = CN_INTEGER_ONE_IDX;
18843 }
18844 para_idx = IL_NEXT_LIST_IDX(para_idx);
18845 }
18846 # endif
18847 res_exp_desc->rank = 2;
18848 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
18849 fold_it = FALSE;
18850 OPND_IDX((*result_opnd)) = OPND_IDX(new_opnd);
18851 OPND_FLD((*result_opnd)) = OPND_FLD(new_opnd);
18852 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
18853 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
18854 }
18855 }
18856 }
18857 }
18858 }
18859 }
18860 #endif
18861
18862 if (OPND_FLD(arg_info_list[info_idx2].ed.shape[0]) == IR_Tbl_Idx) {
18863 PRINTMSG(arg_info_list[info_idx2].line, 1106, Error,
18864 arg_info_list[info_idx2].col);
18865
18866 res_exp_desc->rank = 0;
18867 fold_it = FALSE;
18868 optimize = FALSE;
18869 }
18870 else {
18871 res_exp_desc->rank = (long)
18872 CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx2].ed.shape[0]));
18873
18874 if (res_exp_desc->rank > MAX_NUM_DIMS) {
18875 PRINTMSG(arg_info_list[info_idx2].line, 1106, Error,
18876 arg_info_list[info_idx2].col);
18877
18878 res_exp_desc->rank = 0;
18879 fold_it = FALSE;
18880 optimize = FALSE;
18881 }
18882 else if (arg_info_list[info_idx2].ed.foldable) {
18883
18884
18885 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
18886
18887 # ifdef _DEBUG
18888 if (attr_idx == NULL_IDX ||
18889 AT_OBJ_CLASS(attr_idx) != Data_Obj ||
18890 ATD_CLASS(attr_idx) != Compiler_Tmp ||
18891 ATD_FLD(attr_idx) != CN_Tbl_Idx ||
18892 ATD_TMP_IDX(attr_idx) == NULL_IDX) {
18893
18894 PRINTMSG(arg_info_list[info_idx2].line, 626, Internal,
18895 arg_info_list[info_idx2].col,
18896 "array constant", "reshape_intrinsic");
18897 }
18898 # endif
18899
18900 NTR_IR_TBL(sub_idx);
18901 IR_OPR(sub_idx) = Subscript_Opr;
18902 IR_TYPE_IDX(sub_idx) = ATD_TYPE_IDX(attr_idx);
18903 IR_LINE_NUM(sub_idx) = line;
18904 IR_COL_NUM(sub_idx) = col;
18905
18906 IR_FLD_L(sub_idx) = AT_Tbl_Idx;
18907 IR_IDX_L(sub_idx) = attr_idx;
18908
18909 IR_FLD_R(sub_idx) = IL_Tbl_Idx;
18910 IR_LIST_CNT_R(sub_idx) = 1;
18911 NTR_IR_LIST_TBL(list_idx);
18912
18913 IR_IDX_R(sub_idx) = list_idx;
18914
18915 IL_FLD(list_idx) = CN_Tbl_Idx;
18916
18917 exp_desc = init_exp_desc;
18918 exp_desc.type_idx = ATD_TYPE_IDX(attr_idx);
18919 exp_desc.type = TYP_TYPE(exp_desc.type_idx);
18920 exp_desc.linear_type = TYP_LINEAR(exp_desc.type_idx);
18921 exp_desc.foldable = TRUE;
18922 exp_desc.constant = TRUE;
18923
18924 for (i = 0; i < res_exp_desc->rank; i++) {
18925 IL_IDX(list_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i+1);
18926
18927 OPND_FLD(opnd) = IR_Tbl_Idx;
18928 OPND_IDX(opnd) = sub_idx;
18929
18930 ok = fold_aggragate_expression(&opnd,
18931 &exp_desc,
18932 TRUE);
18933
18934 if (compare_cn_and_value(OPND_IDX(opnd), 0, Lt_Opr)) {
18935 PRINTMSG(arg_info_list[info_idx2].line, 1176, Error,
18936 arg_info_list[info_idx2].col);
18937
18938 fold_it = FALSE;
18939 optimize = FALSE;
18940 break;
18941 }
18942 }
18943
18944 FREE_IR_NODE(sub_idx);
18945 FREE_IR_LIST_NODE(list_idx);
18946 }
18947 }
18948
18949 switch (res_exp_desc->rank) {
18950 case 0: ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)) = NULL_IDX;
18951 break;
18952 case 1: ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)) = BD_DEFERRED_1_IDX;
18953 break;
18954 case 2: ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)) = BD_DEFERRED_2_IDX;
18955 break;
18956 case 3: ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)) = BD_DEFERRED_3_IDX;
18957 break;
18958 case 4: ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)) = BD_DEFERRED_4_IDX;
18959 break;
18960 case 5: ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)) = BD_DEFERRED_5_IDX;
18961 break;
18962 case 6: ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)) = BD_DEFERRED_6_IDX;
18963 break;
18964 case 7: ATD_ARRAY_IDX(ATP_RSLT_IDX(*spec_idx)) = BD_DEFERRED_7_IDX;
18965 break;
18966 }
18967
18968
18969 if (list_idx3 != NULL_IDX && IL_IDX(list_idx3) != NULL_IDX) {
18970 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
18971
18972 fold_it = fold_it && arg_info_list[info_idx3].ed.foldable;
18973
18974 if (arg_info_list[info_idx3].ed.rank < 1) {
18975 PRINTMSG(arg_info_list[info_idx3].line, 640, Error,
18976 arg_info_list[info_idx3].col);
18977 fold_it = FALSE;
18978 optimize = FALSE;
18979 }
18980 }
18981 else {
18982 if (fold_it) {
18983 valu2 = 1;
18984 for (i = 1; i <= res_exp_desc->rank; i++) {
18985 COPY_OPND(opnd, IL_OPND(list_idx2));
18986 vv = i;
18987 cn_idx = get_next_array_expr_element(&opnd, &vv);
18988 valu2 = valu2 * (long) CN_INT_TO_C(cn_idx);
18989 COPY_OPND(IL_OPND(list_idx2), opnd);
18990 }
18991
18992 valu1 = 1;
18993 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
18994 valu1 = valu1 * (long)
18995 CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx1].ed.shape[i-1]));
18996 }
18997
18998 if (valu1 < valu2) {
18999 PRINTMSG(arg_info_list[info_idx2].line, 1187, Error,
19000 arg_info_list[info_idx2].col);
19001 fold_it = FALSE;
19002 optimize = FALSE;
19003 }
19004 }
19005 }
19006
19007
19008 if (list_idx4 != NULL_IDX && IL_IDX(list_idx4) != NULL_IDX) {
19009 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
19010 fold_it = fold_it && arg_info_list[info_idx4].ed.foldable;
19011
19012 if (arg_info_list[info_idx4].ed.rank != 1) {
19013 PRINTMSG(arg_info_list[info_idx4].line, 654, Error,
19014 arg_info_list[info_idx4].col);
19015 fold_it = FALSE;
19016 optimize = FALSE;
19017 }
19018 }
19019
19020 #ifdef KEY
19021
19022
19023 if (TYP_CHAR_CLASS(arg_info_list[info_idx1].ed.type_idx) ==
19024 Assumed_Size_Char) {
19025 optimize = FALSE;
19026 }
19027 #endif
19028
19029 if (fold_it) {
19030
19031 COPY_OPND(opnd, IL_OPND(list_idx1));
19032 gen_internal_dope_vector(&dope_1,
19033 &opnd,
19034 FALSE,
19035 &arg_info_list[info_idx1].ed);
19036
19037
19038
19039
19040
19041
19042 tmp_idx = find_base_attr(&opnd, &line, &col);
19043
19044 if (AT_OBJ_CLASS(tmp_idx) == Data_Obj &&
19045 ATD_CLASS(tmp_idx) == Compiler_Tmp) {
19046
19047 AT_REFERENCED(tmp_idx) = Not_Referenced;
19048 }
19049
19050 COPY_OPND(opnd, IL_OPND(list_idx2));
19051 gen_internal_dope_vector(&dope_2,
19052 &opnd,
19053 FALSE,
19054 &arg_info_list[info_idx2].ed);
19055
19056
19057
19058
19059
19060
19061 tmp_idx = find_base_attr(&opnd, &line, &col);
19062
19063 if (AT_OBJ_CLASS(tmp_idx) == Data_Obj &&
19064 ATD_CLASS(tmp_idx) == Compiler_Tmp) {
19065
19066 AT_REFERENCED(tmp_idx) = Not_Referenced;
19067 }
19068
19069 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
19070
19071 gen_internal_dope_vector(&dope_result,
19072 &opnd,
19073 TRUE,
19074 &arg_info_list[info_idx1].ed);
19075
19076
19077 dope_result.num_dims = res_exp_desc->rank;
19078
19079 if ((IL_IDX(list_idx3) == NULL_IDX) && (IL_IDX(list_idx4) == NULL_IDX)) {
19080 if (folder_driver((char *)&dope_1,
19081 arg_info_list[info_idx1].ed.type_idx,
19082 (char *)&dope_2,
19083 arg_info_list[info_idx2].ed.type_idx,
19084 (long_type *)&dope_result,
19085 &type_idx,
19086 IR_LINE_NUM(ir_idx),
19087 IR_COL_NUM(ir_idx),
19088 4,
19089 Reshape_Opr,
19090 0L,
19091 0L,
19092 0L,
19093 0L)) {
19094 }
19095 }
19096 else if (IL_IDX(list_idx4) == NULL_IDX) {
19097
19098 COPY_OPND(opnd, IL_OPND(list_idx3));
19099 gen_internal_dope_vector(&dope_3,
19100 &opnd,
19101 FALSE,
19102 &arg_info_list[info_idx3].ed);
19103
19104
19105
19106
19107
19108
19109 tmp_idx = find_base_attr(&opnd, &line, &col);
19110
19111 if (AT_OBJ_CLASS(tmp_idx) == Data_Obj &&
19112 ATD_CLASS(tmp_idx) == Compiler_Tmp) {
19113
19114 AT_REFERENCED(tmp_idx) = Not_Referenced;
19115 }
19116
19117 if (folder_driver((char *)&dope_1,
19118 arg_info_list[info_idx1].ed.type_idx,
19119 (char *)&dope_2,
19120 arg_info_list[info_idx2].ed.type_idx,
19121 (long_type *)&dope_result,
19122 &type_idx,
19123 IR_LINE_NUM(ir_idx),
19124 IR_COL_NUM(ir_idx),
19125 4,
19126 Reshape_Opr,
19127 (char *)&dope_3,
19128 (long)arg_info_list[info_idx3].ed.type_idx,
19129 0L,
19130 0L)) {
19131 }
19132 }
19133 else if (IL_IDX(list_idx3) == NULL_IDX) {
19134
19135 COPY_OPND(opnd, IL_OPND(list_idx4));
19136 gen_internal_dope_vector(&dope_4,
19137 &opnd,
19138 FALSE,
19139 &arg_info_list[info_idx4].ed);
19140
19141
19142
19143
19144
19145
19146 tmp_idx = find_base_attr(&opnd, &line, &col);
19147
19148 if (AT_OBJ_CLASS(tmp_idx) == Data_Obj &&
19149 ATD_CLASS(tmp_idx) == Compiler_Tmp) {
19150
19151 AT_REFERENCED(tmp_idx) = Not_Referenced;
19152 }
19153
19154 if (folder_driver((char *)&dope_1,
19155 arg_info_list[info_idx1].ed.type_idx,
19156 (char *)&dope_2,
19157 arg_info_list[info_idx2].ed.type_idx,
19158 (long_type *)&dope_result,
19159 &type_idx,
19160 IR_LINE_NUM(ir_idx),
19161 IR_COL_NUM(ir_idx),
19162 4,
19163 Reshape_Opr,
19164 0L,
19165 0L,
19166 (char *)&dope_4,
19167 (long)arg_info_list[info_idx4].ed.type_idx)) {
19168 }
19169 }
19170 else {
19171 COPY_OPND(opnd, IL_OPND(list_idx3));
19172 gen_internal_dope_vector(&dope_3,
19173 &opnd,
19174 FALSE,
19175 &arg_info_list[info_idx3].ed);
19176
19177
19178
19179
19180
19181
19182 tmp_idx = find_base_attr(&opnd, &line, &col);
19183
19184 if (AT_OBJ_CLASS(tmp_idx) == Data_Obj &&
19185 ATD_CLASS(tmp_idx) == Compiler_Tmp) {
19186
19187 AT_REFERENCED(tmp_idx) = Not_Referenced;
19188 }
19189
19190 COPY_OPND(opnd, IL_OPND(list_idx4));
19191 gen_internal_dope_vector(&dope_4,
19192 &opnd,
19193 FALSE,
19194 &arg_info_list[info_idx4].ed);
19195
19196
19197
19198
19199
19200
19201 tmp_idx = find_base_attr(&opnd, &line, &col);
19202
19203 if (AT_OBJ_CLASS(tmp_idx) == Data_Obj &&
19204 ATD_CLASS(tmp_idx) == Compiler_Tmp) {
19205
19206 AT_REFERENCED(tmp_idx) = Not_Referenced;
19207 }
19208
19209 if (folder_driver((char *)&dope_1,
19210 arg_info_list[info_idx1].ed.type_idx,
19211 (char *)&dope_2,
19212 arg_info_list[info_idx2].ed.type_idx,
19213 (long_type *)&dope_result,
19214 &type_idx,
19215 IR_LINE_NUM(ir_idx),
19216 IR_COL_NUM(ir_idx),
19217 4,
19218 Reshape_Opr,
19219 (char *)&dope_3,
19220 (long)arg_info_list[info_idx3].ed.type_idx,
19221 (char *)&dope_4,
19222 (long)arg_info_list[info_idx4].ed.type_idx)) {
19223 }
19224 }
19225
19226 bit_length = 1;
19227 for (i = 1; i <= dope_result.num_dims; i++) {
19228 bit_length = bit_length * dope_result.dim[i-1].extent;
19229 }
19230 bit_length = bit_length * dope_result.el_len;
19231
19232 if (char_len_in_bytes) {
19233 if (TYP_TYPE(type_idx) == Character) {
19234
19235 bit_length *= CHAR_BIT;
19236 }
19237 }
19238
19239 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
19240 TYP_TYPE(TYP_WORK_IDX) = Typeless;
19241 TYP_BIT_LEN(TYP_WORK_IDX) = bit_length;
19242 constant_type_idx = ntr_type_tbl();
19243
19244
19245 the_cn_idx = ntr_const_tbl(constant_type_idx,
19246 FALSE,
19247 (long_type *)(dope_result.base_addr));
19248
19249 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
19250 IR_COL_NUM(ir_idx),
19251 Shared, TRUE);
19252
19253 ATD_TYPE_IDX(tmp_idx) = type_idx;
19254 AT_SEMANTICS_DONE(tmp_idx)= TRUE;
19255
19256 for (i = 1; i <= dope_result.num_dims; i++) {
19257 OPND_FLD(shape_opnd) = CN_Tbl_Idx;
19258 OPND_IDX(shape_opnd) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
19259 dope_result.dim[i-1].extent);
19260 OPND_LINE_NUM(shape_opnd) = IR_LINE_NUM(ir_idx);
19261 OPND_COL_NUM(shape_opnd) = IR_COL_NUM(ir_idx);
19262
19263 SHAPE_WILL_FOLD_LATER(shape_opnd) = TRUE;
19264 SHAPE_FOLDABLE(shape_opnd) = TRUE;
19265 res_exp_desc->shape[i-1] = shape_opnd;
19266 }
19267
19268 res_exp_desc->type = arg_info_list[info_idx1].ed.type;
19269 res_exp_desc->linear_type = arg_info_list[info_idx1].ed.linear_type;
19270 res_exp_desc->type_idx = arg_info_list[info_idx1].ed.type_idx;
19271
19272 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(res_exp_desc,
19273 IR_LINE_NUM(ir_idx),
19274 IR_COL_NUM(ir_idx));
19275
19276 ATD_SAVED(tmp_idx) = TRUE;
19277 ATD_DATA_INIT(tmp_idx) = TRUE;
19278 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STATIC_INIT_IDX(curr_scp_idx);
19279 ATD_FLD(tmp_idx) = CN_Tbl_Idx;
19280 ATD_TMP_IDX(tmp_idx) = the_cn_idx;
19281 ATD_TMP_INIT_NOT_DONE(tmp_idx) = TRUE;
19282
19283 OPND_IDX((*result_opnd)) = tmp_idx;
19284 OPND_FLD((*result_opnd)) = AT_Tbl_Idx;
19285 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
19286 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
19287
19288 if (insert_subs_ok) {
19289 if (res_exp_desc->rank) {
19290 ok = gen_whole_subscript(result_opnd, res_exp_desc);
19291 }
19292 else if (res_exp_desc->type == Character) {
19293 ok = gen_whole_substring(result_opnd, res_exp_desc->rank);
19294 }
19295 }
19296
19297 AT_REFERENCED(tmp_idx) = Referenced;
19298 AT_DEFINED(tmp_idx) = TRUE;
19299
19300 res_exp_desc->foldable = TRUE;
19301 res_exp_desc->tmp_reference = TRUE;
19302 }
19303 else if (! res_exp_desc->will_fold_later && optimize &&
19304 optimize_reshape(result_opnd, res_exp_desc)) {
19305 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
19306 }
19307
19308 IR_TYPE_IDX(ir_idx) = type_idx;
19309 IR_RANK(ir_idx) = res_exp_desc->rank;
19310
19311 if (res_exp_desc->type == Character) {
19312 res_exp_desc->char_len.fld = TYP_FLD(type_idx);
19313 res_exp_desc->char_len.idx = TYP_IDX(type_idx);
19314 }
19315
19316 TRACE (Func_Exit, "reshape_intrinsic", NULL);
19317
19318 }
19319
19320
19321
19322
19323
19324
19325
19326
19327
19328
19329
19330
19331
19332
19333
19334
19335
19336
19337 void mmx_intrinsic(opnd_type *result_opnd,
19338 expr_arg_type *res_exp_desc,
19339 int *spec_idx)
19340 {
19341 int ir_idx;
19342
19343
19344 TRACE (Func_Entry, "mmx_intrinsic", NULL);
19345
19346 ir_idx = OPND_IDX((*result_opnd));
19347 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
19348
19349 conform_check(0,
19350 ir_idx,
19351 res_exp_desc,
19352 spec_idx,
19353 FALSE);
19354
19355 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19356 IR_RANK(ir_idx) = res_exp_desc->rank;
19357 IR_OPR(ir_idx) = Mmx_Opr;
19358
19359 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
19360 IR_OPND_R(ir_idx) = null_opnd;
19361
19362
19363
19364
19365 res_exp_desc->foldable = FALSE;
19366 res_exp_desc->will_fold_later = FALSE;
19367
19368 TRACE (Func_Exit, "mmx_intrinsic", NULL);
19369
19370 }
19371
19372
19373
19374
19375
19376
19377
19378
19379
19380
19381
19382
19383
19384
19385
19386
19387
19388
19389 void mldmx_intrinsic(opnd_type *result_opnd,
19390 expr_arg_type *res_exp_desc,
19391 int *spec_idx)
19392 {
19393 int ir_idx;
19394
19395
19396 TRACE (Func_Entry, "mldmx_intrinsic", NULL);
19397
19398 ir_idx = OPND_IDX((*result_opnd));
19399 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
19400
19401 conform_check(0,
19402 ir_idx,
19403 res_exp_desc,
19404 spec_idx,
19405 FALSE);
19406
19407 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19408 IR_RANK(ir_idx) = res_exp_desc->rank;
19409 IR_OPR(ir_idx) = Mldmx_Opr;
19410
19411 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
19412 IR_OPND_R(ir_idx) = null_opnd;
19413
19414
19415
19416
19417 res_exp_desc->foldable = FALSE;
19418 res_exp_desc->will_fold_later = FALSE;
19419
19420 TRACE (Func_Exit, "mldmx_intrinsic", NULL);
19421
19422 }
19423
19424
19425
19426
19427
19428
19429
19430
19431
19432
19433
19434
19435
19436
19437
19438
19439
19440
19441 void mld_intrinsic(opnd_type *result_opnd,
19442 expr_arg_type *res_exp_desc,
19443 int *spec_idx)
19444 {
19445 int ir_idx;
19446
19447
19448 TRACE (Func_Entry, "mld_intrinsic", NULL);
19449
19450 ir_idx = OPND_IDX((*result_opnd));
19451 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
19452
19453 conform_check(0,
19454 ir_idx,
19455 res_exp_desc,
19456 spec_idx,
19457 FALSE);
19458
19459 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19460 IR_RANK(ir_idx) = res_exp_desc->rank;
19461 IR_OPR(ir_idx) = Mld_Opr;
19462
19463 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
19464 IR_OPND_R(ir_idx) = null_opnd;
19465
19466
19467
19468
19469 res_exp_desc->foldable = FALSE;
19470 res_exp_desc->will_fold_later = FALSE;
19471
19472 TRACE (Func_Exit, "mld_intrinsic", NULL);
19473
19474 }
19475
19476
19477
19478
19479
19480
19481
19482
19483
19484
19485
19486
19487
19488
19489
19490
19491
19492
19493 void mul_intrinsic(opnd_type *result_opnd,
19494 expr_arg_type *res_exp_desc,
19495 int *spec_idx)
19496 {
19497 int ir_idx;
19498
19499
19500 TRACE (Func_Entry, "mul_intrinsic", NULL);
19501
19502 ir_idx = OPND_IDX((*result_opnd));
19503 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
19504
19505 conform_check(0,
19506 ir_idx,
19507 res_exp_desc,
19508 spec_idx,
19509 FALSE);
19510
19511 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19512 IR_RANK(ir_idx) = res_exp_desc->rank;
19513 IR_OPR(ir_idx) = Mul_Opr;
19514
19515 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
19516 IR_OPND_R(ir_idx) = null_opnd;
19517
19518
19519
19520
19521 res_exp_desc->foldable = FALSE;
19522 res_exp_desc->will_fold_later = FALSE;
19523
19524 TRACE (Func_Exit, "mul_intrinsic", NULL);
19525
19526 }
19527
19528
19529
19530
19531
19532
19533
19534
19535
19536
19537
19538
19539
19540
19541
19542
19543
19544
19545 void mclr_intrinsic(opnd_type *result_opnd,
19546 expr_arg_type *res_exp_desc,
19547 int *spec_idx)
19548 {
19549 int ir_idx;
19550
19551
19552 TRACE (Func_Entry, "mclr_intrinsic", NULL);
19553
19554 ir_idx = OPND_IDX((*result_opnd));
19555 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
19556
19557 conform_check(0,
19558 ir_idx,
19559 res_exp_desc,
19560 spec_idx,
19561 FALSE);
19562
19563 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19564 IR_RANK(ir_idx) = res_exp_desc->rank;
19565 IR_OPR(ir_idx) = Mcbl_Opr;
19566
19567 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
19568 IR_OPND_R(ir_idx) = null_opnd;
19569
19570
19571
19572
19573 res_exp_desc->foldable = FALSE;
19574 res_exp_desc->will_fold_later = FALSE;
19575
19576 TRACE (Func_Exit, "mclr_intrinsic", NULL);
19577
19578 }
19579
19580
19581
19582
19583
19584
19585
19586
19587
19588
19589
19590
19591
19592
19593
19594
19595
19596
19597
19598 void unknown_intrinsic(opnd_type *result_opnd,
19599 expr_arg_type *res_exp_desc,
19600 int *spec_idx)
19601 {
19602 TRACE (Func_Entry, "unknown_intrinsic", NULL);
19603
19604 PRINTMSG(stmt_start_line, 937, Internal, stmt_start_col);
19605
19606 TRACE (Func_Exit, "unknown_intrinsic", NULL);
19607
19608 }
19609
19610 #ifdef KEY
19611
19612
19613
19614
19615
19616
19617
19618
19619
19620
19621
19622
19623
19624
19625
19626
19627 void time_intrinsic(opnd_type *result_opnd,
19628 expr_arg_type *res_exp_desc,
19629 int *spec_idx)
19630
19631 {
19632 int ir_idx;
19633 int type_idx;
19634
19635
19636 TRACE (Func_Entry, "time_intrinsic", NULL);
19637
19638 ir_idx = OPND_IDX((*result_opnd));
19639
19640 switch (ATP_INTRIN_ENUM(*spec_idx)) {
19641 case Time4_Intrinsic:
19642 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
19643 break;
19644 case Time8_Intrinsic:
19645 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
19646 break;
19647 }
19648
19649 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19650
19651 conform_check(0,
19652 ir_idx,
19653 res_exp_desc,
19654 spec_idx,
19655 FALSE);
19656
19657 IR_TYPE_IDX(ir_idx) = type_idx;
19658 IR_RANK(ir_idx) = res_exp_desc->rank;
19659 res_exp_desc->type_idx = type_idx;
19660 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
19661
19662
19663
19664
19665 res_exp_desc->foldable = FALSE;
19666 res_exp_desc->will_fold_later = FALSE;
19667
19668 TRACE (Func_Exit, "time_intrinsic", NULL);
19669
19670 }
19671
19672
19673
19674
19675
19676
19677
19678
19679
19680
19681
19682
19683
19684
19685
19686
19687 void fnum_intrinsic(opnd_type *result_opnd,
19688 expr_arg_type *res_exp_desc,
19689 int *spec_idx)
19690 {
19691 int ir_idx;
19692 int type_idx;
19693
19694
19695 TRACE (Func_Entry, "fnum_intrinsic", NULL);
19696
19697 ir_idx = OPND_IDX((*result_opnd));
19698 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
19699
19700 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19701
19702 conform_check(0,
19703 ir_idx,
19704 res_exp_desc,
19705 spec_idx,
19706 FALSE);
19707
19708 IR_TYPE_IDX(ir_idx) = type_idx;
19709 IR_RANK(ir_idx) = res_exp_desc->rank;
19710 res_exp_desc->type_idx = type_idx;
19711 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
19712
19713
19714
19715
19716 res_exp_desc->foldable = FALSE;
19717 res_exp_desc->will_fold_later = FALSE;
19718
19719 TRACE (Func_Exit, "fnum_intrinsic", NULL);
19720
19721 }
19722
19723
19724
19725
19726
19727
19728
19729
19730
19731
19732
19733
19734
19735
19736
19737
19738
19739 void dtime_intrinsic(opnd_type *result_opnd,
19740 expr_arg_type *res_exp_desc,
19741 int *spec_idx)
19742 {
19743 int ir_idx;
19744 int type_idx;
19745
19746
19747 TRACE (Func_Entry, "dtime_intrinsic", NULL);
19748
19749 ir_idx = OPND_IDX((*result_opnd));
19750 #ifdef KEY
19751
19752 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_4;
19753 #else
19754 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_8;
19755 #endif
19756
19757 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19758
19759 conform_check(0,
19760 ir_idx,
19761 res_exp_desc,
19762 spec_idx,
19763 FALSE);
19764
19765 IR_TYPE_IDX(ir_idx) = type_idx;
19766 IR_RANK(ir_idx) = res_exp_desc->rank;
19767 res_exp_desc->type_idx = type_idx;
19768 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
19769
19770
19771
19772
19773 res_exp_desc->foldable = FALSE;
19774 res_exp_desc->will_fold_later = FALSE;
19775
19776 TRACE (Func_Exit, "dtime_intrinsic", NULL);
19777
19778 }
19779
19780
19781
19782
19783
19784
19785
19786
19787
19788
19789
19790
19791
19792
19793
19794
19795 void stat_intrinsic(opnd_type *result_opnd,
19796 expr_arg_type *res_exp_desc,
19797 int *spec_idx)
19798 {
19799 int ir_idx;
19800 int type_idx;
19801 int cn_type_idx;
19802 int list_idx1;
19803 int list_idx2;
19804 int list_idx3;
19805 int info_idx1;
19806 int info_idx2;
19807
19808
19809 TRACE (Func_Entry, "stat_intrinsic", NULL);
19810
19811 ir_idx = OPND_IDX((*result_opnd));
19812 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
19813
19814 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19815
19816 list_idx1 = IR_IDX_R(ir_idx);
19817 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
19818 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
19819 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
19820
19821 conform_check(0,
19822 ir_idx,
19823 res_exp_desc,
19824 spec_idx,
19825 FALSE);
19826
19827 cn_type_idx = CN_TYPE_IDX(IL_IDX(list_idx1));
19828
19829 NTR_IR_LIST_TBL(list_idx3);
19830 IL_FLD(list_idx3) = CN_Tbl_Idx;
19831 IL_ARG_DESC_VARIANT(list_idx3) = TRUE;
19832 IL_LINE_NUM(list_idx3) = IL_LINE_NUM(list_idx1);
19833 IL_COL_NUM(list_idx3) = IL_COL_NUM(list_idx1);
19834 IL_NEXT_LIST_IDX(list_idx2) = IL_NEXT_LIST_IDX(list_idx3);
19835 IL_IDX(list_idx3) = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, CN_CONST(TYP_IDX(cn_type_idx)));
19836
19837 IR_TYPE_IDX(ir_idx) = type_idx;
19838 IR_RANK(ir_idx) = res_exp_desc->rank;
19839 res_exp_desc->type_idx = type_idx;
19840 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
19841
19842
19843
19844
19845 res_exp_desc->foldable = FALSE;
19846 res_exp_desc->will_fold_later = FALSE;
19847
19848 TRACE (Func_Exit, "stat_intrinsic", NULL);
19849
19850 }
19851
19852
19853
19854
19855
19856
19857
19858
19859
19860
19861
19862
19863
19864
19865
19866
19867 void signal_intrinsic(opnd_type *result_opnd,
19868 expr_arg_type *res_exp_desc,
19869 int *spec_idx)
19870 {
19871 int ir_idx;
19872 int type_idx;
19873
19874
19875 TRACE (Func_Entry, "signal_intrinsic", NULL);
19876
19877 ir_idx = OPND_IDX((*result_opnd));
19878 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
19879
19880 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19881
19882 conform_check(0,
19883 ir_idx,
19884 res_exp_desc,
19885 spec_idx,
19886 FALSE);
19887
19888 IR_TYPE_IDX(ir_idx) = type_idx;
19889 IR_RANK(ir_idx) = res_exp_desc->rank;
19890 res_exp_desc->type_idx = type_idx;
19891 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
19892
19893
19894
19895
19896 res_exp_desc->foldable = FALSE;
19897 res_exp_desc->will_fold_later = FALSE;
19898
19899 TRACE (Func_Exit, "sigal_intrinsic", NULL);
19900
19901 }
19902
19903
19904
19905
19906
19907
19908
19909
19910
19911
19912
19913
19914
19915
19916
19917
19918 void kill_intrinsic(opnd_type *result_opnd,
19919 expr_arg_type *res_exp_desc,
19920 int *spec_idx)
19921 {
19922 int ir_idx;
19923 int type_idx;
19924
19925
19926 TRACE (Func_Entry, "kill_intrinsic", NULL);
19927
19928 ir_idx = OPND_IDX((*result_opnd));
19929 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
19930
19931 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19932
19933 conform_check(0,
19934 ir_idx,
19935 res_exp_desc,
19936 spec_idx,
19937 FALSE);
19938
19939 IR_TYPE_IDX(ir_idx) = type_idx;
19940 IR_RANK(ir_idx) = res_exp_desc->rank;
19941 res_exp_desc->type_idx = type_idx;
19942 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
19943
19944
19945
19946
19947 res_exp_desc->foldable = FALSE;
19948 res_exp_desc->will_fold_later = FALSE;
19949
19950 TRACE (Func_Exit, "kill_intrinsic", NULL);
19951
19952 }
19953
19954
19955
19956
19957
19958
19959
19960
19961
19962
19963
19964
19965
19966
19967
19968
19969 void fstat_intrinsic(opnd_type *result_opnd,
19970 expr_arg_type *res_exp_desc,
19971 int *spec_idx)
19972 {
19973 int ir_idx;
19974 int type_idx;
19975 int list_idx1;
19976 int list_idx2;
19977 int info_idx1;
19978 int info_idx2;
19979
19980
19981
19982 TRACE (Func_Entry, "fstat_intrinsic", NULL);
19983
19984 ir_idx = OPND_IDX((*result_opnd));
19985 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
19986
19987 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
19988
19989 list_idx1 = IR_IDX_R(ir_idx);
19990 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
19991 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
19992 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
19993
19994 conform_check(0,
19995 ir_idx,
19996 res_exp_desc,
19997 spec_idx,
19998 FALSE);
19999
20000 IR_TYPE_IDX(ir_idx) = type_idx;
20001 IR_RANK(ir_idx) = res_exp_desc->rank;
20002 res_exp_desc->type_idx = type_idx;
20003 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
20004
20005
20006
20007
20008 res_exp_desc->foldable = FALSE;
20009 res_exp_desc->will_fold_later = FALSE;
20010
20011 TRACE (Func_Exit, "fstat_intrinsic", NULL);
20012
20013 }
20014 #endif
20015 #ifdef KEY
20016
20017
20018
20019
20020
20021
20022
20023
20024
20025
20026
20027
20028
20029
20030
20031
20032
20033
20034 void pathf90_intrinsic(opnd_type *result_opnd,
20035 expr_arg_type *res_exp_desc,
20036 int *spec_idx)
20037 {
20038 int ir_idx;
20039 int type_idx;
20040
20041 TRACE (Func_Entry, "pathf90_intrinsic", NULL);
20042
20043
20044 ir_idx = OPND_IDX((*result_opnd));
20045 if (ATP_PGM_UNIT(*spec_idx) == Function) {
20046 int return_value = ATP_RSLT_IDX(*spec_idx);
20047 type_idx = ATD_TYPE_IDX(return_value);
20048 if (type_idx == CHARACTER_DEFAULT_TYPE) {
20049 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
20050 TYP_TYPE(TYP_WORK_IDX) = Character;
20051 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE;
20052 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char;
20053 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx;
20054 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 24);
20055 type_idx = ntr_type_tbl();
20056
20057 res_exp_desc->type_idx = type_idx;
20058 res_exp_desc->char_len.fld = TYP_FLD(type_idx);
20059 res_exp_desc->char_len.idx = TYP_IDX(type_idx);
20060 }
20061 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
20062 }
20063 else {
20064 type_idx = TYPELESS_DEFAULT_TYPE;
20065 }
20066
20067 conform_check(0,
20068 ir_idx,
20069 res_exp_desc,
20070 spec_idx,
20071 FALSE);
20072
20073 IR_TYPE_IDX(ir_idx) = type_idx;
20074 IR_RANK(ir_idx) = res_exp_desc->rank;
20075 if (type_idx != TYPELESS_DEFAULT_TYPE) {
20076 res_exp_desc->type_idx = type_idx;
20077 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
20078 }
20079
20080
20081
20082
20083 res_exp_desc->foldable = FALSE;
20084 res_exp_desc->will_fold_later = FALSE;
20085
20086 TRACE (Func_Exit, "pathf90_intrinsic", NULL);
20087
20088 }
20089 #endif
20090 #ifdef KEY
20091 static void tf_intrinsic_helper(opnd_type *result_opnd,
20092 expr_arg_type *res_exp_desc,
20093 int *spec_idx,
20094 boolean generate_true)
20095 {
20096 int ir_idx;
20097
20098 TRACE (Func_Entry, "tf_intrinsic_helper", NULL);
20099
20100 ir_idx = OPND_IDX((*result_opnd));
20101 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
20102
20103 conform_check(0,
20104 ir_idx,
20105 res_exp_desc,
20106 spec_idx,
20107 FALSE);
20108
20109
20110 res_exp_desc->rank = 0;
20111
20112 long constant;
20113 OPND_IDX((*result_opnd)) = set_up_logical_constant(&constant,
20114 LOGICAL_DEFAULT_TYPE, generate_true ? TRUE_VALUE : FALSE_VALUE, TRUE);
20115 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
20116
20117
20118
20119
20120 res_exp_desc->foldable = FALSE;
20121 res_exp_desc->will_fold_later = FALSE;
20122
20123 TRACE (Func_Exit, "tf_intrinsic_helper", NULL);
20124
20125 }
20126
20127
20128 void true_intrinsic(opnd_type *result_opnd,
20129 expr_arg_type *res_exp_desc,
20130 int *spec_idx)
20131 {
20132 tf_intrinsic_helper(result_opnd, res_exp_desc, spec_idx, TRUE);
20133 }
20134
20135
20136
20137
20138 void support_uflow_intrinsic(opnd_type *result_opnd,
20139 expr_arg_type *res_exp_desc,
20140 int *spec_idx)
20141 {
20142 #ifdef TARG_X8664
20143 boolean generate_true = Target_SSE2 || Target_SSE3;
20144 #else
20145 boolean generate_true = TRUE;
20146 #endif
20147 tf_intrinsic_helper(result_opnd, res_exp_desc, spec_idx, generate_true);
20148 }
20149 #endif
